diff --git a/src/lib/merkle_ledger/any_ledger.ml b/src/lib/merkle_ledger/any_ledger.ml index 6ead0706150..656cf6a2f8d 100644 --- a/src/lib/merkle_ledger/any_ledger.ml +++ b/src/lib/merkle_ledger/any_ledger.ml @@ -120,6 +120,8 @@ module Make_base (Inputs : Inputs_intf) : let merkle_path (T ((module Base), t)) = Base.merkle_path t + let merkle_path_batch (T ((module Base), t)) = Base.merkle_path_batch t + let merkle_root (T ((module Base), t)) = Base.merkle_root t let index_of_account_exn (T ((module Base), t)) = diff --git a/src/lib/merkle_ledger/base_ledger_intf.ml b/src/lib/merkle_ledger/base_ledger_intf.ml index a656ff4ffca..64f4a934826 100644 --- a/src/lib/merkle_ledger/base_ledger_intf.ml +++ b/src/lib/merkle_ledger/base_ledger_intf.ml @@ -134,6 +134,8 @@ module type S = sig val merkle_path_at_index_exn : t -> int -> Path.t + val merkle_path_batch : t -> Location.t list -> Path.t list + val remove_accounts_exn : t -> account_id list -> unit (** Triggers when the ledger has been detached and should no longer be diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index 92d41962bf7..49d7fb9347d 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -720,6 +720,58 @@ module Make (Inputs : Inputs_intf) : in loop rev_directions rev_hashes [] + let merkle_path_batch mdb locations = + let locations = + List.map locations ~f:(fun location -> + if Location.is_account location then + Location.Hash (Location.to_path_exn location) + else ( + assert (Location.is_hash location) ; + location ) ) + in + let rev_locations, rev_directions, rev_lengths = + let rec loop locations loc_acc dir_acc length_acc = + match (locations, length_acc) with + | [], _ :: length_acc -> + (loc_acc, dir_acc, length_acc) + | k :: locations, length :: length_acc -> + if Location.height ~ledger_depth:mdb.depth k >= mdb.depth then + loop locations loc_acc dir_acc (0 :: length :: length_acc) + else + let sibling = Location.sibling k in + let sibling_dir = + Location.last_direction (Location.to_path_exn k) + in + loop + (Location.parent k :: locations) + (sibling :: loc_acc) (sibling_dir :: dir_acc) + ((length + 1) :: length_acc) + | _ -> + assert false + in + loop locations [] [] [ 0 ] + in + let rev_hashes = get_hash_batch mdb rev_locations in + let rec loop directions hashes lengths acc = + match (directions, hashes, lengths, acc) with + | [], [], [], _ (* actually [] *) :: acc_tl -> + acc_tl + | _, _, 0 :: lengths, _ -> + loop directions hashes lengths ([] :: acc) + | ( direction :: directions + , hash :: hashes + , length :: lengths + , acc_hd :: acc_tl ) -> + let dir = + Direction.map direction ~left:(`Left hash) ~right:(`Right hash) + in + loop directions hashes ((length - 1) :: lengths) + ((dir :: acc_hd) :: acc_tl) + | _ -> + failwith "Mismatched lengths" + in + loop rev_directions rev_hashes rev_lengths [ [] ] + let merkle_path_at_addr_exn t addr = merkle_path t (Location.Hash addr) let merkle_path_at_index_exn t index = diff --git a/src/lib/merkle_ledger/null_ledger.ml b/src/lib/merkle_ledger/null_ledger.ml index cfc0cf953da..2d67ffdfa35 100644 --- a/src/lib/merkle_ledger/null_ledger.ml +++ b/src/lib/merkle_ledger/null_ledger.ml @@ -64,6 +64,8 @@ end = struct in loop location + let merkle_path_batch t locations = List.map ~f:(merkle_path t) locations + let merkle_root t = empty_hash_at_height t.depth let merkle_path_at_addr_exn t addr = merkle_path t (Location.Hash addr) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index f24ef206a70..7e82ed243f5 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -244,6 +244,16 @@ module Make (Inputs : Inputs_intf.S) = struct let parent_merkle_path = Base.merkle_path (get_parent t) location in fixup_merkle_path t parent_merkle_path address + let merkle_path_batch t locations = + assert_is_attached t ; + let addresses = List.map ~f:Location.to_path_exn locations in + let parent_merkle_paths = + Base.merkle_path_batch (get_parent t) locations + in + List.map2_exn + ~f:(fun path address -> fixup_merkle_path t path address) + parent_merkle_paths addresses + (* given a Merkle path corresponding to a starting address, calculate addresses and hashes for each node affected by the starting hash; that is, along the path from the account address to root *)