From 0dcbd6b1779438e6f4309e6e104af2c136f58e27 Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Tue, 30 May 2023 14:39:30 -0700 Subject: [PATCH 1/8] Faster ledger export --- src/app/cli/src/init/coda_run.ml | 71 +++++++++++---------- src/lib/merkle_ledger/base_ledger_intf.ml | 8 +-- src/lib/merkle_ledger/database.ml | 71 +++++++-------------- src/lib/merkle_ledger/null_ledger.ml | 8 +-- src/lib/merkle_mask/masking_merkle_tree.ml | 73 ++++------------------ src/lib/mina_base/ledger.ml | 2 +- src/lib/mina_commands/mina_commands.ml | 23 ++++--- src/lib/mina_lib/mina_lib.ml | 54 +++++++++------- src/lib/mina_lib/mina_lib.mli | 6 +- 9 files changed, 129 insertions(+), 187 deletions(-) diff --git a/src/app/cli/src/init/coda_run.ml b/src/app/cli/src/init/coda_run.ml index aaca95bc8f7..fca8c3aa426 100644 --- a/src/app/cli/src/init/coda_run.ml +++ b/src/app/cli/src/init/coda_run.ml @@ -313,13 +313,11 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port ( Mina_commands.verify_payment coda aid tx proof |> Participating_state.active_error |> Or_error.join ) ) ; implement Daemon_rpcs.Get_public_keys_with_details.rpc (fun () () -> - return - ( Mina_commands.get_keys_with_details coda - |> Participating_state.active_error ) ) + let%map keys = Mina_commands.get_keys_with_details coda in + Participating_state.active_error keys ) ; implement Daemon_rpcs.Get_public_keys.rpc (fun () () -> - return - ( Mina_commands.get_public_keys coda - |> Participating_state.active_error ) ) + let%map keys = Mina_commands.get_public_keys coda in + Participating_state.active_error keys ) ; implement Daemon_rpcs.Get_nonce.rpc (fun () aid -> return ( Mina_commands.get_nonce coda aid @@ -334,36 +332,41 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port ; implement Daemon_rpcs.Clear_hist_status.rpc (fun () flag -> Mina_commands.clear_hist_status ~flag coda ) ; implement Daemon_rpcs.Get_ledger.rpc (fun () lh -> - (* getting the ledger may take more time than a heartbeat timeout - run in thread to allow RPC heartbeats to proceed - *) - Async.In_thread.run (fun () -> Mina_lib.get_ledger coda lh) ) + Mina_lib.get_ledger coda lh ) ; implement Daemon_rpcs.Get_snarked_ledger.rpc (fun () lh -> - Mina_lib.get_snarked_ledger coda lh |> return ) + Mina_lib.get_snarked_ledger coda lh ) ; implement Daemon_rpcs.Get_staking_ledger.rpc (fun () which -> - ( match which with - | Next -> - Option.value_map (Mina_lib.next_epoch_ledger coda) - ~default: - (Or_error.error_string "next staking ledger not available") - ~f:(function - | `Finalized ledger -> - Ok ledger - | `Notfinalized -> - Or_error.error_string - "next staking ledger is not finalized yet" ) - | Current -> - Option.value_map - (Mina_lib.staking_ledger coda) - ~default: - (Or_error.error_string "current staking ledger not available") - ~f:Or_error.return ) - |> Or_error.map ~f:(function - | Genesis_epoch_ledger l -> - Mina_base.Ledger.to_list l - | Ledger_db db -> - Mina_base.Ledger.Db.to_list db ) - |> Deferred.return ) + let ledger_or_error = + match which with + | Next -> + Option.value_map (Mina_lib.next_epoch_ledger coda) + ~default: + (Or_error.error_string "next staking ledger not available") + ~f:(function + | `Finalized ledger -> + Ok ledger + | `Notfinalized -> + Or_error.error_string + "next staking ledger is not finalized yet" ) + | Current -> + Option.value_map + (Mina_lib.staking_ledger coda) + ~default: + (Or_error.error_string + "current staking ledger not available" ) + ~f:Or_error.return + in + match ledger_or_error with + | Ok ledger -> ( + match ledger with + | Genesis_epoch_ledger l -> + let%map accts = Mina_base.Ledger.to_list l in + Ok accts + | Ledger_db db -> + let%map accts = Mina_base.Ledger.Db.to_list db in + Ok accts ) + | Error err -> + return (Error err) ) ; implement Daemon_rpcs.Stop_daemon.rpc (fun () () -> Scheduler.yield () >>= (fun () -> exit 0) |> don't_wait_for ; Deferred.unit ) diff --git a/src/lib/merkle_ledger/base_ledger_intf.ml b/src/lib/merkle_ledger/base_ledger_intf.ml index 96700e0bcb6..74fc0d43936 100644 --- a/src/lib/merkle_ledger/base_ledger_intf.ml +++ b/src/lib/merkle_ledger/base_ledger_intf.ml @@ -44,10 +44,10 @@ module type S = sig and type t := t (** list of accounts in the ledger *) - val to_list : t -> account list + val to_list : t -> account list Async.Deferred.t (** iterate over all indexes and accounts *) - val iteri : t -> f:(index -> account -> unit) -> unit + val iteri : t -> f:(index -> account -> unit) -> unit Async.Deferred.t (** fold over accounts in the ledger, passing the Merkle address *) val foldi : @@ -71,10 +71,10 @@ module type S = sig -> init:'accum -> f:('accum -> account -> ('accum, 'stop) Base.Continue_or_stop.t) -> finish:('accum -> 'stop) - -> 'stop + -> 'stop Async.Deferred.t (** set of account ids associated with accounts *) - val accounts : t -> account_id_set + val accounts : t -> account_id_set Async.Deferred.t (** Get the public key that owns a token. *) val token_owner : t -> token_id -> key option diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index cb640f96124..57d8b87d4c9 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -154,26 +154,6 @@ module Make (Inputs : Inputs_intf) : | None -> empty_hash (Location.height ~ledger_depth:mdb.depth location) - let account_list_bin { kvdb; _ } account_bin_read : Account.t list = - let all_keys_values = Kvdb.to_alist kvdb in - (* see comment at top of location.ml about encoding of locations *) - let account_location_prefix = - Location.Prefix.account |> Unsigned.UInt8.to_int - in - (* just want list of locations and accounts, ignoring other locations *) - let locations_accounts_bin = - List.filter all_keys_values ~f:(fun (loc, _v) -> - let ch = Bigstring.get_uint8 loc ~pos:0 in - Int.equal ch account_location_prefix ) - in - List.map locations_accounts_bin ~f:(fun (_location_bin, account_bin) -> - account_bin_read account_bin ~pos_ref:(ref 0) ) - - let to_list mdb = account_list_bin mdb Account.bin_read_t - - let accounts mdb = - to_list mdb |> List.map ~f:Account.identifier |> Account_id.Set.of_list - let set_raw { kvdb; depth; _ } location bin = Kvdb.set kvdb ~key:(Location.serialize ~ledger_depth:depth location) @@ -623,6 +603,22 @@ module Make (Inputs : Inputs_intf) : let addr = Addr.of_int_exn ~ledger_depth:mdb.depth index in set mdb (Location.Account addr) account + let num_accounts t = + match Account_location.last_location_address t with + | None -> + 0 + | Some addr -> + Addr.to_int addr + 1 + + let to_list mdb = + let num_accounts = num_accounts mdb in + Async.Deferred.List.init ~how:`Parallel num_accounts ~f:(fun i -> + Async.Deferred.return @@ get_at_index_exn mdb i ) + + let accounts mdb = + let%map.Async.Deferred accts = to_list mdb in + List.map accts ~f:Account.identifier |> Account_id.Set.of_list + let get_or_create_account mdb account_id account = match Account_location.get mdb account_id with | Error Account_location_not_found -> ( @@ -639,20 +635,9 @@ module Make (Inputs : Inputs_intf) : | Ok location -> Ok (`Existed, location) - let num_accounts t = - match Account_location.last_location_address t with - | None -> - 0 - | Some addr -> - Addr.to_int addr + 1 - let iteri t ~f = - match Account_location.last_location_address t with - | None -> - () - | Some last_addr -> - Sequence.range ~stop:`inclusive 0 (Addr.to_int last_addr) - |> Sequence.iter ~f:(fun i -> f i (get_at_index_exn t i)) + let%map.Async.Deferred accts = to_list t in + List.iteri accts ~f (* TODO : if key-value store supports iteration mechanism, like RocksDB, maybe use that here, instead of loading all accounts into memory See Issue @@ -680,23 +665,9 @@ module Make (Inputs : Inputs_intf) : let foldi t ~init ~f = foldi_with_ignored_accounts t Account_id.Set.empty ~init ~f - module C : Container.S0 with type t := t and type elt := Account.t = - Container.Make0 (struct - module Elt = Account - - type nonrec t = t - - let fold t ~init ~f = - let f' _index accum account = f accum account in - foldi t ~init ~f:f' - - let iter = `Define_using_fold - - (* Use num_accounts instead? *) - let length = `Define_using_fold - end) - - let fold_until = C.fold_until + let fold_until t ~init ~f ~finish = + let%map.Async.Deferred accts = to_list t in + List.fold_until accts ~init ~f ~finish let merkle_root mdb = get_hash mdb Location.root_hash diff --git a/src/lib/merkle_ledger/null_ledger.ml b/src/lib/merkle_ledger/null_ledger.ml index 45e5addcf19..79855134f03 100644 --- a/src/lib/merkle_ledger/null_ledger.ml +++ b/src/lib/merkle_ledger/null_ledger.ml @@ -103,7 +103,7 @@ end = struct let location_of_account_batch _t accts = List.map accts ~f:(fun acct -> (acct, None)) - let accounts _t = Account_id.Set.empty + let accounts _t = Async.Deferred.return Account_id.Set.empty let token_owner _t _tid = None @@ -116,15 +116,15 @@ end = struct let set_next_available_token _t _tid = failwith "set_next_available_token: null ledgers cannot be mutated" - let iteri _t ~f:_ = () + let iteri _t ~f:_ = Async.Deferred.unit - let fold_until _t ~init ~f:_ ~finish = finish init + let fold_until _t ~init ~f:_ ~finish = Async.Deferred.return @@ finish init let foldi_with_ignored_accounts _t _ ~init ~f:_ = init let foldi _t ~init ~f:_ = init - let to_list _t = [] + let to_list _t = Async.Deferred.return [] let make_space_for _t _tot = () diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 0716966c3a4..bb95b190e39 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -4,7 +4,8 @@ open Core (* builds a Merkle tree mask; it's a Merkle tree, with some additional - operations *) + operations +*) module Make (Inputs : Inputs_intf.S) = struct open Inputs @@ -505,17 +506,6 @@ module Make (Inputs : Inputs_intf.S) = struct assert_is_attached t ; set_all_accounts_rooted_at_exn t address accounts - (* keys from this mask and all ancestors *) - let accounts t = - assert_is_attached t ; - let mask_keys = - Location_binable.Table.data t.account_tbl - |> List.map ~f:Account.identifier - |> Account_id.Set.of_list - in - let parent_keys = Base.accounts (get_parent t) in - Account_id.Set.union parent_keys mask_keys - let token_owner t tid = assert_is_attached t ; match Token_id.Table.find t.token_owners tid with @@ -650,56 +640,19 @@ module Make (Inputs : Inputs_intf.S) = struct let to_list t = assert_is_attached t ; - accounts t |> Set.to_list - |> List.map ~f:(fun key -> - let location = location_of_account t key |> Option.value_exn in - match location with - | Account addr -> - (Addr.to_int addr, get t location |> Option.value_exn) - | location -> - raise (Location_is_not_account location) ) - |> List.sort ~compare:(fun (addr1, _) (addr2, _) -> - Int.compare addr1 addr2 ) - |> List.map ~f:(fun (_, account) -> account) + let num_accounts = num_accounts t in + Async.Deferred.List.init ~how:`Parallel num_accounts ~f:(fun i -> + Async.Deferred.return @@ get_at_index_exn t i ) + + (* keys from this mask and all ancestors *) + let accounts t = + assert_is_attached t ; + let%map.Async.Deferred accts = to_list t in + List.map accts ~f:Account.identifier |> Account_id.Set.of_list let iteri t ~f = - let account_ids = accounts t |> Account_id.Set.to_list in - let idx_account_pairs_unsorted = - List.map account_ids ~f:(fun acct_id -> - let idx = - try index_of_account_exn t acct_id - with exn -> - failwith - (sprintf - !"iter: index_of_account_exn failed, mask uuid: %{sexp: \ - Uuid.t} account id: %{sexp: Account_id.t}, exception: \ - %s" - (get_uuid t) acct_id (Exn.to_string exn) ) - in - match location_of_account t acct_id with - | None -> - failwith - (sprintf - !"iter: location_of_account returned None, mask uuid: \ - %{sexp: Uuid.t} account id: %{sexp: Account_id.t}" - (get_uuid t) acct_id ) - | Some loc -> ( - match get t loc with - | None -> - failwith - (sprintf - !"iter: get returned None, mask uuid: %{sexp: Uuid.t} \ - account id: %{sexp: Account_id.t}" - (get_uuid t) acct_id ) - | Some acct -> - (idx, acct) ) ) - in - (* in case iteration order matters *) - let idx_account_pairs = - List.sort idx_account_pairs_unsorted - ~compare:(fun (idx1, _) (idx2, _) -> Int.compare idx1 idx2) - in - List.iter idx_account_pairs ~f:(fun (idx, acct) -> f idx acct) + let%map.Async.Deferred accts = to_list t in + List.iteri accts ~f let foldi_with_ignored_accounts t ignored_accounts ~init ~f = assert_is_attached t ; diff --git a/src/lib/mina_base/ledger.ml b/src/lib/mina_base/ledger.ml index 5b08ad5f36d..cc7ee1df43b 100644 --- a/src/lib/mina_base/ledger.ml +++ b/src/lib/mina_base/ledger.ml @@ -240,7 +240,7 @@ module Ledger_inner = struct (* TODO: Don't allocate: see Issue #1191 *) let fold_until t ~init ~f ~finish = - let accounts = to_list t in + let%map.Async.Deferred accounts = to_list t in List.fold_until accounts ~init ~f ~finish let create_new_account_exn t account_id account = diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index 6a23a423348..80f3fc676bc 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -14,22 +14,25 @@ let get_account t (addr : Account_id.t) = let%bind loc = Ledger.location_of_account ledger addr in Ledger.get ledger loc -let get_accounts t = - let open Participating_state.Let_syntax in - let%map ledger = Mina_lib.best_ledger t in - Ledger.to_list ledger +let get_accounts t : Account.t list Participating_state.t Deferred.t = + match Mina_lib.best_ledger t with + | `Active ledger -> + let%map accts = Ledger.to_list ledger in + `Active accts + | `Bootstrapping -> + Deferred.return `Bootstrapping let string_of_public_key = Fn.compose Public_key.Compressed.to_base58_check Account.public_key -let get_public_keys t = - let open Participating_state.Let_syntax in - let%map account = get_accounts t in - List.map account ~f:string_of_public_key +let get_public_keys t : string list Participating_state.t Deferred.t = + let%map.Deferred accounts_pstate = get_accounts t in + let%map.Participating_state accounts = accounts_pstate in + List.map accounts ~f:string_of_public_key let get_keys_with_details t = - let open Participating_state.Let_syntax in - let%map accounts = get_accounts t in + let%map.Deferred accounts_pstate = get_accounts t in + let%map.Participating_state accounts = accounts_pstate in List.map accounts ~f:(fun account -> ( string_of_public_key account , account.Account.Poly.balance |> Currency.Balance.to_int diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 1bc10e852c4..81b86f1ddb0 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -519,40 +519,49 @@ let best_protocol_state = compose_of_option best_protocol_state_opt let best_ledger = compose_of_option best_ledger_opt let get_ledger t state_hash_opt = - let open Or_error.Let_syntax in + let open Deferred.Or_error.Let_syntax in let%bind state_hash = - Option.value_map state_hash_opt ~f:Or_error.return - ~default: - ( match best_tip t with - | `Active bc -> - Or_error.return (Frontier_base.Breadcrumb.state_hash bc) - | `Bootstrapping -> - Or_error.error_string - "get_ledger: can't get staged ledger hash while bootstrapping" ) + Deferred.return + @@ Option.value_map state_hash_opt ~f:Or_error.return + ~default: + ( match best_tip t with + | `Active bc -> + Or_error.return (Frontier_base.Breadcrumb.state_hash bc) + | `Bootstrapping -> + Or_error.error_string + "get_ledger: can't get staged ledger hash while bootstrapping" + ) + in + let%bind frontier = + t.components.transition_frontier |> peek_frontier |> Deferred.return in - let%bind frontier = t.components.transition_frontier |> peek_frontier in match Transition_frontier.find frontier state_hash with | Some b -> let staged_ledger = Transition_frontier.Breadcrumb.staged_ledger b in - Ok (Ledger.to_list (Staged_ledger.ledger staged_ledger)) + let%map.Deferred accounts = + Ledger.to_list (Staged_ledger.ledger staged_ledger) + in + Ok accounts | None -> - Or_error.error_string - "get_ledger: state hash not found in transition frontier" + Deferred.return + @@ Or_error.error_string "state hash not found in transition frontier" let get_snarked_ledger t state_hash_opt = - let open Or_error.Let_syntax in + let open Deferred.Or_error.Let_syntax in let%bind state_hash = - Option.value_map state_hash_opt ~f:Or_error.return + Option.value_map state_hash_opt ~f:Deferred.Or_error.return ~default: ( match best_tip t with | `Active bc -> - Or_error.return (Frontier_base.Breadcrumb.state_hash bc) + Deferred.Or_error.return (Frontier_base.Breadcrumb.state_hash bc) | `Bootstrapping -> - Or_error.error_string + Deferred.Or_error.error_string "get_snarked_ledger: can't get snarked ledger hash while \ bootstrapping" ) in - let%bind frontier = t.components.transition_frontier |> peek_frontier in + let%bind frontier = + t.components.transition_frontier |> peek_frontier |> Deferred.return + in match Transition_frontier.find frontier state_hash with | Some b -> let root_snarked_ledger = @@ -560,7 +569,7 @@ let get_snarked_ledger t state_hash_opt = in let ledger = Ledger.of_database root_snarked_ledger in let path = Transition_frontier.path_map frontier b ~f:Fn.id in - let%bind _ = + let%bind () = List.fold_until ~init:(Ok ()) path ~f:(fun _acc b -> if Transition_frontier.Breadcrumb.just_emitted_a_proof b then @@ -615,6 +624,7 @@ let get_snarked_ledger t state_hash_opt = Stop e ) else Continue (Ok ()) ) ~finish:Fn.id + |> Deferred.return in let snarked_ledger_hash = Transition_frontier.Breadcrumb.block b @@ -624,17 +634,17 @@ let get_snarked_ledger t state_hash_opt = in let merkle_root = Ledger.merkle_root ledger in if Frozen_ledger_hash.equal snarked_ledger_hash merkle_root then ( - let res = Ledger.to_list ledger in + let%map.Deferred res = Ledger.to_list ledger in ignore @@ Ledger.unregister_mask_exn ~loc:__LOC__ ledger ; Ok res ) else - Or_error.errorf + Deferred.Or_error.errorf "Expected snarked ledger hash %s but got %s for state hash %s" (Frozen_ledger_hash.to_base58_check snarked_ledger_hash) (Frozen_ledger_hash.to_base58_check merkle_root) (State_hash.to_base58_check state_hash) | None -> - Or_error.error_string + Deferred.Or_error.error_string "get_snarked_ledger: state hash not found in transition frontier" let get_account t aid = diff --git a/src/lib/mina_lib/mina_lib.mli b/src/lib/mina_lib/mina_lib.mli index eca85bffde4..9ded1e66f33 100644 --- a/src/lib/mina_lib/mina_lib.mli +++ b/src/lib/mina_lib/mina_lib.mli @@ -174,9 +174,11 @@ val staged_ledger_ledger_proof : t -> Ledger_proof.t option val transition_frontier : t -> Transition_frontier.t option Broadcast_pipe.Reader.t -val get_ledger : t -> State_hash.t option -> Account.t list Or_error.t +val get_ledger : + t -> State_hash.t option -> Account.t list Or_error.t Deferred.t -val get_snarked_ledger : t -> State_hash.t option -> Account.t list Or_error.t +val get_snarked_ledger : + t -> State_hash.t option -> Account.t list Or_error.t Deferred.t val wallets : t -> Secrets.Wallets.t From 90502230edc4096f95062be4ca983124e56749e3 Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Tue, 30 May 2023 17:50:34 -0700 Subject: [PATCH 2/8] make iteri not in Deferred.t --- src/lib/merkle_ledger/base_ledger_intf.ml | 2 +- src/lib/merkle_ledger/database.ml | 8 ++++++-- src/lib/merkle_ledger/null_ledger.ml | 2 +- src/lib/merkle_mask/masking_merkle_tree.ml | 6 ++++-- src/lib/mina_lib/mina_lib.mli | 5 ++--- 5 files changed, 14 insertions(+), 9 deletions(-) diff --git a/src/lib/merkle_ledger/base_ledger_intf.ml b/src/lib/merkle_ledger/base_ledger_intf.ml index 74fc0d43936..48112728d8e 100644 --- a/src/lib/merkle_ledger/base_ledger_intf.ml +++ b/src/lib/merkle_ledger/base_ledger_intf.ml @@ -47,7 +47,7 @@ module type S = sig val to_list : t -> account list Async.Deferred.t (** iterate over all indexes and accounts *) - val iteri : t -> f:(index -> account -> unit) -> unit Async.Deferred.t + val iteri : t -> f:(index -> account -> unit) -> unit (** fold over accounts in the ledger, passing the Merkle address *) val foldi : diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index 57d8b87d4c9..d018d51ffdc 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -636,8 +636,12 @@ module Make (Inputs : Inputs_intf) : Ok (`Existed, location) let iteri t ~f = - let%map.Async.Deferred accts = to_list t in - List.iteri accts ~f + match Account_location.last_location_address t with + | None -> + () + | Some last_addr -> + Sequence.range ~stop:`inclusive 0 (Addr.to_int last_addr) + |> Sequence.iter ~f:(fun i -> f i (get_at_index_exn t i)) (* TODO : if key-value store supports iteration mechanism, like RocksDB, maybe use that here, instead of loading all accounts into memory See Issue diff --git a/src/lib/merkle_ledger/null_ledger.ml b/src/lib/merkle_ledger/null_ledger.ml index 79855134f03..a140285649f 100644 --- a/src/lib/merkle_ledger/null_ledger.ml +++ b/src/lib/merkle_ledger/null_ledger.ml @@ -116,7 +116,7 @@ end = struct let set_next_available_token _t _tid = failwith "set_next_available_token: null ledgers cannot be mutated" - let iteri _t ~f:_ = Async.Deferred.unit + let iteri _t ~f:_ = () let fold_until _t ~init ~f:_ ~finish = Async.Deferred.return @@ finish init diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index bb95b190e39..44bcdac535b 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -651,8 +651,10 @@ module Make (Inputs : Inputs_intf.S) = struct List.map accts ~f:Account.identifier |> Account_id.Set.of_list let iteri t ~f = - let%map.Async.Deferred accts = to_list t in - List.iteri accts ~f + assert_is_attached t ; + let num_accounts = num_accounts t in + Sequence.range ~stop:`exclusive 0 num_accounts + |> Sequence.iter ~f:(fun i -> f i (get_at_index_exn t i)) let foldi_with_ignored_accounts t ignored_accounts ~init ~f = assert_is_attached t ; diff --git a/src/lib/mina_lib/mina_lib.mli b/src/lib/mina_lib/mina_lib.mli index 9ded1e66f33..08bade835c3 100644 --- a/src/lib/mina_lib/mina_lib.mli +++ b/src/lib/mina_lib/mina_lib.mli @@ -174,11 +174,10 @@ val staged_ledger_ledger_proof : t -> Ledger_proof.t option val transition_frontier : t -> Transition_frontier.t option Broadcast_pipe.Reader.t -val get_ledger : - t -> State_hash.t option -> Account.t list Or_error.t Deferred.t +val get_ledger : t -> State_hash.t option -> Account.t list Deferred.Or_error.t val get_snarked_ledger : - t -> State_hash.t option -> Account.t list Or_error.t Deferred.t + t -> State_hash.t option -> Account.t list Deferred.Or_error.t val wallets : t -> Secrets.Wallets.t From df12623d13f69dea09c4d8a8204a715381a3b9e1 Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Wed, 31 May 2023 19:22:50 -0700 Subject: [PATCH 3/8] add to_list_sequential; fix merkle_ledger_tests --- src/lib/merkle_ledger/any_ledger.ml | 2 + src/lib/merkle_ledger/base_ledger_intf.ml | 3 + src/lib/merkle_ledger/database.ml | 4 + src/lib/merkle_ledger/null_ledger.ml | 2 + src/lib/merkle_ledger_tests/dune | 1 + src/lib/merkle_ledger_tests/test_database.ml | 97 +++++++++++--------- src/lib/merkle_ledger_tests/test_mask.ml | 23 +++-- src/lib/merkle_mask/masking_merkle_tree.ml | 13 ++- 8 files changed, 93 insertions(+), 52 deletions(-) diff --git a/src/lib/merkle_ledger/any_ledger.ml b/src/lib/merkle_ledger/any_ledger.ml index 5892f7bf56f..1d64fac80a7 100644 --- a/src/lib/merkle_ledger/any_ledger.ml +++ b/src/lib/merkle_ledger/any_ledger.ml @@ -181,6 +181,8 @@ module Make_base (Inputs : Inputs_intf) : let to_list (T ((module Base), t)) = Base.to_list t + let to_list_sequential (T ((module Base), t)) = Base.to_list_sequential t + let make_space_for (T ((module Base), t)) = Base.make_space_for t let get_all_accounts_rooted_at_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 48112728d8e..35d5f68904c 100644 --- a/src/lib/merkle_ledger/base_ledger_intf.ml +++ b/src/lib/merkle_ledger/base_ledger_intf.ml @@ -46,6 +46,9 @@ module type S = sig (** list of accounts in the ledger *) val to_list : t -> account list Async.Deferred.t + (** list of accounts via slower sequential mechanism *) + val to_list_sequential : t -> account list + (** iterate over all indexes and accounts *) val iteri : t -> f:(index -> account -> unit) -> unit diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml index d018d51ffdc..7b9756935df 100644 --- a/src/lib/merkle_ledger/database.ml +++ b/src/lib/merkle_ledger/database.ml @@ -615,6 +615,10 @@ module Make (Inputs : Inputs_intf) : Async.Deferred.List.init ~how:`Parallel num_accounts ~f:(fun i -> Async.Deferred.return @@ get_at_index_exn mdb i ) + let to_list_sequential mdb = + let num_accounts = num_accounts mdb in + List.init num_accounts ~f:(fun i -> get_at_index_exn mdb i) + let accounts mdb = let%map.Async.Deferred accts = to_list mdb in List.map accts ~f:Account.identifier |> Account_id.Set.of_list diff --git a/src/lib/merkle_ledger/null_ledger.ml b/src/lib/merkle_ledger/null_ledger.ml index a140285649f..b9123eba9df 100644 --- a/src/lib/merkle_ledger/null_ledger.ml +++ b/src/lib/merkle_ledger/null_ledger.ml @@ -126,6 +126,8 @@ end = struct let to_list _t = Async.Deferred.return [] + let to_list_sequential _t = [] + let make_space_for _t _tot = () let get_all_accounts_rooted_at_exn t addr = diff --git a/src/lib/merkle_ledger_tests/dune b/src/lib/merkle_ledger_tests/dune index 83d5fa44671..f9f6a9a8acc 100644 --- a/src/lib/merkle_ledger_tests/dune +++ b/src/lib/merkle_ledger_tests/dune @@ -15,6 +15,7 @@ ppx_inline_test.config result async_kernel + async_unix async core_kernel ;; local libraries diff --git a/src/lib/merkle_ledger_tests/test_database.ml b/src/lib/merkle_ledger_tests/test_database.ml index b4467258dcc..f40a8dd0c26 100644 --- a/src/lib/merkle_ledger_tests/test_database.ml +++ b/src/lib/merkle_ledger_tests/test_database.ml @@ -31,6 +31,10 @@ let%test_module "test functor on in memory databases" = module Make (Test : Test_intf) = struct module MT = Test.MT + let account_default_token_gen = + let%map.Quickcheck.Generator account = Account.gen in + { account with token_id = Token_id.default } + let%test_unit "getting a non existing account returns None" = Test.with_instance (fun mdb -> Quickcheck.test @@ -50,13 +54,13 @@ let%test_module "test functor on in memory databases" = let%test "add and retrieve an account" = Test.with_instance (fun mdb -> - let account = Quickcheck.random_value Account.gen in + let account = Quickcheck.random_value account_default_token_gen in let location = create_new_account_exn mdb account in Account.equal (Option.value_exn (MT.get mdb location)) account ) let%test "accounts are atomic" = Test.with_instance (fun mdb -> - let account = Quickcheck.random_value Account.gen in + let account = Quickcheck.random_value account_default_token_gen in let location = create_new_account_exn mdb account in MT.set mdb location account ; let location' = @@ -85,7 +89,7 @@ let%test_module "test functor on in memory databases" = let open Quickcheck.Let_syntax in let%bind num_initial_accounts = Int.gen_incl 0 n in let%map accounts = - list_with_length num_initial_accounts Account.gen + list_with_length num_initial_accounts account_default_token_gen in dedup_accounts accounts in @@ -132,7 +136,8 @@ let%test_module "test functor on in memory databases" = let open Quickcheck.Let_syntax in let max_height = Int.min (MT.depth mdb) 5 in let%bind num_accounts = Int.gen_incl 0 (1 lsl max_height) in - Quickcheck.Generator.list_with_length num_accounts Account.gen + Quickcheck.Generator.list_with_length num_accounts + account_default_token_gen in let accounts = Quickcheck.random_value accounts_gen in Sequence.of_list accounts @@ -150,7 +155,7 @@ let%test_module "test functor on in memory databases" = let%test_unit "set_inner_hash_at_addr_exn(address,hash); \ get_inner_hash_at_addr_exn(address) = hash" = let random_hash = - Hash.hash_account @@ Quickcheck.random_value Account.gen + Hash.hash_account @@ Quickcheck.random_value account_default_token_gen in Test.with_instance (fun mdb -> Quickcheck.test @@ -165,7 +170,8 @@ let%test_module "test functor on in memory databases" = let random_accounts max_height = let num_accounts = 1 lsl max_height in Quickcheck.random_value - (Quickcheck.Generator.list_with_length num_accounts Account.gen) + (Quickcheck.Generator.list_with_length num_accounts + account_default_token_gen ) let populate_db mdb max_height = random_accounts max_height @@ -223,7 +229,7 @@ let%test_module "test functor on in memory databases" = let accounts = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts - Account.gen ) + account_default_token_gen ) in if not @@ List.is_empty accounts then let addresses = @@ -316,7 +322,7 @@ let%test_module "test functor on in memory databases" = let accounts = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts - Account.gen ) + account_default_token_gen ) in MT.set_all_accounts_rooted_at_exn mdb address accounts ; let result = @@ -363,7 +369,9 @@ let%test_module "test functor on in memory databases" = Test.with_instance (fun mdb -> let max_height = Int.min (MT.depth mdb) 5 in test_subtree_range mdb max_height ~f:(fun index -> - let account = Quickcheck.random_value Account.gen in + let account = + Quickcheck.random_value account_default_token_gen + in MT.set_at_index_exn mdb index account ; let result = MT.get_at_index_exn mdb index in assert (Account.equal account result) ) ) @@ -404,7 +412,8 @@ let%test_module "test functor on in memory databases" = let accounts = random_accounts max_height |> dedup_accounts in List.iter accounts ~f:(fun account -> ignore (create_new_account_exn mdb account : Test.Location.t) ) ; - [%test_result: Account.t list] accounts ~expect:(MT.to_list mdb) ) + let expect = MT.to_list_sequential mdb in + [%test_result: Account.t list] accounts ~expect ) let%test_unit "Add 2^d accounts (for testing, d is small)" = if Test.depth <= 8 then @@ -474,39 +483,41 @@ let%test_module "test functor on in memory databases" = assert (Int.equal retrieved_total total) ) let%test_unit "fold_until over account balances" = - Test.with_instance (fun mdb -> - let num_accounts = 5 in - let some_num = 3 in - let account_ids = Account_id.gen_accounts num_accounts in - let some_account_ids = List.take account_ids some_num in - let last_account_id = List.hd_exn (List.rev some_account_ids) in - let balances = - Quickcheck.random_value - (Quickcheck.Generator.list_with_length num_accounts Balance.gen) - in - let some_balances = List.take balances some_num in - let total = - List.fold some_balances ~init:0 ~f:(fun accum balance -> - Balance.to_int balance + accum ) - in - let accounts = - List.map2_exn account_ids balances ~f:Account.create - in - List.iter accounts ~f:(fun account -> - ignore @@ create_new_account_exn mdb account ) ; - (* stop folding on last_account_id, sum of balances in accounts should be same as some_balances *) - let retrieved_total = - MT.fold_until mdb ~init:0 - ~f:(fun total account -> - let current_balance = Account.balance account in - let current_account_id = Account.identifier account in - let new_total = Balance.to_int current_balance + total in - if Account_id.equal current_account_id last_account_id then - Stop new_total - else Continue new_total ) - ~finish:(fun total -> total) - in - assert (Int.equal retrieved_total total) ) + Async_unix.Thread_safe.block_on_async_exn (fun () -> + Test.with_instance (fun mdb -> + let num_accounts = 5 in + let some_num = 3 in + let account_ids = Account_id.gen_accounts num_accounts in + let some_account_ids = List.take account_ids some_num in + let last_account_id = List.hd_exn (List.rev some_account_ids) in + let balances = + Quickcheck.random_value + (Quickcheck.Generator.list_with_length num_accounts + Balance.gen ) + in + let some_balances = List.take balances some_num in + let total = + List.fold some_balances ~init:0 ~f:(fun accum balance -> + Balance.to_int balance + accum ) + in + let accounts = + List.map2_exn account_ids balances ~f:Account.create + in + List.iter accounts ~f:(fun account -> + ignore @@ create_new_account_exn mdb account ) ; + (* stop folding on last_account_id, sum of balances in accounts should be same as some_balances *) + let%map.Async.Deferred retrieved_total = + MT.fold_until mdb ~init:0 + ~f:(fun total account -> + let current_balance = Account.balance account in + let current_account_id = Account.identifier account in + let new_total = Balance.to_int current_balance + total in + if Account_id.equal current_account_id last_account_id + then Stop new_total + else Continue new_total ) + ~finish:(fun total -> total) + in + assert (Int.equal retrieved_total total) ) ) end module Make_db (Depth : sig diff --git a/src/lib/merkle_ledger_tests/test_mask.ml b/src/lib/merkle_ledger_tests/test_mask.ml index 170fe5399ec..ac9daef89f4 100644 --- a/src/lib/merkle_ledger_tests/test_mask.ml +++ b/src/lib/merkle_ledger_tests/test_mask.ml @@ -1,4 +1,4 @@ -(* test_make.ml -- tests Merkle mask connected to underlying Merkle tree *) +(* test_mask.ml -- tests Merkle mask connected to underlying Merkle tree *) open Core open Test_stubs @@ -82,7 +82,9 @@ module Make (Test : Test_intf) = struct let dummy_location = Test.Location.Account dummy_address - let dummy_account = Quickcheck.random_value Account.gen + let dummy_account = + let account = Quickcheck.random_value Account.gen in + { account with token_id = Token_id.default } let create_new_account_exn mask account = let public_key = Account.identifier account in @@ -97,9 +99,9 @@ module Make (Test : Test_intf) = struct location let create_existing_account_exn mask account = - let public_key = Account.identifier account in + let account_id = Account.identifier account in let action, location = - Mask.Attached.get_or_create_account mask public_key account + Mask.Attached.get_or_create_account mask account_id account |> Or_error.ok_exn in match action with @@ -262,9 +264,14 @@ module Make (Test : Test_intf) = struct if Test.depth <= 8 then Test.with_instances (fun maskable mask -> let attached_mask = Maskable.register_mask maskable mask in - Mask.Attached.set attached_mask dummy_location dummy_account ; + let loc0 = + Test.Location.Addr.of_directions + (List.init Test.depth ~f:(fun _ -> Direction.Left)) + in + Mask.Attached.set attached_mask (Test.Location.Account loc0) + dummy_account ; (* Make some accounts *) - let num_accounts = 1 lsl Test.depth in + let num_accounts = (1 lsl Test.depth) - 2 in let gen_values gen = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts gen) @@ -551,7 +558,7 @@ module Make (Test : Test_intf) = struct List.iter parent_accounts ~f:(fun account -> ignore @@ parent_create_new_account_exn maskable account ) ; (* all accounts in parent to_list *) - let parent_list = Maskable.to_list maskable in + let parent_list = Maskable.to_list_sequential maskable in let zero_balance account = Account.update_balance account Balance.zero in @@ -559,7 +566,7 @@ module Make (Test : Test_intf) = struct let mask_accounts = List.map parent_accounts ~f:zero_balance in List.iter mask_accounts ~f:(fun account -> ignore @@ create_existing_account_exn attached_mask account ) ; - let mask_list = Mask.Attached.to_list attached_mask in + let mask_list = Mask.Attached.to_list_sequential attached_mask in (* same number of accounts after adding them to mask *) assert (Int.equal (List.length parent_list) (List.length mask_list)) ; (* should only see the zero balances in mask list *) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 44bcdac535b..e6d627eeddc 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -154,7 +154,13 @@ module Make (Inputs : Inputs_intf.S) = struct let self_set_location t account_id location = assert_is_attached t ; - Account_id.Table.set t.location_tbl ~key:account_id ~data:location + Account_id.Table.set t.location_tbl ~key:account_id ~data:location ; + match t.current_location with + | None -> + t.current_location <- Some location + | Some loc -> + if Location.( > ) location loc then + t.current_location <- Some location (* don't rely on a particular implementation *) let self_find_account t location = @@ -644,6 +650,11 @@ module Make (Inputs : Inputs_intf.S) = struct Async.Deferred.List.init ~how:`Parallel num_accounts ~f:(fun i -> Async.Deferred.return @@ get_at_index_exn t i ) + let to_list_sequential t = + assert_is_attached t ; + let num_accounts = num_accounts t in + List.init num_accounts ~f:(fun i -> get_at_index_exn t i) + (* keys from this mask and all ancestors *) let accounts t = assert_is_attached t ; From c566b6c26b4bfe8cd409007f43299663aeb3ac7d Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Wed, 31 May 2023 20:04:34 -0700 Subject: [PATCH 4/8] fix replayer --- src/app/replayer/replayer.ml | 50 ++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 22 deletions(-) diff --git a/src/app/replayer/replayer.ml b/src/app/replayer/replayer.ml index fb7a8e25eb3..83d3e90cdb4 100644 --- a/src/app/replayer/replayer.ml +++ b/src/app/replayer/replayer.ml @@ -63,20 +63,21 @@ let json_ledger_hash_of_ledger ledger = Ledger_hash.to_yojson @@ Ledger.merkle_root ledger let create_ledger_as_list ledger = - List.map (Ledger.to_list ledger) ~f:(fun acc -> + let%map accounts = Ledger.to_list ledger in + List.map accounts ~f:(fun acc -> Genesis_ledger_helper.Accounts.Single.of_account acc None ) let create_output ~target_fork_state_hash ~target_epoch_ledgers_state_hash ~ledger ~staking_epoch_ledger ~staking_seed ~next_epoch_ledger ~next_seed (input_genesis_ledger : Runtime_config.Ledger.t) = - let genesis_ledger_as_list = create_ledger_as_list ledger in + let%bind genesis_ledger_as_list = create_ledger_as_list ledger in let target_genesis_ledger = { input_genesis_ledger with base = Accounts genesis_ledger_as_list } in - let staking_epoch_ledger_as_list = + let%bind staking_epoch_ledger_as_list = create_ledger_as_list staking_epoch_ledger in - let next_epoch_ledger_as_list = create_ledger_as_list next_epoch_ledger in + let%map next_epoch_ledger_as_list = create_ledger_as_list next_epoch_ledger in let target_staking_epoch_data : Runtime_config.Epoch_data.Data.t = let ledger = { input_genesis_ledger with base = Accounts staking_epoch_ledger_as_list } @@ -98,8 +99,9 @@ let create_output ~target_fork_state_hash ~target_epoch_ledgers_state_hash ; target_epoch_data } -let create_replayer_checkpoint ~ledger ~start_slot_since_genesis : input = - let accounts = create_ledger_as_list ledger in +let create_replayer_checkpoint ~ledger ~start_slot_since_genesis : + input Deferred.t = + let%map accounts = create_ledger_as_list ledger in let genesis_ledger : Runtime_config.Ledger.t = { base = Accounts accounts ; num_accounts = None @@ -268,7 +270,7 @@ let update_epoch_ledger ~logger ~name ~ledger ~epoch_ledger epoch_ledger_hash = name (Ledger_hash.to_base58_check epoch_ledger_hash) ; (* Ledger.copy doesn't actually copy, roll our own here *) - let accounts = Ledger.to_list ledger in + let%map accounts = Ledger.to_list ledger in let epoch_ledger = Ledger.create ~depth:(Ledger.depth ledger) () in List.iter accounts ~f:(fun account -> let pk = Account.public_key account in @@ -292,7 +294,7 @@ let update_epoch_ledger ~logger ~name ~ledger ~epoch_ledger epoch_ledger_hash = * (string * Token_id.t)] |> Error.raise ) ; epoch_ledger ) - else epoch_ledger + else return epoch_ledger let update_staking_epoch_data ~logger pool ~ledger ~last_block_id ~staking_epoch_ledger = @@ -306,12 +308,12 @@ let update_staking_epoch_data ~logger pool ~ledger ~last_block_id ~f:(fun db -> Sql.Epoch_data.get_staking_epoch_data_id db state_hash) ~item:"staking epoch id" in - let%map { epoch_ledger_hash; epoch_data_seed } = + let%bind { epoch_ledger_hash; epoch_data_seed } = query_db pool ~f:(fun db -> Sql.Epoch_data.get_epoch_data db staking_epoch_id) ~item:"staking epoch data" in - let ledger = + let%map ledger = update_epoch_ledger ~logger ~name:"staking" ~ledger ~epoch_ledger:staking_epoch_ledger epoch_ledger_hash in @@ -329,12 +331,12 @@ let update_next_epoch_data ~logger pool ~ledger ~last_block_id ~f:(fun db -> Sql.Epoch_data.get_next_epoch_data_id db state_hash) ~item:"next epoch id" in - let%map { epoch_ledger_hash; epoch_data_seed } = + let%bind { epoch_ledger_hash; epoch_data_seed } = query_db pool ~f:(fun db -> Sql.Epoch_data.get_epoch_data db next_epoch_id) ~item:"next epoch data" in - let ledger = + let%map ledger = update_epoch_ledger ~logger ~name:"next" ~ledger ~epoch_ledger:next_epoch_ledger epoch_ledger_hash in @@ -991,9 +993,11 @@ let unquoted_string_of_yojson json = let write_replayer_checkpoint ~logger ~ledger ~last_global_slot_since_genesis = (* start replaying at the slot after the one we've just finished with *) let start_slot_since_genesis = Int64.succ last_global_slot_since_genesis in - let replayer_checkpoint = - create_replayer_checkpoint ~ledger ~start_slot_since_genesis - |> input_to_yojson |> Yojson.Safe.pretty_to_string + let%bind replayer_checkpoint = + let%map input = + create_replayer_checkpoint ~ledger ~start_slot_since_genesis + in + input_to_yojson input |> Yojson.Safe.pretty_to_string in let checkpoint_file = sprintf "replayer-checkpoint-%Ld.json" start_slot_since_genesis @@ -1437,13 +1441,15 @@ let main ~input_file ~output_file_opt ~archive_uri ~set_nonces ~repair_nonces if Int.equal !error_count 0 then ( [%log info] "Writing output to $output_file" ~metadata:[ ("output_file", `String output_file) ] ; - let output = - create_output ~target_epoch_ledgers_state_hash - ~target_fork_state_hash: - (State_hash.of_base58_check_exn target_state_hash) - ~ledger ~staking_epoch_ledger ~staking_seed - ~next_epoch_ledger ~next_seed input.genesis_ledger - |> output_to_yojson |> Yojson.Safe.pretty_to_string + let%bind output = + let%map output = + create_output ~target_epoch_ledgers_state_hash + ~target_fork_state_hash: + (State_hash.of_base58_check_exn target_state_hash) + ~ledger ~staking_epoch_ledger ~staking_seed + ~next_epoch_ledger ~next_seed input.genesis_ledger + in + output_to_yojson output |> Yojson.Safe.pretty_to_string in return @@ Out_channel.with_file output_file ~f:(fun oc -> From 5dc95c04c8b0a9d42cdcbaa2a6ca5dc89f3e5fee Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Fri, 2 Jun 2023 13:23:08 -0700 Subject: [PATCH 5/8] Revert change to substitute use of default token merkle_ledger_tests still pass in `dev` profile --- src/lib/merkle_ledger_tests/test_database.ml | 26 +++++++------------- src/lib/merkle_ledger_tests/test_mask.ml | 2 +- src/lib/merkle_mask/masking_merkle_tree.ml | 3 +++ 3 files changed, 13 insertions(+), 18 deletions(-) diff --git a/src/lib/merkle_ledger_tests/test_database.ml b/src/lib/merkle_ledger_tests/test_database.ml index f40a8dd0c26..3d8301de619 100644 --- a/src/lib/merkle_ledger_tests/test_database.ml +++ b/src/lib/merkle_ledger_tests/test_database.ml @@ -31,10 +31,6 @@ let%test_module "test functor on in memory databases" = module Make (Test : Test_intf) = struct module MT = Test.MT - let account_default_token_gen = - let%map.Quickcheck.Generator account = Account.gen in - { account with token_id = Token_id.default } - let%test_unit "getting a non existing account returns None" = Test.with_instance (fun mdb -> Quickcheck.test @@ -54,13 +50,13 @@ let%test_module "test functor on in memory databases" = let%test "add and retrieve an account" = Test.with_instance (fun mdb -> - let account = Quickcheck.random_value account_default_token_gen in + let account = Quickcheck.random_value Account.gen in let location = create_new_account_exn mdb account in Account.equal (Option.value_exn (MT.get mdb location)) account ) let%test "accounts are atomic" = Test.with_instance (fun mdb -> - let account = Quickcheck.random_value account_default_token_gen in + let account = Quickcheck.random_value Account.gen in let location = create_new_account_exn mdb account in MT.set mdb location account ; let location' = @@ -89,7 +85,7 @@ let%test_module "test functor on in memory databases" = let open Quickcheck.Let_syntax in let%bind num_initial_accounts = Int.gen_incl 0 n in let%map accounts = - list_with_length num_initial_accounts account_default_token_gen + list_with_length num_initial_accounts Account.gen in dedup_accounts accounts in @@ -136,8 +132,7 @@ let%test_module "test functor on in memory databases" = let open Quickcheck.Let_syntax in let max_height = Int.min (MT.depth mdb) 5 in let%bind num_accounts = Int.gen_incl 0 (1 lsl max_height) in - Quickcheck.Generator.list_with_length num_accounts - account_default_token_gen + Quickcheck.Generator.list_with_length num_accounts Account.gen in let accounts = Quickcheck.random_value accounts_gen in Sequence.of_list accounts @@ -155,7 +150,7 @@ let%test_module "test functor on in memory databases" = let%test_unit "set_inner_hash_at_addr_exn(address,hash); \ get_inner_hash_at_addr_exn(address) = hash" = let random_hash = - Hash.hash_account @@ Quickcheck.random_value account_default_token_gen + Hash.hash_account @@ Quickcheck.random_value Account.gen in Test.with_instance (fun mdb -> Quickcheck.test @@ -170,8 +165,7 @@ let%test_module "test functor on in memory databases" = let random_accounts max_height = let num_accounts = 1 lsl max_height in Quickcheck.random_value - (Quickcheck.Generator.list_with_length num_accounts - account_default_token_gen ) + (Quickcheck.Generator.list_with_length num_accounts Account.gen) let populate_db mdb max_height = random_accounts max_height @@ -229,7 +223,7 @@ let%test_module "test functor on in memory databases" = let accounts = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts - account_default_token_gen ) + Account.gen ) in if not @@ List.is_empty accounts then let addresses = @@ -322,7 +316,7 @@ let%test_module "test functor on in memory databases" = let accounts = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts - account_default_token_gen ) + Account.gen ) in MT.set_all_accounts_rooted_at_exn mdb address accounts ; let result = @@ -369,9 +363,7 @@ let%test_module "test functor on in memory databases" = Test.with_instance (fun mdb -> let max_height = Int.min (MT.depth mdb) 5 in test_subtree_range mdb max_height ~f:(fun index -> - let account = - Quickcheck.random_value account_default_token_gen - in + let account = Quickcheck.random_value Account.gen in MT.set_at_index_exn mdb index account ; let result = MT.get_at_index_exn mdb index in assert (Account.equal account result) ) ) diff --git a/src/lib/merkle_ledger_tests/test_mask.ml b/src/lib/merkle_ledger_tests/test_mask.ml index ac9daef89f4..1a89720e660 100644 --- a/src/lib/merkle_ledger_tests/test_mask.ml +++ b/src/lib/merkle_ledger_tests/test_mask.ml @@ -271,7 +271,7 @@ module Make (Test : Test_intf) = struct Mask.Attached.set attached_mask (Test.Location.Account loc0) dummy_account ; (* Make some accounts *) - let num_accounts = (1 lsl Test.depth) - 2 in + let num_accounts = (1 lsl Test.depth) - 1 in let gen_values gen = Quickcheck.random_value (Quickcheck.Generator.list_with_length num_accounts gen) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index e6d627eeddc..4a291b36a5f 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -155,6 +155,9 @@ module Make (Inputs : Inputs_intf.S) = struct let self_set_location t account_id location = assert_is_attached t ; Account_id.Table.set t.location_tbl ~key:account_id ~data:location ; + (* if account is at a hitherto-unused location, that + becomes the current location + *) match t.current_location with | None -> t.current_location <- Some location From d23538cb187d646b375b127b8d6fd3ad417df1b0 Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Mon, 5 Jun 2023 10:39:54 -0700 Subject: [PATCH 6/8] rm redundant location update --- src/lib/merkle_mask/masking_merkle_tree.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 4a291b36a5f..6b6a4852de6 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -759,8 +759,8 @@ module Make (Inputs : Inputs_intf.S) = struct Or_error.error_string "Db_error.Out_of_leaves" | Some location -> set t location account ; + (* the current location is updated by `self_set_location` *) self_set_location t account_id location ; - t.current_location <- Some location ; Ok (`Added, location) ) ) | Some location -> Ok (`Existed, location) From 97d14fd942c3e67761fa9656b26aa670acb2e34a Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Mon, 5 Jun 2023 15:33:11 -0700 Subject: [PATCH 7/8] remove redundant self_set_location --- src/lib/merkle_mask/masking_merkle_tree.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 6b6a4852de6..3d438635a15 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -758,9 +758,10 @@ module Make (Inputs : Inputs_intf.S) = struct | None -> Or_error.error_string "Db_error.Out_of_leaves" | Some location -> + (* `set` calls `self_set_location`, which updates + the current location + *) set t location account ; - (* the current location is updated by `self_set_location` *) - self_set_location t account_id location ; Ok (`Added, location) ) ) | Some location -> Ok (`Existed, location) From a7413f669671b1ad86f7ffa0c506464dc87bafdc Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Mon, 5 Jun 2023 21:49:38 -0700 Subject: [PATCH 8/8] add back apparently-redundant code --- src/lib/merkle_mask/masking_merkle_tree.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index 3d438635a15..0d7c02cb8cd 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -762,6 +762,10 @@ module Make (Inputs : Inputs_intf.S) = struct the current location *) set t location account ; + (* apparently redundant, but the non-default token transaction + SNARK tests fail without it + *) + self_set_location t account_id location ; Ok (`Added, location) ) ) | Some location -> Ok (`Existed, location)