Avoid slowdown when using multiple masks

src/lib/merkle_ledger/any_ledger.ml

@@ -113,8 +113,6 @@ module Make_base (Inputs : Inputs_intf) :
 
     module Addr = Location.Addr
 
-    let remove_accounts_exn (T ((module Base), t)) = Base.remove_accounts_exn t
-
     let merkle_path_at_index_exn (T ((module Base), t)) =
       Base.merkle_path_at_index_exn t
 
@@ -184,8 +182,6 @@ module Make_base (Inputs : Inputs_intf) :
 
     let to_list_sequential (T ((module Base), t)) = Base.to_list_sequential t
 
-    let make_space_for (T ((module Base), t)) = Base.make_space_for t
-
     let get_all_accounts_rooted_at_exn (T ((module Base), t)) =
       Base.get_all_accounts_rooted_at_exn t
 

src/lib/merkle_ledger/base_ledger_intf.ml

@@ -143,8 +143,6 @@ module type S = sig
 
   val get_hash_batch_exn : t -> Location.t list -> hash list
 
-  val remove_accounts_exn : t -> account_id list -> unit
-
   (** Triggers when the ledger has been detached and should no longer be
       accessed.
   *)

src/lib/merkle_ledger/database.ml

@@ -30,8 +30,6 @@ module Make (Inputs : Inputs_intf) :
   module Db_error = struct
     type t = Account_location_not_found | Out_of_leaves | Malformed_database
     [@@deriving sexp]
-
-    exception Db_exception of t
   end
 
   module Path = Merkle_path.Make (Hash)
@@ -198,8 +196,6 @@ module Make (Inputs : Inputs_intf) :
     assert (Addr.depth address <= mdb.depth) ;
     set_bin mdb (Location.Hash address) Hash.bin_size_t Hash.bin_write_t hash
 
-  let make_space_for _t _tot = ()
-
   let get_generic mdb location =
     assert (Location.is_generic location) ;
     get_raw mdb location
@@ -245,8 +241,6 @@ module Make (Inputs : Inputs_intf) :
       |> get_generic_batch mdb
       |> List.map ~f:(Option.bind ~f:parse_location)
 
-    let delete mdb key = delete_raw mdb (build_location key)
-
     let set mdb key location =
       set_raw mdb (build_location key)
         (Location.serialize ~ledger_depth:mdb.depth location)
@@ -361,9 +355,6 @@ module Make (Inputs : Inputs_intf) :
           Account_id.Stable.Latest.bin_size_t
           Account_id.Stable.Latest.bin_write_t account_id
 
-      let remove (mdb : t) (token_id : Token_id.t) : unit =
-        delete_raw mdb (build_location token_id)
-
       let all_owners (t : t) : (Token_id.t * Account_id.t) Sequence.t =
         let deduped_tokens =
           (* First get the sequence of unique tokens *)
@@ -439,18 +430,10 @@ module Make (Inputs : Inputs_intf) :
          most accounts are not going to be managers. *)
       Owner.set mdb (Account_id.derive_token_id ~owner:aid) aid
 
-    let remove mdb pk tid = update mdb pk ~f:(fun tids -> Set.remove tids tid)
-
     let _remove_several mdb pk rem_tids =
       update mdb pk ~f:(fun tids ->
           Set.diff tids (Token_id.Set.of_list rem_tids) )
 
-    let remove_account (mdb : t) (aid : Account_id.t) : unit =
-      let token = Account_id.token_id aid in
-      let key = Account_id.public_key aid in
-      remove mdb key token ;
-      Owner.remove mdb (Account_id.derive_token_id ~owner:aid)
-
     (** Generate a batch of database changes to add the given tokens. *)
     let add_batch_create mdb pks_to_tokens =
       let pks_to_all_tokens =
@@ -661,32 +644,6 @@ module Make (Inputs : Inputs_intf) :
 
   let merkle_root mdb = get_hash mdb Location.root_hash
 
