From c3fcccfee8a938d3be5f90c06db6e42df3f64db3 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 22 Nov 2023 15:11:22 +0100 Subject: [PATCH 01/19] Small refactoring in Masking_merkle_tree --- src/lib/merkle_mask/masking_merkle_tree.ml | 109 +++++++++++---------- 1 file changed, 57 insertions(+), 52 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index b35ba1d6ad7..dc21cd839ca 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -38,16 +38,24 @@ module Make (Inputs : Inputs_intf.S) = struct let t_of_sexp (_ : Sexp.t) : t = Async.Ivar.create () end + type maps_t = + { mutable accounts : Account.t Location_binable.Map.t + ; mutable token_owners : Account_id.t Token_id.Map.t + ; mutable hashes : Hash.t Addr.Map.t + ; mutable locations : Location.t Account_id.Map.t + } + [@@deriving sexp] + + let maps_copy { accounts; token_owners; hashes; locations } = + { accounts; token_owners; hashes; locations } + type t = { uuid : Uuid.Stable.V1.t - ; accounts : Account.t Location_binable.Map.t ref - ; token_owners : Account_id.t Token_id.Map.t ref ; mutable parent : Parent.t ; detached_parent_signal : Detached_parent_signal.t - ; hashes : Hash.t Addr.Map.t ref - ; locations : Location.t Account_id.Map.t ref ; mutable current_location : Location.t option ; depth : int + ; maps : maps_t } [@@deriving sexp] @@ -57,12 +65,14 @@ module Make (Inputs : Inputs_intf.S) = struct { uuid = Uuid_unix.create () ; parent = Error __LOC__ ; detached_parent_signal = Async.Ivar.create () - ; accounts = ref Location_binable.Map.empty - ; token_owners = ref Token_id.Map.empty - ; hashes = ref Addr.Map.empty - ; locations = ref Account_id.Map.empty ; current_location = None ; depth + ; maps = + { accounts = Location_binable.Map.empty + ; token_owners = Token_id.Map.empty + ; hashes = Addr.Map.empty + ; locations = Account_id.Map.empty + } } let get_uuid { uuid; _ } = uuid @@ -132,13 +142,10 @@ module Make (Inputs : Inputs_intf.S) = struct let depth t = assert_is_attached t ; t.depth (* don't rely on a particular implementation *) - let self_find_hash t address = - assert_is_attached t ; - Map.find !(t.hashes) address + let self_find_hash t address = Map.find t.maps.hashes address let self_set_hash t address hash = - assert_is_attached t ; - t.hashes := Map.set !(t.hashes) ~key:address ~data:hash + t.maps.hashes <- Map.set t.maps.hashes ~key:address ~data:hash let set_inner_hash_at_addr_exn t address hash = assert_is_attached t ; @@ -146,13 +153,11 @@ module Make (Inputs : Inputs_intf.S) = struct self_set_hash t address hash (* don't rely on a particular implementation *) - let self_find_location t account_id = - assert_is_attached t ; - Map.find !(t.locations) account_id + let self_find_location t account_id = Map.find t.maps.locations account_id let self_set_location t account_id location = - assert_is_attached t ; - t.locations := Map.set !(t.locations) ~key:account_id ~data:location ; + t.maps.locations <- + Map.set t.maps.locations ~key:account_id ~data:location ; (* if account is at a hitherto-unused location, that becomes the current location *) @@ -164,13 +169,10 @@ module Make (Inputs : Inputs_intf.S) = struct t.current_location <- Some location (* don't rely on a particular implementation *) - let self_find_account t location = - assert_is_attached t ; - Map.find !(t.accounts) location + let self_find_account t location = Map.find t.maps.accounts location let self_set_account t location account = - assert_is_attached t ; - t.accounts := Map.set !(t.accounts) ~key:location ~data:account ; + t.maps.accounts <- Map.set t.maps.accounts ~key:location ~data:account ; self_set_location t (Account.identifier account) location (* a read does a lookup in the account_tbl; if that fails, delegate to @@ -332,7 +334,7 @@ module Make (Inputs : Inputs_intf.S) = struct let merkle_path_at_addr_exn t address = assert_is_attached t ; match - self_merkle_path ~depth:t.depth ~hashes:!(t.hashes) + self_merkle_path ~depth:t.depth ~hashes:t.maps.hashes ~current_location:t.current_location address with | Some path -> @@ -341,7 +343,7 @@ module Make (Inputs : Inputs_intf.S) = struct let parent_merkle_path = Base.merkle_path_at_addr_exn (get_parent t) address in - fixup_merkle_path ~hashes:!(t.hashes) parent_merkle_path ~address + fixup_merkle_path ~hashes:t.maps.hashes parent_merkle_path ~address let merkle_path_at_index_exn t index = merkle_path_at_addr_exn t (Addr.of_int_exn ~ledger_depth:t.depth index) @@ -355,8 +357,8 @@ module Make (Inputs : Inputs_intf.S) = struct let self_paths = List.map locations ~f:(fun location -> let address = Location.to_path_exn location in - self_lookup ~hashes:!(t.hashes) ~current_location:t.current_location - ~depth:t.depth address + self_lookup ~hashes:t.maps.hashes + ~current_location:t.current_location ~depth:t.depth address |> Option.value_map ~default:(Either.Second (location, address)) ~f:Either.first ) @@ -376,7 +378,8 @@ module Make (Inputs : Inputs_intf.S) = struct (parent_paths, path) | Either.Second (_, address) -> let path = - fixup_path ~hashes:!(t.hashes) ~address (List.hd_exn parent_paths) + fixup_path ~hashes:t.maps.hashes ~address + (List.hd_exn parent_paths) in (List.tl_exn parent_paths, path) in @@ -424,15 +427,15 @@ module Make (Inputs : Inputs_intf.S) = struct assert_is_attached t ; (* remove account and key from tables *) let account = Option.value_exn (self_find_account t location) in - t.accounts := Map.remove !(t.accounts) location ; + t.maps.accounts <- Map.remove t.maps.accounts location ; (* Update token info. *) let account_id = Account.identifier account in - t.token_owners := - Token_id.Map.remove !(t.token_owners) + t.maps.token_owners <- + Token_id.Map.remove t.maps.token_owners (Account_id.derive_token_id ~owner:account_id) ; (* TODO : use stack database to save unused location, which can be used when allocating a location *) - t.locations := Map.remove !(t.locations) account_id ; + t.maps.locations <- Map.remove t.maps.locations account_id ; (* reuse location if possible *) Option.iter t.current_location ~f:(fun curr_loc -> if Location.equal location curr_loc then @@ -457,8 +460,8 @@ module Make (Inputs : Inputs_intf.S) = struct self_set_account t location account ; (* Update token info. *) let account_id = Account.identifier account in - t.token_owners := - Map.set !(t.token_owners) + t.maps.token_owners <- + Map.set t.maps.token_owners ~key:(Account_id.derive_token_id ~owner:account_id) ~data:account_id @@ -543,10 +546,10 @@ module Make (Inputs : Inputs_intf.S) = struct let commit t = assert_is_attached t ; let old_root_hash = merkle_root t in - let account_data = Map.to_alist !(t.accounts) in + let account_data = Map.to_alist t.maps.accounts in Base.set_batch (get_parent t) account_data ; - t.accounts := Location_binable.Map.empty ; - t.hashes := Addr.Map.empty ; + t.maps.accounts <- Location_binable.Map.empty ; + t.maps.hashes <- Addr.Map.empty ; Debug_assert.debug_assert (fun () -> [%test_result: Hash.t] ~message: @@ -564,12 +567,9 @@ module Make (Inputs : Inputs_intf.S) = struct { uuid = Uuid_unix.create () ; parent = Ok (get_parent t) ; detached_parent_signal = Async.Ivar.create () - ; accounts = ref !(t.accounts) - ; token_owners = ref !(t.token_owners) - ; locations = ref !(t.locations) - ; hashes = ref !(t.hashes) ; current_location = t.current_location ; depth = t.depth + ; maps = maps_copy t.maps } let last_filled t = @@ -623,6 +623,7 @@ module Make (Inputs : Inputs_intf.S) = struct Option.value_exn (get_hash t (Location.to_path_exn location)) let set_raw_hash_batch t locations_and_hashes = + assert_is_attached t ; List.iter locations_and_hashes ~f:(fun (location, hash) -> self_set_hash t (Location.to_path_exn location) hash ) @@ -630,13 +631,14 @@ module Make (Inputs : Inputs_intf.S) = struct t.current_location <- Some last_location ; Mina_stdlib.Nonempty_list.iter account_to_location_list ~f:(fun (key, data) -> - t.locations := Map.set !(t.locations) ~key ~data ) + t.maps.locations <- Map.set t.maps.locations ~key ~data ) let set_raw_account_batch t locations_and_accounts = + assert_is_attached t ; List.iter locations_and_accounts ~f:(fun (location, account) -> let account_id = Account.identifier account in - t.token_owners := - Map.set !(t.token_owners) + t.maps.token_owners <- + Map.set t.maps.token_owners ~key:(Account_id.derive_token_id ~owner:account_id) ~data:account_id ; self_set_account t location account ) @@ -653,7 +655,7 @@ module Make (Inputs : Inputs_intf.S) = struct let token_owner t tid = assert_is_attached t ; - match Map.find !(t.token_owners) tid with + match Map.find t.maps.token_owners tid with | Some id -> Some id | None -> @@ -662,7 +664,7 @@ module Make (Inputs : Inputs_intf.S) = struct let token_owners (t : t) : Account_id.Set.t = assert_is_attached t ; let mask_owners = - Map.fold !(t.token_owners) ~init:Account_id.Set.empty + Map.fold t.maps.token_owners ~init:Account_id.Set.empty ~f:(fun ~key:_tid ~data:owner acc -> Set.add acc owner) in Set.union mask_owners (Base.token_owners (get_parent t)) @@ -670,7 +672,7 @@ module Make (Inputs : Inputs_intf.S) = struct let tokens t pk = assert_is_attached t ; let mask_tokens = - Map.keys !(t.locations) + Map.keys t.maps.locations |> List.filter_map ~f:(fun aid -> if Key.equal pk (Account_id.public_key aid) then Some (Account_id.token_id aid) @@ -801,9 +803,9 @@ module Make (Inputs : Inputs_intf.S) = struct as sometimes this is desired behavior *) let close t = assert_is_attached t ; - t.accounts := Location_binable.Map.empty ; - t.hashes := Addr.Map.empty ; - t.locations := Account_id.Map.empty ; + t.maps.accounts <- Location_binable.Map.empty ; + t.maps.hashes <- Addr.Map.empty ; + t.maps.locations <- Account_id.Map.empty ; Async.Ivar.fill_if_empty t.detached_parent_signal () let index_of_account_exn t key = @@ -847,7 +849,7 @@ module Make (Inputs : Inputs_intf.S) = struct let foldi_with_ignored_accounts t ignored_accounts ~init ~f = assert_is_attached t ; - let locations_and_accounts = Map.to_alist !(t.accounts) in + let locations_and_accounts = Map.to_alist t.maps.accounts in (* parent should ignore accounts in this mask *) let mask_accounts = List.map locations_and_accounts ~f:(fun (_loc, acct) -> @@ -891,9 +893,12 @@ module Make (Inputs : Inputs_intf.S) = struct module For_testing = struct let location_in_mask t location = + assert_is_attached t ; Option.is_some (self_find_account t location) - let address_in_mask t addr = Option.is_some (self_find_hash t addr) + let address_in_mask t addr = + assert_is_attached t ; + Option.is_some (self_find_hash t addr) let current_location t = t.current_location end From cb22e039fcf728fd90d9584a18f12334ad12f471 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 22 Nov 2023 17:22:32 +0100 Subject: [PATCH 02/19] Remove remove_accounts_exn from masking tree --- src/lib/merkle_ledger/any_ledger.ml | 2 - src/lib/merkle_ledger/base_ledger_intf.ml | 2 - src/lib/merkle_ledger/database.ml | 41 -------- src/lib/merkle_ledger/null_ledger.ml | 4 - src/lib/merkle_ledger_tests/test_database.ml | 22 ---- src/lib/merkle_ledger_tests/test_mask.ml | 101 ------------------- src/lib/merkle_mask/masking_merkle_tree.ml | 32 ------ src/lib/mina_base/ledger_intf.ml | 2 - src/lib/mina_base/sparse_ledger_base.ml | 3 - 9 files changed, 209 deletions(-) diff --git a/src/lib/merkle_ledger/any_ledger.ml b/src/lib/merkle_ledger/any_ledger.ml index 0541f47acbd..2fd41f8573e 100644 --- a/src/lib/merkle_ledger/any_ledger.ml +++ b/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 diff --git a/src/lib/merkle_ledger/base_ledger_intf.ml b/src/lib/merkle_ledger/base_ledger_intf.ml index f85caa808b5..74c13db4376 100644 --- a/src/lib/merkle_ledger/base_ledger_intf.ml +++ b/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. *) diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index ec1e2c1e856..7763f03835c 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/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) @@ -245,8 +243,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 +357,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 +432,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 +646,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 diff --git a/src/lib/merkle_ledger/null_ledger.ml b/src/lib/merkle_ledger/null_ledger.ml index 644dbfc9a5c..8939ee5262f 100644 --- a/src/lib/merkle_ledger/null_ledger.ml +++ b/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 diff --git a/src/lib/merkle_ledger_tests/test_database.ml b/src/lib/merkle_ledger_tests/test_database.ml index a5bd751d866..70c21a828d3 100644 --- a/src/lib/merkle_ledger_tests/test_database.ml +++ b/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 diff --git a/src/lib/merkle_ledger_tests/test_mask.ml b/src/lib/merkle_ledger_tests/test_mask.ml index f273f52d798..4d59d339c50 100644 --- a/src/lib/merkle_ledger_tests/test_mask.ml +++ b/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 diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index dc21cd839ca..6f76bb40fe9 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -767,38 +767,6 @@ module Make (Inputs : Inputs_intf.S) = struct assert (Addr.depth address <= t.depth) ; get_hash t address |> Option.value_exn - let remove_accounts_exn t keys = - assert_is_attached t ; - let rec loop keys parent_keys mask_locations = - match keys with - | [] -> - (parent_keys, mask_locations) - | key :: rest -> ( - match self_find_location t key with - | None -> - loop rest (key :: parent_keys) mask_locations - | Some loc -> - loop rest parent_keys (loc :: mask_locations) ) - in - (* parent_keys not in mask, may be in parent mask_locations definitely in - mask *) - let parent_keys, mask_locations = loop keys [] [] in - (* allow call to parent to raise an exception if raised, the parent - hasn't removed any accounts, and we don't try to remove any accounts - from mask *) - Base.remove_accounts_exn (get_parent t) parent_keys ; - (* removing accounts in parent succeeded, so proceed with removing - accounts from mask we sort mask locations in reverse order, - potentially allowing reuse of locations *) - let rev_sorted_mask_locations = - List.sort mask_locations ~compare:(fun loc1 loc2 -> - let loc1 = Location.to_path_exn loc1 in - let loc2 = Location.to_path_exn loc2 in - Location.Addr.compare loc2 loc1 ) - in - List.iter rev_sorted_mask_locations - ~f:(remove_account_and_update_hashes t) - (* Destroy intentionally does not commit before destroying as sometimes this is desired behavior *) let close t = diff --git a/src/lib/mina_base/ledger_intf.ml b/src/lib/mina_base/ledger_intf.ml index 1e86851eda2..8d020da799e 100644 --- a/src/lib/mina_base/ledger_intf.ml +++ b/src/lib/mina_base/ledger_intf.ml @@ -21,8 +21,6 @@ module type S = sig val create_new_account : t -> Account_id.t -> Account.t -> unit Or_error.t - val remove_accounts_exn : t -> Account_id.t list -> unit - val merkle_root : t -> Ledger_hash.t val with_ledger : depth:int -> f:(t -> 'a) -> 'a diff --git a/src/lib/mina_base/sparse_ledger_base.ml b/src/lib/mina_base/sparse_ledger_base.ml index d8fe3128431..791bf7185cd 100644 --- a/src/lib/mina_base/sparse_ledger_base.ml +++ b/src/lib/mina_base/sparse_ledger_base.ml @@ -111,9 +111,6 @@ module L = struct let create_new_account t id to_set = get_or_create_account t id to_set |> Or_error.map ~f:ignore - let remove_accounts_exn : t -> Account_id.t list -> unit = - fun _t _xs -> failwith "remove_accounts_exn: not implemented" - let merkle_root : t -> Ledger_hash.t = fun t -> M.merkle_root !t let with_ledger : depth:int -> f:(t -> 'a) -> 'a = From b90eab438e8e3d59195034ed6a2ac2d93fcd0730 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 22 Nov 2023 17:41:05 +0100 Subject: [PATCH 03/19] Remove make_space_for --- src/lib/merkle_ledger/any_ledger.ml | 2 -- src/lib/merkle_ledger/database.ml | 2 -- src/lib/merkle_ledger/null_ledger.ml | 2 -- src/lib/merkle_ledger/syncable_intf.ml | 2 -- src/lib/merkle_mask/masking_merkle_tree.ml | 4 ---- src/lib/syncable_ledger/syncable_ledger.ml | 1 - 6 files changed, 13 deletions(-) diff --git a/src/lib/merkle_ledger/any_ledger.ml b/src/lib/merkle_ledger/any_ledger.ml index 2fd41f8573e..147fa13e03a 100644 --- a/src/lib/merkle_ledger/any_ledger.ml +++ b/src/lib/merkle_ledger/any_ledger.ml @@ -182,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 diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index 7763f03835c..4e0ff038537 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -196,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 diff --git a/src/lib/merkle_ledger/null_ledger.ml b/src/lib/merkle_ledger/null_ledger.ml index 8939ee5262f..e9e511f15c2 100644 --- a/src/lib/merkle_ledger/null_ledger.ml +++ b/src/lib/merkle_ledger/null_ledger.ml @@ -147,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 diff --git a/src/lib/merkle_ledger/syncable_intf.ml b/src/lib/merkle_ledger/syncable_intf.ml index 6d9d74fe510..7665106793d 100644 --- a/src/lib/merkle_ledger/syncable_intf.ml +++ b/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 diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 6f76bb40fe9..6822fdc0f44 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -758,10 +758,6 @@ module Make (Inputs : Inputs_intf.S) = struct set_account_unsafe t location account ) (* not needed for in-memory mask; in the database, it's currently a NOP *) - let make_space_for t = - assert_is_attached t ; - Base.make_space_for (get_parent t) - let get_inner_hash_at_addr_exn t address = assert_is_attached t ; assert (Addr.depth address <= t.depth) ; diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index ba7654d3f1b..a5db250cda5 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -525,7 +525,6 @@ end = struct (* FIXME: bug when height=0 https://github.com/o1-labs/nanobit/issues/365 *) let actual = complete_with_empties content_hash height (MT.depth t.tree) in if Hash.equal actual rh then ( - MT.make_space_for t.tree n ; Addr.Table.clear t.waiting_parents ; (* We should use this information to set the empty account slots empty and start syncing at the content root. See #1972. *) From 833003ba0877b071b735ed3b0058964c4250a5aa Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 22 Nov 2023 18:26:28 +0100 Subject: [PATCH 04/19] Simplify self_xxx functions --- src/lib/merkle_mask/masking_merkle_tree.ml | 36 +++++++++------------- 1 file changed, 14 insertions(+), 22 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 6822fdc0f44..8228f6379a4 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -141,9 +141,6 @@ module Make (Inputs : Inputs_intf.S) = struct let depth t = assert_is_attached t ; t.depth - (* don't rely on a particular implementation *) - let self_find_hash t address = Map.find t.maps.hashes address - let self_set_hash t address hash = t.maps.hashes <- Map.set t.maps.hashes ~key:address ~data:hash @@ -152,9 +149,6 @@ module Make (Inputs : Inputs_intf.S) = struct assert (Addr.depth address <= t.depth) ; self_set_hash t address hash - (* don't rely on a particular implementation *) - let self_find_location t account_id = Map.find t.maps.locations account_id - let self_set_location t account_id location = t.maps.locations <- Map.set t.maps.locations ~key:account_id ~data:location ; @@ -168,9 +162,6 @@ module Make (Inputs : Inputs_intf.S) = struct if Location.( > ) location loc then t.current_location <- Some location - (* don't rely on a particular implementation *) - let self_find_account t location = Map.find t.maps.accounts location - let self_set_account t location account = t.maps.accounts <- Map.set t.maps.accounts ~key:location ~data:account ; self_set_location t (Account.identifier account) location @@ -179,7 +170,7 @@ module Make (Inputs : Inputs_intf.S) = struct parent *) let get t location = assert_is_attached t ; - match self_find_account t location with + match Map.find t.maps.accounts location with | Some account -> Some account | None -> @@ -218,7 +209,7 @@ module Make (Inputs : Inputs_intf.S) = struct let get_batch t = let self_find id = - let res = self_find_account t id in + let res = Map.find t.maps.accounts id in let res = if Option.is_none res then let is_empty = @@ -417,7 +408,7 @@ module Make (Inputs : Inputs_intf.S) = struct (* use mask Merkle root, if it exists, else get from parent *) let merkle_root t = assert_is_attached t ; - match self_find_hash t (Addr.root ()) with + match Map.find t.maps.hashes (Addr.root ()) with | Some hash -> hash | None -> @@ -426,7 +417,7 @@ module Make (Inputs : Inputs_intf.S) = struct let remove_account_and_update_hashes t location = assert_is_attached t ; (* remove account and key from tables *) - let account = Option.value_exn (self_find_account t location) in + let account = Option.value_exn (Map.find t.maps.accounts location) in t.maps.accounts <- Map.remove t.maps.accounts location ; (* Update token info. *) let account_id = Account.identifier account in @@ -485,11 +476,11 @@ module Make (Inputs : Inputs_intf.S) = struct if the account in the parent is the same in the mask *) let parent_set_notify t account = assert_is_attached t ; - match self_find_location t (Account.identifier account) with + match Map.find t.maps.locations (Account.identifier account) with | None -> () | Some location -> ( - match self_find_account t location with + match Map.find t.maps.accounts location with | Some existing_account -> if Account.equal account existing_account then remove_account_and_update_hashes t location @@ -500,7 +491,7 @@ module Make (Inputs : Inputs_intf.S) = struct parent *) let get_hash t addr = assert_is_attached t ; - match self_find_hash t addr with + match Map.find t.maps.hashes addr with | Some hash -> Some hash | None -> ( @@ -520,7 +511,7 @@ module Make (Inputs : Inputs_intf.S) = struct assert_is_attached t ; let self_hashes_rev = List.rev_map locations ~f:(fun location -> - (location, self_find_hash t (Location.to_path_exn location)) ) + (location, Map.find t.maps.hashes (Location.to_path_exn location)) ) in let parent_locations_rev = List.filter_map self_hashes_rev ~f:(fun (location, hash) -> @@ -696,7 +687,7 @@ module Make (Inputs : Inputs_intf.S) = struct let location_of_account t account_id = assert_is_attached t ; - let mask_result = self_find_location t account_id in + let mask_result = Map.find t.maps.locations account_id in match mask_result with | Some _ -> mask_result @@ -705,7 +696,8 @@ module Make (Inputs : Inputs_intf.S) = struct let location_of_account_batch t = self_find_or_batch_lookup - (fun id -> (id, Option.map ~f:Option.some @@ self_find_location t id)) + (fun id -> + (id, Option.map ~f:Option.some @@ Map.find t.maps.locations id) ) Base.location_of_account_batch t (* Adds specified accounts to the mask by laoding them from parent ledger. @@ -858,11 +850,11 @@ module Make (Inputs : Inputs_intf.S) = struct module For_testing = struct let location_in_mask t location = assert_is_attached t ; - Option.is_some (self_find_account t location) + Option.is_some (Map.find t.maps.accounts location) let address_in_mask t addr = assert_is_attached t ; - Option.is_some (self_find_hash t addr) + Option.is_some (Map.find t.maps.hashes addr) let current_location t = t.current_location end @@ -881,7 +873,7 @@ module Make (Inputs : Inputs_intf.S) = struct (* NB: updates the mutable current_location field in t *) let get_or_create_account t account_id account = assert_is_attached t ; - match self_find_location t account_id with + match Map.find t.maps.locations account_id with | None -> ( (* not in mask, maybe in parent *) match Base.location_of_account (get_parent t) account_id with From aed3521c49338b17211ad01d4e9bf2035b247135 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 22 Nov 2023 20:50:43 +0100 Subject: [PATCH 05/19] Prototype of optimizing lookups over masks Problem: 290 layers of masking trees makes processing of transactions to be O(290*logn) where n is the size of a mask. This 290x factor is a significant slowdown Solution: have a mechanism to replace O(290*logn) to something around O(30*logn). This PR is prototype, without logic integrated into frontier handling --- src/lib/merkle_mask/maskable_merkle_tree.ml | 4 +- .../merkle_mask/maskable_merkle_tree_intf.ml | 5 +- src/lib/merkle_mask/masking_merkle_tree.ml | 165 +++++++++++------- .../merkle_mask/masking_merkle_tree_intf.ml | 7 +- src/lib/mina_ledger/ledger.ml | 6 +- src/lib/mina_ledger/ledger.mli | 5 +- 6 files changed, 126 insertions(+), 66 deletions(-) diff --git a/src/lib/merkle_mask/maskable_merkle_tree.ml b/src/lib/merkle_mask/maskable_merkle_tree.ml index 45235a1970a..b4115b2ff2c 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree.ml @@ -144,8 +144,8 @@ module Make (Inputs : Inputs_intf) = struct let unsafe_preload_accounts_from_parent = Mask.Attached.unsafe_preload_accounts_from_parent - let register_mask t mask = - let attached_mask = Mask.set_parent mask t in + let register_mask ?accumulated t mask = + let attached_mask = Mask.set_parent ?accumulated mask t in List.iter (Uuid.Table.data registered_masks) ~f:(fun ms -> List.iter ms ~f:(fun m -> [%test_result: bool] diff --git a/src/lib/merkle_mask/maskable_merkle_tree_intf.ml b/src/lib/merkle_mask/maskable_merkle_tree_intf.ml index aa447ab9d1c..d452fe01a19 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree_intf.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree_intf.ml @@ -8,12 +8,15 @@ module type S = sig type attached_mask + type accumulated_t + (* registering a mask makes it an active child of the parent Merkle tree - reads to the mask that fail are delegated to the parent - writes to the parent notify the child mask *) - val register_mask : t -> unattached_mask -> attached_mask + val register_mask : + ?accumulated:accumulated_t -> t -> unattached_mask -> attached_mask val unsafe_preload_accounts_from_parent : attached_mask -> account_id list -> unit diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 8228f6379a4..3d6f3db129f 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -49,6 +49,8 @@ module Make (Inputs : Inputs_intf.S) = struct let maps_copy { accounts; token_owners; hashes; locations } = { accounts; token_owners; hashes; locations } + type accumulated_t = { accumulated_maps : maps_t; ancestor : Base.t } + type t = { uuid : Uuid.Stable.V1.t ; mutable parent : Parent.t @@ -56,6 +58,10 @@ module Make (Inputs : Inputs_intf.S) = struct ; mutable current_location : Location.t option ; depth : int ; maps : maps_t + (* If present, contains maps containing changes both for this mask + and for a few ancestors. + This is used as a lookup cache. *) + ; mutable accumulated : (accumulated_t[@sexp.opaque]) option } [@@deriving sexp] @@ -67,6 +73,7 @@ module Make (Inputs : Inputs_intf.S) = struct ; detached_parent_signal = Async.Ivar.create () ; current_location = None ; depth + ; accumulated = None ; maps = { accounts = Location_binable.Map.empty ; token_owners = Token_id.Map.empty @@ -104,6 +111,15 @@ module Make (Inputs : Inputs_intf.S) = struct Dangling_parent_reference of Uuid.t * (* Location where null was set*) string + let to_accumulated t = + match (t.accumulated, t.parent) with + | Some { accumulated_maps; ancestor }, _ -> + { ancestor; accumulated_maps = maps_copy accumulated_maps } + | None, Ok ancestor -> + { ancestor; accumulated_maps = maps_copy t.maps } + | None, Error loc -> + raise (Dangling_parent_reference (t.uuid, loc)) + let create () = failwith "Mask.Attached.create: cannot create an attached mask; use Mask.create \ @@ -117,6 +133,7 @@ module Make (Inputs : Inputs_intf.S) = struct let unset_parent ?(trigger_signal = true) ~loc t = assert (Result.is_ok t.parent) ; t.parent <- Error loc ; + t.accumulated <- None ; if trigger_signal then Async.Ivar.fill_if_empty t.detached_parent_signal () ; t @@ -133,6 +150,13 @@ module Make (Inputs : Inputs_intf.S) = struct let get_parent ({ parent = opt; _ } as t) = assert_is_attached t ; Result.ok_or_failwith opt + let maps_and_ancestor t = + match t.accumulated with + | Some { accumulated_maps; ancestor } -> + (accumulated_maps, ancestor) + | None -> + (t.maps, get_parent t) + let get_uuid t = assert_is_attached t ; t.uuid let get_directory t = @@ -141,8 +165,13 @@ module Make (Inputs : Inputs_intf.S) = struct let depth t = assert_is_attached t ; t.depth + let update_maps ~f t = + f t.maps ; + Option.iter t.accumulated ~f:(fun { accumulated_maps = ms; _ } -> f ms) + let self_set_hash t address hash = - t.maps.hashes <- Map.set t.maps.hashes ~key:address ~data:hash + update_maps t ~f:(fun maps -> + maps.hashes <- Map.set maps.hashes ~key:address ~data:hash ) let set_inner_hash_at_addr_exn t address hash = assert_is_attached t ; @@ -150,8 +179,9 @@ module Make (Inputs : Inputs_intf.S) = struct self_set_hash t address hash let self_set_location t account_id location = - t.maps.locations <- - Map.set t.maps.locations ~key:account_id ~data:location ; + update_maps t ~f:(fun maps -> + maps.locations <- + Map.set maps.locations ~key:account_id ~data:location ) ; (* if account is at a hitherto-unused location, that becomes the current location *) @@ -163,14 +193,21 @@ module Make (Inputs : Inputs_intf.S) = struct t.current_location <- Some location let self_set_account t location account = - t.maps.accounts <- Map.set t.maps.accounts ~key:location ~data:account ; + update_maps t ~f:(fun maps -> + maps.accounts <- Map.set maps.accounts ~key:location ~data:account ) ; self_set_location t (Account.identifier account) location + let self_set_token_owner t token_id account_id = + update_maps t ~f:(fun maps -> + maps.token_owners <- + Map.set maps.token_owners ~key:token_id ~data:account_id ) + (* a read does a lookup in the account_tbl; if that fails, delegate to parent *) let get t location = assert_is_attached t ; - match Map.find t.maps.accounts location with + let maps, ancestor = maps_and_ancestor t in + match Map.find maps.accounts location with | Some account -> Some account | None -> @@ -183,11 +220,12 @@ module Make (Inputs : Inputs_intf.S) = struct let current_address = Location.to_path_exn current_location in Addr.is_further_right ~than:current_address address in - if is_empty then None else Base.get (get_parent t) location + if is_empty then None else Base.get ancestor location let self_find_or_batch_lookup self_find lookup_parent t ids = assert_is_attached t ; - let self_found_or_none = List.map ids ~f:self_find in + let maps, ancestor = maps_and_ancestor t in + let self_found_or_none = List.map ids ~f:(self_find ~maps) in let not_found = List.filter_map self_found_or_none ~f:(function | id, None -> @@ -195,7 +233,7 @@ module Make (Inputs : Inputs_intf.S) = struct | _ -> None ) in - let from_parent = lookup_parent (get_parent t) not_found in + let from_parent = lookup_parent ancestor not_found in List.fold_map self_found_or_none ~init:from_parent ~f:(fun from_parent (id, self_found) -> match (self_found, from_parent) with @@ -208,8 +246,8 @@ module Make (Inputs : Inputs_intf.S) = struct |> snd let get_batch t = - let self_find id = - let res = Map.find t.maps.accounts id in + let self_find ~maps id = + let res = Map.find maps.accounts id in let res = if Option.is_none res then let is_empty = @@ -324,17 +362,18 @@ module Make (Inputs : Inputs_intf.S) = struct let merkle_path_at_addr_exn t address = assert_is_attached t ; + let maps, ancestor = maps_and_ancestor t in match - self_merkle_path ~depth:t.depth ~hashes:t.maps.hashes + self_merkle_path ~depth:t.depth ~hashes:maps.hashes ~current_location:t.current_location address with | Some path -> path | None -> let parent_merkle_path = - Base.merkle_path_at_addr_exn (get_parent t) address + Base.merkle_path_at_addr_exn ancestor address in - fixup_merkle_path ~hashes:t.maps.hashes parent_merkle_path ~address + fixup_merkle_path ~hashes:maps.hashes parent_merkle_path ~address let merkle_path_at_index_exn t index = merkle_path_at_addr_exn t (Addr.of_int_exn ~ledger_depth:t.depth index) @@ -344,12 +383,12 @@ module Make (Inputs : Inputs_intf.S) = struct let path_batch_impl ~fixup_path ~self_lookup ~base_lookup t locations = assert_is_attached t ; - let parent = get_parent t in + let maps, ancestor = maps_and_ancestor t in let self_paths = List.map locations ~f:(fun location -> let address = Location.to_path_exn location in - self_lookup ~hashes:t.maps.hashes - ~current_location:t.current_location ~depth:t.depth address + self_lookup ~hashes:maps.hashes ~current_location:t.current_location + ~depth:t.depth address |> Option.value_map ~default:(Either.Second (location, address)) ~f:Either.first ) @@ -362,15 +401,14 @@ module Make (Inputs : Inputs_intf.S) = struct | Either.Second (location, _) -> Some location ) in - if List.is_empty locs then [] else base_lookup parent locs + if List.is_empty locs then [] else base_lookup ancestor locs in let f parent_paths = function | Either.First path -> (parent_paths, path) | Either.Second (_, address) -> let path = - fixup_path ~hashes:t.maps.hashes ~address - (List.hd_exn parent_paths) + fixup_path ~hashes:maps.hashes ~address (List.hd_exn parent_paths) in (List.tl_exn parent_paths, path) in @@ -408,14 +446,15 @@ module Make (Inputs : Inputs_intf.S) = struct (* use mask Merkle root, if it exists, else get from parent *) let merkle_root t = assert_is_attached t ; - match Map.find t.maps.hashes (Addr.root ()) with + let maps, ancestor = maps_and_ancestor t in + match Map.find maps.hashes (Addr.root ()) with | Some hash -> hash | None -> - Base.merkle_root (get_parent t) + Base.merkle_root ancestor let remove_account_and_update_hashes t location = - assert_is_attached t ; + t.accumulated <- None ; (* remove account and key from tables *) let account = Option.value_exn (Map.find t.maps.accounts location) in t.maps.accounts <- Map.remove t.maps.accounts location ; @@ -451,10 +490,9 @@ module Make (Inputs : Inputs_intf.S) = struct self_set_account t location account ; (* Update token info. *) let account_id = Account.identifier account in - t.maps.token_owners <- - Map.set t.maps.token_owners - ~key:(Account_id.derive_token_id ~owner:account_id) - ~data:account_id + self_set_token_owner t + (Account_id.derive_token_id ~owner:account_id) + account_id (* a write writes only to the mask, parent is not involved need to update both account and hash pieces of the mask *) @@ -491,12 +529,13 @@ module Make (Inputs : Inputs_intf.S) = struct parent *) let get_hash t addr = assert_is_attached t ; - match Map.find t.maps.hashes addr with + let maps, ancestor = maps_and_ancestor t in + match Map.find maps.hashes addr with | Some hash -> Some hash | None -> ( try - let hash = Base.get_inner_hash_at_addr_exn (get_parent t) addr in + let hash = Base.get_inner_hash_at_addr_exn ancestor addr in Some hash with _ -> None ) @@ -509,9 +548,10 @@ module Make (Inputs : Inputs_intf.S) = struct let get_hash_batch_exn t locations = assert_is_attached t ; + let maps, ancestor = maps_and_ancestor t in let self_hashes_rev = List.rev_map locations ~f:(fun location -> - (location, Map.find t.maps.hashes (Location.to_path_exn location)) ) + (location, Map.find maps.hashes (Location.to_path_exn location)) ) in let parent_locations_rev = List.filter_map self_hashes_rev ~f:(fun (location, hash) -> @@ -519,7 +559,7 @@ module Make (Inputs : Inputs_intf.S) = struct in let parent_hashes_rev = if List.is_empty parent_locations_rev then [] - else Base.get_hash_batch_exn (get_parent t) parent_locations_rev + else Base.get_hash_batch_exn ancestor parent_locations_rev in let rec recombine self_hashes_rev parent_hashes_rev acc = match (self_hashes_rev, parent_hashes_rev) with @@ -536,22 +576,22 @@ module Make (Inputs : Inputs_intf.S) = struct (* transfer state from mask to parent; flush local state *) let commit t = assert_is_attached t ; + let parent = get_parent t in let old_root_hash = merkle_root t in let account_data = Map.to_alist t.maps.accounts in - Base.set_batch (get_parent t) account_data ; + Base.set_batch parent account_data ; t.maps.accounts <- Location_binable.Map.empty ; t.maps.hashes <- Addr.Map.empty ; + (* TODO why only 2/4 maps are updated ? *) Debug_assert.debug_assert (fun () -> [%test_result: Hash.t] ~message: "Parent merkle root after committing should be the same as the \ old one in the mask" - ~expect:old_root_hash - (Base.merkle_root (get_parent t)) ; + ~expect:old_root_hash (Base.merkle_root parent) ; [%test_result: Hash.t] ~message:"Merkle root of the mask should delegate to the parent now" - ~expect:(merkle_root t) - (Base.merkle_root (get_parent t)) ) + ~expect:(merkle_root t) (Base.merkle_root parent) ) (* copy tables in t; use same parent *) let copy t = @@ -561,6 +601,9 @@ module Make (Inputs : Inputs_intf.S) = struct ; current_location = t.current_location ; depth = t.depth ; maps = maps_copy t.maps + ; accumulated = + Option.map t.accumulated ~f:(fun acc -> + { acc with accumulated_maps = maps_copy acc.accumulated_maps } ) } let last_filled t = @@ -621,17 +664,15 @@ module Make (Inputs : Inputs_intf.S) = struct let set_location_batch ~last_location t account_to_location_list = t.current_location <- Some last_location ; Mina_stdlib.Nonempty_list.iter account_to_location_list - ~f:(fun (key, data) -> - t.maps.locations <- Map.set t.maps.locations ~key ~data ) + ~f:(fun (key, data) -> self_set_location t key data) let set_raw_account_batch t locations_and_accounts = assert_is_attached t ; List.iter locations_and_accounts ~f:(fun (location, account) -> let account_id = Account.identifier account in - t.maps.token_owners <- - Map.set t.maps.token_owners - ~key:(Account_id.derive_token_id ~owner:account_id) - ~data:account_id ; + self_set_token_owner t + (Account_id.derive_token_id ~owner:account_id) + account_id ; self_set_account t location account ) end) @@ -646,31 +687,34 @@ module Make (Inputs : Inputs_intf.S) = struct let token_owner t tid = assert_is_attached t ; - match Map.find t.maps.token_owners tid with + let maps, ancestor = maps_and_ancestor t in + match Map.find maps.token_owners tid with | Some id -> Some id | None -> - Base.token_owner (get_parent t) tid + Base.token_owner ancestor tid let token_owners (t : t) : Account_id.Set.t = assert_is_attached t ; + let maps, ancestor = maps_and_ancestor t in let mask_owners = - Map.fold t.maps.token_owners ~init:Account_id.Set.empty + Map.fold maps.token_owners ~init:Account_id.Set.empty ~f:(fun ~key:_tid ~data:owner acc -> Set.add acc owner) in - Set.union mask_owners (Base.token_owners (get_parent t)) + Set.union mask_owners (Base.token_owners ancestor) let tokens t pk = assert_is_attached t ; + let maps, ancestor = maps_and_ancestor t in let mask_tokens = - Map.keys t.maps.locations + Map.keys maps.locations |> List.filter_map ~f:(fun aid -> if Key.equal pk (Account_id.public_key aid) then Some (Account_id.token_id aid) else None ) |> Token_id.Set.of_list in - Set.union mask_tokens (Base.tokens (get_parent t) pk) + Set.union mask_tokens (Base.tokens ancestor pk) let num_accounts t = assert_is_attached t ; @@ -687,17 +731,18 @@ module Make (Inputs : Inputs_intf.S) = struct let location_of_account t account_id = assert_is_attached t ; - let mask_result = Map.find t.maps.locations account_id in + let maps, ancestor = maps_and_ancestor t in + let mask_result = Map.find maps.locations account_id in match mask_result with | Some _ -> mask_result | None -> - Base.location_of_account (get_parent t) account_id + Base.location_of_account ancestor account_id let location_of_account_batch t = self_find_or_batch_lookup - (fun id -> - (id, Option.map ~f:Option.some @@ Map.find t.maps.locations id) ) + (fun ~maps id -> + (id, Option.map ~f:Option.some @@ Map.find maps.locations id) ) Base.location_of_account_batch t (* Adds specified accounts to the mask by laoding them from parent ledger. @@ -734,9 +779,7 @@ module Make (Inputs : Inputs_intf.S) = struct in generate_locations non_empty_locations [] in - let all_hashes = - Base.get_hash_batch_exn (get_parent t) all_hash_locations - in + let all_hashes = get_hash_batch_exn t all_hash_locations in (* Batch import merkle paths and self hashes. *) List.iter2_exn all_hash_locations all_hashes ~f:(fun location hash -> let address = Location.to_path_exn location in @@ -805,7 +848,8 @@ module Make (Inputs : Inputs_intf.S) = struct let foldi_with_ignored_accounts t ignored_accounts ~init ~f = assert_is_attached t ; - let locations_and_accounts = Map.to_alist t.maps.accounts in + let maps, ancestor = maps_and_ancestor t in + let locations_and_accounts = Map.to_alist maps.accounts in (* parent should ignore accounts in this mask *) let mask_accounts = List.map locations_and_accounts ~f:(fun (_loc, acct) -> @@ -817,8 +861,7 @@ module Make (Inputs : Inputs_intf.S) = struct in (* in parent, ignore any passed-in ignored accounts and accounts in mask *) let parent_result = - Base.foldi_with_ignored_accounts (get_parent t) all_ignored_accounts - ~init ~f + Base.foldi_with_ignored_accounts ancestor all_ignored_accounts ~init ~f in let f' accum (location, account) = (* for mask, ignore just passed-in ignored accounts *) @@ -873,10 +916,11 @@ module Make (Inputs : Inputs_intf.S) = struct (* NB: updates the mutable current_location field in t *) let get_or_create_account t account_id account = assert_is_attached t ; - match Map.find t.maps.locations account_id with + let maps, ancestor = maps_and_ancestor t in + match Map.find maps.locations account_id with | None -> ( (* not in mask, maybe in parent *) - match Base.location_of_account (get_parent t) account_id with + match Base.location_of_account ancestor account_id with | Some location -> Ok (`Existed, location) | None -> ( @@ -905,12 +949,13 @@ module Make (Inputs : Inputs_intf.S) = struct let location_of_sexp = Location.t_of_sexp end - let set_parent t parent = + let set_parent ?accumulated t parent = assert (Result.is_error t.parent) ; assert (Option.is_none (Async.Ivar.peek t.detached_parent_signal)) ; assert (Int.equal t.depth (Base.depth parent)) ; t.parent <- Ok parent ; t.current_location <- Attached.last_filled t ; + t.accumulated <- accumulated ; t let addr_to_location addr = Location.Account addr diff --git a/src/lib/merkle_mask/masking_merkle_tree_intf.ml b/src/lib/merkle_mask/masking_merkle_tree_intf.ml index 6b366cb9d57..a88ace61018 100644 --- a/src/lib/merkle_mask/masking_merkle_tree_intf.ml +++ b/src/lib/merkle_mask/masking_merkle_tree_intf.ml @@ -32,6 +32,8 @@ module type S = sig val get_uuid : t -> Uuid.t + type accumulated_t + module Attached : sig include Base_merkle_tree_intf.S @@ -85,6 +87,8 @@ module type S = sig *) val unsafe_preload_accounts_from_parent : t -> account_id list -> unit + val to_accumulated : t -> accumulated_t + (** already have module For_testing from include above *) module For_testing : sig val location_in_mask : t -> location -> bool @@ -96,5 +100,6 @@ module type S = sig end (** tell mask about parent *) - val set_parent : unattached -> parent -> Attached.t + val set_parent : + ?accumulated:accumulated_t -> unattached -> parent -> Attached.t end diff --git a/src/lib/mina_ledger/ledger.ml b/src/lib/mina_ledger/ledger.ml index 0272b13c8ca..2d4fa8f4ae2 100644 --- a/src/lib/mina_ledger/ledger.ml +++ b/src/lib/mina_ledger/ledger.ml @@ -164,6 +164,7 @@ module Ledger_inner = struct and type root_hash := Hash.t and type unattached_mask := Mask.t and type attached_mask := Mask.Attached.t + and type accumulated_t := Mask.accumulated_t and type t := Any_ledger.M.t = Merkle_mask.Maskable_merkle_tree.Make (struct include Inputs @@ -270,7 +271,8 @@ module Ledger_inner = struct let packed t = Any_ledger.cast (module Mask.Attached) t - let register_mask t mask = Maskable.register_mask (packed t) mask + let register_mask ?accumulated t mask = + Maskable.register_mask ?accumulated (packed t) mask let unsafe_preload_accounts_from_parent = Maskable.unsafe_preload_accounts_from_parent @@ -284,6 +286,8 @@ module Ledger_inner = struct type attached_mask = Mask.Attached.t + type accumulated_t = Mask.accumulated_t + (* inside MaskedLedger, the functor argument has assigned to location, account, and path but the module signature for the functor result wants them, so we declare them here *) type location = Location.t diff --git a/src/lib/mina_ledger/ledger.mli b/src/lib/mina_ledger/ledger.mli index e38703f548b..6742e24dcf4 100644 --- a/src/lib/mina_ledger/ledger.mli +++ b/src/lib/mina_ledger/ledger.mli @@ -56,6 +56,7 @@ module Maskable : and type root_hash := Ledger_hash.t and type unattached_mask := Mask.t and type attached_mask := Mask.Attached.t + and type accumulated_t := Mask.accumulated_t and type t := Any_ledger.M.t include @@ -73,6 +74,7 @@ include and type t = Mask.Attached.t and type attached_mask = Mask.Attached.t and type unattached_mask = Mask.t + and type accumulated_t = Mask.accumulated_t (* We override the type of unregister_mask_exn that comes from Merkle_mask.Maskable_merkle_tree_intf.S because at this level callers aren't @@ -100,7 +102,8 @@ val of_database : Db.t -> t (** This is not _really_ copy, merely a stop-gap until we remove usages of copy in our codebase. What this actually does is creates a new empty mask on top of the current ledger *) val copy : t -> t -val register_mask : t -> Mask.t -> Mask.Attached.t +val register_mask : + ?accumulated:Mask.accumulated_t -> t -> Mask.t -> Mask.Attached.t val commit : Mask.Attached.t -> unit From 7fbea17444e86c8e975ee7623b0c0130627d299b Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 24 Nov 2023 23:26:43 +0100 Subject: [PATCH 06/19] Integrate mask accumulation into ledger lifecycle --- src/lib/merkle_mask/maskable_merkle_tree.ml | 113 ++++++++++---------- src/lib/merkle_mask/masking_merkle_tree.ml | 68 ++++++++---- src/lib/mina_ledger/ledger.ml | 5 +- src/lib/mina_ledger/ledger.mli | 3 +- 4 files changed, 111 insertions(+), 78 deletions(-) diff --git a/src/lib/merkle_mask/maskable_merkle_tree.ml b/src/lib/merkle_mask/maskable_merkle_tree.ml index b4115b2ff2c..ea0e741d41b 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree.ml @@ -157,67 +157,68 @@ module Make (Inputs : Inputs_intf) = struct Uuid.Table.add_multi registered_masks ~key:(get_uuid t) ~data:attached_mask ; attached_mask - let rec unregister_mask_exn ?(grandchildren = `Check) ~loc - (mask : Mask.Attached.t) : Mask.unattached = + let rec iter_descendants ~f uuid = + List.iter + (Hashtbl.find registered_masks uuid |> Option.value ~default:[]) + ~f:(fun child_mask -> + if f child_mask then + iter_descendants ~f (Mask.Attached.get_uuid child_mask) ) + + let unregister_mask_error_msg ~uuid ~parent_uuid suffix = + sprintf "Couldn't unregister mask with UUID %s from parent %s, %s" + (Uuid.to_string_hum uuid) + (Uuid.to_string_hum parent_uuid) + suffix + + let unregister_mask_exn_do ?trigger_signal mask = + let uuid = Mask.Attached.get_uuid mask in let parent_uuid = Mask.Attached.get_parent mask |> get_uuid in - let error_msg suffix = - sprintf "Couldn't unregister mask with UUID %s from parent %s, %s" - (Mask.Attached.get_uuid mask |> Uuid.to_string_hum) - (Uuid.to_string_hum parent_uuid) - suffix - in - let trigger_detach_signal = - match grandchildren with - | `Check | `Recursive -> - true - | `I_promise_I_am_reparenting_this_mask -> - false - in - ( match grandchildren with - | `Check -> ( - match Hashtbl.find registered_masks (Mask.Attached.get_uuid mask) with - | Some children -> - failwith @@ error_msg - @@ sprintf - !"mask has children that must be unregistered first: %{sexp: \ - Uuid.t list}" - (List.map ~f:Mask.Attached.get_uuid children) - | None -> - () ) - | `I_promise_I_am_reparenting_this_mask -> - () - | `Recursive -> - (* You must not retain any references to children of the mask we're - unregistering if you pass `Recursive, so this is only used in - with_ephemeral_ledger. *) - List.iter - ( Hashtbl.find registered_masks (Mask.Attached.get_uuid mask) - |> Option.value ~default:[] ) - ~f:(fun child_mask -> - ignore - @@ unregister_mask_exn ~loc ~grandchildren:`Recursive child_mask ) - ) ; + let error_msg = unregister_mask_error_msg ~uuid ~parent_uuid in match Uuid.Table.find registered_masks parent_uuid with | None -> failwith @@ error_msg "parent not in registered_masks" | Some masks -> - ( match List.find masks ~f:(fun m -> phys_equal m mask) with - | None -> - failwith @@ error_msg "mask not registered with that parent" - | Some _ -> ( - let bad, good = - List.partition_tf masks ~f:(fun m -> phys_equal m mask) - in - assert (List.length bad = 1) ; - match good with - | [] -> - (* no other masks for this maskable *) - Uuid.Table.remove registered_masks parent_uuid - | other_masks -> - Uuid.Table.set registered_masks ~key:parent_uuid - ~data:other_masks ) ) ; - Mask.Attached.unset_parent ~trigger_signal:trigger_detach_signal ~loc - mask + let bad, good = + List.partition_tf masks ~f:(fun m -> phys_equal m mask) + in + if List.length bad <> 1 then + failwith @@ error_msg "mask not registered with that parent" ; + if List.is_empty good then + (* no other masks for this maskable *) + Uuid.Table.remove registered_masks parent_uuid + else Uuid.Table.set registered_masks ~key:parent_uuid ~data:good ; + Mask.Attached.unset_parent ?trigger_signal mask + + let unregister_mask_exn ?(grandchildren = `Check) ~loc (mask : Mask.Attached.t) + : Mask.unattached = + let uuid = Mask.Attached.get_uuid mask in + let parent_uuid = Mask.Attached.get_parent mask |> get_uuid in + let error_msg = unregister_mask_error_msg ~uuid ~parent_uuid in + let trigger_signal = + match grandchildren with + | `Check -> ( + match Hashtbl.find registered_masks (Mask.Attached.get_uuid mask) with + | Some children -> + failwith @@ error_msg + @@ sprintf + !"mask has children that must be unregistered first: \ + %{sexp: Uuid.t list}" + (List.map ~f:Mask.Attached.get_uuid children) + | None -> + true ) + | `I_promise_I_am_reparenting_this_mask -> + false + | `Recursive -> + (* You must not retain any references to children of the mask we're + unregistering if you pass `Recursive, so this is only used in + with_ephemeral_ledger. *) + iter_descendants uuid + ~f: + ( Fn.compose (Fn.const true) + @@ unregister_mask_exn_do ~trigger_signal:true ~loc ) ; + true + in + unregister_mask_exn_do ~trigger_signal ~loc mask (** a set calls the Base implementation set, notifies registered mask childen *) let set t location account = diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 3d6f3db129f..1049357c533 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -49,7 +49,15 @@ module Make (Inputs : Inputs_intf.S) = struct let maps_copy { accounts; token_owners; hashes; locations } = { accounts; token_owners; hashes; locations } - type accumulated_t = { accumulated_maps : maps_t; ancestor : Base.t } + type accumulated_t = + { current : maps_t + ; next : maps_t + ; base : Base.t + ; detached_next_signal : Detached_parent_signal.t + (* Ivar for mask from which next was started being built + When it's fulfilled, "next" becomes "current". + *) + } type t = { uuid : Uuid.Stable.V1.t @@ -67,6 +75,13 @@ module Make (Inputs : Inputs_intf.S) = struct type unattached = t [@@deriving sexp] + let empty_maps () = + { accounts = Location_binable.Map.empty + ; token_owners = Token_id.Map.empty + ; hashes = Addr.Map.empty + ; locations = Account_id.Map.empty + } + let create ~depth () = { uuid = Uuid_unix.create () ; parent = Error __LOC__ @@ -74,12 +89,7 @@ module Make (Inputs : Inputs_intf.S) = struct ; current_location = None ; depth ; accumulated = None - ; maps = - { accounts = Location_binable.Map.empty - ; token_owners = Token_id.Map.empty - ; hashes = Addr.Map.empty - ; locations = Account_id.Map.empty - } + ; maps = empty_maps () } let get_uuid { uuid; _ } = uuid @@ -113,10 +123,18 @@ module Make (Inputs : Inputs_intf.S) = struct let to_accumulated t = match (t.accumulated, t.parent) with - | Some { accumulated_maps; ancestor }, _ -> - { ancestor; accumulated_maps = maps_copy accumulated_maps } - | None, Ok ancestor -> - { ancestor; accumulated_maps = maps_copy t.maps } + | Some { base; detached_next_signal; next; current }, _ -> + { base + ; detached_next_signal + ; next = maps_copy next + ; current = maps_copy current + } + | None, Ok base -> + { base + ; next = maps_copy t.maps + ; current = maps_copy t.maps + ; detached_next_signal = t.detached_parent_signal + } | None, Error loc -> raise (Dangling_parent_reference (t.uuid, loc)) @@ -133,9 +151,9 @@ module Make (Inputs : Inputs_intf.S) = struct let unset_parent ?(trigger_signal = true) ~loc t = assert (Result.is_ok t.parent) ; t.parent <- Error loc ; - t.accumulated <- None ; - if trigger_signal then - Async.Ivar.fill_if_empty t.detached_parent_signal () ; + if trigger_signal then ( + t.accumulated <- None ; + Async.Ivar.fill_if_empty t.detached_parent_signal () ) ; t let assert_is_attached t = @@ -151,9 +169,19 @@ module Make (Inputs : Inputs_intf.S) = struct assert_is_attached t ; Result.ok_or_failwith opt let maps_and_ancestor t = + Option.iter t.accumulated + ~f:(fun { detached_next_signal; next; base; current = _ } -> + if Async.Ivar.is_full detached_next_signal then + t.accumulated <- + Some + { next = empty_maps () + ; current = next + ; detached_next_signal = t.detached_parent_signal + ; base + } ) ; match t.accumulated with - | Some { accumulated_maps; ancestor } -> - (accumulated_maps, ancestor) + | Some { current; base; _ } -> + (current, base) | None -> (t.maps, get_parent t) @@ -167,7 +195,8 @@ module Make (Inputs : Inputs_intf.S) = struct let update_maps ~f t = f t.maps ; - Option.iter t.accumulated ~f:(fun { accumulated_maps = ms; _ } -> f ms) + Option.iter t.accumulated ~f:(fun { current; next; _ } -> + f current ; f next ) let self_set_hash t address hash = update_maps t ~f:(fun maps -> @@ -603,7 +632,10 @@ module Make (Inputs : Inputs_intf.S) = struct ; maps = maps_copy t.maps ; accumulated = Option.map t.accumulated ~f:(fun acc -> - { acc with accumulated_maps = maps_copy acc.accumulated_maps } ) + { acc with + next = maps_copy acc.next + ; current = maps_copy acc.current + } ) } let last_filled t = diff --git a/src/lib/mina_ledger/ledger.ml b/src/lib/mina_ledger/ledger.ml index 2d4fa8f4ae2..ff5a12bdbe6 100644 --- a/src/lib/mina_ledger/ledger.ml +++ b/src/lib/mina_ledger/ledger.ml @@ -271,8 +271,9 @@ module Ledger_inner = struct let packed t = Any_ledger.cast (module Mask.Attached) t - let register_mask ?accumulated t mask = - Maskable.register_mask ?accumulated (packed t) mask + let register_mask t = + let accumulated = Mask.Attached.to_accumulated t in + Maskable.register_mask ~accumulated (packed t) let unsafe_preload_accounts_from_parent = Maskable.unsafe_preload_accounts_from_parent diff --git a/src/lib/mina_ledger/ledger.mli b/src/lib/mina_ledger/ledger.mli index 6742e24dcf4..adc8643d2cc 100644 --- a/src/lib/mina_ledger/ledger.mli +++ b/src/lib/mina_ledger/ledger.mli @@ -102,8 +102,7 @@ val of_database : Db.t -> t (** This is not _really_ copy, merely a stop-gap until we remove usages of copy in our codebase. What this actually does is creates a new empty mask on top of the current ledger *) val copy : t -> t -val register_mask : - ?accumulated:Mask.accumulated_t -> t -> Mask.t -> Mask.Attached.t +val register_mask : t -> Mask.t -> Mask.Attached.t val commit : Mask.Attached.t -> unit From 1b5779ebeba576acc014cd465f6190bea822aaab Mon Sep 17 00:00:00 2001 From: georgeee Date: Sat, 25 Nov 2023 09:23:03 +0100 Subject: [PATCH 07/19] Fix merkle_ledger_tests --- src/lib/merkle_ledger_tests/test_mask.ml | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/lib/merkle_ledger_tests/test_mask.ml b/src/lib/merkle_ledger_tests/test_mask.ml index 4d59d339c50..eea869a5753 100644 --- a/src/lib/merkle_ledger_tests/test_mask.ml +++ b/src/lib/merkle_ledger_tests/test_mask.ml @@ -716,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 = From 3dba63a0f599cc198e3746ec96e0b06e22057fd4 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 30 Nov 2023 11:31:13 +0100 Subject: [PATCH 08/19] Fix bug in Mask's copy --- src/lib/merkle_mask/masking_merkle_tree.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 1049357c533..12140f7c7f6 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -624,16 +624,18 @@ module Make (Inputs : Inputs_intf.S) = struct (* copy tables in t; use same parent *) let copy t = + let detached_parent_signal = Async.Ivar.create () in { uuid = Uuid_unix.create () ; parent = Ok (get_parent t) - ; detached_parent_signal = Async.Ivar.create () + ; detached_parent_signal ; current_location = t.current_location ; depth = t.depth ; maps = maps_copy t.maps ; accumulated = Option.map t.accumulated ~f:(fun acc -> - { acc with - next = maps_copy acc.next + { base = acc.base + ; detached_next_signal = detached_parent_signal + ; next = maps_copy acc.next ; current = maps_copy acc.current } ) } From d05242cf7fb4b2a2dc0a83a093f0095d63a1aac9 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 30 Nov 2023 11:33:29 +0100 Subject: [PATCH 09/19] Nit: remove Fn.compose Fn.id --- src/lib/mina_base/ledger_hash.ml | 2 +- src/lib/mina_base/pending_coinbase.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/mina_base/ledger_hash.ml b/src/lib/mina_base/ledger_hash.ml index 3862ae47cf3..0ae6909ab4d 100644 --- a/src/lib/mina_base/ledger_hash.ml +++ b/src/lib/mina_base/ledger_hash.ml @@ -45,7 +45,7 @@ let empty_hash = of_hash Outside_hash_image.t let%bench "Ledger_hash.merge ~height:1 empty_hash empty_hash" = merge ~height:1 empty_hash empty_hash -let of_digest = Fn.compose Fn.id of_hash +let of_digest = of_hash type path = Random_oracle.Digest.t list diff --git a/src/lib/mina_base/pending_coinbase.ml b/src/lib/mina_base/pending_coinbase.ml index dc8639181ba..44996128dbe 100644 --- a/src/lib/mina_base/pending_coinbase.ml +++ b/src/lib/mina_base/pending_coinbase.ml @@ -396,7 +396,7 @@ module Make_str (A : Wire_types.Concrete) = struct let empty_hash = Random_oracle.(digest (salt "PendingCoinbaseMerkleTree")) |> of_hash - let of_digest = Fn.compose Fn.id of_hash + let of_digest = of_hash end module Update = struct From a2e68ac7c7cefc4c91f45d08054bea1241220059 Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 1 Dec 2023 23:41:45 +0100 Subject: [PATCH 10/19] Fix couple of bugs in reparenting --- src/lib/merkle_mask/masking_merkle_tree.ml | 27 +++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 12140f7c7f6..493a853f971 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -49,6 +49,16 @@ module Make (Inputs : Inputs_intf.S) = struct let maps_copy { accounts; token_owners; hashes; locations } = { accounts; token_owners; hashes; locations } + (** Merges second maps object into the first one, + potentially overwriting some keys *) + let maps_merge base { accounts; token_owners; hashes; locations } = + let combine ~key:_ _ v = v in + base.accounts <- Map.merge_skewed ~combine base.accounts accounts ; + base.token_owners <- + Map.merge_skewed ~combine base.token_owners token_owners ; + base.hashes <- Map.merge_skewed ~combine base.hashes hashes ; + base.locations <- Map.merge_skewed ~combine base.locations locations + type accumulated_t = { current : maps_t ; next : maps_t @@ -174,7 +184,7 @@ module Make (Inputs : Inputs_intf.S) = struct if Async.Ivar.is_full detached_next_signal then t.accumulated <- Some - { next = empty_maps () + { next = t.maps ; current = next ; detached_next_signal = t.detached_parent_signal ; base @@ -983,13 +993,24 @@ module Make (Inputs : Inputs_intf.S) = struct let location_of_sexp = Location.t_of_sexp end - let set_parent ?accumulated t parent = + let set_parent ?accumulated:accumulated_opt t parent = assert (Result.is_error t.parent) ; assert (Option.is_none (Async.Ivar.peek t.detached_parent_signal)) ; assert (Int.equal t.depth (Base.depth parent)) ; t.parent <- Ok parent ; t.current_location <- Attached.last_filled t ; - t.accumulated <- accumulated ; + (* If [t.accumulated] isn't empty, then this mask had a parent before + and now we just reparent it (which may only happen if both old and new parents + have the same merkle root (and some masks in between may have been removed), + hence no need to modify [t.accumulated]) *) + ( match accumulated_opt with + | Some { current; next; base; detached_next_signal } + when Option.is_none t.accumulated -> + maps_merge current t.maps ; + maps_merge next t.maps ; + t.accumulated <- Some { current; next; base; detached_next_signal } + | _ -> + () ) ; t let addr_to_location addr = Location.Account addr From 4c97874e9e9046834163caf672cfbf0cb2d25078 Mon Sep 17 00:00:00 2001 From: georgeee Date: Sat, 2 Dec 2023 01:28:37 +0100 Subject: [PATCH 11/19] Avoid force-evaluation-induced bug --- src/lib/mina_ledger/ledger.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/mina_ledger/ledger.ml b/src/lib/mina_ledger/ledger.ml index ff5a12bdbe6..f4fd61a37ff 100644 --- a/src/lib/mina_ledger/ledger.ml +++ b/src/lib/mina_ledger/ledger.ml @@ -271,9 +271,9 @@ module Ledger_inner = struct let packed t = Any_ledger.cast (module Mask.Attached) t - let register_mask t = + let register_mask t mask = let accumulated = Mask.Attached.to_accumulated t in - Maskable.register_mask ~accumulated (packed t) + Maskable.register_mask ~accumulated (packed t) mask let unsafe_preload_accounts_from_parent = Maskable.unsafe_preload_accounts_from_parent From b6d0391565a5a96578cd2b24f8cc40fc5f2c40cb Mon Sep 17 00:00:00 2001 From: Tang Jiawei Date: Mon, 4 Dec 2023 18:08:22 +0800 Subject: [PATCH 12/19] fix the order of unset_parent when unregister_mask --- src/lib/merkle_ledger/database.ml | 4 +++- src/lib/merkle_mask/maskable_merkle_tree.ml | 12 ++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index 4e0ff038537..863fcbcdf54 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -670,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 diff --git a/src/lib/merkle_mask/maskable_merkle_tree.ml b/src/lib/merkle_mask/maskable_merkle_tree.ml index ea0e741d41b..536f63b6b11 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree.ml @@ -161,8 +161,8 @@ module Make (Inputs : Inputs_intf) = struct List.iter (Hashtbl.find registered_masks uuid |> Option.value ~default:[]) ~f:(fun child_mask -> - if f child_mask then - iter_descendants ~f (Mask.Attached.get_uuid child_mask) ) + iter_descendants ~f (Mask.Attached.get_uuid child_mask) ; + f child_mask ) let unregister_mask_error_msg ~uuid ~parent_uuid suffix = sprintf "Couldn't unregister mask with UUID %s from parent %s, %s" @@ -212,10 +212,10 @@ module Make (Inputs : Inputs_intf) = struct (* You must not retain any references to children of the mask we're unregistering if you pass `Recursive, so this is only used in with_ephemeral_ledger. *) - iter_descendants uuid - ~f: - ( Fn.compose (Fn.const true) - @@ unregister_mask_exn_do ~trigger_signal:true ~loc ) ; + iter_descendants uuid ~f:(fun mask -> + ignore + ( unregister_mask_exn_do ~trigger_signal:true ~loc mask + : Mask.unattached ) ) ; true in unregister_mask_exn_do ~trigger_signal ~loc mask From bbe1860dff199f0a797233d227e887f1e1f8aaee Mon Sep 17 00:00:00 2001 From: Tang Jiawei Date: Tue, 5 Dec 2023 03:15:29 +0800 Subject: [PATCH 13/19] remove `remove_accounts_exn` --- src/lib/snarkyjs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/snarkyjs b/src/lib/snarkyjs index 9042677986a..8530e25a4c1 160000 --- a/src/lib/snarkyjs +++ b/src/lib/snarkyjs @@ -1 +1 @@ -Subproject commit 9042677986ac3d2465aab75a228f089972c6cdb6 +Subproject commit 8530e25a4c1dd05d4740cc303ba0c155f43ac486 From 2be17633b9177e03b020a5e7a5c4e6ac38ed2172 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 5 Dec 2023 01:01:51 +0100 Subject: [PATCH 14/19] Safeguard against unexpected parent update Problem: accumulated solution is heavily relied upon assumption of immutability of a parent ledger/mask. If this assumption is accidentally broken, this might be problematic. Solution: when a conflicting update to parent is detected, log it and reset the accumulated state all down the ancestry. --- src/lib/merkle_mask/dune | 2 + src/lib/merkle_mask/maskable_merkle_tree.ml | 32 ++++++++++++--- src/lib/merkle_mask/masking_merkle_tree.ml | 41 ++++++++++++------- .../merkle_mask/masking_merkle_tree_intf.ml | 6 +++ 4 files changed, 61 insertions(+), 20 deletions(-) diff --git a/src/lib/merkle_mask/dune b/src/lib/merkle_mask/dune index 02538f4c132..bcf75bb1cde 100644 --- a/src/lib/merkle_mask/dune +++ b/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 diff --git a/src/lib/merkle_mask/maskable_merkle_tree.ml b/src/lib/merkle_mask/maskable_merkle_tree.ml index 536f63b6b11..03cd755ee93 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree.ml @@ -25,6 +25,8 @@ module Make (Inputs : Inputs_intf) = struct open Inputs include Base + let logger = Logger.create () + (** Maps parent ledger UUIDs to child masks. *) let (registered_masks : Mask.Attached.t list Uuid.Table.t) = Uuid.Table.create () @@ -223,12 +225,22 @@ module Make (Inputs : Inputs_intf) = struct (** a set calls the Base implementation set, notifies registered mask childen *) let set t location account = Base.set t location account ; - match Uuid.Table.find registered_masks (get_uuid t) with + let uuid = get_uuid t in + match Uuid.Table.find registered_masks uuid with | None -> () | Some masks -> List.iter masks ~f:(fun mask -> - Mask.Attached.parent_set_notify mask account ) + if not (Mask.Attached.is_committing mask) then ( + Mask.Attached.parent_set_notify mask account ; + let child_uuid = Mask.Attached.get_uuid mask in +Mask.Attached.drop_accumulated mask; + iter_descendants child_uuid ~f:Mask.Attached.drop_accumulated ; + [%log error] + "Update of an account in parent %s conflicted with an account \ + in mask %s" + (Uuid.to_string_hum uuid) + (Uuid.to_string_hum child_uuid) ) ) let remove_and_reparent_exn t t_as_mask = let parent = Mask.Attached.get_parent t_as_mask in @@ -248,13 +260,23 @@ module Make (Inputs : Inputs_intf) = struct ignore (register_mask parent m : Mask.Attached.t) ) let batch_notify_mask_children t accounts = - match Uuid.Table.find registered_masks (get_uuid t) with + let uuid = get_uuid t in + match Uuid.Table.find registered_masks uuid with | None -> () | Some masks -> List.iter masks ~f:(fun mask -> - List.iter accounts ~f:(fun account -> - Mask.Attached.parent_set_notify mask account ) ) + if not (Mask.Attached.is_committing mask) then ( + let child_uuid = Mask.Attached.get_uuid mask in +Mask.Attached.drop_accumulated mask; + iter_descendants child_uuid ~f:Mask.Attached.drop_accumulated ; + [%log error] + "Update of an account in parent %s conflicted with an account \ + in mask %s" + (Uuid.to_string_hum uuid) + (Uuid.to_string_hum child_uuid) ; + List.iter accounts ~f:(fun account -> + Mask.Attached.parent_set_notify mask account ) ) ) let set_batch t locations_and_accounts = Base.set_batch t locations_and_accounts ; diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 493a853f971..1066bedf873 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -80,6 +80,7 @@ module Make (Inputs : Inputs_intf.S) = struct and for a few ancestors. This is used as a lookup cache. *) ; mutable accumulated : (accumulated_t[@sexp.opaque]) option + ; mutable is_committing : bool } [@@deriving sexp] @@ -100,6 +101,7 @@ module Make (Inputs : Inputs_intf.S) = struct ; depth ; accumulated = None ; maps = empty_maps () + ; is_committing = false } let get_uuid { uuid; _ } = uuid @@ -493,7 +495,6 @@ module Make (Inputs : Inputs_intf.S) = struct Base.merkle_root ancestor let remove_account_and_update_hashes t location = - t.accumulated <- None ; (* remove account and key from tables *) let account = Option.value_exn (Map.find t.maps.accounts location) in t.maps.accounts <- Map.remove t.maps.accounts location ; @@ -550,19 +551,22 @@ module Make (Inputs : Inputs_intf.S) = struct self_set_hash t addr hash ) (* if the mask's parent sets an account, we can prune an entry in the mask - if the account in the parent is the same in the mask *) + if the account in the parent is the same in the mask + + returns true is the mask is in the state of being comitted *) let parent_set_notify t account = assert_is_attached t ; - match Map.find t.maps.locations (Account.identifier account) with - | None -> - () - | Some location -> ( - match Map.find t.maps.accounts location with - | Some existing_account -> - if Account.equal account existing_account then - remove_account_and_update_hashes t location - | None -> - () ) + Option.value ~default:() + @@ let%bind.Option location = + Map.find t.maps.locations (Account.identifier account) + in + let%bind.Option existing_account = Map.find t.maps.accounts location in + let%map.Option () = + Option.some_if (Account.equal account existing_account) () + in + remove_account_and_update_hashes t location + + let is_committing t = t.is_committing (* as for accounts, we see if we have it in the mask, else delegate to parent *) @@ -614,14 +618,17 @@ module Make (Inputs : Inputs_intf.S) = struct (* transfer state from mask to parent; flush local state *) let commit t = + assert (not t.is_committing) ; + t.is_committing <- true ; assert_is_attached t ; let parent = get_parent t in let old_root_hash = merkle_root t in let account_data = Map.to_alist t.maps.accounts in - Base.set_batch parent account_data ; t.maps.accounts <- Location_binable.Map.empty ; t.maps.hashes <- Addr.Map.empty ; - (* TODO why only 2/4 maps are updated ? *) + t.maps.locations <- Account_id.Map.empty ; + t.maps.token_owners <- Token_id.Map.empty ; + Base.set_batch parent account_data ; Debug_assert.debug_assert (fun () -> [%test_result: Hash.t] ~message: @@ -630,7 +637,8 @@ module Make (Inputs : Inputs_intf.S) = struct ~expect:old_root_hash (Base.merkle_root parent) ; [%test_result: Hash.t] ~message:"Merkle root of the mask should delegate to the parent now" - ~expect:(merkle_root t) (Base.merkle_root parent) ) + ~expect:(merkle_root t) (Base.merkle_root parent) ) ; + t.is_committing <- false (* copy tables in t; use same parent *) let copy t = @@ -648,6 +656,7 @@ module Make (Inputs : Inputs_intf.S) = struct ; next = maps_copy acc.next ; current = maps_copy acc.current } ) + ; is_committing = false } let last_filled t = @@ -673,6 +682,8 @@ module Make (Inputs : Inputs_intf.S) = struct "last_filled: expected account locations for the parent \ and mask" ) ) + let drop_accumulated t = t.accumulated <- None + include Merkle_ledger.Util.Make (struct module Location = Location module Location_binable = Location_binable diff --git a/src/lib/merkle_mask/masking_merkle_tree_intf.ml b/src/lib/merkle_mask/masking_merkle_tree_intf.ml index a88ace61018..cf4a54df36f 100644 --- a/src/lib/merkle_mask/masking_merkle_tree_intf.ml +++ b/src/lib/merkle_mask/masking_merkle_tree_intf.ml @@ -89,6 +89,12 @@ module type S = sig val to_accumulated : t -> accumulated_t + (** Drop accumulated structure, a method used in safeguard against + unwanted modification of ancestor's mask *) + val drop_accumulated : t -> unit + + val is_committing : t -> bool + (** already have module For_testing from include above *) module For_testing : sig val location_in_mask : t -> location -> bool From bacfd17277641c8accf83a8f50b97fb04606a2d7 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 5 Dec 2023 01:42:55 +0100 Subject: [PATCH 15/19] Actualize accumulated in to_accumulated --- src/lib/merkle_mask/masking_merkle_tree.ml | 42 ++++++++++++---------- 1 file changed, 23 insertions(+), 19 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 1066bedf873..aa1c958b7ab 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -133,23 +133,6 @@ module Make (Inputs : Inputs_intf.S) = struct Dangling_parent_reference of Uuid.t * (* Location where null was set*) string - let to_accumulated t = - match (t.accumulated, t.parent) with - | Some { base; detached_next_signal; next; current }, _ -> - { base - ; detached_next_signal - ; next = maps_copy next - ; current = maps_copy current - } - | None, Ok base -> - { base - ; next = maps_copy t.maps - ; current = maps_copy t.maps - ; detached_next_signal = t.detached_parent_signal - } - | None, Error loc -> - raise (Dangling_parent_reference (t.uuid, loc)) - let create () = failwith "Mask.Attached.create: cannot create an attached mask; use Mask.create \ @@ -180,7 +163,7 @@ module Make (Inputs : Inputs_intf.S) = struct let get_parent ({ parent = opt; _ } as t) = assert_is_attached t ; Result.ok_or_failwith opt - let maps_and_ancestor t = + let actualize_accumulated t = Option.iter t.accumulated ~f:(fun { detached_next_signal; next; base; current = _ } -> if Async.Ivar.is_full detached_next_signal then @@ -190,13 +173,34 @@ module Make (Inputs : Inputs_intf.S) = struct ; current = next ; detached_next_signal = t.detached_parent_signal ; base - } ) ; + } ) + + let maps_and_ancestor t = + actualize_accumulated t ; match t.accumulated with | Some { current; base; _ } -> (current, base) | None -> (t.maps, get_parent t) + let to_accumulated t = + actualize_accumulated t ; + match (t.accumulated, t.parent) with + | Some { base; detached_next_signal; next; current }, _ -> + { base + ; detached_next_signal + ; next = maps_copy next + ; current = maps_copy current + } + | None, Ok base -> + { base + ; next = maps_copy t.maps + ; current = maps_copy t.maps + ; detached_next_signal = t.detached_parent_signal + } + | None, Error loc -> + raise (Dangling_parent_reference (t.uuid, loc)) + let get_uuid t = assert_is_attached t ; t.uuid let get_directory t = From d325d03a1f44432d9edc7f93a7d29ba6dae26a70 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 5 Dec 2023 02:04:48 +0100 Subject: [PATCH 16/19] Add comments about accumulated structure --- src/lib/merkle_mask/masking_merkle_tree.ml | 34 ++++++++++++++++++++-- 1 file changed, 31 insertions(+), 3 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index aa1c958b7ab..f351dee111c 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -59,13 +59,35 @@ module Make (Inputs : Inputs_intf.S) = struct base.hashes <- Map.merge_skewed ~combine base.hashes hashes ; base.locations <- Map.merge_skewed ~combine base.locations locations + (** Structure managing cache accumulated since the "base" ledger. + + Its purpose is to optimize lookups through a few consequitive masks + (by using just one map lookup instead of [O(number of masks)] map lookups). + + With a number of mask around 290, this trick gives a sizeable performance improvement. + + Accumulator is inherited from parent mask if [set_parent ~accumulated] of a child + is called with [to_acumulated t] of the parent mask. + + Structure maintains two caches: [current] and [next], with the former + being always a superset of a latter and [next] always being superset of mask's contents + from [maps] field. These two caches are being rotated according to a certain rule + to ensure that no much more memory is used within accumulator as compared to the case + when [accumulated = None] for all masks. + + Garbage-collection/rotation mechanism for [next] and [current] is based on idea to set + [current] to [next] and [next] to [t.maps] when the mask at which accumulation of [next] started + became detached. *) type accumulated_t = { current : maps_t + (** Currently used cache: contains a superset of contents of masks from base ledger to the current mask *) ; next : maps_t - ; base : Base.t + (** Cache that will be used after the current cache is garbage-collected *) + ; base : Base.t (** Base ledger *) ; detached_next_signal : Detached_parent_signal.t - (* Ivar for mask from which next was started being built - When it's fulfilled, "next" becomes "current". + (** Ivar for mask from which next was started being built. + When it's fulfilled, [next] becomes [current] (because next contains superset of all masks from [baser], + [detached_signal] is reset to the current mask and [next] is set to contents of the current mask. *) } @@ -163,6 +185,8 @@ module Make (Inputs : Inputs_intf.S) = struct let get_parent ({ parent = opt; _ } as t) = assert_is_attached t ; Result.ok_or_failwith opt + (** Check whether mask from which we started computing the [next] + accumulator is detached and [current] can be garbage-collected. *) let actualize_accumulated t = Option.iter t.accumulated ~f:(fun { detached_next_signal; next; base; current = _ } -> @@ -175,6 +199,9 @@ module Make (Inputs : Inputs_intf.S) = struct ; base } ) + (** When [accumulated] is not configured, returns current [t.maps] and parent. + + Otherwise, returns the [current] accumulator and [base]. *) let maps_and_ancestor t = actualize_accumulated t ; match t.accumulated with @@ -183,6 +210,7 @@ module Make (Inputs : Inputs_intf.S) = struct | None -> (t.maps, get_parent t) + (** Either copies accumulated or initializes it with the parent being used as the [base]. *) let to_accumulated t = actualize_accumulated t ; match (t.accumulated, t.parent) with From 7fdb2a874a7b33336863b1948c27645663d4b958 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 5 Dec 2023 02:05:18 +0100 Subject: [PATCH 17/19] Revert "Fix bug in Mask's copy" Reverts a faulty change (original version was correct). This reverts commit 3dba63a0f599cc198e3746ec96e0b06e22057fd4. --- src/lib/merkle_mask/masking_merkle_tree.ml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index f351dee111c..eadc747687d 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -674,18 +674,16 @@ module Make (Inputs : Inputs_intf.S) = struct (* copy tables in t; use same parent *) let copy t = - let detached_parent_signal = Async.Ivar.create () in { uuid = Uuid_unix.create () ; parent = Ok (get_parent t) - ; detached_parent_signal + ; detached_parent_signal = Async.Ivar.create () ; current_location = t.current_location ; depth = t.depth ; maps = maps_copy t.maps ; accumulated = Option.map t.accumulated ~f:(fun acc -> - { base = acc.base - ; detached_next_signal = detached_parent_signal - ; next = maps_copy acc.next + { acc with + next = maps_copy acc.next ; current = maps_copy acc.current } ) ; is_committing = false From e2b4ff6a1752cbf66fb121764c0461c044a1e95b Mon Sep 17 00:00:00 2001 From: Nathan Holland Date: Wed, 6 Dec 2023 17:28:50 -0600 Subject: [PATCH 18/19] Refactor ledger mask update_maps; fix mutation bug in set_parent --- src/lib/merkle_mask/maskable_merkle_tree.ml | 4 +- src/lib/merkle_mask/masking_merkle_tree.ml | 121 +++++++++++--------- 2 files changed, 69 insertions(+), 56 deletions(-) diff --git a/src/lib/merkle_mask/maskable_merkle_tree.ml b/src/lib/merkle_mask/maskable_merkle_tree.ml index 03cd755ee93..f057a9f6587 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree.ml @@ -234,7 +234,7 @@ module Make (Inputs : Inputs_intf) = struct if not (Mask.Attached.is_committing mask) then ( Mask.Attached.parent_set_notify mask account ; let child_uuid = Mask.Attached.get_uuid mask in -Mask.Attached.drop_accumulated mask; + Mask.Attached.drop_accumulated mask ; iter_descendants child_uuid ~f:Mask.Attached.drop_accumulated ; [%log error] "Update of an account in parent %s conflicted with an account \ @@ -268,7 +268,7 @@ Mask.Attached.drop_accumulated mask; List.iter masks ~f:(fun mask -> if not (Mask.Attached.is_committing mask) then ( let child_uuid = Mask.Attached.get_uuid mask in -Mask.Attached.drop_accumulated mask; + Mask.Attached.drop_accumulated mask ; iter_descendants child_uuid ~f:Mask.Attached.drop_accumulated ; [%log error] "Update of an account in parent %s conflicted with an account \ diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index eadc747687d..d147c85964b 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -39,25 +39,22 @@ module Make (Inputs : Inputs_intf.S) = struct end type maps_t = - { mutable accounts : Account.t Location_binable.Map.t - ; mutable token_owners : Account_id.t Token_id.Map.t - ; mutable hashes : Hash.t Addr.Map.t - ; mutable locations : Location.t Account_id.Map.t + { accounts : Account.t Location_binable.Map.t + ; token_owners : Account_id.t Token_id.Map.t + ; hashes : Hash.t Addr.Map.t + ; locations : Location.t Account_id.Map.t } [@@deriving sexp] - let maps_copy { accounts; token_owners; hashes; locations } = - { accounts; token_owners; hashes; locations } - (** Merges second maps object into the first one, potentially overwriting some keys *) let maps_merge base { accounts; token_owners; hashes; locations } = let combine ~key:_ _ v = v in - base.accounts <- Map.merge_skewed ~combine base.accounts accounts ; - base.token_owners <- - Map.merge_skewed ~combine base.token_owners token_owners ; - base.hashes <- Map.merge_skewed ~combine base.hashes hashes ; - base.locations <- Map.merge_skewed ~combine base.locations locations + { accounts = Map.merge_skewed ~combine base.accounts accounts + ; token_owners = Map.merge_skewed ~combine base.token_owners token_owners + ; hashes = Map.merge_skewed ~combine base.hashes hashes + ; locations = Map.merge_skewed ~combine base.locations locations + } (** Structure managing cache accumulated since the "base" ledger. @@ -79,9 +76,9 @@ module Make (Inputs : Inputs_intf.S) = struct [current] to [next] and [next] to [t.maps] when the mask at which accumulation of [next] started became detached. *) type accumulated_t = - { current : maps_t + { mutable current : maps_t (** Currently used cache: contains a superset of contents of masks from base ledger to the current mask *) - ; next : maps_t + ; mutable next : maps_t (** Cache that will be used after the current cache is garbage-collected *) ; base : Base.t (** Base ledger *) ; detached_next_signal : Detached_parent_signal.t @@ -97,7 +94,7 @@ module Make (Inputs : Inputs_intf.S) = struct ; detached_parent_signal : Detached_parent_signal.t ; mutable current_location : Location.t option ; depth : int - ; maps : maps_t + ; mutable maps : maps_t (* If present, contains maps containing changes both for this mask and for a few ancestors. This is used as a lookup cache. *) @@ -200,7 +197,7 @@ module Make (Inputs : Inputs_intf.S) = struct } ) (** When [accumulated] is not configured, returns current [t.maps] and parent. - + Otherwise, returns the [current] accumulator and [base]. *) let maps_and_ancestor t = actualize_accumulated t ; @@ -215,15 +212,11 @@ module Make (Inputs : Inputs_intf.S) = struct actualize_accumulated t ; match (t.accumulated, t.parent) with | Some { base; detached_next_signal; next; current }, _ -> - { base - ; detached_next_signal - ; next = maps_copy next - ; current = maps_copy current - } + { base; detached_next_signal; next; current } | None, Ok base -> { base - ; next = maps_copy t.maps - ; current = maps_copy t.maps + ; next = t.maps + ; current = t.maps ; detached_next_signal = t.detached_parent_signal } | None, Error loc -> @@ -238,13 +231,14 @@ module Make (Inputs : Inputs_intf.S) = struct let depth t = assert_is_attached t ; t.depth let update_maps ~f t = - f t.maps ; - Option.iter t.accumulated ~f:(fun { current; next; _ } -> - f current ; f next ) + t.maps <- f t.maps ; + Option.iter t.accumulated ~f:(fun acc -> + acc.current <- f acc.current ; + acc.next <- f acc.next ) let self_set_hash t address hash = update_maps t ~f:(fun maps -> - maps.hashes <- Map.set maps.hashes ~key:address ~data:hash ) + { maps with hashes = Map.set maps.hashes ~key:address ~data:hash } ) let set_inner_hash_at_addr_exn t address hash = assert_is_attached t ; @@ -253,8 +247,9 @@ module Make (Inputs : Inputs_intf.S) = struct let self_set_location t account_id location = update_maps t ~f:(fun maps -> - maps.locations <- - Map.set maps.locations ~key:account_id ~data:location ) ; + { maps with + locations = Map.set maps.locations ~key:account_id ~data:location + } ) ; (* if account is at a hitherto-unused location, that becomes the current location *) @@ -267,13 +262,17 @@ module Make (Inputs : Inputs_intf.S) = struct let self_set_account t location account = update_maps t ~f:(fun maps -> - maps.accounts <- Map.set maps.accounts ~key:location ~data:account ) ; + { maps with + accounts = Map.set maps.accounts ~key:location ~data:account + } ) ; self_set_location t (Account.identifier account) location let self_set_token_owner t token_id account_id = update_maps t ~f:(fun maps -> - maps.token_owners <- - Map.set maps.token_owners ~key:token_id ~data:account_id ) + { maps with + token_owners = + Map.set maps.token_owners ~key:token_id ~data:account_id + } ) (* a read does a lookup in the account_tbl; if that fails, delegate to parent *) @@ -529,15 +528,19 @@ module Make (Inputs : Inputs_intf.S) = struct let remove_account_and_update_hashes t location = (* remove account and key from tables *) let account = Option.value_exn (Map.find t.maps.accounts location) in - t.maps.accounts <- Map.remove t.maps.accounts location ; - (* Update token info. *) let account_id = Account.identifier account in - t.maps.token_owners <- - Token_id.Map.remove t.maps.token_owners - (Account_id.derive_token_id ~owner:account_id) ; - (* TODO : use stack database to save unused location, which can be used - when allocating a location *) - t.maps.locations <- Map.remove t.maps.locations account_id ; + t.maps <- + { t.maps with + (* remove account and key from tables *) + accounts = + Map.remove t.maps.accounts location (* update token info. *) + ; token_owners = + Token_id.Map.remove t.maps.token_owners + (Account_id.derive_token_id ~owner:account_id) + (* TODO : use stack database to save unused location, which can be used + when allocating a location *) + ; locations = Map.remove t.maps.locations account_id + } ; (* reuse location if possible *) Option.iter t.current_location ~f:(fun curr_loc -> if Location.equal location curr_loc then @@ -656,10 +659,12 @@ module Make (Inputs : Inputs_intf.S) = struct let parent = get_parent t in let old_root_hash = merkle_root t in let account_data = Map.to_alist t.maps.accounts in - t.maps.accounts <- Location_binable.Map.empty ; - t.maps.hashes <- Addr.Map.empty ; - t.maps.locations <- Account_id.Map.empty ; - t.maps.token_owners <- Token_id.Map.empty ; + t.maps <- + { t.maps with + accounts = Location_binable.Map.empty + ; hashes = Addr.Map.empty + ; token_owners = Token_id.Map.empty + } ; Base.set_batch parent account_data ; Debug_assert.debug_assert (fun () -> [%test_result: Hash.t] @@ -679,12 +684,13 @@ module Make (Inputs : Inputs_intf.S) = struct ; detached_parent_signal = Async.Ivar.create () ; current_location = t.current_location ; depth = t.depth - ; maps = maps_copy t.maps + ; maps = t.maps ; accumulated = Option.map t.accumulated ~f:(fun acc -> - { acc with - next = maps_copy acc.next - ; current = maps_copy acc.current + { base = acc.base + ; detached_next_signal = acc.detached_next_signal + ; next = acc.next + ; current = acc.current } ) ; is_committing = false } @@ -887,9 +893,12 @@ module Make (Inputs : Inputs_intf.S) = struct as sometimes this is desired behavior *) let close t = assert_is_attached t ; - t.maps.accounts <- Location_binable.Map.empty ; - t.maps.hashes <- Addr.Map.empty ; - t.maps.locations <- Account_id.Map.empty ; + t.maps <- + { t.maps with + accounts = Location_binable.Map.empty + ; hashes = Addr.Map.empty + ; locations = Account_id.Map.empty + } ; Async.Ivar.fill_if_empty t.detached_parent_signal () let index_of_account_exn t key = @@ -1047,9 +1056,13 @@ module Make (Inputs : Inputs_intf.S) = struct ( match accumulated_opt with | Some { current; next; base; detached_next_signal } when Option.is_none t.accumulated -> - maps_merge current t.maps ; - maps_merge next t.maps ; - t.accumulated <- Some { current; next; base; detached_next_signal } + t.accumulated <- + Some + { current = maps_merge current t.maps + ; next = maps_merge next t.maps + ; base + ; detached_next_signal + } | _ -> () ) ; t From 4f8bb8e51f1783b07d143a2e6a8af96e41f36f5d Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 7 Dec 2023 17:38:16 +0100 Subject: [PATCH 19/19] fixup! Refactor ledger mask update_maps; fix mutation bug in set_parent --- src/lib/merkle_mask/masking_merkle_tree.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index d147c85964b..ab56cf72e51 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -660,10 +660,10 @@ module Make (Inputs : Inputs_intf.S) = struct let old_root_hash = merkle_root t in let account_data = Map.to_alist t.maps.accounts in t.maps <- - { t.maps with - accounts = Location_binable.Map.empty + { accounts = Location_binable.Map.empty ; hashes = Addr.Map.empty ; token_owners = Token_id.Map.empty + ; locations = Account_id.Map.empty } ; Base.set_batch parent account_data ; Debug_assert.debug_assert (fun () ->