From eab56d9169597e381d1162fa60a2c3d0962a3c94 Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Mon, 6 Nov 2023 14:19:41 +0000 Subject: [PATCH] Allow setting and getting from empty paths in the sparse ledger --- src/lib/mina_base/pending_coinbase.ml | 8 ++- src/lib/mina_base/sparse_ledger_base.ml | 15 +++-- src/lib/sparse_ledger_lib/dune | 2 + src/lib/sparse_ledger_lib/sparse_ledger.ml | 66 +++++++++++++++------- 4 files changed, 66 insertions(+), 25 deletions(-) diff --git a/src/lib/mina_base/pending_coinbase.ml b/src/lib/mina_base/pending_coinbase.ml index 84aeabc8a4a..75f75f5f708 100644 --- a/src/lib/mina_base/pending_coinbase.ml +++ b/src/lib/mina_base/pending_coinbase.ml @@ -766,7 +766,13 @@ module Make_str (A : Wire_types.Concrete) = struct Type_equal.t ) = Type_equal.T - module M = Sparse_ledger_lib.Sparse_ledger.Make (Hash) (Stack_id) (Stack) + module M = + Sparse_ledger_lib.Sparse_ledger.Make (Hash) (Stack_id) + (struct + include Stack + + let empty = lazy empty + end) [%%define_locally M.(of_hash, get_exn, path_exn, set_exn, find_index, add_path, merkle_root)] diff --git a/src/lib/mina_base/sparse_ledger_base.ml b/src/lib/mina_base/sparse_ledger_base.ml index 0592af627ae..f9eea65fdde 100644 --- a/src/lib/mina_base/sparse_ledger_base.ml +++ b/src/lib/mina_base/sparse_ledger_base.ml @@ -28,6 +28,8 @@ module Account = struct include Account let data_hash = Fn.compose Ledger_hash.of_digest Account.digest + + let empty = lazy empty end module Global_state = struct @@ -68,9 +70,10 @@ module L = struct let location_of_account : t -> Account_id.t -> location option = fun t id -> - match M.find_index !t id with - | None -> None - | Some loc -> + match M.find_index !t id with + | None -> + None + | Some loc -> let account = M.get_exn !t loc in if Public_key.Compressed.(equal empty account.public_key) then None else Some loc @@ -96,7 +99,7 @@ module L = struct | None -> let loc, new_t = M.allocate_index !t id in t := new_t ; - let account' = create_account loc Account.empty in + let account' = create_account loc (Lazy.force Account.empty) in (`Added, account', loc) | Some loc -> let account = M.get_exn !t loc in @@ -227,7 +230,9 @@ let handler t = index | None -> let index, new_ledger = allocate_index !ledger pk in - let new_ledger = set_exn new_ledger index Account.empty in + let new_ledger = + set_exn new_ledger index (Lazy.force Account.empty) + in ledger := new_ledger ; index in diff --git a/src/lib/sparse_ledger_lib/dune b/src/lib/sparse_ledger_lib/dune index d4ceea27859..0c0157f9676 100644 --- a/src/lib/sparse_ledger_lib/dune +++ b/src/lib/sparse_ledger_lib/dune @@ -13,6 +13,8 @@ bin_prot.shape result ppx_version.runtime + ;; local libraries + empty_hashes ) (preprocess (pps ppx_jane ppx_compare ppx_deriving_yojson ppx_version)) diff --git a/src/lib/sparse_ledger_lib/sparse_ledger.ml b/src/lib/sparse_ledger_lib/sparse_ledger.ml index b152b655421..4b57716c11c 100644 --- a/src/lib/sparse_ledger_lib/sparse_ledger.ml +++ b/src/lib/sparse_ledger_lib/sparse_ledger.ml @@ -100,6 +100,8 @@ end) (Account : sig type t [@@deriving equal, sexp, yojson] val data_hash : t -> Hash.t + + val empty : t Lazy.t end) : sig include S @@ -109,6 +111,14 @@ end) : sig val hash : (Hash.t, Account.t) Tree.t -> Hash.t end = struct + let empty_hash = + lazy + (Empty_hashes.extensible_cache + (module Hash) + ~init_hash:(Account.data_hash (Lazy.force Account.empty)) ) + + let empty_hash i = (Lazy.force empty_hash) i + type t = (Hash.t, Account_id.t, Account.t) T.t [@@deriving sexp, yojson] let of_hash ~depth ~current_location (hash : Hash.t) = @@ -215,6 +225,8 @@ end = struct | false, Node (_, l, r) -> let go_right = ith_bit idx i in if go_right then go (i - 1) r else go (i - 1) l + | _, Hash h when Hash.equal h (empty_hash i) -> + Lazy.force Account.empty | _ -> let expected_kind = if i < 0 then "n account" else " node" in let kind = @@ -244,6 +256,14 @@ end = struct if go_right then (l, go (i - 1) r) else (go (i - 1) l, r) in Node (Hash.merge ~height:i (hash l) (hash r), l, r) + | false, Hash h when Hash.equal h (empty_hash i) -> + let inner = + if i > 0 then Tree.Hash (empty_hash (i - 1)) + else Tree.Account (Lazy.force Account.empty) + in + go i (Node (h, inner, inner)) + | true, Hash h when Hash.equal h (empty_hash i) -> + Tree.Account acct | _ -> let expected_kind = if i < 0 then "n account" else " node" in let kind = @@ -269,6 +289,12 @@ end = struct match tree with | Tree.Account _ -> failwithf "Sparse_ledger.path: Bad depth at index %i." idx () + | Hash h when Hash.equal h (empty_hash i) -> + let inner = + if i > 0 then Tree.Hash (empty_hash (i - 1)) + else Tree.Account (Lazy.force Account.empty) + in + go acc i (Tree.Node (h, inner, inner)) | Hash _ -> failwithf "Sparse_ledger.path: Dead end at index %i." idx () | Node (_, l, r) -> @@ -283,6 +309,27 @@ type ('hash, 'key, 'account) t = ('hash, 'key, 'account) T.t [@@deriving yojson] let%test_module "sparse-ledger-test" = ( module struct + module Account = struct + module T = struct + type t = { name : string; favorite_number : int } + [@@deriving bin_io, equal, sexp, yojson] + end + + include T + + let key { name; _ } = name + + let data_hash t = Md5.digest_string (Binable.to_string (module T) t) + + let gen = + let open Quickcheck.Generator.Let_syntax in + let%map name = String.quickcheck_generator + and favorite_number = Int.quickcheck_generator in + { name; favorite_number } + + let empty = lazy { name = ""; favorite_number = 0 } + end + module Hash = struct type t = Core_kernel.Md5.t [@@deriving sexp, compare] @@ -307,25 +354,6 @@ let%test_module "sparse-ledger-test" = ~f:Md5.digest_string end - module Account = struct - module T = struct - type t = { name : string; favorite_number : int } - [@@deriving bin_io, equal, sexp, yojson] - end - - include T - - let key { name; _ } = name - - let data_hash t = Md5.digest_string (Binable.to_string (module T) t) - - let gen = - let open Quickcheck.Generator.Let_syntax in - let%map name = String.quickcheck_generator - and favorite_number = Int.quickcheck_generator in - { name; favorite_number } - end - module Account_id = struct type t = string [@@deriving sexp, equal, yojson] end