diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index ec1e2c1e8568..a0a173e98b7a 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -713,7 +713,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/sparse_ledger_lib/sparse_ledger.ml b/src/lib/sparse_ledger_lib/sparse_ledger.ml index a594d6c13f2b..4138c5474681 100644 --- a/src/lib/sparse_ledger_lib/sparse_ledger.ml +++ b/src/lib/sparse_ledger_lib/sparse_ledger.ml @@ -133,22 +133,26 @@ end = struct let merkle_root { T.tree; _ } = hash tree - let add_path_impl ~left_sibling_hash ~right_sibling_hash depth0 tree0 path0 - account = - let rec build_tree height p = + let add_path_impl ~left_split ~right_split ~mk_left_merge ~mk_right_merge + depth0 tree0 path0 account = + let rec build_tree n_hash height p = match p with - | `Left h :: path -> - let l = build_tree (height - 1) path in - Tree.Node - ( Hash.merge ~height (hash l) (left_sibling_hash h) - , l - , Hash (left_sibling_hash h) ) - | `Right h :: path -> - let r = build_tree (height - 1) path in - Node - ( Hash.merge ~height (right_sibling_hash h) (hash r) - , Hash (right_sibling_hash h) - , r ) + | `Left hash :: path -> + let l_hash, r_hash = left_split hash in + let l_tree = build_tree l_hash (height - 1) path in + let n_hash' = + let merge = mk_left_merge n_hash in + merge ~height l_tree r_hash + in + Tree.Node (n_hash', l_tree, Hash r_hash) + | `Right hash :: path -> + let l_hash, r_hash = right_split hash in + let r_tree = build_tree r_hash (height - 1) path in + let n_hash' = + let merge = mk_right_merge n_hash in + merge ~height l_hash r_tree + in + Node (n_hash', Hash l_hash, r_tree) | [] -> assert (height = -1) ; Account account @@ -156,19 +160,11 @@ end = struct let rec union height tree path = match (tree, path) with | Tree.Hash h, path -> - let t = build_tree height path in - [%test_result: Hash.t] - ~message: - "Hashes in union are not equal, something is wrong with your \ - ledger" - ~expect:h (hash t) ; - t - | Node (h, l, r), `Left h' :: path -> - assert (Hash.equal (left_sibling_hash h') (hash r)) ; + build_tree (Some h) height path + | Node (h, l, r), `Left _ :: path -> let l = union (height - 1) l path in Node (h, l, r) - | Node (h, l, r), `Right h' :: path -> - assert (Hash.equal (right_sibling_hash h') (hash l)) ; + | Node (h, l, r), `Right _ :: path -> let r = union (height - 1) r path in Node (h, l, r) | Node _, [] -> @@ -181,27 +177,35 @@ end = struct in union (depth0 - 1) tree0 (List.rev path0) + let index_from ~path = + List.foldi path ~init:0 ~f:(fun i acc x -> + match x with `Right _ -> acc + (1 lsl i) | `Left _ -> acc ) + let add_path (t : t) path account_id account = - let index = - List.foldi path ~init:0 ~f:(fun i acc x -> - match x with `Right _ -> acc + (1 lsl i) | `Left _ -> acc ) - in + let index = index_from ~path in { t with tree = - add_path_impl ~left_sibling_hash:ident ~right_sibling_hash:ident t.depth - t.tree path account + add_path_impl + ~left_split:(function h -> (None, h)) + ~right_split:(fun h -> (h, None)) + ~mk_left_merge:(fun _ ~height l_tree r_hash -> + Hash.merge ~height (hash l_tree) r_hash ) + ~mk_right_merge:(fun _ ~height l_hash r_tree -> + Hash.merge ~height l_hash (hash r_tree) ) + t.depth t.tree path account ; indexes = (account_id, index) :: t.indexes } let add_wide_path_unsafe (t : t) path account_id account = - let index = - List.foldi path ~init:0 ~f:(fun i acc x -> - match x with `Right _ -> acc + (1 lsl i) | `Left _ -> acc ) - in + let index = index_from ~path in { t with tree = - add_path_impl ~left_sibling_hash:snd ~right_sibling_hash:fst t.depth - t.tree path account + add_path_impl + ~left_split:(fun (l, r) -> (Some l, r)) + ~right_split:(fun (l, r) -> (l, Some r)) + ~mk_left_merge:(fun h ~height:_ _ _ -> Option.value_exn h) + ~mk_right_merge:(fun h ~height:_ _ _ -> Option.value_exn h) + t.depth t.tree path account ; indexes = (account_id, index) :: t.indexes }