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/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 -> 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 96700e0bcb6..35d5f68904c 100644 --- a/src/lib/merkle_ledger/base_ledger_intf.ml +++ b/src/lib/merkle_ledger/base_ledger_intf.ml @@ -44,7 +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 + + (** 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 @@ -71,10 +74,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..7b9756935df 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,26 @@ 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 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 + let get_or_create_account mdb account_id account = match Account_location.get mdb account_id with | Error Account_location_not_found -> ( @@ -639,13 +639,6 @@ 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 -> @@ -680,23 +673,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..b9123eba9df 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 @@ -118,13 +118,15 @@ end = struct let iteri _t ~f:_ = () - 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 to_list_sequential _t = [] let make_space_for _t _tot = () 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..3d8301de619 100644 --- a/src/lib/merkle_ledger_tests/test_database.ml +++ b/src/lib/merkle_ledger_tests/test_database.ml @@ -404,7 +404,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 +475,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..1a89720e660 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) - 1 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 0716966c3a4..0d7c02cb8cd 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 @@ -153,7 +154,16 @@ 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 ; + (* if account is at a hitherto-unused location, that + becomes the current 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 = @@ -505,17 +515,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 +649,26 @@ 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 ) + + 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 ; + 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) + 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 ; @@ -789,9 +758,14 @@ 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 ; + (* apparently redundant, but the non-default token transaction + SNARK tests fail without it + *) self_set_location t account_id location ; - t.current_location <- Some location ; Ok (`Added, location) ) ) | Some location -> Ok (`Existed, location) 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..08bade835c3 100644 --- a/src/lib/mina_lib/mina_lib.mli +++ b/src/lib/mina_lib/mina_lib.mli @@ -174,9 +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 +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 +val get_snarked_ledger : + t -> State_hash.t option -> Account.t list Deferred.Or_error.t val wallets : t -> Secrets.Wallets.t