From da5379243c2b85fde2809283fa57ebcd90ef46eb Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Mon, 6 Nov 2023 14:57:02 +0000 Subject: [PATCH 1/4] Batch account location lookups for sparse ledger --- src/lib/mina_ledger/sparse_ledger.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/lib/mina_ledger/sparse_ledger.ml b/src/lib/mina_ledger/sparse_ledger.ml index 304a163dffc..2e9271f0dec 100644 --- a/src/lib/mina_ledger/sparse_ledger.ml +++ b/src/lib/mina_ledger/sparse_ledger.ml @@ -8,10 +8,11 @@ let of_ledger_root ledger = let of_ledger_subset_exn (oledger : Ledger.t) keys = let ledger = Ledger.copy oledger in + let locations = Ledger.location_of_account_batch ledger keys in let _, sparse = - List.fold keys - ~f:(fun (new_keys, sl) key -> - match Ledger.location_of_account ledger key with + List.fold locations + ~f:(fun (new_keys, sl) (key, loc) -> + match loc with | Some loc -> ( new_keys , add_path sl From a96b86b070727831942c6aeb9a61e66d0e0cbfd0 Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Wed, 8 Nov 2023 15:39:53 +0000 Subject: [PATCH 2/4] Fixup Masking_merkle_tree.location_of_account_batch --- src/lib/merkle_mask/masking_merkle_tree.ml | 46 +++++++++++++++++----- 1 file changed, 37 insertions(+), 9 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index f24ef206a70..4aa7dd5d820 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -535,16 +535,44 @@ module Make (Inputs : Inputs_intf.S) = struct let location_of_account_batch t account_ids = assert_is_attached t ; - let found_locations, leftover_account_ids = - List.partition_map account_ids ~f:(fun account_id -> - match self_find_location t account_id with - | Some location -> - Either.first (account_id, Some location) - | None -> - Either.second account_id ) + let account_ids_with_locations_rev, leftover_account_ids_rev = + let rec go account_ids account_ids_with_locations_rev + leftover_account_ids_rev = + match account_ids with + | [] -> + (account_ids_with_locations_rev, leftover_account_ids_rev) + | account_id :: account_ids -> ( + match self_find_location t account_id with + | None -> + go account_ids + ((account_id, None) :: account_ids_with_locations_rev) + (account_id :: leftover_account_ids_rev) + | Some loc -> + go account_ids + ((account_id, Some loc) :: account_ids_with_locations_rev) + leftover_account_ids_rev ) + in + go account_ids [] [] + in + let leftover_account_id_locs_rev = + Base.location_of_account_batch (get_parent t) leftover_account_ids_rev + in + let rec go account_ids_with_locations_rev leftover_account_ids_rev locs = + match (account_ids_with_locations_rev, leftover_account_ids_rev) with + | [], _ -> + locs + | ( (account_id, None) :: account_ids_with_locations_rev + , (_account_id, loc) :: leftover_account_ids_rev ) -> + go account_ids_with_locations_rev leftover_account_ids_rev + ((account_id, loc) :: locs) + | ( (account_id, Some loc) :: account_ids_with_locations_rev + , leftover_account_ids_rev ) -> + go account_ids_with_locations_rev leftover_account_ids_rev + ((account_id, Some loc) :: locs) + | _ :: _, [] -> + assert false in - found_locations - @ Base.location_of_account_batch (get_parent t) leftover_account_ids + go account_ids_with_locations_rev leftover_account_id_locs_rev [] (* not needed for in-memory mask; in the database, it's currently a NOP *) let make_space_for t = From d10bf7edea5f33d525e5756a5244801e92876d2b Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 8 Nov 2023 17:22:25 +0100 Subject: [PATCH 3/4] Fixup batching operations in masking ledger --- src/lib/merkle_mask/masking_merkle_tree.ml | 77 ++++++++-------------- 1 file changed, 28 insertions(+), 49 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 4aa7dd5d820..5dd06f6026c 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -183,17 +183,33 @@ module Make (Inputs : Inputs_intf.S) = struct | None -> Base.get (get_parent t) location - let get_batch t locations = + let self_find_or_batch_lookup self_find lookup_parent t ids = assert_is_attached t ; - let found_accounts, leftover_locations = - List.partition_map locations ~f:(fun location -> - match self_find_account t location with - | Some account -> - Either.first (location, Some account) - | None -> - Either.second location ) + let self_found_or_none = + List.map ids ~f:(fun id -> (id, self_find t id)) + in + let not_found = + List.filter_map self_found_or_none ~f:(function + | id, None -> + Some id + | _ -> + None ) in - found_accounts @ Base.get_batch (get_parent t) leftover_locations + let from_parent = lookup_parent (get_parent t) not_found in + let _, res = + List.fold_map self_found_or_none ~init:from_parent + ~f:(fun from_parent (id, self_found) -> + match (self_found, from_parent) with + | None, r :: rest -> + (rest, r) + | Some _, _ -> + (from_parent, (id, self_found)) + | _ -> + failwith "unexpected number of results from DB" ) + in + res + + let get_batch = self_find_or_batch_lookup self_find_account Base.get_batch (* fixup_merkle_path patches a Merkle path reported by the parent, overriding with hashes which are stored in the mask *) @@ -533,46 +549,9 @@ module Make (Inputs : Inputs_intf.S) = struct | None -> Base.location_of_account (get_parent t) account_id - let location_of_account_batch t account_ids = - assert_is_attached t ; - let account_ids_with_locations_rev, leftover_account_ids_rev = - let rec go account_ids account_ids_with_locations_rev - leftover_account_ids_rev = - match account_ids with - | [] -> - (account_ids_with_locations_rev, leftover_account_ids_rev) - | account_id :: account_ids -> ( - match self_find_location t account_id with - | None -> - go account_ids - ((account_id, None) :: account_ids_with_locations_rev) - (account_id :: leftover_account_ids_rev) - | Some loc -> - go account_ids - ((account_id, Some loc) :: account_ids_with_locations_rev) - leftover_account_ids_rev ) - in - go account_ids [] [] - in - let leftover_account_id_locs_rev = - Base.location_of_account_batch (get_parent t) leftover_account_ids_rev - in - let rec go account_ids_with_locations_rev leftover_account_ids_rev locs = - match (account_ids_with_locations_rev, leftover_account_ids_rev) with - | [], _ -> - locs - | ( (account_id, None) :: account_ids_with_locations_rev - , (_account_id, loc) :: leftover_account_ids_rev ) -> - go account_ids_with_locations_rev leftover_account_ids_rev - ((account_id, loc) :: locs) - | ( (account_id, Some loc) :: account_ids_with_locations_rev - , leftover_account_ids_rev ) -> - go account_ids_with_locations_rev leftover_account_ids_rev - ((account_id, Some loc) :: locs) - | _ :: _, [] -> - assert false - in - go account_ids_with_locations_rev leftover_account_id_locs_rev [] + let location_of_account_batch = + self_find_or_batch_lookup self_find_location + Base.location_of_account_batch (* not needed for in-memory mask; in the database, it's currently a NOP *) let make_space_for t = From f8c70177747c0d21d1473365e17ff9017e0ac1ce Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 28 Nov 2023 18:17:31 +0100 Subject: [PATCH 4/4] Rename variable in merkle_path_dependencies_exn --- src/lib/merkle_ledger/location.ml | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/lib/merkle_ledger/location.ml b/src/lib/merkle_ledger/location.ml index 8c2e6105f2b..e19fc5f6f14 100644 --- a/src/lib/merkle_ledger/location.ml +++ b/src/lib/merkle_ledger/location.ml @@ -147,17 +147,23 @@ module T = struct | Right -> (sibling, base) + (* Returns a reverse of traversal path from top of the tree to the location + (direction to take and sibling's hash).contents + + By reverse it means that head of returned list contains direction from + location's parent to the location along with the location's sibling. + *) let merkle_path_dependencies_exn (location : t) : (t * Direction.t) list = - let rec loop k acc = - if Addr.depth k = 0 then acc + let rec loop k = + if Addr.depth k = 0 then [] else let sibling = Hash (Addr.sibling k) in - let sibling_dir = last_direction k in - loop (Addr.parent_exn k) ((sibling, sibling_dir) :: acc) + let dir = last_direction k in + (sibling, dir) :: loop (Addr.parent_exn k) in match location with | Hash addr -> - List.rev (loop addr []) + loop addr | _ -> failwith "can only get merkle path dependencies of a hash location"