diff --git a/src/app/archive/lib/diff.ml b/src/app/archive/lib/diff.ml index d5405a4cb7b2..1935c7dd36e8 100644 --- a/src/app/archive/lib/diff.ml +++ b/src/app/archive/lib/diff.ml @@ -1,4 +1,3 @@ -open Mina_block open Core_kernel open Mina_base module Breadcrumb = Transition_frontier.Breadcrumb @@ -101,13 +100,7 @@ module Builder = struct let account_creation_fee = precomputed_values.constraint_constants.account_creation_fee in - let previous_block_state_hash = - Mina_block.header block |> Header.protocol_state - |> Mina_state.Protocol_state.previous_state_hash - in - List.map - (Staged_ledger.latest_block_accounts_created staged_ledger - ~previous_block_state_hash ) ~f:(fun acct_id -> + List.map (Breadcrumb.accounts_created breadcrumb) ~f:(fun acct_id -> (acct_id, account_creation_fee) ) in let tokens_used = diff --git a/src/app/cli/src/init/test_submit_to_archive.ml b/src/app/cli/src/init/test_submit_to_archive.ml index 0080a911780e..1e07338caa4a 100644 --- a/src/app/cli/src/init/test_submit_to_archive.ml +++ b/src/app/cli/src/init/test_submit_to_archive.ml @@ -135,12 +135,17 @@ module Block = struct (* [create_exn] is only safe to use for initial genesis block. *) Staged_ledger.create_exn ~constraint_constants ~ledger in + let accounts_created = + Precomputed_values.accounts precomputed_values + |> Lazy.force + |> List.map ~f:Precomputed_values.id_of_account_record + in [%log info] "Generating genesis breadcrumb" ; let breadcrumb = Frontier_base.Breadcrumb.create ~validated_transition:validated ~staged_ledger ~transition_receipt_time:(Some (Time.now ())) - ~just_emitted_a_proof:false + ~just_emitted_a_proof:false ~accounts_created in (* Block proof contained in genesis header is just a stub. Hence we need to generate the real proof here, in order to diff --git a/src/app/dump_blocks/dump_blocks.ml b/src/app/dump_blocks/dump_blocks.ml index 7e2363acf69a..35b28afa97e0 100644 --- a/src/app/dump_blocks/dump_blocks.ml +++ b/src/app/dump_blocks/dump_blocks.ml @@ -91,7 +91,10 @@ let f (type a) ?parent (outputs : a codec io list) make_breadcrumb = List.iter outputs ~f:(fun output -> let module Enc = (val output.encoding) in let content = - Enc.of_breadcrumb ?with_parent_statehash:parent breadcrumb + Enc.of_breadcrumb ?with_parent_statehash:parent + ~accounts_created: + (Frontier_base.Breadcrumb.accounts_created breadcrumb) + breadcrumb in eprintf !"Randomly generated block, %s: %s\n" diff --git a/src/app/dump_blocks/encoding.ml b/src/app/dump_blocks/encoding.ml index c4b0924e6cb6..a762f223c711 100644 --- a/src/app/dump_blocks/encoding.ml +++ b/src/app/dump_blocks/encoding.ml @@ -8,7 +8,7 @@ type 'a content = let append_newline s = s ^ "\n" -let block_of_breadcrumb ?with_parent_statehash breadcrumb = +let block_of_breadcrumb ?with_parent_statehash ~accounts_created:_ breadcrumb = let open Mina_block in let block = Frontier_base.Breadcrumb.block breadcrumb in match with_parent_statehash with @@ -37,7 +37,10 @@ module type S = sig val name : string val of_breadcrumb : - ?with_parent_statehash:string -> Frontier_base.Breadcrumb.t -> t + ?with_parent_statehash:string + -> accounts_created:Mina_base.Account_id.t list + -> Frontier_base.Breadcrumb.t + -> t val to_string : t -> string @@ -80,9 +83,12 @@ let precomputed_values = Lazy.force Precomputed_values.for_unit_tests let constraint_constants = precomputed_values.constraint_constants -let precomputed_of_breadcrumb ?with_parent_statehash breadcrumb = +let precomputed_of_breadcrumb ?with_parent_statehash ~accounts_created + breadcrumb = let open Frontier_base in - let block = block_of_breadcrumb ?with_parent_statehash breadcrumb in + let block = + block_of_breadcrumb ?with_parent_statehash ~accounts_created breadcrumb + in let staged_ledger = Transition_frontier.Breadcrumb.staged_ledger breadcrumb in let scheduled_time = Mina_block.Stable.Latest.header block @@ -93,6 +99,7 @@ let precomputed_of_breadcrumb ?with_parent_statehash breadcrumb = Mina_block.Precomputed.of_block ~logger ~constraint_constants ~staged_ledger ~scheduled_time (Breadcrumb.block_with_hash breadcrumb) + ~accounts_created module Sexp_precomputed : S with type t = Mina_block.Precomputed.t = struct type t = Mina_block.Precomputed.t diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 34ed23947431..55d02015c573 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -291,6 +291,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants | Ok ( `Ledger_proof ledger_proof_opt , `Staged_ledger transitioned_staged_ledger + , `Accounts_created _ , `Pending_coinbase_update (is_new_stack, pending_coinbase_update) ) -> [%log internal] "Hash_new_staged_ledger" ; @@ -357,7 +358,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants in let ledger_proof_statement = match ledger_proof_opt with - | Some (proof, _) -> + | Some proof -> Ledger_proof.Cached.statement proof | None -> let state = @@ -372,7 +373,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants in let supply_increase = Option.value_map ledger_proof_opt - ~f:(fun (proof, _) -> + ~f:(fun proof -> (Ledger_proof.Cached.statement proof).supply_increase ) ~default:Currency.Amount.Signed.zero in @@ -423,7 +424,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants (Consensus.Data.Block_data.prover_state block_data) ~staged_ledger_diff:(Staged_ledger_diff.forget diff) ~ledger_proof: - (Option.map ledger_proof_opt ~f:(fun (proof, _) -> + (Option.map ledger_proof_opt ~f:(fun proof -> Ledger_proof.Cached.read_proof_from_disk proof ) ) ) in let witness = diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index bdb28d29fa34..9fea0140e643 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -430,6 +430,17 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier time_deferred (let open Deferred.Let_syntax in let temp_mask = Root_ledger.as_masked temp_snarked_ledger in + (* [of_scan_state_pending_coinbases_and_snarked_ledger] is called here + * to verify the scan state we received. We ignore the resulting staged + * ledger (from [temp_mask]). Later we call [Transition_frontier.load] + * which will indirectly invoke + * [of_scan_state_pending_coinbases_and_snarked_ledger_unchecked] + * repeating the same computation (except for proof verification + * which is skipped). Chain of calls: + * [Transition_frontier.load] -> .. -> [load_from_persistence_and_start] + * -> [load_full_frontier] -> [construct_staged_ledger_at_root] -> + * -> [of_scan_state_pending_coinbases_and_snarked_ledger_unchecked] + *) let%map result = Staged_ledger .of_scan_state_pending_coinbases_and_snarked_ledger ~logger diff --git a/src/lib/mina_block/precomputed_block.ml b/src/lib/mina_block/precomputed_block.ml index 93e24dddc05c..74d3bcd47d9e 100644 --- a/src/lib/mina_block/precomputed_block.ml +++ b/src/lib/mina_block/precomputed_block.ml @@ -100,7 +100,7 @@ end] let of_block ~logger ~(constraint_constants : Genesis_constants.Constraint_constants.t) - ~scheduled_time ~staged_ledger block_with_hash = + ~scheduled_time ~staged_ledger ~accounts_created block_with_hash = let ledger = Staged_ledger.ledger staged_ledger in let block = With_hash.data block_with_hash in let state_hash = @@ -145,13 +145,7 @@ let of_block ~logger ] ; let accounts_created = let account_creation_fee = constraint_constants.account_creation_fee in - let previous_block_state_hash = - Mina_state.Protocol_state.previous_state_hash - (Header.protocol_state header) - in - List.map - (Staged_ledger.latest_block_accounts_created staged_ledger - ~previous_block_state_hash ) ~f:(fun acct_id -> + List.map accounts_created ~f:(fun acct_id -> (acct_id, account_creation_fee) ) in let tokens_used = diff --git a/src/lib/mina_block/precomputed_block.mli b/src/lib/mina_block/precomputed_block.mli index abfb2af42da7..eca3d2860007 100644 --- a/src/lib/mina_block/precomputed_block.mli +++ b/src/lib/mina_block/precomputed_block.mli @@ -56,5 +56,6 @@ val of_block : -> constraint_constants:Genesis_constants.Constraint_constants.t -> scheduled_time:Block_time.Time.t -> staged_ledger:Staged_ledger.t + -> accounts_created:Account_id.t list -> (Block.t, Mina_base.State_hash.State_hashes.t) With_hash.t -> t diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 24fde96ba037..b59f0590039d 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -500,6 +500,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger in let%bind.Deferred.Result ( `Ledger_proof proof_opt , `Staged_ledger transitioned_staged_ledger + , `Accounts_created accounts_created , `Pending_coinbase_update _ ) = Staged_ledger.apply ?skip_verification:skip_staged_ledger_verification ~get_completed_work @@ -547,7 +548,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger | None -> (*There was no proof emitted, snarked ledger hash shouldn't change*) Protocol_state.snarked_ledger_hash parent_protocol_state - | Some (proof, _) -> + | Some proof -> Mina_state.Snarked_ledger_state.snarked_ledger_hash @@ Ledger_proof.Cached.statement proof in @@ -580,7 +581,8 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger ( `Just_emitted_a_proof (Option.is_some proof_opt) , `Block_with_validation (t, Unsafe.set_valid_staged_ledger_diff validation) - , `Staged_ledger transitioned_staged_ledger ) + , `Staged_ledger transitioned_staged_ledger + , `Accounts_created accounts_created ) | Error errors -> Error (`Invalid_staged_ledger_diff errors) diff --git a/src/lib/mina_block/validation.mli b/src/lib/mina_block/validation.mli index 955f36f92b38..f8d681e60e70 100644 --- a/src/lib/mina_block/validation.mli +++ b/src/lib/mina_block/validation.mli @@ -378,6 +378,7 @@ val validate_staged_ledger_diff : , 'f ) with_block ] * [ `Staged_ledger of Staged_ledger.t ] + * [ `Accounts_created of Account_id.t list ] , [> `Staged_ledger_application_failed of Staged_ledger.Staged_ledger_error.t | `Invalid_body_reference diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index e09fc86d8398..9813573baa5a 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -853,11 +853,6 @@ let most_recent_valid_transition t = t.components.most_recent_valid_block let block_produced_bvar t = t.components.block_produced_bvar -let staged_ledger_ledger_proof t = - let open Option.Let_syntax in - let%bind sl = best_staged_ledger_opt t in - Staged_ledger.current_ledger_proof sl - let validated_transitions t = t.pipes.validated_transitions_reader let initialization_finish_signal t = t.initialization_finish_signal diff --git a/src/lib/mina_lib/mina_lib.mli b/src/lib/mina_lib/mina_lib.mli index f07c96d6127b..ca599abf5acb 100644 --- a/src/lib/mina_lib/mina_lib.mli +++ b/src/lib/mina_lib/mina_lib.mli @@ -227,8 +227,6 @@ val stop_snark_worker : ?should_wait_kill:bool -> t -> unit Deferred.t val create : commit_id:string -> ?wallets:Secrets.Wallets.t -> Config.t -> t Deferred.t -val staged_ledger_ledger_proof : t -> Ledger_proof.Cached.t option - val transition_frontier : t -> Transition_frontier.t option Broadcast_pipe.Reader.t diff --git a/src/lib/mina_lib/mina_subscriptions.ml b/src/lib/mina_lib/mina_subscriptions.ml index ec710be10fb1..4f2978b6cdba 100644 --- a/src/lib/mina_lib/mina_subscriptions.ml +++ b/src/lib/mina_lib/mina_subscriptions.ml @@ -144,6 +144,9 @@ let create ~logger ~constraint_constants ~wallets ~new_blocks in Mina_block.Precomputed.of_block ~logger ~constraint_constants ~staged_ledger ~scheduled_time + ~accounts_created: + (Frontier_base.Breadcrumb.accounts_created + breadcrumb ) new_block in [%log debug] "Precomputed block generated in $time ms" diff --git a/src/lib/one_or_two/one_or_two.ml b/src/lib/one_or_two/one_or_two.ml index f20633bd7d2f..c66526c288db 100644 --- a/src/lib/one_or_two/one_or_two.ml +++ b/src/lib/one_or_two/one_or_two.ml @@ -35,21 +35,21 @@ let to_numbered_list = function | `Two (a, b) -> [ (0, a); (1, b) ] -let group_sequence : 'a Sequence.t -> 'a t Sequence.t = - fun to_group -> - Sequence.unfold ~init:to_group ~f:(fun acc -> - match Sequence.next acc with - | None -> - None - | Some (a, rest_1) -> ( - match Sequence.next rest_1 with - | None -> - Some (`One a, Sequence.empty) - | Some (b, rest_2) -> - Some (`Two (a, b), rest_2) ) ) - let group_list : 'a list -> 'a t list = - fun xs -> xs |> Sequence.of_list |> group_sequence |> Sequence.to_list + let f (el, acc) x = + match el with + | `One a -> + (`Two (a, x), acc) + | `Two (a, b) -> + (`One x, `Two (a, b) :: acc) + in + function + | [] -> + [] + | fst_x :: xs -> + let init = (`One fst_x, []) in + let last, res = List.fold ~init ~f xs in + List.rev @@ (last :: res) let zip : 'a t -> 'b t -> ('a * 'b) t Or_error.t = fun a b -> diff --git a/src/lib/one_or_two/one_or_two.mli b/src/lib/one_or_two/one_or_two.mli index 0183b5366f3a..085f5eacec28 100644 --- a/src/lib/one_or_two/one_or_two.mli +++ b/src/lib/one_or_two/one_or_two.mli @@ -24,8 +24,6 @@ val to_list : 'a t -> 'a list val to_numbered_list : 'a t -> (int * 'a) list -val group_sequence : 'a Sequence.t -> 'a t Sequence.t - val group_list : 'a list -> 'a t list val zip : 'a t -> 'b t -> ('a * 'b) t Or_error.t diff --git a/src/lib/snark_profiler_lib/snark_profiler_lib.ml b/src/lib/snark_profiler_lib/snark_profiler_lib.ml index 41b236783252..de44712b0940 100644 --- a/src/lib/snark_profiler_lib/snark_profiler_lib.ml +++ b/src/lib/snark_profiler_lib/snark_profiler_lib.ml @@ -570,8 +570,7 @@ let profile_user_command (module T : Transaction_snark.S) ~genesis_constants ~f:(fun ((max_span, source_ledger, coinbase_stack_source), proofs) (target_ledger, applied) -> let txn = - With_status.data - @@ Mina_ledger.Ledger.transaction_of_applied applied + Mina_transaction_logic.Transaction_applied.transaction applied in (* the txn was already valid before apply, we are just recasting it here after application *) let (`If_this_is_used_it_should_have_a_comment_justifying_it @@ -792,8 +791,8 @@ let check_base_snarks ~genesis_constants ~constraint_constants ~logger |> List.fold ~init:sparse_ledger0 ~f:(fun source_ledger (target_ledger, applied_txn) -> let txn = - With_status.data - @@ Mina_ledger.Ledger.transaction_of_applied applied_txn + Mina_transaction_logic.Transaction_applied.transaction + applied_txn in (* the txn was already valid before apply, we are just recasting it here after application *) let (`If_this_is_used_it_should_have_a_comment_justifying_it @@ -857,8 +856,8 @@ let generate_base_snarks_witness ~genesis_constants ~constraint_constants |> List.fold ~init:sparse_ledger0 ~f:(fun source_ledger (target_ledger, applied_txn) -> let txn = - With_status.data - @@ Mina_ledger.Ledger.transaction_of_applied applied_txn + Mina_transaction_logic.Transaction_applied.transaction + applied_txn in (* the txn was already valid before apply, we are just recasting it here after application *) let (`If_this_is_used_it_should_have_a_comment_justifying_it diff --git a/src/lib/snark_work_lib/metrics.ml b/src/lib/snark_work_lib/metrics.ml index e3debb3d9e86..8af3c436bb31 100644 --- a/src/lib/snark_work_lib/metrics.ml +++ b/src/lib/snark_work_lib/metrics.ml @@ -1,20 +1,5 @@ open Core_kernel - -module Transaction_type = struct - type t = [ `Zkapp_command | `Signed_command | `Coinbase | `Fee_transfer ] - [@@deriving to_yojson] - - let of_transaction = function - | Mina_transaction.Transaction.Command - (Mina_base.User_command.Zkapp_command _) -> - `Zkapp_command - | Command (Signed_command _) -> - `Signed_command - | Coinbase _ -> - `Coinbase - | Fee_transfer _ -> - `Fee_transfer -end +module Transaction_type = Mina_transaction.Transaction_type let emit_single_metrics_impl ~logger ~(single_spec : (Transaction_type.t, _) Single_spec.Poly.t) ~elapsed = diff --git a/src/lib/staged_ledger/pre_diff_info.ml b/src/lib/staged_ledger/pre_diff_info.ml index 0bc14a91d87e..ee8398f4e081 100644 --- a/src/lib/staged_ledger/pre_diff_info.ml +++ b/src/lib/staged_ledger/pre_diff_info.ml @@ -403,7 +403,8 @@ let compute_statuses let split_transaction_statuses txns_with_statuses = List.partition_map txns_with_statuses ~f:(fun txn_applied -> let { With_status.data = txn; status } = - Mina_ledger.Ledger.transaction_of_applied txn_applied + Mina_transaction_logic.Transaction_applied.transaction_with_status + txn_applied in match txn with | Transaction.Command cmd -> diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 9d8e483586ed..72f47ea439ec 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -242,8 +242,8 @@ module T = struct } let proof_txns_with_state_hashes t = - Scan_state.latest_ledger_proof t.scan_state - |> Option.bind ~f:(Fn.compose Mina_stdlib.Nonempty_list.of_list_opt snd) + Scan_state.latest_ledger_proof_txs t.scan_state + |> Option.bind ~f:Mina_stdlib.Nonempty_list.of_list_opt let scan_state { scan_state; _ } = scan_state @@ -273,26 +273,20 @@ module T = struct in let statement_check = `Partial in let last_proof_statement = - Option.map - ~f:(fun ((p, _), _) -> Ledger_proof.Cached.statement p) + Option.map ~f:Ledger_proof.Cached.statement (Scan_state.latest_ledger_proof scan_state) in Statement_scanner.check_invariants ~constraint_constants scan_state ~statement_check ~verifier:() ~error_prefix ~registers_end ~last_proof_statement - let of_scan_state_and_ledger_unchecked ~ledger ~scan_state - ~constraint_constants ~pending_coinbase_collection = - { ledger; scan_state; constraint_constants; pending_coinbase_collection } - let of_scan_state_and_ledger ~logger ~(constraint_constants : Genesis_constants.Constraint_constants.t) ~verifier ~last_proof_statement ~ledger ~scan_state ~pending_coinbase_collection ~get_state ~first_pass_ledger_target = let open Deferred.Or_error.Let_syntax in let t = - of_scan_state_and_ledger_unchecked ~ledger ~scan_state - ~constraint_constants ~pending_coinbase_collection + { ledger; scan_state; constraint_constants; pending_coinbase_collection } in let%bind pending_coinbase_stack = Pending_coinbase.latest_stack ~is_new_stack:false @@ -320,6 +314,7 @@ module T = struct ~last_proof_statement ~ledger ~scan_state ~pending_coinbase_collection ~first_pass_ledger_target = let open Deferred.Or_error.Let_syntax in + (* TODO consider removing the invariants check *) let%bind pending_coinbase_stack = Pending_coinbase.latest_stack ~is_new_stack:false pending_coinbase_collection @@ -378,12 +373,15 @@ module T = struct in let last_proof_statement = Scan_state.latest_ledger_proof scan_state - |> Option.map ~f:(fun ((p, _), _) -> Ledger_proof.Cached.statement p) + |> Option.map ~f:Ledger_proof.Cached.statement in f ~constraint_constants ~last_proof_statement ~ledger:snarked_ledger ~scan_state ~pending_coinbase_collection:pending_coinbases ~first_pass_ledger_target + (* Used in bootstrap (to verify data received from network) + Consider changing types to work on stable scan state + *) let of_scan_state_pending_coinbases_and_snarked_ledger ~logger ~constraint_constants ~verifier ~scan_state ~snarked_ledger ~snarked_local_state ~expected_merkle_root ~pending_coinbases ~get_state @@ -393,6 +391,7 @@ module T = struct ~expected_merkle_root ~get_state ~signature_kind (of_scan_state_and_ledger ~logger ~get_state ~verifier) + (* Used in loading the root from disk *) let of_scan_state_pending_coinbases_and_snarked_ledger_unchecked ~constraint_constants ~logger ~scan_state ~snarked_ledger ~snarked_local_state ~expected_merkle_root ~pending_coinbases ~get_state @@ -435,11 +434,6 @@ module T = struct |> Or_error.ok_exn } - let current_ledger_proof t = - Option.map - (Scan_state.latest_ledger_proof t.scan_state) - ~f:(Fn.compose fst fst) - let replace_ledger_exn t ledger = [%test_result: Ledger_hash.t] ~message:"Cannot replace ledger since merkle_root differs" @@ -565,7 +559,7 @@ module T = struct else let txn_with_expected_status = { With_status.data = - With_status.data (Ledger.transaction_of_applied applied_txn) + Mina_transaction_logic.Transaction_applied.transaction applied_txn ; status = pre_stmt.expected_status } in @@ -593,14 +587,15 @@ module T = struct ; sok_digest = () } in - { Scan_state.Transaction_with_witness.transaction_with_info = applied_txn - ; state_hash = state_and_body_hash - ; first_pass_ledger_witness = pre_stmt.first_pass_ledger_witness - ; second_pass_ledger_witness = ledger_witness - ; init_stack = pre_stmt.init_stack - ; statement - ; block_global_slot = global_slot - } + ( { Scan_state.Transaction_with_witness.transaction_with_info = applied_txn + ; state_hash = state_and_body_hash + ; first_pass_ledger_witness = pre_stmt.first_pass_ledger_witness + ; second_pass_ledger_witness = ledger_witness + ; init_stack = pre_stmt.init_stack + ; statement + ; block_global_slot = global_slot + } + , Mina_transaction_logic.Transaction_applied.new_accounts applied_txn ) let apply_transactions_first_pass ~yield ~constraint_constants ~global_slot ~signature_kind ledger init_pending_coinbase_stack_state ts @@ -780,7 +775,11 @@ module T = struct List.fold_right ~init:(Ok []) data ~f:(fun (d : Scan_state.Transaction_with_witness.t) acc -> let%map.Or_error acc = acc in - let t = d.transaction_with_info |> Ledger.transaction_of_applied in + let t = + d.transaction_with_info + |> Mina_transaction_logic.Transaction_applied + .transaction_with_status + in t :: acc ) in let total_fee_excess txns = @@ -946,7 +945,7 @@ module T = struct (* Deleting oldest stack if proof emitted *) let%bind pending_coinbase_collection_updated1 = match ledger_proof with - | Some (proof, _) -> + | Some proof -> let%bind oldest_stack, pending_coinbase_collection_updated1 = Pending_coinbase.remove_coinbase_stack ~depth pending_coinbase_collection @@ -1066,6 +1065,19 @@ module T = struct t.pending_coinbase_collection transactions current_state_view state_and_body_hash ) in + let witnesses = List.map data ~f:fst in + let accounts_created = List.concat_map data ~f:snd in + (* + let state_hash = + Mina_state.Protocol_state.compute_state_hash + ~previous_state_hash:(fst state_and_body_hash) + ~state_body_hash:(snd state_and_body_hash) + in + let _tagged_witnesses, _tagged_works = + State_hash.File_storage.write_values_exn state_hash + ~f:(persist_witnesses_and_works witnesses works) + in +*) let slots = List.length data in let work_count = List.length works in let required_pairs = Scan_state.work_statements_for_new_diff t.scan_state in @@ -1093,18 +1105,20 @@ module T = struct else Deferred.Result.return () ) in [%log internal] "Check_zero_fee_excess" ; - let%bind () = Deferred.return (check_zero_fee_excess t.scan_state data) in + let%bind () = + Deferred.return (check_zero_fee_excess t.scan_state witnesses) + in [%log internal] "Fill_work_and_enqueue_transactions" ; let%bind res_opt, scan_state' = O1trace.thread "fill_work_and_enqueue_transactions" (fun () -> let r = Scan_state.fill_work_and_enqueue_transactions t.scan_state ~logger - data works + witnesses works in Or_error.iter_error r ~f:(fun e -> let data_json = `List - (List.map data + (List.map witnesses ~f:(fun { Scan_state.Transaction_with_witness.statement; _ } -> Transaction_snark.Statement.to_yojson statement ) ) @@ -1179,6 +1193,7 @@ module T = struct in ( `Ledger_proof res_opt , `Staged_ledger new_staged_ledger + , `Accounts_created accounts_created , `Pending_coinbase_update ( is_new_stack , { Pending_coinbase.Update.Poly.action = stack_update_in_snark @@ -1245,7 +1260,7 @@ module T = struct in let apply_diff_start_time = Core.Time.now () in [%log internal] "Apply_diff" ; - let%map ((_, `Staged_ledger new_staged_ledger, _) as res) = + let%map ((_, `Staged_ledger new_staged_ledger, _, _) as res) = apply_diff ~skip_verification: ([%equal: [ `All | `Proofs ] option] skip_verification (Some `All)) @@ -2260,39 +2275,6 @@ module T = struct ( { Staged_ledger_diff.With_valid_signatures_and_proofs.diff } , invalid_on_this_ledger ) ) ) - let latest_block_accounts_created t ~previous_block_state_hash = - let scan_state = scan_state t in - (* filter leaves by state hash from previous block *) - let block_transactions_applied = - let f - ({ state_hash = leaf_block_hash, _; transaction_with_info; _ } : - Scan_state.Transaction_with_witness.t ) = - if State_hash.equal leaf_block_hash previous_block_state_hash then - Some transaction_with_info.varying - else None - in - List.filter_map (Scan_state.base_jobs_on_latest_tree scan_state) ~f - @ List.filter_map - (Scan_state.base_jobs_on_earlier_tree ~index:0 scan_state) - ~f - in - List.map block_transactions_applied ~f:(function - | Command (Signed_command cmd) -> ( - match cmd.body with - | Payment { new_accounts } -> - new_accounts - | Stake_delegation _ -> - [] - | Failed -> - [] ) - | Command (Zkapp_command { new_accounts; _ }) -> - new_accounts - | Fee_transfer { new_accounts; _ } -> - new_accounts - | Coinbase { new_accounts; _ } -> - new_accounts ) - |> List.concat - let convert_and_apply_all_masks_to_ledger ~hardfork_db ({ ledger; _ } : t) = let accounts = Ledger.all_accounts_on_masks ledger @@ -2444,6 +2426,7 @@ let%test_module "staged ledger tests" = let diff' = Staged_ledger_diff.forget diff in let%map ( `Ledger_proof ledger_proof , `Staged_ledger sl' + , `Accounts_created _ , `Pending_coinbase_update (is_new_stack, pc_update) ) = match%map Sl.apply ~constraint_constants ~global_slot !sl diff' ~logger @@ -2687,17 +2670,10 @@ let%test_module "staged ledger tests" = |> Sequence.to_list (* Fee excess at top level ledger proofs should always be zero *) - let assert_fee_excess : - ( Ledger_proof.Cached.t - * (Transaction.t With_status.t * _ * _) - Sl.Scan_state.Transactions_ordered.Poly.t - list ) - option - -> unit = + let assert_fee_excess : Ledger_proof.Cached.t option -> unit = fun proof_opt -> let fee_excess = - Option.value_map ~default:Fee_excess.zero proof_opt - ~f:(fun (proof, _txns) -> + Option.value_map ~default:Fee_excess.zero proof_opt ~f:(fun proof -> (Ledger_proof.Cached.statement proof).fee_excess ) in assert (Fee_excess.is_zero fee_excess) @@ -2825,7 +2801,7 @@ let%test_module "staged ledger tests" = in let%bind () = match proof_opt with - | Some (proof, _transactions) -> + | Some proof -> (*update snarked ledger with the transactions in the most recently emitted proof*) let%map res = Sl.Scan_state.get_snarked_ledger_async @@ -3430,6 +3406,7 @@ let%test_module "staged ledger tests" = | Ok ( `Ledger_proof _ledger_proof , `Staged_ledger sl' + , `Accounts_created _ , `Pending_coinbase_update _ ) -> sl := sl' ; (false, diff) diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 52407c556b84..263bc6a30615 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -228,15 +228,9 @@ val apply : -> ?transaction_pool_proxy:Check_commands.transaction_pool_proxy -> t -> Staged_ledger_diff.t - -> ( [ `Ledger_proof of - ( Ledger_proof.Cached.t - * ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Scan_state.Transactions_ordered.Poly.t - list ) - option ] + -> ( [ `Ledger_proof of Ledger_proof.Cached.t option ] * [ `Staged_ledger of t ] + * [ `Accounts_created of Account_id.t list ] * [ `Pending_coinbase_update of bool * Pending_coinbase.Update.t ] , Staged_ledger_error.t ) Deferred.Result.t @@ -253,22 +247,13 @@ val apply_diff_unchecked : -> signature_kind:Mina_signature_kind.t -> t -> Staged_ledger_diff.With_valid_signatures_and_proofs.t - -> ( [ `Ledger_proof of - ( Ledger_proof.Cached.t - * ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Scan_state.Transactions_ordered.Poly.t - list ) - option ] + -> ( [ `Ledger_proof of Ledger_proof.Cached.t option ] * [ `Staged_ledger of t ] + * [ `Accounts_created of Account_id.t list ] * [ `Pending_coinbase_update of bool * Pending_coinbase.Update.t ] , Staged_ledger_error.t ) Deferred.Result.t -(** Most recent ledger proof in t *) -val current_ledger_proof : t -> Ledger_proof.Cached.t option - (* Internals of the txn application. This is only exposed to facilitate writing unit tests. *) module Application_state : sig @@ -363,12 +348,6 @@ val all_work_pairs : (** Statements of all the pending work in t*) val all_work_statements_exn : t -> Transaction_snark_work.Statement.t list -(** Account ids created in the latest block, taken from the new_accounts - in the latest and next-to-latest trees of the scan state -*) -val latest_block_accounts_created : - t -> previous_block_state_hash:State_hash.t -> Account_id.t list - (** Go through all masks until reach root, convert all accounts accumulated along the way, and commit them to a HF database *) @@ -401,7 +380,9 @@ module Test_helpers : sig -> Zkapp_precondition.Protocol_state.View.t -> Frozen_ledger_hash.t * Frozen_ledger_hash.t -> ( bool - * Transaction_snark_scan_state.Transaction_with_witness.t list + * ( Transaction_snark_scan_state.Transaction_with_witness.t + * Account_id.t list ) + list * Pending_coinbase.Update.Action.t * [> `Update_none | `Update_one of Pending_coinbase.Stack_versioned.t diff --git a/src/lib/transaction/transaction_type.ml b/src/lib/transaction/transaction_type.ml new file mode 100644 index 000000000000..547acd0dc9ff --- /dev/null +++ b/src/lib/transaction/transaction_type.ml @@ -0,0 +1,12 @@ +type t = [ `Zkapp_command | `Signed_command | `Coinbase | `Fee_transfer ] +[@@deriving to_yojson] + +let of_transaction = function + | Transaction.Command (Mina_base.User_command.Zkapp_command _) -> + `Zkapp_command + | Command (Signed_command _) -> + `Signed_command + | Coinbase _ -> + `Coinbase + | Fee_transfer _ -> + `Fee_transfer diff --git a/src/lib/transaction_logic/mina_transaction_logic.ml b/src/lib/transaction_logic/mina_transaction_logic.ml index f6b5f0617ced..b7bb24a2b1a3 100644 --- a/src/lib/transaction_logic/mina_transaction_logic.ml +++ b/src/lib/transaction_logic/mina_transaction_logic.ml @@ -11,9 +11,6 @@ module type S = sig type location - val transaction_of_applied : - Transaction_applied.t -> Transaction.t With_status.t - val status_of_applied : Transaction_applied.t -> Transaction_status.t module Global_state : sig @@ -444,21 +441,6 @@ module Make (L : Ledger_intf.S) : transaction expiry slot %{sexp: Global_slot_since_genesis.t}" current_global_slot valid_until - let transaction_of_applied : - Transaction_applied.t -> Transaction.t With_status.t = - fun { varying; _ } -> - match varying with - | Command (Signed_command uc) -> - With_status.map uc.common.user_command ~f:(fun cmd -> - Transaction.Command (User_command.Signed_command cmd) ) - | Command (Zkapp_command s) -> - With_status.map s.command ~f:(fun c -> - Transaction.Command (User_command.Zkapp_command c) ) - | Fee_transfer f -> - With_status.map f.fee_transfer ~f:(fun f -> Transaction.Fee_transfer f) - | Coinbase c -> - With_status.map c.coinbase ~f:(fun c -> Transaction.Coinbase c) - let status_of_applied : Transaction_applied.t -> Transaction_status.t = fun { varying; _ } -> match varying with diff --git a/src/lib/transaction_logic/transaction_applied.ml b/src/lib/transaction_logic/transaction_applied.ml index 5ee3c4b28e19..64c60bf11fdf 100644 --- a/src/lib/transaction_logic/transaction_applied.ml +++ b/src/lib/transaction_logic/transaction_applied.ml @@ -314,6 +314,19 @@ let supply_increase : Option.value_map total ~default:(Or_error.error_string "overflow") ~f:(fun v -> Ok v) +let transaction : t -> Transaction.t = + fun { varying; _ } -> + match varying with + | Command (Signed_command { common = { user_command = { data; _ }; _ }; _ }) + -> + Transaction.Command (User_command.Signed_command data) + | Command (Zkapp_command { command = { data; _ }; _ }) -> + Transaction.Command (User_command.Zkapp_command data) + | Fee_transfer { fee_transfer = { data; _ }; _ } -> + Transaction.Fee_transfer data + | Coinbase { coinbase = { data; _ }; _ } -> + Transaction.Coinbase data + let transaction_with_status : t -> Transaction.t With_status.t = fun { varying; _ } -> match varying with diff --git a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml index 199944e3c907..79809bd92337 100644 --- a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml +++ b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml @@ -273,8 +273,8 @@ let create_expected_statement ~constraint_constants Frozen_ledger_hash.of_ledger_hash @@ Sparse_ledger.merkle_root second_pass_ledger_witness in - let { With_status.data = transaction; status = _ } = - Ledger.transaction_of_applied transaction_with_info + let transaction = + Mina_transaction_logic.Transaction_applied.transaction transaction_with_info in let%bind protocol_state = get_state (fst state_hash) in let state_view = Mina_state.Protocol_state.Body.view protocol_state.body in @@ -735,13 +735,13 @@ module Transactions_ordered = struct (txn_with_witness : Transaction_with_witness.t) -> let txn = - Ledger.transaction_of_applied + Mina_transaction_logic.Transaction_applied.transaction txn_with_witness.transaction_with_info in let target_first_pass_ledger = txn_with_witness.statement.target.first_pass_ledger in - match txn.data with + match txn with | Transaction.Coinbase _ | Fee_transfer _ | Command (User_command.Signed_command _) -> @@ -804,13 +804,20 @@ end let extract_txn_and_global_slot (txn_with_witness : Transaction_with_witness.t) = let txn = - Ledger.transaction_of_applied txn_with_witness.transaction_with_info + Mina_transaction_logic.Transaction_applied.transaction_with_status + txn_with_witness.transaction_with_info in let state_hash = fst txn_with_witness.state_hash in let global_slot = txn_with_witness.block_global_slot in (txn, state_hash, global_slot) -let latest_ledger_proof' t = +let latest_ledger_proof t = + let%map.Option (proof, _), _ = + Parallel_scan.last_emitted_value t.scan_state + in + proof + +let latest_ledger_proof_and_txs' t = let open Option.Let_syntax in let%map proof, txns_with_witnesses = Parallel_scan.last_emitted_value t.scan_state @@ -839,15 +846,13 @@ let latest_ledger_proof' t = in (proof, txns) -let latest_ledger_proof t = - Option.map (latest_ledger_proof' t) ~f:(fun (p, txns) -> - ( p - , List.map txns - ~f:(Transactions_ordered.map ~f:extract_txn_and_global_slot) ) ) +let latest_ledger_proof_txs t = + Option.map (latest_ledger_proof_and_txs' t) ~f:(fun (_, txns) -> + List.map txns ~f:(Transactions_ordered.map ~f:extract_txn_and_global_slot) ) let incomplete_txns_from_recent_proof_tree t = let open Option.Let_syntax in - let%map proof, txns_per_block = latest_ledger_proof' t in + let%map proof, txns_per_block = latest_ledger_proof_and_txs' t in let txns = match List.last txns_per_block with | None -> @@ -1076,8 +1081,8 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns Previous_incomplete_txns.Unapplied (List.filter txns ~f:(fun txn -> match - (Ledger.transaction_of_applied txn.transaction_with_info) - .data + Mina_transaction_logic.Transaction_applied.transaction + txn.transaction_with_info with | Command (Zkapp_command _) -> true @@ -1189,7 +1194,7 @@ let apply_ordered_txns_async ?stop_at_first_pass ordered_txns let get_snarked_ledger_sync ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind t = - match latest_ledger_proof' t with + match latest_ledger_proof_and_txs' t with | None -> Or_error.errorf "No transactions found" | Some (_, txns_per_block) -> @@ -1201,7 +1206,7 @@ let get_snarked_ledger_sync ~ledger ~get_protocol_state ~apply_first_pass let get_snarked_ledger_async ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind t = - match latest_ledger_proof' t with + match latest_ledger_proof_and_txs' t with | None -> Deferred.Or_error.errorf "No transactions found" | Some (_, txns_per_block) -> @@ -1242,20 +1247,6 @@ let partition_if_overflowing t = (slots, bundle_count job_count) ) } -let extract_from_job (job : job) = - match job with - | Parallel_scan.Available_job.Base d -> - First - ( d.transaction_with_info - , d.statement - , d.state_hash - , d.first_pass_ledger_witness - , d.second_pass_ledger_witness - , d.init_stack - , d.block_global_slot ) - | Merge ((p1, _), (p2, _)) -> - Second (p1, p2) - let snark_job_list_json t = let all_jobs : Job_view.t list list = let fa (a : Ledger_proof_with_sok_message.t) = @@ -1302,70 +1293,67 @@ let work_statements_for_new_diff t : Transaction_snark_work.Statement.t list = | Some stmt -> stmt ) ) ) +let single_spec_of_job ~get_state : + job -> Snark_work_lib.Spec.Single.t Or_error.t = function + | Parallel_scan.Available_job.Base + { transaction_with_info + ; statement + ; state_hash + ; first_pass_ledger_witness + ; second_pass_ledger_witness + ; init_stack + ; block_global_slot + } -> + let%map.Or_error witness = + let { With_status.data = transaction; status } = + Mina_transaction_logic.Transaction_applied.transaction_with_status + transaction_with_info + in + let%bind.Or_error protocol_state_body = + get_state (fst state_hash) + |> Or_error.map ~f:Mina_state.Protocol_state.body + in + let%map.Or_error init_stack = + match init_stack with + | Base x -> + Ok x + | Merge -> + Or_error.error_string "init_stack was Merge" + in + { Transaction_witness.first_pass_ledger = first_pass_ledger_witness + ; second_pass_ledger = second_pass_ledger_witness + ; transaction + ; protocol_state_body + ; init_stack + ; status + ; block_global_slot + } + in + Snark_work_lib.Work.Single.Spec.Transition (statement, witness) + | Merge ((p1, _), (p2, _)) -> + let%map.Or_error merged = + Transaction_snark.Statement.merge + (Ledger_proof.Cached.statement p1) + (Ledger_proof.Cached.statement p2) + in + Snark_work_lib.Work.Single.Spec.Merge (merged, p1, p2) + +let single_spec_one_or_twos_rev_of_job_list ~get_state jobs = + List.fold_result ~init:[] (One_or_two.group_list jobs) ~f:(fun acc' pair -> + let%map.Or_error spec = + One_or_two.Or_error.map ~f:(single_spec_of_job ~get_state) pair + in + spec :: acc' ) + let all_work_pairs t ~(get_state : State_hash.t -> Mina_state.Protocol_state.value Or_error.t) : - ( Transaction_witness.t - , Ledger_proof.Cached.t ) - Snark_work_lib.Work.Single.Spec.t - One_or_two.t - list - Or_error.t = + Snark_work_lib.Spec.Single.t One_or_two.t list Or_error.t = let all_jobs = all_jobs t in - let module A = Available_job in - let open Or_error.Let_syntax in - let single_spec (job : job) = - match extract_from_job job with - | First - ( transaction_with_info - , statement - , state_hash - , first_pass_ledger_witness - , second_pass_ledger_witness - , init_stack - , block_global_slot ) -> - let%map witness = - let { With_status.data = transaction; status } = - Mina_transaction_logic.Transaction_applied.transaction_with_status - transaction_with_info - in - let%bind protocol_state_body = - let%map state = get_state (fst state_hash) in - Mina_state.Protocol_state.body state - in - let%map init_stack = - match init_stack with - | Base x -> - Ok x - | Merge -> - Or_error.error_string "init_stack was Merge" - in - { Transaction_witness.first_pass_ledger = first_pass_ledger_witness - ; second_pass_ledger = second_pass_ledger_witness - ; transaction - ; protocol_state_body - ; init_stack - ; status - ; block_global_slot - } - in - Snark_work_lib.Work.Single.Spec.Transition (statement, witness) - | Second (p1, p2) -> - let%map merged = - Transaction_snark.Statement.merge - (Ledger_proof.Cached.statement p1) - (Ledger_proof.Cached.statement p2) - in - Snark_work_lib.Work.Single.Spec.Merge (merged, p1, p2) - in List.fold_until all_jobs ~init:[] ~finish:(fun lst -> Ok lst) ~f:(fun acc jobs -> - let specs_list : 'a One_or_two.t list Or_error.t = - List.fold ~init:(Ok []) (One_or_two.group_list jobs) - ~f:(fun acc' pair -> - let%bind acc' = acc' in - let%map spec = One_or_two.Or_error.map ~f:single_spec pair in - spec :: acc' ) + let specs_list = + single_spec_one_or_twos_rev_of_job_list ~get_state jobs in match specs_list with | Ok list -> @@ -1443,10 +1431,7 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = value_exn is safe here [latest_ledger_proof] generates ordered transactions appropriately*) - let (proof, _), txns = - Option.value_exn (latest_ledger_proof scan_state') - in - Ok (Some (proof, txns), scan_state') + Ok (latest_ledger_proof scan_state', scan_state') | Error e -> Or_error.errorf "The new final statement does not connect to the previous \ diff --git a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.mli b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.mli index 7fecbf0a5de8..b59c37c0a8ea 100644 --- a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.mli +++ b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.mli @@ -90,24 +90,17 @@ val fill_work_and_enqueue_transactions : -> logger:Logger.t -> Transaction_with_witness.t list -> Transaction_snark_work.t list - -> ( ( Ledger_proof.Cached.t - * ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_ordered.Poly.t - list ) - option - * t ) - Or_error.t + -> (Ledger_proof.Cached.t option * t) Or_error.t + +val latest_ledger_proof : t -> Ledger_proof.Cached.t option -val latest_ledger_proof : +val latest_ledger_proof_txs : t - -> ( Ledger_proof_with_sok_message.t - * ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_ordered.Poly.t - list ) + -> ( Transaction.t With_status.t + * State_hash.t + * Mina_numbers.Global_slot_since_genesis.t ) + Transactions_ordered.Poly.t + list option (** Apply transactions coorresponding to the last emitted proof based on the diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index c9fa5d412204..aa0dc13ebf0c 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -14,6 +14,7 @@ module T = struct ; just_emitted_a_proof : bool ; transition_receipt_time : Time.t option ; staged_ledger_hash : Staged_ledger_hash.t + ; accounts_created : Account_id.t list } [@@deriving fields] @@ -22,16 +23,17 @@ module T = struct -> staged_ledger:Staged_ledger.t -> just_emitted_a_proof:bool -> transition_receipt_time:Time.t option + -> accounts_created:Account_id.t list -> 'a let map_creator creator ~f ~validated_transition ~staged_ledger - ~just_emitted_a_proof ~transition_receipt_time = + ~just_emitted_a_proof ~transition_receipt_time ~accounts_created = f (creator ~validated_transition ~staged_ledger ~just_emitted_a_proof - ~transition_receipt_time ) + ~transition_receipt_time ~accounts_created ) let create ~validated_transition ~staged_ledger ~just_emitted_a_proof - ~transition_receipt_time = + ~transition_receipt_time ~accounts_created = (* TODO This looks terrible, consider removing this in the hardfork by either removing staged_ledger_hash from the header or computing it consistently for the genesis block *) @@ -48,6 +50,7 @@ module T = struct ; just_emitted_a_proof ; transition_receipt_time ; staged_ledger_hash + ; accounts_created } let to_yojson @@ -56,6 +59,7 @@ module T = struct ; just_emitted_a_proof ; transition_receipt_time ; staged_ledger_hash = _ + ; accounts_created = _ } = `Assoc [ ( "validated_transition" @@ -76,7 +80,8 @@ T. , just_emitted_a_proof , transition_receipt_time , to_yojson - , staged_ledger_hash )] + , staged_ledger_hash + , accounts_created )] include Allocation_functor.Make.Basic (T) @@ -131,14 +136,15 @@ let build ?skip_staged_ledger_verification ?transaction_pool_proxy ~logger | Ok ( `Just_emitted_a_proof just_emitted_a_proof , `Block_with_validation fully_valid_block - , `Staged_ledger transitioned_staged_ledger ) -> + , `Staged_ledger transitioned_staged_ledger + , `Accounts_created accounts_created ) -> [%log internal] "Create_breadcrumb" ; Deferred.Result.return (create ~validated_transition: (Mina_block.Validated.lift fully_valid_block) - ~staged_ledger:transitioned_staged_ledger ~just_emitted_a_proof - ~transition_receipt_time ) + ~staged_ledger:transitioned_staged_ledger ~accounts_created + ~just_emitted_a_proof ~transition_receipt_time ) | Error `Invalid_body_reference -> let message = "invalid body reference" in let%map () = @@ -415,6 +421,7 @@ module For_tests = struct in let%bind ( `Ledger_proof ledger_proof_opt , `Staged_ledger transitioned_staged_ledger + , `Accounts_created _ , `Pending_coinbase_update _ ) = match%bind Staged_ledger.apply_diff_unchecked parent_staged_ledger @@ -440,8 +447,7 @@ module For_tests = struct |> Blockchain_state.ledger_proof_statement in let ledger_proof_statement = - Option.value_map ledger_proof_opt - ~f:(fun (proof, _) -> Ledger_proof.Cached.statement proof) + Option.value_map ledger_proof_opt ~f:Ledger_proof.Cached.statement ~default:previous_ledger_proof_stmt in let genesis_ledger_hash = diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index 491b5e629192..e9d5875dbf85 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -25,6 +25,7 @@ val create : -> staged_ledger:Staged_ledger.t -> just_emitted_a_proof:bool -> transition_receipt_time:Time.t option + -> accounts_created:Account_id.t list -> t val build : @@ -85,6 +86,10 @@ val name : t -> string val staged_ledger_hash : t -> Staged_ledger_hash.t +(** The accounts created in the block that this breadcrumb represents + For convenience of implementation, it's by definition an empty list for the root *) +val accounts_created : t -> Account_id.t list + module For_tests : sig val gen : ?logger:Logger.t diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index c547af12952f..bd7e5d9be767 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -165,6 +165,8 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger Breadcrumb.create ~validated_transition ~staged_ledger:root_data.staged_ledger ~just_emitted_a_proof:false ~transition_receipt_time + (* accounts created shouldn't be used for the root *) + ~accounts_created:[] in let root_node = { Node.breadcrumb = root_breadcrumb; successor_hashes = []; length = 0 } @@ -560,6 +562,8 @@ let move_root ({ context = (module Context); _ } as t) ~new_root_hash (Breadcrumb.just_emitted_a_proof new_root_node.breadcrumb) ~transition_receipt_time: (Breadcrumb.transition_receipt_time new_root_node.breadcrumb) + (* accounts created shouldn't be used for the root *) + ~accounts_created:[] in (*Update the protocol states required for scan state at the new root. Note: this should be after applying the transactions to the snarked ledger (Step 5) diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 61e1866a8207..0f61e08d6f34 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -622,7 +622,7 @@ module For_tests = struct in Breadcrumb.create ~validated_transition:genesis_transition ~staged_ledger:genesis_staged_ledger ~just_emitted_a_proof:false - ~transition_receipt_time ) + ~transition_receipt_time ~accounts_created:[] ) let gen_persistence ?(logger = Logger.null ()) ~verifier ~(precomputed_values : Precomputed_values.t) () =