From f4c1eaea6ad974439addfa420eac998fe94f7540 Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Mon, 6 Nov 2023 11:57:20 +0000 Subject: [PATCH 1/5] Add current_location to Sparse_ledger.t --- src/lib/mina_base/pending_coinbase.ml | 5 ++++- src/lib/mina_base/sparse_ledger_base.ml | 8 +++++--- src/lib/mina_base/sparse_ledger_base.mli | 2 +- src/lib/mina_ledger/sparse_ledger.ml | 11 ++++++++++- src/lib/sparse_ledger_lib/sparse_ledger.ml | 17 +++++++++++++---- 5 files changed, 33 insertions(+), 10 deletions(-) diff --git a/src/lib/mina_base/pending_coinbase.ml b/src/lib/mina_base/pending_coinbase.ml index dc8639181ba..b0202a716c1 100644 --- a/src/lib/mina_base/pending_coinbase.ml +++ b/src/lib/mina_base/pending_coinbase.ml @@ -1055,7 +1055,10 @@ module Make_str (A : Wire_types.Concrete) = struct in let root_hash = hash_at_level depth in { Poly.tree = - make_tree (Merkle_tree.of_hash ~depth root_hash) Stack_id.zero + make_tree + (Merkle_tree.of_hash ~depth root_hash + ~current_location:(* Hack: unused*) None ) + Stack_id.zero ; pos_list = [] ; new_pos = Stack_id.zero } diff --git a/src/lib/mina_base/sparse_ledger_base.ml b/src/lib/mina_base/sparse_ledger_base.ml index 649cff6309c..f3e53261f13 100644 --- a/src/lib/mina_base/sparse_ledger_base.ml +++ b/src/lib/mina_base/sparse_ledger_base.ml @@ -50,7 +50,8 @@ type account_state = [ `Added | `Existed ] [@@deriving equal] This ledger has an invalid root hash, and cannot be used except as a placeholder. *) -let empty ~depth () = M.of_hash ~depth Outside_hash_image.t +let empty ~depth () = + M.of_hash ~depth ~current_location:None Outside_hash_image.t module L = struct type t = M.t ref @@ -156,8 +157,9 @@ M. , merkle_root , iteri )] -let of_root ~depth (h : Ledger_hash.t) = - of_hash ~depth (Ledger_hash.of_digest (h :> Random_oracle.Digest.t)) +let of_root ~depth ~current_location (h : Ledger_hash.t) = + of_hash ~depth ~current_location + (Ledger_hash.of_digest (h :> Random_oracle.Digest.t)) let get_or_initialize_exn account_id t idx = let account = get_exn t idx in diff --git a/src/lib/mina_base/sparse_ledger_base.mli b/src/lib/mina_base/sparse_ledger_base.mli index 3c30e910a12..67a09efa1d1 100644 --- a/src/lib/mina_base/sparse_ledger_base.mli +++ b/src/lib/mina_base/sparse_ledger_base.mli @@ -44,7 +44,7 @@ val path_exn : val find_index_exn : t -> Account_id.t -> int -val of_root : depth:int -> Ledger_hash.t -> t +val of_root : depth:int -> current_location:int option -> Ledger_hash.t -> t (** Create a new 'empty' ledger. This ledger has an invalid root hash, and cannot be used except as a diff --git a/src/lib/mina_ledger/sparse_ledger.ml b/src/lib/mina_ledger/sparse_ledger.ml index 304a163dffc..7ffb5fef0f1 100644 --- a/src/lib/mina_ledger/sparse_ledger.ml +++ b/src/lib/mina_ledger/sparse_ledger.ml @@ -4,7 +4,12 @@ include Sparse_ledger_base module GS = Global_state let of_ledger_root ledger = - of_root ~depth:(Ledger.depth ledger) (Ledger.merkle_root ledger) + of_root ~depth:(Ledger.depth ledger) + ~current_location: + ( Option.map ~f:(fun x -> + Ledger.Location.Addr.to_int @@ Ledger.Location.to_path_exn x ) + @@ Ledger.last_filled ledger ) + (Ledger.merkle_root ledger) let of_ledger_subset_exn (oledger : Ledger.t) keys = let ledger = Ledger.copy oledger in @@ -35,6 +40,10 @@ let of_ledger_index_subset_exn (ledger : Ledger.Any_ledger.witness) indexes = ~init: (of_root ~depth:(Ledger.Any_ledger.M.depth ledger) + ~current_location: + ( Option.map ~f:(fun x -> + Ledger.Location.Addr.to_int @@ Ledger.Location.to_path_exn x ) + @@ Ledger.Any_ledger.M.last_filled ledger ) (Ledger.Any_ledger.M.merkle_root ledger) ) ~f:(fun acc i -> let account = Ledger.Any_ledger.M.get_at_index_exn ledger i in diff --git a/src/lib/sparse_ledger_lib/sparse_ledger.ml b/src/lib/sparse_ledger_lib/sparse_ledger.ml index 168d408b614..c80d9649a5f 100644 --- a/src/lib/sparse_ledger_lib/sparse_ledger.ml +++ b/src/lib/sparse_ledger_lib/sparse_ledger.ml @@ -39,6 +39,7 @@ module T = struct { indexes : ('key * int) list ; depth : int ; tree : ('hash, 'account) Tree.Stable.V1.t + ; current_location : int option } [@@deriving sexp, yojson] end @@ -48,6 +49,7 @@ module T = struct { indexes : ('key * int) list ; depth : int ; tree : ('hash, 'account) Tree.t + ; current_location : int option } [@@deriving sexp, yojson] end @@ -61,7 +63,7 @@ module type S = sig type t = (hash, account_id, account) T.t [@@deriving sexp, yojson] - val of_hash : depth:int -> hash -> t + val of_hash : depth:int -> current_location:int option -> hash -> t val get_exn : t -> int -> account @@ -83,7 +85,8 @@ end let tree { T.tree; _ } = tree -let of_hash ~depth h = { T.indexes = []; depth; tree = Hash h } +let of_hash ~depth ~current_location h = + { T.indexes = []; depth; tree = Hash h; current_location } module Make (Hash : sig type t [@@deriving equal, sexp, yojson, compare] @@ -106,7 +109,8 @@ end) : sig end = struct type t = (Hash.t, Account_id.t, Account.t) T.t [@@deriving sexp, yojson] - let of_hash ~depth (hash : Hash.t) = of_hash ~depth hash + let of_hash ~depth ~current_location (hash : Hash.t) = + of_hash ~depth ~current_location hash let hash : (Hash.t, Account.t) Tree.t -> Hash.t = function | Account a -> @@ -364,7 +368,12 @@ let%test_module "sparse-ledger-test" = in let%bind depth = Int.gen_incl 0 16 in let%map tree = gen depth >>| prune_hash_branches in - { T.tree; depth; indexes = indexes depth tree } + let current_location = + (* Except with negligible probability, every hash and account will be + non-empty, so we behave as if the ledger is full. *) + Some ((1 lsl depth) - 1) + in + { T.tree; depth; indexes = indexes depth tree; current_location } let%test_unit "iteri consistent indices with t.indexes" = Quickcheck.test gen ~f:(fun t -> From ac684ab1f2371e065c8d1f90260a274ca186ad00 Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Mon, 6 Nov 2023 12:08:31 +0000 Subject: [PATCH 2/5] Add Sparse_ledger.find_index --- src/lib/mina_base/sparse_ledger_base.ml | 1 + src/lib/mina_base/sparse_ledger_base.mli | 2 ++ src/lib/sparse_ledger_lib/sparse_ledger.ml | 7 ++++++- 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/lib/mina_base/sparse_ledger_base.ml b/src/lib/mina_base/sparse_ledger_base.ml index f3e53261f13..1391ba60474 100644 --- a/src/lib/mina_base/sparse_ledger_base.ml +++ b/src/lib/mina_base/sparse_ledger_base.ml @@ -152,6 +152,7 @@ M. , get_exn , path_exn , set_exn + , find_index , find_index_exn , add_path , merkle_root diff --git a/src/lib/mina_base/sparse_ledger_base.mli b/src/lib/mina_base/sparse_ledger_base.mli index 67a09efa1d1..3e69bb01238 100644 --- a/src/lib/mina_base/sparse_ledger_base.mli +++ b/src/lib/mina_base/sparse_ledger_base.mli @@ -42,6 +42,8 @@ val set_exn : t -> int -> Account.t -> t val path_exn : t -> int -> [ `Left of Ledger_hash.t | `Right of Ledger_hash.t ] list +val find_index : t -> Account_id.t -> int option + val find_index_exn : t -> Account_id.t -> int val of_root : depth:int -> current_location:int option -> Ledger_hash.t -> t diff --git a/src/lib/sparse_ledger_lib/sparse_ledger.ml b/src/lib/sparse_ledger_lib/sparse_ledger.ml index c80d9649a5f..eb20bc31cba 100644 --- a/src/lib/sparse_ledger_lib/sparse_ledger.ml +++ b/src/lib/sparse_ledger_lib/sparse_ledger.ml @@ -71,6 +71,8 @@ module type S = sig val set_exn : t -> int -> account -> t + val find_index : t -> account_id -> int option + val find_index_exn : t -> account_id -> int val add_path : @@ -192,8 +194,11 @@ end = struct let ith_bit idx i = (idx lsr i) land 1 = 1 + let find_index (t : t) aid = + List.Assoc.find t.indexes ~equal:Account_id.equal aid + let find_index_exn (t : t) aid = - match List.Assoc.find t.indexes ~equal:Account_id.equal aid with + match find_index t aid with | Some x -> x | None -> From 88a05a49fd9c68d0b076b02aa9b81405ed1c2437 Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Mon, 6 Nov 2023 12:32:12 +0000 Subject: [PATCH 3/5] Add allocate_index helper function --- src/lib/mina_base/sparse_ledger_base.ml | 1 + src/lib/mina_base/sparse_ledger_base.mli | 2 ++ src/lib/sparse_ledger_lib/sparse_ledger.ml | 12 ++++++++++++ 3 files changed, 15 insertions(+) diff --git a/src/lib/mina_base/sparse_ledger_base.ml b/src/lib/mina_base/sparse_ledger_base.ml index 1391ba60474..4b6e95b6c9a 100644 --- a/src/lib/mina_base/sparse_ledger_base.ml +++ b/src/lib/mina_base/sparse_ledger_base.ml @@ -152,6 +152,7 @@ M. , get_exn , path_exn , set_exn + , allocate_index , find_index , find_index_exn , add_path diff --git a/src/lib/mina_base/sparse_ledger_base.mli b/src/lib/mina_base/sparse_ledger_base.mli index 3e69bb01238..d694b204f5b 100644 --- a/src/lib/mina_base/sparse_ledger_base.mli +++ b/src/lib/mina_base/sparse_ledger_base.mli @@ -42,6 +42,8 @@ val set_exn : t -> int -> Account.t -> t val path_exn : t -> int -> [ `Left of Ledger_hash.t | `Right of Ledger_hash.t ] list +val allocate_index : t -> Account_id.t -> int * t + val find_index : t -> Account_id.t -> int option val find_index_exn : t -> Account_id.t -> int diff --git a/src/lib/sparse_ledger_lib/sparse_ledger.ml b/src/lib/sparse_ledger_lib/sparse_ledger.ml index eb20bc31cba..050a577acc4 100644 --- a/src/lib/sparse_ledger_lib/sparse_ledger.ml +++ b/src/lib/sparse_ledger_lib/sparse_ledger.ml @@ -65,6 +65,8 @@ module type S = sig val of_hash : depth:int -> current_location:int option -> hash -> t + val allocate_index : t -> account_id -> int * t + val get_exn : t -> int -> account val path_exn : t -> int -> [ `Left of hash | `Right of hash ] list @@ -209,6 +211,16 @@ end = struct (List.map t.indexes ~f:fst) () + let allocate_index ({ T.current_location; indexes; _ } as t) account_id = + let new_location = + match current_location with None -> 0 | Some x -> x + 1 + in + ( new_location + , { t with + current_location = Some new_location + ; indexes = (account_id, new_location) :: indexes + } ) + let get_exn ({ T.tree; depth; _ } as t) idx = let rec go i tree = match (i < 0, tree) with From 55f41f4d96f4c0f9d56ff3ebc80a13e15d4e0a1a Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Mon, 6 Nov 2023 13:28:51 +0000 Subject: [PATCH 4/5] Remove Sparse_ledger.find_index_exn --- src/lib/mina_base/pending_coinbase.ml | 17 ++--- src/lib/mina_base/sparse_ledger_base.ml | 65 +++++++++++++------ src/lib/mina_base/sparse_ledger_base.mli | 2 - src/lib/sparse_ledger_lib/sparse_ledger.ml | 14 ---- .../mina_transaction_logic.ml | 4 +- .../transaction_logic/zkapp_command_logic.ml | 13 ++-- .../transaction_snark/transaction_snark.ml | 27 ++++++-- 7 files changed, 81 insertions(+), 61 deletions(-) diff --git a/src/lib/mina_base/pending_coinbase.ml b/src/lib/mina_base/pending_coinbase.ml index b0202a716c1..84aeabc8a4a 100644 --- a/src/lib/mina_base/pending_coinbase.ml +++ b/src/lib/mina_base/pending_coinbase.ml @@ -769,14 +769,7 @@ module Make_str (A : Wire_types.Concrete) = struct module M = Sparse_ledger_lib.Sparse_ledger.Make (Hash) (Stack_id) (Stack) [%%define_locally - M. - ( of_hash - , get_exn - , path_exn - , set_exn - , find_index_exn - , add_path - , merkle_root )] + M.(of_hash, get_exn, path_exn, set_exn, find_index, add_path, merkle_root)] end module Checked = struct @@ -1076,7 +1069,7 @@ module Make_str (A : Wire_types.Concrete) = struct try_with (fun () -> Merkle_tree.path_exn t.tree index) let find_index (t : t) key = - try_with (fun () -> Merkle_tree.find_index_exn t.tree key) + try_with (fun () -> Option.value_exn @@ Merkle_tree.find_index t.tree key) let next_index ~depth (t : t) = if @@ -1113,7 +1106,9 @@ module Make_str (A : Wire_types.Concrete) = struct Option.value ~default:Stack_id.zero (curr_stack_id t) in Or_error.try_with (fun () -> - let index = Merkle_tree.find_index_exn t.tree prev_stack_id in + let index = + Option.value_exn @@ Merkle_tree.find_index t.tree prev_stack_id + in Merkle_tree.get_exn t.tree index ) let latest_stack (t : t) ~is_new_stack = @@ -1121,7 +1116,7 @@ module Make_str (A : Wire_types.Concrete) = struct let key = latest_stack_id t ~is_new_stack in let%bind res = Or_error.try_with (fun () -> - let index = Merkle_tree.find_index_exn t.tree key in + let index = Option.value_exn @@ Merkle_tree.find_index t.tree key in Merkle_tree.get_exn t.tree index ) in if is_new_stack then diff --git a/src/lib/mina_base/sparse_ledger_base.ml b/src/lib/mina_base/sparse_ledger_base.ml index 4b6e95b6c9a..0592af627ae 100644 --- a/src/lib/mina_base/sparse_ledger_base.ml +++ b/src/lib/mina_base/sparse_ledger_base.ml @@ -68,12 +68,12 @@ module L = struct let location_of_account : t -> Account_id.t -> location option = fun t id -> - try - let loc = M.find_index_exn !t id in - let account = M.get_exn !t loc in - if Public_key.Compressed.(equal empty account.public_key) then None - else Some loc - with _ -> None + 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 let set : t -> location -> Account.t -> unit = fun t loc a -> t := M.set_exn !t loc a @@ -81,9 +81,7 @@ module L = struct let get_or_create_exn : t -> Account_id.t -> account_state * Account.t * location = fun t id -> - let loc = M.find_index_exn !t id in - let account = M.get_exn !t loc in - if Public_key.Compressed.(equal empty account.public_key) then ( + let create_account loc account = let public_key = Account_id.public_key id in let account' : Account.t = { account with @@ -92,9 +90,20 @@ module L = struct ; token_id = Account_id.token_id id } in - set t loc account' ; - (`Added, account', loc) ) - else (`Existed, account, loc) + set t loc account' ; account' + in + match M.find_index !t id with + | None -> + let loc, new_t = M.allocate_index !t id in + t := new_t ; + let account' = create_account loc Account.empty in + (`Added, account', loc) + | Some loc -> + let account = M.get_exn !t loc in + if Public_key.Compressed.(equal empty account.public_key) then + let account' = create_account loc account in + (`Added, account', loc) + else (`Existed, account, loc) let get_or_create t id = Or_error.try_with (fun () -> get_or_create_exn t id) @@ -102,12 +111,18 @@ module L = struct t -> Account_id.t -> Account.t -> (account_state * location) Or_error.t = fun t id to_set -> Or_error.try_with (fun () -> - let loc = M.find_index_exn !t id in - let a = M.get_exn !t loc in - if Public_key.Compressed.(equal empty a.public_key) then ( - set t loc to_set ; - (`Added, loc) ) - else (`Existed, loc) ) + match M.find_index !t id with + | None -> + let loc, new_ledger = M.allocate_index !t id in + t := new_ledger ; + set t loc to_set ; + (`Added, loc) + | Some loc -> + let a = M.get_exn !t loc in + if Public_key.Compressed.(equal empty a.public_key) then ( + set t loc to_set ; + (`Added, loc) ) + else (`Existed, loc) ) let create_new_account t id to_set = get_or_create_account t id to_set |> Or_error.map ~f:ignore @@ -154,7 +169,6 @@ M. , set_exn , allocate_index , find_index - , find_index_exn , add_path , merkle_root , iteri )] @@ -181,7 +195,7 @@ let get_or_initialize_exn account_id t idx = else (`Existed, account) let has_locked_tokens_exn ~global_slot ~account_id t = - let idx = find_index_exn t account_id in + let idx = Option.value_exn (find_index t account_id) in let _, account = get_or_initialize_exn account_id t idx in Account.has_locked_tokens ~global_slot account @@ -207,7 +221,16 @@ let handler t = ledger := set_exn !ledger idx account ; respond (Provide ()) | Ledger_hash.Find_index pk -> - let index = find_index_exn !ledger pk in + let index = + match find_index !ledger pk with + | Some index -> + index + | None -> + let index, new_ledger = allocate_index !ledger pk in + let new_ledger = set_exn new_ledger index Account.empty in + ledger := new_ledger ; + index + in respond (Provide index) | _ -> unhandled ) diff --git a/src/lib/mina_base/sparse_ledger_base.mli b/src/lib/mina_base/sparse_ledger_base.mli index d694b204f5b..6dcecdfe0bc 100644 --- a/src/lib/mina_base/sparse_ledger_base.mli +++ b/src/lib/mina_base/sparse_ledger_base.mli @@ -46,8 +46,6 @@ val allocate_index : t -> Account_id.t -> int * t val find_index : t -> Account_id.t -> int option -val find_index_exn : t -> Account_id.t -> int - val of_root : depth:int -> current_location:int option -> Ledger_hash.t -> t (** Create a new 'empty' ledger. diff --git a/src/lib/sparse_ledger_lib/sparse_ledger.ml b/src/lib/sparse_ledger_lib/sparse_ledger.ml index 050a577acc4..b152b655421 100644 --- a/src/lib/sparse_ledger_lib/sparse_ledger.ml +++ b/src/lib/sparse_ledger_lib/sparse_ledger.ml @@ -75,8 +75,6 @@ module type S = sig val find_index : t -> account_id -> int option - val find_index_exn : t -> account_id -> int - val add_path : t -> [ `Left of hash | `Right of hash ] list -> account_id -> account -> t @@ -199,18 +197,6 @@ end = struct let find_index (t : t) aid = List.Assoc.find t.indexes ~equal:Account_id.equal aid - let find_index_exn (t : t) aid = - match find_index t aid with - | Some x -> - x - | None -> - failwithf - !"Sparse_ledger.find_index_exn: %{sexp:Account_id.t} not in %{sexp: \ - Account_id.t list}" - aid - (List.map t.indexes ~f:fst) - () - let allocate_index ({ T.current_location; indexes; _ } as t) account_id = let new_location = match current_location with None -> 0 | Some x -> x + 1 diff --git a/src/lib/transaction_logic/mina_transaction_logic.ml b/src/lib/transaction_logic/mina_transaction_logic.ml index 7bc07a237ca..d4f5dce3fa9 100644 --- a/src/lib/transaction_logic/mina_transaction_logic.ml +++ b/src/lib/transaction_logic/mina_transaction_logic.ml @@ -1225,11 +1225,11 @@ module Make (L : Ledger_intf.S) : type inclusion_proof = [ `Existing of location | `New ] - let get_account p l = + let get_or_initialize_account p l = let loc, acct = Or_error.ok_exn (get_with_location l (Account_update.account_id p)) in - (acct, loc) + (l, acct, loc) let set_account l (a, loc) = Or_error.ok_exn (set_with_location l loc a) ; diff --git a/src/lib/transaction_logic/zkapp_command_logic.ml b/src/lib/transaction_logic/zkapp_command_logic.ml index f120ad17b7a..4abb4335210 100644 --- a/src/lib/transaction_logic/zkapp_command_logic.ml +++ b/src/lib/transaction_logic/zkapp_command_logic.ml @@ -490,7 +490,8 @@ module type Ledger_intf = sig val empty : depth:int -> unit -> t - val get_account : account_update -> t -> account * inclusion_proof + val get_or_initialize_account : + account_update -> t -> t * account * inclusion_proof val set_account : t -> account * inclusion_proof -> t @@ -1165,9 +1166,13 @@ module Make (Inputs : Inputs_intf) = struct Local_state.add_check local_state Token_owner_not_caller default_token_or_token_owner_was_caller ) in - let ((a, inclusion_proof) as acct) = - with_label ~label:"get account" (fun () -> - Inputs.Ledger.get_account account_update local_state.ledger ) + let local_state, ((a, inclusion_proof) as acct) = + let ledger, a, inclusion_proof = + with_label ~label:"get account" (fun () -> + Inputs.Ledger.get_or_initialize_account account_update + local_state.ledger ) + in + ({ local_state with ledger }, (a, inclusion_proof)) in Inputs.Ledger.check_inclusion local_state.ledger (a, inclusion_proof) ; let transaction_commitment, full_transaction_commitment = diff --git a/src/lib/transaction_snark/transaction_snark.ml b/src/lib/transaction_snark/transaction_snark.ml index dd437ebf4fe..96f0b00471e 100644 --- a/src/lib/transaction_snark/transaction_snark.ml +++ b/src/lib/transaction_snark/transaction_snark.ml @@ -1468,7 +1468,7 @@ module Make_str (A : Wire_types.Concrete) = struct ( Ledger_hash.var_of_t (Sparse_ledger.merkle_root t) , V.create (fun () -> t) ) - let idx ledger id = Sparse_ledger.find_index_exn ledger id + let idx ledger id = Sparse_ledger.find_index ledger id let body_id (body : Account_update.Body.Checked.t) = let open As_prover in @@ -1476,10 +1476,19 @@ module Make_str (A : Wire_types.Concrete) = struct (read Signature_lib.Public_key.Compressed.typ body.public_key) (read Mina_base.Token_id.typ body.token_id) - let get_account { account_update; _ } ((_root, ledger) : t) = - let idx = - V.map ledger ~f:(fun l -> idx l (body_id account_update.data)) + let get_or_initialize_account { account_update; _ } + ((root, ledger) : t) = + let idx_and_ledger = + V.map ledger ~f:(fun l -> + let account_id = body_id account_update.data in + match idx l account_id with + | None -> + Sparse_ledger.allocate_index l account_id + | Some idx -> + (idx, As_prover.read (V.typ ()) ledger) ) in + let idx = V.map ~f:fst idx_and_ledger in + let ledger = V.map ~f:snd idx_and_ledger in let account = exists Mina_base.Account.Checked.Unhashed.typ ~compute:(fun () -> @@ -1501,7 +1510,7 @@ module Make_str (A : Wire_types.Concrete) = struct | `Right h -> (true, h) ) ) in - (account, incl) + ((root, ledger), account, incl) let set_account ((_root, ledger) : t) ((a, incl) : Account.t * _) : t = @@ -1513,7 +1522,10 @@ module Make_str (A : Wire_types.Concrete) = struct let a : Mina_base.Account.t = read Mina_base.Account.Checked.Unhashed.typ a.data in - let idx = idx ledger (Mina_base.Account.identifier a) in + let idx = + Option.value_exn + @@ idx ledger (Mina_base.Account.identifier a) + in Sparse_ledger.set_exn ledger idx a) ) let check_inclusion ((root, _) : t) (account, incl) = @@ -3982,7 +3994,8 @@ module Make_str (A : Wire_types.Concrete) = struct let account : Account.t = Sparse_ledger.( get_exn witness.local_state_init.ledger - (find_index_exn witness.local_state_init.ledger account_id)) + ( Option.value_exn + @@ find_index witness.local_state_init.ledger account_id )) in match Option.value_map ~default:None account.zkapp ~f:(fun s -> From eab56d9169597e381d1162fa60a2c3d0962a3c94 Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Mon, 6 Nov 2023 14:19:41 +0000 Subject: [PATCH 5/5] 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