-  let remove_accounts_exn t keys =
-    let locations =
-      (* if we don't have a location for all keys, raise an exception *)
-      let rec loop keys accum =
-        match keys with
-        | [] ->
-            accum (* no need to reverse *)
-        | key :: rest -> (
-            match Account_location.get t key with
-            | Ok loc ->
-                loop rest (loc :: accum)
-            | Error err ->
-                raise (Db_error.Db_exception err) )
-      in
-      loop keys []
-    in
-    (* N.B.: we're not using stack database here to make available newly-freed
-       locations *)
-    List.iter keys ~f:(Account_location.delete t) ;
-    List.iter keys ~f:(Tokens.remove_account t) ;
-    List.iter locations ~f:(fun loc -> delete_raw t loc) ;
-    (* recalculate hashes for each removed account *)
-    List.iter locations ~f:(fun loc ->
-        let hash_loc = Location.Hash (Location.to_path_exn loc) in
-        set_hash t hash_loc Hash.empty_account )
-
   let merkle_path mdb location =
     let location =
       if Location.is_account location then
@@ -713,7 +670,9 @@ module Make (Inputs : Inputs_intf) :
       List.map locations ~f:Location.merkle_path_dependencies_exn
     in
     let all_locs =
-      List.map list_of_dependencies ~f:(fun deps -> List.map ~f:fst deps |> expand_query) |> List.concat
+      List.map list_of_dependencies ~f:(fun deps ->
+          List.map ~f:fst deps |> expand_query )
+      |> List.concat
     in
     let hashes = get_hash_batch_exn mdb all_locs in
     snd @@ List.fold_map ~init:hashes ~f:compute_path list_of_dependencies

src/lib/merkle_ledger/null_ledger.ml

@@ -39,10 +39,6 @@ end = struct
 
   let create ~depth () = { uuid = Uuid_unix.create (); depth }
 
-  let remove_accounts_exn _t keys =
-    if List.is_empty keys then ()
-    else failwith "remove_accounts_exn: null ledgers cannot be mutated"
-
   let empty_hash_at_height =
     Empty_hashes.extensible_cache (module Hash) ~init_hash:Hash.empty_account
 
@@ -151,8 +147,6 @@ end = struct
 
   let to_list_sequential _t = []
 
-  let make_space_for _t _tot = ()
-
   let get_all_accounts_rooted_at_exn t addr =
     let first_node, last_node =
       Addr.Range.subtree_range ~ledger_depth:t.depth addr

src/lib/merkle_ledger/syncable_intf.ml

@@ -30,6 +30,4 @@ module type S = sig
   val get_all_accounts_rooted_at_exn : t -> addr -> (addr * account) list
 
   val merkle_root : t -> root_hash
-
-  val make_space_for : t -> int -> unit
 end

src/lib/merkle_ledger_tests/test_database.ml

@@ -430,28 +430,6 @@ let%test_module "test functor on in memory databases" =
                 Stdlib.List.compare_lengths accounts retrieved_accounts = 0 ) ;
               assert (List.equal Account.equal accounts retrieved_accounts) )
 
-      let%test_unit "removing accounts restores Merkle root" =
-        Test.with_instance (fun mdb ->
-            let num_accounts = 5 in
-            let account_ids = Account_id.gen_accounts num_accounts in
-            let balances =
-              Quickcheck.random_value
-                (Quickcheck.Generator.list_with_length num_accounts Balance.gen)
-            in
-            let accounts =
-              List.map2_exn account_ids balances ~f:Account.create
-            in
-            let merkle_root0 = MT.merkle_root mdb in
-            List.iter accounts ~f:(fun account ->
-                ignore @@ create_new_account_exn mdb account ) ;
-            let merkle_root1 = MT.merkle_root mdb in
-            (* adding accounts should change the Merkle root *)
-            assert (not (Hash.equal merkle_root0 merkle_root1)) ;
-            MT.remove_accounts_exn mdb account_ids ;
-            (* should see original Merkle root after removing the accounts *)
-            let merkle_root2 = MT.merkle_root mdb in
-            assert (Hash.equal merkle_root2 merkle_root0) )
-
       let%test_unit "fold over account balances" =
         Test.with_instance (fun mdb ->
             let num_accounts = 5 in

src/lib/merkle_ledger_tests/test_mask.ml

@@ -420,82 +420,6 @@ module Make (Test : Test_intf) = struct
             Stdlib.List.compare_lengths base_accounts retrieved_accounts = 0 ) ;
           assert (List.equal Account.equal expected_accounts retrieved_accounts) )
 
