don't compute hashes

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

src/lib/sparse_ledger_lib/sparse_ledger.ml

@@ -133,42 +133,38 @@ 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
     in
     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
     }