-  let%test_unit "removing accounts from mask restores Merkle root" =
-    Test.with_instances (fun maskable mask ->
-        let attached_mask = Maskable.register_mask maskable mask in
-        let num_accounts = 5 in
-        let account_ids = Account_id.gen_accounts num_accounts in
-        let balances =
-          Quickcheck.random_value
-            (Quickcheck.Generator.list_with_length num_accounts Balance.gen)
-        in
-        let accounts = List.map2_exn account_ids balances ~f:Account.create in
-        let merkle_root0 = Mask.Attached.merkle_root attached_mask in
-        List.iter accounts ~f:(fun account ->
-            ignore @@ create_new_account_exn attached_mask account ) ;
-        let merkle_root1 = Mask.Attached.merkle_root attached_mask in
-        (* adding accounts should change the Merkle root *)
-        assert (not (Hash.equal merkle_root0 merkle_root1)) ;
-        Mask.Attached.remove_accounts_exn attached_mask account_ids ;
-        (* should see original Merkle root after removing the accounts *)
-        let merkle_root2 = Mask.Attached.merkle_root attached_mask in
-        assert (Hash.equal merkle_root2 merkle_root0) )
-
-  let%test_unit "removing accounts from parent restores Merkle root" =
-    Test.with_instances (fun maskable mask ->
-        let attached_mask = Maskable.register_mask maskable mask in
-        let num_accounts = 5 in
-        let account_ids = Account_id.gen_accounts num_accounts in
-        let balances =
-          Quickcheck.random_value
-            (Quickcheck.Generator.list_with_length num_accounts Balance.gen)
-        in
-        let accounts = List.map2_exn account_ids balances ~f:Account.create in
-        let merkle_root0 = Mask.Attached.merkle_root attached_mask in
-        (* add accounts to parent *)
-        List.iter accounts ~f:(fun account ->
-            ignore @@ parent_create_new_account_exn maskable account ) ;
-        (* observe Merkle root in mask *)
-        let merkle_root1 = Mask.Attached.merkle_root attached_mask in
-        (* adding accounts should change the Merkle root *)
-        assert (not (Hash.equal merkle_root0 merkle_root1)) ;
-        Mask.Attached.remove_accounts_exn attached_mask account_ids ;
-        (* should see original Merkle root after removing the accounts *)
-        let merkle_root2 = Mask.Attached.merkle_root attached_mask in
-        assert (Hash.equal merkle_root2 merkle_root0) )
-
-  let%test_unit "removing accounts from parent and mask restores Merkle root" =
-    Test.with_instances (fun maskable mask ->
-        let attached_mask = Maskable.register_mask maskable mask in
-        let num_accounts_parent = 5 in
-        let num_accounts_mask = 5 in
-        let num_accounts = num_accounts_parent + num_accounts_mask in
-        let account_ids = Account_id.gen_accounts num_accounts in
-        let balances =
-          Quickcheck.random_value
-            (Quickcheck.Generator.list_with_length num_accounts Balance.gen)
-        in
-        let accounts = List.map2_exn account_ids balances ~f:Account.create in
-        let parent_accounts, mask_accounts =
-          List.split_n accounts num_accounts_parent
-        in
-        let merkle_root0 = Mask.Attached.merkle_root attached_mask in
-        (* add accounts to parent *)
-        List.iter parent_accounts ~f:(fun account ->
-            ignore @@ parent_create_new_account_exn maskable account ) ;
-        (* add accounts to mask *)
-        List.iter mask_accounts ~f:(fun account ->
-            ignore @@ create_new_account_exn attached_mask account ) ;
-        (* observe Merkle root in mask *)
-        let merkle_root1 = Mask.Attached.merkle_root attached_mask in
-        (* adding accounts should change the Merkle root *)
-        assert (not (Hash.equal merkle_root0 merkle_root1)) ;
-        (* remove accounts from mask and parent *)
-        Mask.Attached.remove_accounts_exn attached_mask account_ids ;
-        (* should see original Merkle root after removing the accounts *)
-        let merkle_root2 = Mask.Attached.merkle_root attached_mask in
-        assert (Hash.equal merkle_root2 merkle_root0) )
-
   let%test_unit "fold of addition over account balances in parent and mask" =
     Test.with_instances (fun maskable mask ->
         let attached_mask = Maskable.register_mask maskable mask in
@@ -620,31 +544,6 @@ module Make (Test : Test_intf) = struct
         | `Added, _new_loc ->
             [%test_eq: Hash.t] start_hash (merkle_root ledger) )
 
-  let%test_unit "reuse of locations for removed accounts" =
-    Test.with_instances (fun maskable mask ->
-        let attached_mask = Maskable.register_mask maskable mask in
-        let num_accounts = 5 in
-        let account_ids = Account_id.gen_accounts num_accounts in
-        let balances =
-          Quickcheck.random_value
-            (Quickcheck.Generator.list_with_length num_accounts Balance.gen)
-        in
-        let accounts = List.map2_exn account_ids balances ~f:Account.create in
-        assert (
-          Option.is_none
-            (Mask.Attached.For_testing.current_location attached_mask) ) ;
-        (* add accounts to mask *)
-        List.iter accounts ~f:(fun account ->
-            ignore @@ create_new_account_exn attached_mask account ) ;
-        assert (
-          Option.is_some
-            (Mask.Attached.For_testing.current_location attached_mask) ) ;
-        (* remove accounts *)
-        Mask.Attached.remove_accounts_exn attached_mask account_ids ;
-        assert (
-          Option.is_none
-            (Mask.Attached.For_testing.current_location attached_mask) ) )
-
   let%test_unit "num_accounts for unique keys in mask and parent" =
     Test.with_instances (fun maskable mask ->
         let attached_mask = Maskable.register_mask maskable mask in
@@ -817,13 +716,18 @@ module Make_maskable_and_mask_with_depth (Depth : Depth_S) = struct
        and type hash := Hash.t
        and type unattached_mask := Mask.t
        and type attached_mask := Mask.Attached.t
-       and type t := Base.t = Merkle_mask.Maskable_merkle_tree.Make (struct
-    include Inputs
-    module Base = Base
-    module Mask = Mask
+       and type accumulated_t = Mask.accumulated_t
+       and type t := Base.t = struct
+    type accumulated_t = Mask.accumulated_t
 
-    let mask_to_base m = Any_base.cast (module Mask.Attached) m
-  end)
+    include Merkle_mask.Maskable_merkle_tree.Make (struct
+      include Inputs
+      module Base = Base
+      module Mask = Mask
+
+      let mask_to_base m = Any_base.cast (module Mask.Attached) m
+    end)
+  end
 
   (* test runner *)
   let with_instances f =

src/lib/merkle_mask/dune

@@ -24,9 +24,11 @@
    mina_stdlib
    direction
    empty_hashes
+   logger
  )
  (preprocess
   (pps
+    ppx_mina
     ppx_compare
     ppx_deriving.show
     ppx_deriving_yojson