From 52b83de4116493bde129b9671f6eb6b8f2787f46 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 18 Nov 2025 12:52:52 +0100 Subject: [PATCH 001/122] Persist witnesses and proofs on disk First step towards using multi-key file storage tags instead of witnesses and proofs stored in memory. --- src/lib/mina_base/dune | 3 +- src/lib/mina_base/state_hash.ml | 7 ++++ src/lib/mina_state/protocol_state.ml | 11 +++--- src/lib/mina_state/protocol_state_intf.ml | 5 +++ src/lib/staged_ledger/dune | 3 +- src/lib/staged_ledger/staged_ledger.ml | 38 +++++++++++++++++++ .../transaction_snark_scan_state.mli | 17 +++++++++ 7 files changed, 77 insertions(+), 7 deletions(-) diff --git a/src/lib/mina_base/dune b/src/lib/mina_base/dune index 90483c9a08a2..3eb39adb5eda 100644 --- a/src/lib/mina_base/dune +++ b/src/lib/mina_base/dune @@ -73,7 +73,8 @@ snark_bits error_json ppx_version.runtime - proof_cache_tag) + proof_cache_tag + multi_key_file_storage) (preprocess (pps ppx_annot diff --git a/src/lib/mina_base/state_hash.ml b/src/lib/mina_base/state_hash.ml index a3387f8461b1..be4016dc2ca0 100644 --- a/src/lib/mina_base/state_hash.ml +++ b/src/lib/mina_base/state_hash.ml @@ -60,3 +60,10 @@ module With_state_hashes = struct State_hashes.state_body_hash hash ~compute_hashes:(fun () -> compute_hashes data ) end + +module File_storage = Multi_key_file_storage.Make_custom (struct + type filename_key = t + + (* TODO replace with hex string, pass directory parameter *) + let filename h = T.to_decimal_string h ^ ".dat" +end) diff --git a/src/lib/mina_state/protocol_state.ml b/src/lib/mina_state/protocol_state.ml index f31888e6835a..acad307ddfd8 100644 --- a/src/lib/mina_state/protocol_state.ml +++ b/src/lib/mina_state/protocol_state.ml @@ -34,14 +34,15 @@ module Make_str (A : Wire_types.Concrete) = struct end] end + let compute_state_hash ~previous_state_hash ~state_body_hash = + Random_oracle.hash ~init:Hash_prefix.protocol_state + [| (previous_state_hash :> Field.t); (state_body_hash :> Field.t) |] + |> State_hash.of_hash + let hashes_abstract ~hash_body ({ previous_state_hash; body } : (State_hash.t, _) Poly.t) = let state_body_hash : State_body_hash.t = hash_body body in - let state_hash = - Random_oracle.hash ~init:Hash_prefix.protocol_state - [| (previous_state_hash :> Field.t); (state_body_hash :> Field.t) |] - |> State_hash.of_hash - in + let state_hash = compute_state_hash ~previous_state_hash ~state_body_hash in { State_hash.State_hashes.state_hash ; state_body_hash = Some state_body_hash } diff --git a/src/lib/mina_state/protocol_state_intf.ml b/src/lib/mina_state/protocol_state_intf.ml index e90bb31b587b..c490636188bd 100644 --- a/src/lib/mina_state/protocol_state_intf.ml +++ b/src/lib/mina_state/protocol_state_intf.ml @@ -14,6 +14,11 @@ module type Full = sig end] end + val compute_state_hash : + previous_state_hash:State_hash.t + -> state_body_hash:State_body_hash.t + -> State_hash.t + val hashes_abstract : hash_body:('body -> State_body_hash.t) -> (State_hash.t, 'body) Poly.t diff --git a/src/lib/staged_ledger/dune b/src/lib/staged_ledger/dune index 437cb5fff416..9f590d8a80aa 100644 --- a/src/lib/staged_ledger/dune +++ b/src/lib/staged_ledger/dune @@ -60,7 +60,8 @@ transaction_witness verifier with_hash - zkapp_command_builder) + zkapp_command_builder + multi_key_file_storage) (instrumentation (backend bisect_ppx)) (preprocess diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 9d8e483586ed..21b61eed5206 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -35,6 +35,35 @@ module Pre_statement = struct } end +let persist_witnesses_and_works witnesses works writer = + let module FS = State_hash.File_storage in + let write_witness = + FS.write_value writer + ( module Transaction_snark_scan_state.Transaction_with_witness.Stable + .Latest ) + in + let write_proof = FS.write_value writer (module Ledger_proof.Stable.Latest) in + let write_witness' = + (* TODO remove read_all_proofs_from_disk *) + Fn.compose write_witness + Transaction_snark_scan_state.Transaction_with_witness + .read_all_proofs_from_disk + in + let write_proof' ~fee ~prover proof = + (* TODO remove read_proof_from_disk *) + let proof_tag = + Ledger_proof.Cached.read_proof_from_disk proof |> write_proof + in + (proof_tag, Sok_message.create ~fee ~prover) + in + let tagged_witnesses = List.map ~f:write_witness' witnesses in + let tagged_works = + List.concat_map works + ~f:(fun { Transaction_snark_work.proofs; fee; prover } -> + One_or_two.to_list proofs |> List.map ~f:(write_proof' ~fee ~prover) ) + in + (tagged_witnesses, tagged_works) + module T = struct module Scan_state = Transaction_snark_scan_state module Pre_diff_info = Pre_diff_info @@ -1066,6 +1095,15 @@ module T = struct t.pending_coinbase_collection transactions current_state_view state_and_body_hash ) 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 data 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 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..cd20713a3a83 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 @@ -18,6 +18,15 @@ end] type t module Transaction_with_witness : sig + [%%versioned: + module Stable : sig + [@@@no_toplevel_latest_type] + + module V2 : sig + type t + end + end] + (* TODO: The statement is redundant here - it can be computed from the witness and the transaction *) type t = { transaction_with_info : Mina_transaction_logic.Transaction_applied.t @@ -28,6 +37,14 @@ module Transaction_with_witness : sig ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t } + + val write_all_proofs_to_disk : + signature_kind:Mina_signature_kind.t + -> proof_cache_db:Proof_cache_tag.cache_db + -> Stable.Latest.t + -> t + + val read_all_proofs_from_disk : t -> Stable.Latest.t end module Ledger_proof_with_sok_message : sig From 06e226d0942145f7c7ed5d6389a1f95786c78343 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 00:18:52 +0100 Subject: [PATCH 002/122] Introduce Tagged types for witness and ledger proof --- .../multi_key_file_storage.ml | 1 + .../multi_key_file_storage.mli | 2 +- .../transaction_snark_scan_state.ml | 31 +++++++++++++++++++ 3 files changed, 33 insertions(+), 1 deletion(-) diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.ml b/src/lib/multi-key-file-storage/multi_key_file_storage.ml index 1ac676f35c8f..9876f323afc6 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.ml @@ -11,6 +11,7 @@ module Tag = struct module V1 = struct type ('filename_key, 'a) t = { filename_key : 'filename_key; offset : int64; size : int } + [@@deriving sexp] end end] end diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.mli b/src/lib/multi-key-file-storage/multi_key_file_storage.mli index 7ded5b8413e3..7d2dc8b0a91e 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.mli +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.mli @@ -4,7 +4,7 @@ module Tag : sig [%%versioned: module Stable : sig module V1 : sig - type ('filename_key, 'a) t + type ('filename_key, 'a) t [@@deriving sexp] end end] end 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..647f167f01d6 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 @@ -47,6 +47,21 @@ module Transaction_with_witness = struct end end] + module Tagged = struct + [%%versioned + module Stable = struct + module V1 = struct + type t = + ( State_hash.Stable.V1.t + , Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t + [@@deriving sexp] + + let to_latest = Fn.id + end + end] + end + type t = { transaction_with_info : Mina_transaction_logic.Transaction_applied.t ; state_hash : State_hash.t * State_body_hash.t @@ -111,6 +126,22 @@ module Ledger_proof_with_sok_message = struct end end] + module Tagged = struct + [%%versioned + module Stable = struct + module V1 = struct + type t = + ( State_hash.Stable.V1.t + , Ledger_proof.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t + * Sok_message.Stable.V1.t + [@@deriving sexp] + + let to_latest = Fn.id + end + end] + end + type t = Ledger_proof.Cached.t * Sok_message.t end From b35745f0e64184c77e299403a2c56e43318a5158 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 12:27:32 +0100 Subject: [PATCH 003/122] Add some comments --- src/lib/bootstrap_controller/bootstrap_controller.ml | 11 +++++++++++ src/lib/staged_ledger/staged_ledger.ml | 12 ++++++------ 2 files changed, 17 insertions(+), 6 deletions(-) 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/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 21b61eed5206..34ccc8bee9b5 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -310,18 +310,13 @@ module T = struct ~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 @@ -349,6 +344,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 @@ -413,6 +409,9 @@ module T = struct ~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 @@ -422,6 +421,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 From 9b71088999c01c43c843330cf6615c158d760c39 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 12:50:03 +0100 Subject: [PATCH 004/122] Simplify One_or_two.group_list --- src/lib/one_or_two/one_or_two.ml | 28 ++++++++++++++-------------- src/lib/one_or_two/one_or_two.mli | 2 -- 2 files changed, 14 insertions(+), 16 deletions(-) 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 From 0eb863a9c2245defcac2148edc1f675ac8571b51 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 12:50:32 +0100 Subject: [PATCH 005/122] Simplify all_work_pairs --- .../transaction_snark_scan_state.ml | 127 ++++++++---------- 1 file changed, 55 insertions(+), 72 deletions(-) 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 647f167f01d6..3b7d73f1ac52 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 @@ -1273,20 +1273,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) = @@ -1333,70 +1319,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 -> From 2cf32d524586c6ce9d8bccbd1af797cbf4fa70d3 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 13:18:39 +0100 Subject: [PATCH 006/122] Remove transaction_of_applied Function is a duplicate of `Transaction_applied.transaction_with_status` --- .../snark_profiler_lib/snark_profiler_lib.ml | 11 +++++------ src/lib/staged_ledger/pre_diff_info.ml | 3 ++- src/lib/staged_ledger/staged_ledger.ml | 8 ++++++-- .../mina_transaction_logic.ml | 18 ------------------ .../transaction_logic/transaction_applied.ml | 13 +++++++++++++ .../transaction_snark_scan_state.ml | 15 ++++++++------- 6 files changed, 34 insertions(+), 34 deletions(-) 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/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 34ccc8bee9b5..cbea5b1708fa 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -594,7 +594,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 @@ -809,7 +809,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 = 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 3b7d73f1ac52..09981afe7854 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 @@ -304,8 +304,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 @@ -766,13 +766,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 _) -> @@ -835,7 +835,8 @@ 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 @@ -1107,8 +1108,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 From 5ad7878261a30e80de2acfb7fd9eb49a6a04a101 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 13:21:19 +0100 Subject: [PATCH 007/122] Remove `status_of_applied` Function is a duplicate of `Transaction_applied.transaction_status` --- src/lib/staged_ledger/staged_ledger.ml | 5 ++++- .../transaction_logic/mina_transaction_logic.ml | 15 --------------- src/lib/transaction_snark/test/util.ml | 4 +++- .../transaction_snark_scan_state.ml | 4 +++- 4 files changed, 10 insertions(+), 18 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index cbea5b1708fa..1d7a6f471cfc 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -588,7 +588,10 @@ module T = struct ~constraint_constants applied_txn ) in let%map () = - let actual_status = Ledger.status_of_applied applied_txn in + let actual_status = + Mina_transaction_logic.Transaction_applied.transaction_status + applied_txn + in if Transaction_status.equal pre_stmt.expected_status actual_status then return () else diff --git a/src/lib/transaction_logic/mina_transaction_logic.ml b/src/lib/transaction_logic/mina_transaction_logic.ml index b7bb24a2b1a3..b37bca0be979 100644 --- a/src/lib/transaction_logic/mina_transaction_logic.ml +++ b/src/lib/transaction_logic/mina_transaction_logic.ml @@ -11,8 +11,6 @@ module type S = sig type location - val status_of_applied : Transaction_applied.t -> Transaction_status.t - module Global_state : sig type t = { first_pass_ledger : ledger @@ -441,19 +439,6 @@ module Make (L : Ledger_intf.S) : transaction expiry slot %{sexp: Global_slot_since_genesis.t}" current_global_slot valid_until - let status_of_applied : Transaction_applied.t -> Transaction_status.t = - fun { varying; _ } -> - match varying with - | Command - (Signed_command { common = { user_command = { status; _ }; _ }; _ }) -> - status - | Command (Zkapp_command c) -> - c.command.status - | Fee_transfer f -> - f.fee_transfer.status - | Coinbase c -> - c.coinbase.status - let get_new_accounts action pk = if Ledger_intf.equal_account_state action `Added then [ pk ] else [] diff --git a/src/lib/transaction_snark/test/util.ml b/src/lib/transaction_snark/test/util.ml index 1978de0a4168..cde91948a1fb 100644 --- a/src/lib/transaction_snark/test/util.ml +++ b/src/lib/transaction_snark/test/util.ml @@ -629,7 +629,9 @@ let test_transaction_union ?expected_failure ?txn_global_slot ledger txn = with | Ok res -> ( if Option.is_some expected_failure then - match Ledger.status_of_applied res with + match + Mina_transaction_logic.Transaction_applied.transaction_status res + with | Applied -> failwith (sprintf "Expected Ledger.apply_transaction to fail with %s" 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 09981afe7854..f5309c7d6076 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 @@ -982,7 +982,9 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns k () | (expected_status, partially_applied_txn) :: partially_applied_txns' -> let%bind res = apply_second_pass ledger partially_applied_txn in - let status = Ledger.status_of_applied res in + let status = + Mina_transaction_logic.Transaction_applied.transaction_status res + in if Transaction_status.equal expected_status status then Ok (`Continue From 8067c8a3e424f156570933de952e79eb1a7e48b3 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 16:39:54 +0100 Subject: [PATCH 008/122] Don't source accounts created from scan state This is an intermediate step to simplify definition of the scan state. --- src/app/archive/lib/diff.ml | 9 +-- .../cli/src/init/test_submit_to_archive.ml | 2 +- src/app/dump_blocks/dump_blocks.ml | 5 +- src/app/dump_blocks/encoding.ml | 15 +++-- src/lib/block_producer/block_producer.ml | 1 + src/lib/mina_block/precomputed_block.ml | 10 +-- src/lib/mina_block/precomputed_block.mli | 1 + src/lib/mina_block/validation.ml | 4 +- src/lib/mina_block/validation.mli | 1 + src/lib/mina_lib/mina_subscriptions.ml | 3 + src/lib/staged_ledger/staged_ledger.ml | 67 ++++++------------- src/lib/staged_ledger/staged_ledger.mli | 12 ++-- .../frontier_base/breadcrumb.ml | 21 ++++-- .../frontier_base/breadcrumb.mli | 5 ++ .../full_frontier/full_frontier.ml | 4 ++ .../transition_frontier.ml | 2 +- 16 files changed, 78 insertions(+), 84 deletions(-) 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..1b2d97a813bd 100644 --- a/src/app/cli/src/init/test_submit_to_archive.ml +++ b/src/app/cli/src/init/test_submit_to_archive.ml @@ -140,7 +140,7 @@ module Block = struct 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..2264f66443e8 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" ; 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..6aee05d40853 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 @@ -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_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/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 1d7a6f471cfc..80d25ac5e6f1 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -625,14 +625,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 @@ -1107,10 +1108,12 @@ module T = struct ~previous_state_hash:(fst state_and_body_hash) ~state_body_hash:(snd state_and_body_hash) in + let witnesses = List.map data ~f:fst in let _tagged_witnesses, _tagged_works = State_hash.File_storage.write_values_exn state_hash - ~f:(persist_witnesses_and_works data works) + ~f:(persist_witnesses_and_works witnesses works) in + let accounts_created = List.concat_map data ~f:snd 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 @@ -1138,18 +1141,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 ) ) @@ -1224,6 +1229,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 @@ -1290,7 +1296,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)) @@ -2305,39 +2311,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 @@ -2489,6 +2462,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 @@ -3475,6 +3449,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..07d2ad46b86f 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -237,6 +237,7 @@ val apply : list ) 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 @@ -262,6 +263,7 @@ val apply_diff_unchecked : list ) 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 @@ -363,12 +365,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 +397,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/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index c9fa5d412204..fed0d361114d 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 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 bf4c3b1262d0..e70ef06f8aa9 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -628,7 +628,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) () = From fee63d263dc1e48ab426f93f2a9320d4985bdbc9 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 17:18:37 +0100 Subject: [PATCH 009/122] CAUTION DON'T MERGE: simplify transaction witness --- .../disk_caching_stats/disk_caching_stats.ml | 32 +-- src/app/heap_usage/values.ml | 123 +++--------- src/lib/mina_networking/rpcs.ml | 4 +- src/lib/staged_ledger/staged_ledger.ml | 12 +- src/lib/staged_ledger/staged_ledger.mli | 8 +- .../transaction_logic/transaction_applied.ml | 19 ++ .../transaction_snark_scan_state.ml | 185 ++++++++++++------ .../transaction_snark_scan_state.mli | 18 +- .../transition_frontier/frontier_base/diff.ml | 30 ++- .../frontier_base/root_data.ml | 50 ++++- .../frontier_base/root_data.mli | 34 +++- .../persistent_frontier/database.ml | 8 +- 12 files changed, 317 insertions(+), 206 deletions(-) diff --git a/src/app/disk_caching_stats/disk_caching_stats.ml b/src/app/disk_caching_stats/disk_caching_stats.ml index 24a6fd8d6c50..69df4af13fb2 100644 --- a/src/app/disk_caching_stats/disk_caching_stats.ml +++ b/src/app/disk_caching_stats/disk_caching_stats.ml @@ -364,7 +364,7 @@ module Values (S : Sample) = struct let base_work varying witness : Transaction_snark_scan_state.Transaction_with_witness.t = - { transaction_with_info = { previous_hash = field (); varying = varying () } + { transaction_with_status = varying () ; state_hash = (state_hash (), field ()) ; statement = (*Transaction_snark.Statement.Stable.V2.t*) @@ -397,36 +397,18 @@ module Values (S : Sample) = struct Transaction_snark_scan_state.Transaction_with_witness.t = base_work (fun () -> - Command - (Zkapp_command - { accounts = - List.init Params.max_accounts_modified_per_zkapp_command - ~f:(fun _ -> - let a = account () in - (Mina_base.Account.identifier a, Some a) ) - ; command = - { status = Applied; data = zkapp_command' () } - (* the worst case is that no new accounts are created and they are all cached, so we leave this empty *) - ; new_accounts = [] - } ) ) + { Mina_base.With_status.status = Applied + ; data = Command (Zkapp_command (zkapp_command' ())) + } ) (zkapp_command_witness ~config) let signed_command_base_work ~config () : Transaction_snark_scan_state.Transaction_with_witness.t = base_work (fun () -> - Command - (Signed_command - { common = - { user_command = - { status = Applied; data = signed_command' () } - } - ; body = - Payment - { new_accounts = - [ Mina_base.Account.identifier (account ()) ] - } - } ) ) + { Mina_base.With_status.status = Applied + ; data = Command (Signed_command (signed_command' ())) + } ) (signed_command_witness ~config) let sok_message () : Mina_base.Sok_message.t = diff --git a/src/app/heap_usage/values.ml b/src/app/heap_usage/values.ml index 89f380fad8e0..cc77a78d3895 100644 --- a/src/app/heap_usage/values.ml +++ b/src/app/heap_usage/values.ml @@ -68,8 +68,7 @@ let verification_key = let applied = Mina_base.Transaction_status.Applied -let mk_scan_state_base_node - (varying : Mina_transaction_logic.Transaction_applied.Varying.t) +let mk_scan_state_base_node (transaction : Mina_transaction.Transaction.t) ~(constraint_constants : Genesis_constants.Constraint_constants.t) : Transaction_snark_scan_state.Transaction_with_witness.t Parallel_scan.Base.t = @@ -87,20 +86,16 @@ let mk_scan_state_base_node let ledger_witness = let depth = constraint_constants.ledger_depth in let account_access_statuses = - match varying with + match transaction with | Command (Signed_command signed_cmd) -> - let user_cmd = signed_cmd.common.user_command.data in - Mina_base.Signed_command.account_access_statuses user_cmd applied + Mina_base.Signed_command.account_access_statuses signed_cmd applied | Command (Zkapp_command zkapp_cmd) -> - let zkapp_cmd = zkapp_cmd.command.data in Mina_base.Zkapp_command.account_access_statuses zkapp_cmd applied | Fee_transfer ft -> - let fee_transfer = ft.fee_transfer.data in - List.map (Mina_base.Fee_transfer.receivers fee_transfer) - ~f:(fun acct_id -> (acct_id, `Accessed)) + List.map (Mina_base.Fee_transfer.receivers ft) ~f:(fun acct_id -> + (acct_id, `Accessed) ) | Coinbase cb -> - let coinbase = cb.coinbase.data in - Mina_base.Coinbase.account_access_statuses coinbase applied + Mina_base.Coinbase.account_access_statuses cb applied in let num_accounts_accessed = List.count account_access_statuses ~f:(fun (_acct_id, accessed) -> @@ -122,12 +117,8 @@ let mk_scan_state_base_node acct ) ) ; !ledger in - let transaction_with_info : Mina_transaction_logic.Transaction_applied.t = - let previous_hash = get Mina_base.Ledger_hash.gen in - { previous_hash; varying } - in let job : Transaction_snark_scan_state.Transaction_with_witness.t = - { transaction_with_info + { transaction_with_status = { status = applied; data = transaction } ; state_hash = (state_hash, state_body_hash) ; statement ; init_stack @@ -144,89 +135,39 @@ let mk_scan_state_base_node (weight, job) let scan_state_base_node_coinbase = - let varying : Mina_transaction_logic.Transaction_applied.Varying.t = - let coinbase = - Mina_base.Coinbase.create ~amount:Currency.Amount.zero - ~receiver:sample_pk_compressed ~fee_transfer:None - |> Or_error.ok_exn - in - Coinbase - { coinbase = Mina_base.With_status.{ data = coinbase; status = Applied } - ; new_accounts = [] - ; burned_tokens = Currency.Amount.zero - } + let coinbase = + Mina_base.Coinbase.create ~amount:Currency.Amount.zero + ~receiver:sample_pk_compressed ~fee_transfer:None + |> Or_error.ok_exn in - mk_scan_state_base_node varying + mk_scan_state_base_node (Coinbase coinbase) let scan_state_base_node_payment = - let varying : Mina_transaction_logic.Transaction_applied.Varying.t = - let payload : Mina_base.Signed_command_payload.t = - let payment_payload = - Quickcheck.random_value - (Mina_base.Payment_payload.gen Currency.Amount.zero) - in - let body : Mina_base.Signed_command_payload.Body.t = - Payment payment_payload - in - let common : Mina_base.Signed_command_payload.Common.t = - { fee = Currency.Fee.zero - ; fee_payer_pk = sample_pk_compressed - ; nonce = Mina_numbers.Account_nonce.zero - ; valid_until = Mina_numbers.Global_slot_since_genesis.max_value - ; memo = Mina_base.Signed_command_memo.empty - } - in - { common; body } - in - let user_command : _ Mina_base.With_status.t = - let signer = sample_pk in - let data : Mina_base.Signed_command.t = - { payload; signer; signature = Mina_base.Signature.dummy } - in - { data; status = Applied } + let payload : Mina_base.Signed_command_payload.t = + let payment_payload = + Quickcheck.random_value + (Mina_base.Payment_payload.gen Currency.Amount.zero) in - let common : - Mina_transaction_logic.Transaction_applied.Signed_command_applied.Common - .t = - { user_command } + let body : Mina_base.Signed_command_payload.Body.t = + Payment payment_payload in - let body : - Mina_transaction_logic.Transaction_applied.Signed_command_applied.Body.t - = - Payment { new_accounts = [] } + let common : Mina_base.Signed_command_payload.Common.t = + { fee = Currency.Fee.zero + ; fee_payer_pk = sample_pk_compressed + ; nonce = Mina_numbers.Account_nonce.zero + ; valid_until = Mina_numbers.Global_slot_since_genesis.max_value + ; memo = Mina_base.Signed_command_memo.empty + } in - Command (Signed_command { common; body }) + { common; body } in - mk_scan_state_base_node varying - -let scan_state_base_node_zkapp ~constraint_constants ~zkapp_command = - let varying : Mina_transaction_logic.Transaction_applied.Varying.t = - let zkapp_command_applied : - Mina_transaction_logic.Transaction_applied.Zkapp_command_applied.t = - let accounts = - (* fudge: the `accounts` calculation is more complex; see `apply_zkapp_command_unchecked_aux` - also, we're using the same account repeatedly - *) - let accessed = - Mina_base.Zkapp_command.account_access_statuses zkapp_command applied - |> List.filter_map ~f:(fun (acct_id, accessed) -> - match accessed with - | `Accessed -> - Some acct_id - | `Not_accessed -> - None ) - in - List.map accessed ~f:(fun acct_id -> (acct_id, Some account)) - in - let command = - Mina_base.With_status.{ data = zkapp_command; status = applied } - in - let new_accounts = [] in - { accounts; command; new_accounts } - in - Command (Zkapp_command zkapp_command_applied) + let user_command : Mina_base.Signed_command.t = + { payload; signer = sample_pk; signature = Mina_base.Signature.dummy } in - mk_scan_state_base_node varying ~constraint_constants + mk_scan_state_base_node (Command (Signed_command user_command)) + +let scan_state_base_node_zkapp ~zkapp_command = + mk_scan_state_base_node (Command (Zkapp_command zkapp_command)) let scan_state_merge_node ~proof_cache_db : Transaction_snark_scan_state.Ledger_proof_with_sok_message.t diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index a02d73534a7a..42abfb560123 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -252,12 +252,12 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct include Master end) - module V2 = struct + module V3 = struct module T = struct type query = State_hash.Stable.V1.t type response = - ( Staged_ledger.Scan_state.Stable.V2.t + ( Staged_ledger.Scan_state.Stable.V3.t * Ledger_hash.Stable.V1.t * Pending_coinbase.Stable.V2.t * Mina_state.Protocol_state.Value.Stable.V2.t list ) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 80d25ac5e6f1..b252a5ff0ff0 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -448,7 +448,7 @@ module T = struct ; pending_coinbase_collection } : Staged_ledger_hash.t = Staged_ledger_hash.of_aux_ledger_and_coinbase_hash - Scan_state.(Stable.Latest.hash @@ read_all_proofs_from_disk scan_state) + (Scan_state.hash scan_state) (Ledger.merkle_root ledger) pending_coinbase_collection @@ -625,7 +625,9 @@ module T = struct ; sok_digest = () } in - ( { Scan_state.Transaction_with_witness.transaction_with_info = applied_txn + ( { Scan_state.Transaction_with_witness.transaction_with_status = + Mina_transaction_logic.Transaction_applied.transaction_with_status + applied_txn ; state_hash = state_and_body_hash ; first_pass_ledger_witness = pre_stmt.first_pass_ledger_witness ; second_pass_ledger_witness = ledger_witness @@ -813,11 +815,7 @@ 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 - |> Mina_transaction_logic.Transaction_applied - .transaction_with_status - in + let t = d.transaction_with_status in t :: acc ) in let total_fee_excess txns = diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 07d2ad46b86f..6a75a097f75a 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -12,11 +12,17 @@ module Scan_state : sig module Stable : sig [@@@no_toplevel_latest_type] - module V2 : sig + module V3 : sig type t val hash : t -> Staged_ledger_hash.Aux_hash.t end + + module V2 : sig + type t + + val to_latest : t -> V3.t + end end] type t diff --git a/src/lib/transaction_logic/transaction_applied.ml b/src/lib/transaction_logic/transaction_applied.ml index 64c60bf11fdf..87321202ca47 100644 --- a/src/lib/transaction_logic/transaction_applied.ml +++ b/src/lib/transaction_logic/transaction_applied.ml @@ -170,6 +170,9 @@ module Varying : sig module V2 : sig type t [@@deriving sexp, to_yojson] + + val transaction_with_status : + t -> Transaction.Stable.V2.t With_status.Stable.V2.t end end] @@ -198,6 +201,19 @@ end = struct [@@deriving sexp, to_yojson] let to_latest = Fn.id + + let transaction_with_status = function + | 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) end end] @@ -327,6 +343,9 @@ let transaction : t -> Transaction.t = | Coinbase { coinbase = { data; _ }; _ } -> Transaction.Coinbase data +let transaction_with_status_stable { Stable.Latest.varying; _ } = + Varying.Stable.Latest.transaction_with_status varying + 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 f5309c7d6076..31c77112e5fd 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 @@ -23,6 +23,26 @@ module Transaction_with_witness = struct module Stable = struct [@@@no_toplevel_latest_type] + module V3 = struct + type t = + { transaction_with_status : + Transaction.Stable.V2.t With_status.Stable.V2.t + ; state_hash : State_hash.Stable.V1.t * State_body_hash.Stable.V1.t + ; statement : Transaction_snark.Statement.Stable.V2.t + ; init_stack : + Transaction_snark.Pending_coinbase_stack_state.Init_stack.Stable.V1 + .t + ; first_pass_ledger_witness : + (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; second_pass_ledger_witness : + (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t + } + [@@deriving sexp, to_yojson] + + let to_latest = Fn.id + end + module V2 = struct (* TODO: The statement is redundant here - it can be computed from the witness and the transaction @@ -43,7 +63,25 @@ module Transaction_with_witness = struct } [@@deriving sexp, to_yojson] - let to_latest = Fn.id + let to_latest : t -> V3.t = + fun { transaction_with_info + ; state_hash + ; statement + ; init_stack + ; first_pass_ledger_witness + ; second_pass_ledger_witness + ; block_global_slot + } -> + { transaction_with_status = + Mina_transaction_logic.Transaction_applied + .transaction_with_status_stable transaction_with_info + ; statement + ; state_hash + ; init_stack + ; first_pass_ledger_witness + ; second_pass_ledger_witness + ; block_global_slot + } end end] @@ -63,7 +101,7 @@ module Transaction_with_witness = struct end type t = - { transaction_with_info : Mina_transaction_logic.Transaction_applied.t + { transaction_with_status : Transaction.t With_status.t ; state_hash : State_hash.t * State_body_hash.t ; statement : Transaction_snark.Statement.t ; init_stack : Transaction_snark.Pending_coinbase_stack_state.Init_stack.t @@ -73,7 +111,7 @@ module Transaction_with_witness = struct } let write_all_proofs_to_disk ~signature_kind ~proof_cache_db - { Stable.Latest.transaction_with_info + { Stable.Latest.transaction_with_status ; state_hash ; statement ; init_stack @@ -81,9 +119,12 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness ; block_global_slot } = - { transaction_with_info = - Mina_transaction_logic.Transaction_applied.write_all_proofs_to_disk - ~signature_kind ~proof_cache_db transaction_with_info + { transaction_with_status = + With_status.map + ~f: + (Transaction.write_all_proofs_to_disk ~signature_kind + ~proof_cache_db ) + transaction_with_status ; state_hash ; statement ; init_stack @@ -93,7 +134,7 @@ module Transaction_with_witness = struct } let read_all_proofs_from_disk - { transaction_with_info + { transaction_with_status ; state_hash ; statement ; init_stack @@ -101,9 +142,9 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness ; block_global_slot } = - { Stable.Latest.transaction_with_info = - Mina_transaction_logic.Transaction_applied.read_all_proofs_from_disk - transaction_with_info + { Stable.Latest.transaction_with_status = + With_status.map ~f:Transaction.read_all_proofs_from_disk + transaction_with_status ; state_hash ; statement ; init_stack @@ -225,6 +266,31 @@ end type job = Available_job.t +let hash_generic ~serialize_ledger_proof_with_sok_message + ~serialize_transaction_with_witness scan_state + previous_incomplete_zkapp_updates = + let state_hash = + Parallel_scan.State.hash scan_state serialize_ledger_proof_with_sok_message + serialize_transaction_with_witness + in + let ( previous_incomplete_zkapp_updates + , `Border_block_continued_in_the_next_tree continue_in_next_tree ) = + previous_incomplete_zkapp_updates + in + let incomplete_updates = + List.fold ~init:(Digestif.SHA256.init ()) previous_incomplete_zkapp_updates + ~f:(fun h t -> + Digestif.SHA256.feed_string h @@ serialize_transaction_with_witness t ) + |> Digestif.SHA256.get + in + let continue_in_next_tree = + Digestif.SHA256.digest_string (Bool.to_string continue_in_next_tree) + in + [ state_hash; incomplete_updates; continue_in_next_tree ] + |> List.fold ~init:(Digestif.SHA256.init ()) ~f:(fun h t -> + Digestif.SHA256.feed_string h (Digestif.SHA256.to_raw_string t) ) + |> Digestif.SHA256.get |> Staged_ledger_hash.Aux_hash.of_sha256 + (*Scan state and any zkapp updates that were applied to the to the most recent snarked ledger but are from the tree just before the tree corresponding to the snarked ledger*) @@ -232,6 +298,33 @@ type job = Available_job.t module Stable = struct [@@@no_toplevel_latest_type] + (* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) + module V3 = struct + type t = + { scan_state : + ( Ledger_proof_with_sok_message.Stable.V2.t + , Transaction_with_witness.Stable.V3.t ) + Parallel_scan.State.Stable.V1.t + ; previous_incomplete_zkapp_updates : + Transaction_with_witness.Stable.V3.t list + * [ `Border_block_continued_in_the_next_tree of bool ] + } + + let serialize_ledger_proof_with_sok_message = + Binable.to_string (module Ledger_proof_with_sok_message.Stable.V2) + + let serialize_transaction_with_witness = + Binable.to_string (module Transaction_with_witness.Stable.V3) + + (* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) + let hash (t : t) = + hash_generic t.scan_state t.previous_incomplete_zkapp_updates + ~serialize_ledger_proof_with_sok_message + ~serialize_transaction_with_witness + + let to_latest = Fn.id + end + module V2 = struct type t = { scan_state : @@ -243,32 +336,17 @@ module Stable = struct * [ `Border_block_continued_in_the_next_tree of bool ] } - let to_latest = Fn.id - - let hash (t : t) = - let state_hash = - Parallel_scan.State.hash t.scan_state - (Binable.to_string (module Ledger_proof_with_sok_message.Stable.V2)) - (Binable.to_string (module Transaction_with_witness.Stable.V2)) - in - let ( previous_incomplete_zkapp_updates - , `Border_block_continued_in_the_next_tree continue_in_next_tree ) = - t.previous_incomplete_zkapp_updates - in - let incomplete_updates = - List.fold ~init:(Digestif.SHA256.init ()) - previous_incomplete_zkapp_updates ~f:(fun h t -> - Digestif.SHA256.feed_string h - @@ Binable.to_string (module Transaction_with_witness.Stable.V2) t ) - |> Digestif.SHA256.get - in - let continue_in_next_tree = - Digestif.SHA256.digest_string (Bool.to_string continue_in_next_tree) - in - [ state_hash; incomplete_updates; continue_in_next_tree ] - |> List.fold ~init:(Digestif.SHA256.init ()) ~f:(fun h t -> - Digestif.SHA256.feed_string h (Digestif.SHA256.to_raw_string t) ) - |> Digestif.SHA256.get |> Staged_ledger_hash.Aux_hash.of_sha256 + let to_latest : t -> V3.t = + fun { scan_state + ; previous_incomplete_zkapp_updates = updates, continue_in_next_tree + } -> + { scan_state = + Parallel_scan.State.map scan_state ~f1:ident + ~f2:Transaction_with_witness.Stable.V2.to_latest + ; previous_incomplete_zkapp_updates = + ( List.map updates ~f:Transaction_with_witness.Stable.V2.to_latest + , continue_in_next_tree ) + } end end] @@ -282,12 +360,22 @@ type t = * [ `Border_block_continued_in_the_next_tree of bool ] } +(* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) +let hash (t : t) = + hash_generic t.scan_state t.previous_incomplete_zkapp_updates + ~serialize_ledger_proof_with_sok_message: + (Fn.compose Stable.Latest.serialize_ledger_proof_with_sok_message + (Tuple2.map_fst ~f:Ledger_proof.Cached.read_proof_from_disk) ) + ~serialize_transaction_with_witness: + (Fn.compose Stable.Latest.serialize_transaction_with_witness + Transaction_with_witness.read_all_proofs_from_disk ) + (**********Helpers*************) let create_expected_statement ~constraint_constants ~(get_state : State_hash.t -> Mina_state.Protocol_state.value Or_error.t) ~connecting_merkle_root - { Transaction_with_witness.transaction_with_info + { Transaction_with_witness.transaction_with_status ; state_hash ; first_pass_ledger_witness ; second_pass_ledger_witness @@ -304,9 +392,7 @@ let create_expected_statement ~constraint_constants Frozen_ledger_hash.of_ledger_hash @@ Sparse_ledger.merkle_root second_pass_ledger_witness in - let transaction = - Mina_transaction_logic.Transaction_applied.transaction transaction_with_info - in + let transaction = With_status.data transaction_with_status in let%bind protocol_state = get_state (fst state_hash) in let state_view = Mina_state.Protocol_state.Body.view protocol_state.body in let empty_local_state = Mina_state.Local_state.empty () in @@ -766,8 +852,7 @@ module Transactions_ordered = struct (txn_with_witness : Transaction_with_witness.t) -> let txn = - Mina_transaction_logic.Transaction_applied.transaction - txn_with_witness.transaction_with_info + With_status.data txn_with_witness.transaction_with_status in let target_first_pass_ledger = txn_with_witness.statement.target.first_pass_ledger @@ -834,10 +919,7 @@ end let extract_txn_and_global_slot (txn_with_witness : Transaction_with_witness.t) = - let txn = - Mina_transaction_logic.Transaction_applied.transaction_with_status - txn_with_witness.transaction_with_info - in + let txn = txn_with_witness.transaction_with_status 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) @@ -1109,10 +1191,7 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns | Previous_incomplete_txns.Unapplied txns -> Previous_incomplete_txns.Unapplied (List.filter txns ~f:(fun txn -> - match - Mina_transaction_logic.Transaction_applied.transaction - txn.transaction_with_info - with + match With_status.data txn.transaction_with_status with | Command (Zkapp_command _) -> true | _ -> @@ -1325,7 +1404,7 @@ let work_statements_for_new_diff t : Transaction_snark_work.Statement.t list = 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 + { transaction_with_status = { data = transaction; status } ; statement ; state_hash ; first_pass_ledger_witness @@ -1334,10 +1413,6 @@ let single_spec_of_job ~get_state : ; 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 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 cd20713a3a83..fa450a7890e5 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 @@ -8,28 +8,42 @@ module Ledger = Mina_ledger.Ledger module Stable : sig [@@@no_toplevel_latest_type] - module V2 : sig + module V3 : sig type t val hash : t -> Staged_ledger_hash.Aux_hash.t end + + module V2 : sig + type t + + val to_latest : t -> V3.t + end end] type t +val hash : t -> Staged_ledger_hash.Aux_hash.t + module Transaction_with_witness : sig [%%versioned: module Stable : sig [@@@no_toplevel_latest_type] + module V3 : sig + type t + end + module V2 : sig type t + + val to_latest : t -> V3.t end end] (* TODO: The statement is redundant here - it can be computed from the witness and the transaction *) type t = - { transaction_with_info : Mina_transaction_logic.Transaction_applied.t + { transaction_with_status : Transaction.t With_status.t ; state_hash : State_hash.t * State_body_hash.t ; statement : Transaction_snark.Statement.t ; init_stack : Transaction_snark.Pending_coinbase_stack_state.Init_stack.t diff --git a/src/lib/transition_frontier/frontier_base/diff.ml b/src/lib/transition_frontier/frontier_base/diff.ml index f13b00cd7751..91805639aad6 100644 --- a/src/lib/transition_frontier/frontier_base/diff.ml +++ b/src/lib/transition_frontier/frontier_base/diff.ml @@ -83,6 +83,16 @@ module Root_transition = struct module Stable = struct [@@@no_toplevel_latest_type] + module V5 = struct + type t = + { new_root : Root_data.Limited.Stable.V4.t + ; garbage : Node_list.Lite.Stable.V1.t + ; just_emitted_a_proof : bool + } + + let to_latest = Fn.id + end + module V4 = struct type t = { new_root : Root_data.Limited.Stable.V3.t @@ -90,7 +100,11 @@ module Root_transition = struct ; just_emitted_a_proof : bool } - let to_latest = Fn.id + let to_latest t = + { V5.new_root = Root_data.Limited.Stable.V3.to_latest t.new_root + ; garbage = t.garbage + ; just_emitted_a_proof = t.just_emitted_a_proof + } end end] end @@ -101,10 +115,16 @@ module Root_transition = struct module Stable = struct [@@@no_toplevel_latest_type] + module V5 = struct + type t = Lite_binable.Stable.V5.t + + let to_latest = Fn.id + end + module V4 = struct type t = Lite_binable.Stable.V4.t - let to_latest = Fn.id + let to_latest = Lite_binable.Stable.V4.to_latest end end] end @@ -123,12 +143,12 @@ module Root_transition = struct ; just_emitted_a_proof ; old_root_scan_state = Lite } : - t ) : Binable_arg.Stable.V4.t = + t ) : Binable_arg.Stable.V5.t = { new_root; garbage; just_emitted_a_proof } let of_binable ({ new_root; garbage; just_emitted_a_proof } : - Binable_arg.Stable.V4.t ) : t = + Binable_arg.Stable.V5.t ) : t = { new_root ; garbage ; old_root_scan_state = Lite @@ -136,7 +156,7 @@ module Root_transition = struct } end - include Binable.Of_binable (Binable_arg.Stable.V4) (T_nonbinable) + include Binable.Of_binable (Binable_arg.Stable.V5) (T_nonbinable) let to_latest = Fn.id end diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 7850bd3fc2aa..e077e6c48868 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -6,13 +6,26 @@ module Common = struct module Stable = struct [@@@no_toplevel_latest_type] + module V3 = struct + type t = + { scan_state : Staged_ledger.Scan_state.Stable.V3.t + ; pending_coinbase : Pending_coinbase.Stable.V2.t + } + + let to_latest = Fn.id + end + module V2 = struct type t = { scan_state : Staged_ledger.Scan_state.Stable.V2.t ; pending_coinbase : Pending_coinbase.Stable.V2.t } - let to_latest = Fn.id + let to_latest { scan_state; pending_coinbase } = + { V3.scan_state = + Staged_ledger.Scan_state.Stable.V2.to_latest scan_state + ; pending_coinbase + } end end] @@ -74,14 +87,14 @@ module Limited = struct module Stable = struct [@@@no_toplevel_latest_type] - module V3 = struct + module V4 = struct type t = { transition : Mina_block.Validated.Stable.V2.t ; protocol_states : Mina_state.Protocol_state.Value.Stable.V2.t Mina_base.State_hash.With_state_hashes.Stable.V1.t list - ; common : Common.Stable.V2.t + ; common : Common.Stable.V3.t } [@@deriving fields] @@ -90,9 +103,27 @@ module Limited = struct let hashes t = Mina_block.Validated.Stable.Latest.hashes t.transition let create ~transition ~scan_state ~pending_coinbase ~protocol_states = - let common = { Common.Stable.V2.scan_state; pending_coinbase } in + let common = { Common.Stable.V3.scan_state; pending_coinbase } in { transition; common; protocol_states } end + + module V3 = struct + type t = + { transition : Mina_block.Validated.Stable.V2.t + ; protocol_states : + Mina_state.Protocol_state.Value.Stable.V2.t + Mina_base.State_hash.With_state_hashes.Stable.V1.t + list + ; common : Common.Stable.V2.t + } + [@@deriving fields] + + let to_latest { transition; protocol_states; common } = + { V4.transition + ; protocol_states + ; common = Common.Stable.V2.to_latest common + } + end end] type t = @@ -135,8 +166,8 @@ module Minimal = struct module Stable = struct [@@@no_toplevel_latest_type] - module V2 = struct - type t = { hash : State_hash.Stable.V1.t; common : Common.Stable.V2.t } + module V3 = struct + type t = { hash : State_hash.Stable.V1.t; common : Common.Stable.V3.t } [@@deriving fields] let of_limited ~common hash = { hash; common } @@ -149,6 +180,13 @@ module Minimal = struct let pending_coinbase t = t.common.Common.Stable.Latest.pending_coinbase end + + module V2 = struct + type t = { hash : State_hash.Stable.V1.t; common : Common.Stable.V2.t } + + let to_latest { hash; common } = + { V3.hash; common = Common.Stable.V2.to_latest common } + end end] type t = { hash : State_hash.t; common : Common.t } [@@deriving fields] diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index a77c4e415983..783513303356 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -5,14 +5,20 @@ module Common : sig module Stable : sig [@@@no_toplevel_latest_type] + module V3 : sig + type t + end + module V2 : sig type t + + val to_latest : t -> V3.t end end] type t - val read_all_proofs_from_disk : t -> Stable.V2.t + val read_all_proofs_from_disk : t -> Stable.Latest.t end (* Historical root data is similar to Limited root data, except that it also @@ -40,12 +46,12 @@ module Limited : sig module Stable : sig [@@@no_toplevel_latest_type] - module V3 : sig + module V4 : sig type t val hashes : t -> State_hash.State_hashes.Stable.V1.t - val common : t -> Common.Stable.V2.t + val common : t -> Common.Stable.V3.t val protocol_states : t @@ -55,7 +61,7 @@ module Limited : sig val create : transition:Mina_block.Validated.Stable.V2.t - -> scan_state:Staged_ledger.Scan_state.Stable.V2.t + -> scan_state:Staged_ledger.Scan_state.Stable.V3.t -> pending_coinbase:Pending_coinbase.Stable.V2.t -> protocol_states: Mina_state.Protocol_state.value @@ -65,6 +71,12 @@ module Limited : sig val transition : t -> Mina_block.Validated.Stable.V2.t end + + module V3 : sig + type t + + val to_latest : t -> V4.t + end end] type t [@@deriving to_yojson] @@ -103,19 +115,25 @@ module Minimal : sig module Stable : sig [@@@no_toplevel_latest_type] - module V2 : sig + module V3 : sig type t val hash : t -> State_hash.t - val of_limited : common:Common.Stable.V2.t -> State_hash.Stable.V1.t -> t + val of_limited : common:Common.Stable.V3.t -> State_hash.Stable.V1.t -> t - val common : t -> Common.Stable.V2.t + val common : t -> Common.Stable.V3.t - val scan_state : t -> Staged_ledger.Scan_state.Stable.V2.t + val scan_state : t -> Staged_ledger.Scan_state.Stable.V3.t val pending_coinbase : t -> Pending_coinbase.Stable.V2.t end + + module V2 : sig + type t + + val to_latest : t -> V3.t + end end] type t diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 4093e31594b7..622d4dfed809 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -62,9 +62,9 @@ module Schema = struct Most of the time, we just need the hash, but whole `Root` is being read; This combos with `bin_prot` being slow results in 90s bottleneck. *) - | Root : Root_data.Minimal.Stable.V2.t t + | Root : Root_data.Minimal.Stable.V3.t t | Root_hash : State_hash.Stable.V1.t t - | Root_common : Root_data.Common.Stable.V2.t t + | Root_common : Root_data.Common.Stable.V3.t t | Best_tip : State_hash.Stable.V1.t t | Protocol_states_for_root_scan_state : Mina_state.Protocol_state.Value.Stable.V2.t list t @@ -277,14 +277,14 @@ let get_root t = | [ Some (Some_key_value (Root_hash, hash)) ; Some (Some_key_value (Root_common, common)) ] -> - Ok (Root_data.Minimal.Stable.V2.of_limited ~common hash) + Ok (Root_data.Minimal.Stable.Latest.of_limited ~common hash) | _ -> ( match get t.db ~key:Root ~error:(`Not_found `Root) with | Ok root -> (* automatically split Root into (Root_hash, Root_common) *) Batch.with_batch t.db ~f:(fun batch -> let hash = Root_data.Minimal.Stable.Latest.hash root in - let common = Root_data.Minimal.Stable.V2.common root in + let common = Root_data.Minimal.Stable.Latest.common root in Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:hash ; Batch.set batch ~key:Root_common ~data:common ) ; From f46c6048a5719f5c55a9ae5a657a983c731f20fc Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 19:13:54 +0100 Subject: [PATCH 010/122] Add previous_protocol_state_body_opt to witness --- .../disk_caching_stats/disk_caching_stats.ml | 3 +- src/app/heap_usage/values.ml | 4 +- src/lib/block_producer/block_producer.ml | 8 +- src/lib/mina_block/validation.ml | 4 +- src/lib/staged_ledger/staged_ledger.ml | 114 ++++++++++-------- src/lib/staged_ledger/staged_ledger.mli | 5 +- .../transaction_snark_scan_state.ml | 42 ++++++- .../transaction_snark_scan_state.mli | 2 + .../extensions/snark_pool_refcount.ml | 2 +- .../frontier_base/breadcrumb.ml | 11 +- 10 files changed, 128 insertions(+), 67 deletions(-) diff --git a/src/app/disk_caching_stats/disk_caching_stats.ml b/src/app/disk_caching_stats/disk_caching_stats.ml index 69df4af13fb2..b335590809b4 100644 --- a/src/app/disk_caching_stats/disk_caching_stats.ml +++ b/src/app/disk_caching_stats/disk_caching_stats.ml @@ -390,7 +390,8 @@ module Values (S : Sample) = struct ; init_stack = Base (pending_coinbase_stack ()) ; first_pass_ledger_witness = witness () ; second_pass_ledger_witness = witness () - ; block_global_slot = global_slot_since_genesis () + ; block_global_slot = global_slot_since_genesis () (* TODO: add a value *) + ; previous_protocol_state_body_opt = None } let zkapp_command_base_work ~config () : diff --git a/src/app/heap_usage/values.ml b/src/app/heap_usage/values.ml index cc77a78d3895..680716ab7303 100644 --- a/src/app/heap_usage/values.ml +++ b/src/app/heap_usage/values.ml @@ -124,7 +124,9 @@ let mk_scan_state_base_node (transaction : Mina_transaction.Transaction.t) ; init_stack ; first_pass_ledger_witness = ledger_witness ; second_pass_ledger_witness = ledger_witness - ; block_global_slot = Mina_numbers.Global_slot_since_genesis.zero + ; block_global_slot = + Mina_numbers.Global_slot_since_genesis.zero (* TODO: add a value *) + ; previous_protocol_state_body_opt = None } in let record : _ Parallel_scan.Base.Record.t = diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 2264f66443e8..09eec46b7e12 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -199,9 +199,11 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants ~body_hash:previous_protocol_state_body_hash previous_protocol_state ) .state_hash in - let previous_state_view = + let previous_protocol_state_body = Protocol_state.body previous_protocol_state - |> Mina_state.Protocol_state.Body.view + in + let previous_state_view = + Protocol_state.Body.view previous_protocol_state_body in let global_slot = Consensus.Data.Block_data.global_slot_since_genesis block_data @@ -282,7 +284,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants let%bind.Deferred.Result diff = return diff in Staged_ledger.apply_diff_unchecked staged_ledger ~constraint_constants ~global_slot diff ~logger - ~current_state_view:previous_state_view + ~parent_protocol_state_body:previous_protocol_state_body ~state_and_body_hash: (previous_protocol_state_hash, previous_protocol_state_body_hash) ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 6aee05d40853..48292166d860 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -498,6 +498,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger Deferred.Result.return () else Deferred.Result.fail `Invalid_body_reference in + let parent_protocol_state_body = Protocol_state.body parent_protocol_state in let%bind.Deferred.Result ( `Ledger_proof proof_opt , `Staged_ledger transitioned_staged_ledger , `Accounts_created accounts_created @@ -508,8 +509,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger precomputed_values.Precomputed_values.constraint_constants ~global_slot ~logger ~verifier parent_staged_ledger (Staged_ledger_diff.Body.staged_ledger_diff body) - ~current_state_view: - Mina_state.Protocol_state.(Body.view @@ body parent_protocol_state) + ~parent_protocol_state_body ~state_and_body_hash: (let body_hash = Protocol_state.(Body.hash @@ body parent_protocol_state) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index b252a5ff0ff0..2b9987e1584a 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -634,6 +634,7 @@ module T = struct ; init_stack = pre_stmt.init_stack ; statement ; block_global_slot = global_slot + ; previous_protocol_state_body_opt = None } , Mina_transaction_logic.Transaction_applied.new_accounts applied_txn ) @@ -1039,7 +1040,7 @@ module T = struct ) let apply_diff ?(skip_verification = false) ~logger ~constraint_constants - ~global_slot ~current_state_view ~state_and_body_hash ~log_prefix + ~global_slot ~parent_protocol_state_body ~state_and_body_hash ~log_prefix ~zkapp_cmd_limit_hardcap ~signature_kind t pre_diff_info = let open Deferred.Result.Let_syntax in let max_throughput = @@ -1090,6 +1091,9 @@ module T = struct ; ("proofs_waiting", `Int proofs_waiting) ; ("max_throughput", `Int max_throughput) ] ; + let current_state_view = + Mina_state.Protocol_state.(Body.view parent_protocol_state_body) + in let%bind ( is_new_stack , data , stack_update_in_snark @@ -1106,7 +1110,13 @@ module T = struct ~previous_state_hash:(fst state_and_body_hash) ~state_body_hash:(snd state_and_body_hash) in - let witnesses = List.map data ~f:fst in + let to_witness (witness, _) = + { witness with + Transaction_snark_scan_state.Transaction_with_witness + .previous_protocol_state_body_opt = Some parent_protocol_state_body + } + in + let witnesses = List.map data ~f:to_witness in let _tagged_witnesses, _tagged_works = State_hash.File_storage.write_values_exn state_hash ~f:(persist_witnesses_and_works witnesses works) @@ -1262,7 +1272,7 @@ module T = struct type transaction_pool_proxy = Check_commands.transaction_pool_proxy let apply ?skip_verification ~constraint_constants ~global_slot - ~get_completed_work ~logger ~verifier ~current_state_view + ~get_completed_work ~logger ~verifier ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind ?(transaction_pool_proxy = Check_commands.dummy_transaction_pool_proxy) t @@ -1300,7 +1310,7 @@ module T = struct ([%equal: [ `All | `Proofs ] option] skip_verification (Some `All)) ~constraint_constants ~global_slot t (forget_prediff_info prediff) - ~logger ~current_state_view ~state_and_body_hash + ~logger ~parent_protocol_state_body ~state_and_body_hash ~log_prefix:"apply_diff" ~zkapp_cmd_limit_hardcap ~signature_kind in [%log internal] "Diff_applied" ; @@ -1321,7 +1331,7 @@ module T = struct res let apply_diff_unchecked ~constraint_constants ~global_slot ~logger - ~current_state_view ~state_and_body_hash ~coinbase_receiver + ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind t (sl_diff : Staged_ledger_diff.With_valid_signatures_and_proofs.t) = let open Deferred.Result.Let_syntax in @@ -1333,7 +1343,7 @@ module T = struct in apply_diff t (forget_prediff_info prediff) - ~constraint_constants ~global_slot ~logger ~current_state_view + ~constraint_constants ~global_slot ~logger ~parent_protocol_state_body ~state_and_body_hash ~log_prefix:"apply_diff_unchecked" ~zkapp_cmd_limit_hardcap ~signature_kind @@ -2370,12 +2380,15 @@ module Test_helpers = struct (Mina_state.Protocol_state.previous_state_hash state) ~body in + let parent_protocol_state_body = + Mina_state.Protocol_state.body state_with_global_slot + in ( state_with_global_slot - , Mina_state.Protocol_state.Body.view - (Mina_state.Protocol_state.body state_with_global_slot) ) + , Mina_state.Protocol_state.Body.view parent_protocol_state_body + , parent_protocol_state_body ) let dummy_state_view ?global_slot () = - dummy_state_and_view ?global_slot () |> snd + dummy_state_and_view ?global_slot () |> fun (_, view, _) -> view let update_coinbase_stack_and_get_data_impl = update_coinbase_stack_and_get_data_impl @@ -2435,8 +2448,7 @@ let%test_module "staged ledger tests" = Sl.can_apply_supercharged_coinbase_exn ~winner ~global_slot ~epoch_ledger (* Functor for testing with different instantiated staged ledger modules. *) - let create_and_apply_with_state_body_hash - ~(current_state_view : Zkapp_precondition.Protocol_state.View.t) + let create_and_apply_with_state_body_hash ~parent_protocol_state_body ~global_slot ~state_and_body_hash ~signature_kind ?zkapp_cmd_limit ?(coinbase_receiver = coinbase_receiver) ?(winner = self_pk) sl txns stmt_to_work = @@ -2444,6 +2456,9 @@ let%test_module "staged ledger tests" = let supercharge_coinbase = supercharge_coinbase ~ledger:(Sl.ledger !sl) ~winner ~global_slot in + let current_state_view = + Mina_state.Protocol_state.(Body.view parent_protocol_state_body) + in let diff = Sl.create_diff ~constraint_constants ~global_slot !sl ~logger ~current_state_view ~transactions_by_fee:txns @@ -2464,9 +2479,9 @@ let%test_module "staged ledger tests" = , `Pending_coinbase_update (is_new_stack, pc_update) ) = match%map Sl.apply ~constraint_constants ~global_slot !sl diff' ~logger - ~verifier ~get_completed_work:(Fn.const None) ~current_state_view - ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase - ~zkapp_cmd_limit_hardcap ~signature_kind + ~verifier ~get_completed_work:(Fn.const None) + ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver + ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind with | Ok x -> x @@ -2479,13 +2494,13 @@ let%test_module "staged ledger tests" = (ledger_proof, diff', is_new_stack, pc_update, supercharge_coinbase) let create_and_apply ?(coinbase_receiver = coinbase_receiver) - ?(winner = self_pk) ~global_slot ~protocol_state_view + ?(winner = self_pk) ~global_slot ~parent_protocol_state_body ~state_and_body_hash ~signature_kind sl txns stmt_to_work = let open Deferred.Let_syntax in let%map ledger_proof, diff, _, _, _ = create_and_apply_with_state_body_hash ~coinbase_receiver ~winner - ~current_state_view:protocol_state_view ~global_slot - ~state_and_body_hash sl txns stmt_to_work ~signature_kind + ~parent_protocol_state_body ~global_slot ~state_and_body_hash sl txns + stmt_to_work ~signature_kind in (ledger_proof, diff) @@ -2784,7 +2799,7 @@ let%test_module "staged ledger tests" = in let state_tbl = State_hash.Table.create () in (*Add genesis state to the table*) - let genesis, _ = dummy_state_and_view () in + let genesis, _, _ = dummy_state_and_view () in let state_hash = (Mina_state.Protocol_state.hashes genesis).state_hash in State_hash.Table.add state_tbl ~key:state_hash ~data:genesis |> ignore ; let%map `Proof_count total_ledger_proofs, _ = @@ -2792,7 +2807,7 @@ let%test_module "staged ledger tests" = (`Proof_count 0, `Slot global_slot) (fun cmds_left count_opt cmds_this_iter (`Proof_count proof_count, `Slot global_slot) -> - let current_state, current_view = + let current_state, current_view, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_hash = @@ -2801,7 +2816,7 @@ let%test_module "staged ledger tests" = State_hash.Table.add state_tbl ~key:state_hash ~data:current_state |> ignore ; let%bind ledger_proof, diff = - create_and_apply ~global_slot ~protocol_state_view:current_view + create_and_apply ~global_slot ~parent_protocol_state_body ~state_and_body_hash: ( state_hash , (Mina_state.Protocol_state.hashes current_state) @@ -3418,7 +3433,7 @@ let%test_module "staged ledger tests" = ~coinbase_amount:constraint_constants.coinbase_amount ~global_slot cmds_this_iter work_done partitions in - let current_state, current_view = + let current_state, _, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_hashes = @@ -3427,7 +3442,7 @@ let%test_module "staged ledger tests" = let%bind apply_res = Sl.apply ~constraint_constants ~global_slot !sl diff ~logger ~verifier ~get_completed_work:(Fn.const None) - ~current_state_view:current_view + ~parent_protocol_state_body ~state_and_body_hash: ( state_hashes.state_hash , state_hashes.state_body_hash |> Option.value_exn ) @@ -3567,7 +3582,7 @@ let%test_module "staged ledger tests" = let global_slot = Mina_numbers.Global_slot_since_genesis.of_int global_slot in - let current_state, current_state_view = + let current_state, current_state_view, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -3579,8 +3594,7 @@ let%test_module "staged ledger tests" = in let%map proof, diff = create_and_apply ~global_slot ~state_and_body_hash - ~protocol_state_view:current_state_view ~signature_kind sl - cmds_this_iter + ~parent_protocol_state_body ~signature_kind sl cmds_this_iter (stmt_to_work_restricted (List.take work_list proofs_available_this_iter) provers ) @@ -3765,7 +3779,7 @@ let%test_module "staged ledger tests" = let global_slot = Mina_numbers.Global_slot_since_genesis.of_int global_slot in - let current_state, current_state_view = + let current_state, _, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -3776,9 +3790,8 @@ let%test_module "staged ledger tests" = , state_hashes.state_body_hash |> Option.value_exn ) in let%map _proof, diff = - create_and_apply ~global_slot - ~protocol_state_view:current_state_view ~state_and_body_hash - ~signature_kind sl cmds_this_iter + create_and_apply ~global_slot ~state_and_body_hash + ~parent_protocol_state_body ~signature_kind sl cmds_this_iter (stmt_to_work_random_fee work_to_be_done provers) in let sorted_work_from_diff1 @@ -3992,7 +4005,7 @@ let%test_module "staged ledger tests" = List.hd_exn proofs_available_left in let sl_before = !sl in - let current_state, current_state_view = + let current_state, current_state_view, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -4003,7 +4016,7 @@ let%test_module "staged ledger tests" = , state_hashes.state_body_hash |> Option.value_exn ) in let%map proof, diff, is_new_stack, pc_update, supercharge_coinbase = - create_and_apply_with_state_body_hash ~current_state_view + create_and_apply_with_state_body_hash ~parent_protocol_state_body ~global_slot ~state_and_body_hash ~signature_kind sl cmds_this_iter (stmt_to_work_restricted @@ -4125,7 +4138,7 @@ let%test_module "staged ledger tests" = let global_slot = Mina_numbers.Global_slot_since_genesis.of_int block_count in - let current_state, current_state_view = + let current_state, _, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -4136,7 +4149,7 @@ let%test_module "staged ledger tests" = let%bind _ = create_and_apply_with_state_body_hash ~winner:delegator.public_key ~coinbase_receiver:coinbase_receiver.public_key sl - ~current_state_view + ~parent_protocol_state_body ~global_slot: (Mina_numbers.Global_slot_since_genesis.of_int block_count) ~state_and_body_hash ~signature_kind Sequence.empty @@ -4431,7 +4444,8 @@ let%test_module "staged ledger tests" = let global_slot = Mina_numbers.Global_slot_since_genesis.of_int global_slot in - let current_state, current_state_view = + let current_state, current_state_view, parent_protocol_state_body + = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -4479,7 +4493,7 @@ let%test_module "staged ledger tests" = Sl.apply ~constraint_constants ~global_slot !sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) - ~current_state_view ~state_and_body_hash + ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase:false ~zkapp_cmd_limit_hardcap ~signature_kind with @@ -4644,7 +4658,7 @@ let%test_module "staged ledger tests" = let global_slot = Mina_numbers.Global_slot_since_genesis.of_int global_slot in - let current_state, current_state_view = + let current_state, current_state_view, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -4692,9 +4706,9 @@ let%test_module "staged ledger tests" = Sl.apply ~constraint_constants ~global_slot sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) - ~current_state_view ~state_and_body_hash ~coinbase_receiver - ~supercharge_coinbase:false ~zkapp_cmd_limit_hardcap - ~signature_kind + ~parent_protocol_state_body ~state_and_body_hash + ~coinbase_receiver ~supercharge_coinbase:false + ~zkapp_cmd_limit_hardcap ~signature_kind with | Ok _x -> ( let valid_command_1_with_status = @@ -4739,7 +4753,7 @@ let%test_module "staged ledger tests" = Sl.apply ~constraint_constants ~global_slot sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) - ~current_state_view ~state_and_body_hash + ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase:false ~zkapp_cmd_limit_hardcap ~signature_kind with @@ -4823,7 +4837,7 @@ let%test_module "staged ledger tests" = let global_slot = Mina_numbers.Global_slot_since_genesis.of_int 1 in - let current_state, current_state_view = + let current_state, _, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -4836,9 +4850,9 @@ let%test_module "staged ledger tests" = let%map result = apply ~logger ~constraint_constants ~global_slot ~get_completed_work:(Fn.const None) ~verifier - ~current_state_view ~state_and_body_hash ~coinbase_receiver - ~supercharge_coinbase:false sl diff ~zkapp_cmd_limit_hardcap - ~signature_kind + ~parent_protocol_state_body ~state_and_body_hash + ~coinbase_receiver ~supercharge_coinbase:false sl diff + ~zkapp_cmd_limit_hardcap ~signature_kind in match (expectation, result) with | `Accept, Ok _ | `Reject, Error _ -> @@ -5118,7 +5132,7 @@ let%test_module "staged ledger tests" = (Zkapp_command.Valid.For_tests.to_valid ~failed:true ~find_vk:(find_vk ledger) zkapp_command ) in - let current_state, current_state_view = + let current_state, _, parent_protocol_state_body = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -5130,7 +5144,7 @@ let%test_module "staged ledger tests" = in let%bind _proof, diff = create_and_apply ~global_slot ~state_and_body_hash - ~protocol_state_view:current_state_view ~signature_kind sl + ~parent_protocol_state_body ~signature_kind sl (Sequence.singleton (User_command.Zkapp_command failed_zkapp_command) ) stmt_to_work_one_prover @@ -5170,7 +5184,7 @@ let%test_module "staged ledger tests" = let sl = ref @@ Sl.create_exn ~constraint_constants ~ledger in let%bind _proof, diff = create_and_apply sl ~global_slot ~state_and_body_hash - ~protocol_state_view:current_state_view ~signature_kind + ~parent_protocol_state_body ~signature_kind (Sequence.singleton (User_command.Zkapp_command valid_zkapp_command) ) stmt_to_work_one_prover @@ -5241,7 +5255,9 @@ let%test_module "staged ledger tests" = let global_slot = Mina_numbers.Global_slot_since_genesis.of_int global_slot in - let current_state, current_state_view = + let ( current_state + , current_state_view + , parent_protocol_state_body ) = dummy_state_and_view ~global_slot () in let state_and_body_hash = @@ -5279,7 +5295,7 @@ let%test_module "staged ledger tests" = Sl.apply ~constraint_constants ~global_slot !sl (Staged_ledger_diff.forget diff) ~get_completed_work:(Fn.const None) ~logger - ~verifier:verifier_full ~current_state_view + ~verifier:verifier_full ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase:false ~zkapp_cmd_limit_hardcap ~signature_kind diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 6a75a097f75a..6b249b6588be 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -225,7 +225,7 @@ val apply : -> Transaction_snark_work.Checked.t option ) -> logger:Logger.t -> verifier:Verifier.t - -> current_state_view:Zkapp_precondition.Protocol_state.View.t + -> parent_protocol_state_body:Mina_state.Protocol_state.Body.Value.t -> state_and_body_hash:State_hash.t * State_body_hash.t -> coinbase_receiver:Public_key.Compressed.t -> supercharge_coinbase:bool @@ -252,7 +252,7 @@ val apply_diff_unchecked : constraint_constants:Genesis_constants.Constraint_constants.t -> global_slot:Mina_numbers.Global_slot_since_genesis.t -> logger:Logger.t - -> current_state_view:Zkapp_precondition.Protocol_state.View.t + -> parent_protocol_state_body:Mina_state.Protocol_state.Body.Value.t -> state_and_body_hash:State_hash.t * State_body_hash.t -> coinbase_receiver:Public_key.Compressed.t -> supercharge_coinbase:bool @@ -383,6 +383,7 @@ module Test_helpers : sig -> unit -> Mina_state.Protocol_state.value * Zkapp_precondition.Protocol_state.View.t + * Mina_state.Protocol_state.Body.Value.t val dummy_state_view : ?global_slot:Mina_numbers.Global_slot_since_genesis.t 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 31c77112e5fd..45c1f82dab23 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 @@ -37,6 +37,9 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness : (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t + (* TODO: in Mesa remove the option, just have the value *) + ; previous_protocol_state_body_opt : + Mina_state.Protocol_state.Body.Value.Stable.V2.t option } [@@deriving sexp, to_yojson] @@ -81,6 +84,7 @@ module Transaction_with_witness = struct ; first_pass_ledger_witness ; second_pass_ledger_witness ; block_global_slot + ; previous_protocol_state_body_opt = None } end end] @@ -108,6 +112,8 @@ module Transaction_with_witness = struct ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t + ; previous_protocol_state_body_opt : + Mina_state.Protocol_state.Body.Value.t option } let write_all_proofs_to_disk ~signature_kind ~proof_cache_db @@ -118,6 +124,7 @@ module Transaction_with_witness = struct ; first_pass_ledger_witness ; second_pass_ledger_witness ; block_global_slot + ; previous_protocol_state_body_opt } = { transaction_with_status = With_status.map @@ -131,6 +138,7 @@ module Transaction_with_witness = struct ; first_pass_ledger_witness ; second_pass_ledger_witness ; block_global_slot + ; previous_protocol_state_body_opt } let read_all_proofs_from_disk @@ -141,6 +149,7 @@ module Transaction_with_witness = struct ; first_pass_ledger_witness ; second_pass_ledger_witness ; block_global_slot + ; previous_protocol_state_body_opt } = { Stable.Latest.transaction_with_status = With_status.map ~f:Transaction.read_all_proofs_from_disk @@ -151,6 +160,7 @@ module Transaction_with_witness = struct ; first_pass_ledger_witness ; second_pass_ledger_witness ; block_global_slot + ; previous_protocol_state_body_opt } end @@ -382,6 +392,7 @@ let create_expected_statement ~constraint_constants ; init_stack ; statement ; block_global_slot + ; previous_protocol_state_body_opt } = let open Or_error.Let_syntax in let source_first_pass_merkle_root = @@ -393,8 +404,17 @@ let create_expected_statement ~constraint_constants @@ Sparse_ledger.merkle_root second_pass_ledger_witness in let transaction = With_status.data transaction_with_status in - let%bind protocol_state = get_state (fst state_hash) in - let state_view = Mina_state.Protocol_state.Body.view protocol_state.body in + let%bind previous_protocol_state_body = + match previous_protocol_state_body_opt with + | Some protocol_state -> + Ok protocol_state + | None -> + get_state (fst state_hash) + |> Or_error.map ~f:Mina_state.Protocol_state.body + in + let state_view = + Mina_state.Protocol_state.Body.view previous_protocol_state_body + in let empty_local_state = Mina_state.Local_state.empty () in let%bind ( target_first_pass_merkle_root , target_second_pass_merkle_root @@ -1368,6 +1388,11 @@ let snark_job_list_json t = (List.map all_jobs ~f:(fun tree -> `List (List.map tree ~f:Job_view.to_yojson) ) ) ) +(* TODO create a function work_statements_length and use it + where only the length of the list is needed *) +(* Length is used in ledger application. Whole list is + needed only in a test and in Snark_pool_refcount extension (i.e. + processing will happen once on each block) *) (*Always the same pairing of jobs*) let all_work_statements_exn t : Transaction_snark_work.Statement.t list = let work_seqs = all_jobs t in @@ -1389,6 +1414,10 @@ let k_work_pairs_for_new_diff t ~k = List.( take (concat_map work_list ~f:(fun works -> One_or_two.group_list works)) k) +(* TODO create a function work_statements_length and use it + where only the length of the list is needed *) +(* Length is used in ledger application. Whole list is + needed only in a tests and in [Staged_ledger.create_diff] *) (*Always the same pairing of jobs*) let work_statements_for_new_diff t : Transaction_snark_work.Statement.t list = let work_list = Parallel_scan.jobs_for_next_update t.scan_state in @@ -1411,11 +1440,16 @@ let single_spec_of_job ~get_state : ; second_pass_ledger_witness ; init_stack ; block_global_slot + ; previous_protocol_state_body_opt } -> let%map.Or_error witness = let%bind.Or_error protocol_state_body = - get_state (fst state_hash) - |> Or_error.map ~f:Mina_state.Protocol_state.body + match previous_protocol_state_body_opt with + | Some protocol_state_body -> + Ok protocol_state_body + | None -> + 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 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 fa450a7890e5..b69ddfe23ec8 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 @@ -50,6 +50,8 @@ module Transaction_with_witness : sig ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t + ; previous_protocol_state_body_opt : + Mina_state.Protocol_state.Body.Value.t option } val write_all_proofs_to_disk : diff --git a/src/lib/transition_frontier/extensions/snark_pool_refcount.ml b/src/lib/transition_frontier/extensions/snark_pool_refcount.ml index d01ca4ce16dd..087d413fdc19 100644 --- a/src/lib/transition_frontier/extensions/snark_pool_refcount.ml +++ b/src/lib/transition_frontier/extensions/snark_pool_refcount.ml @@ -15,7 +15,7 @@ module T = struct *) ; mutable best_tip_table : Work.Set.t (** The set of all snark work statements present in the scan state - for the last 10 blocks in the best chain. + for the last 3 blocks in the best chain. *) } diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index fed0d361114d..8df4f624eee1 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -388,18 +388,20 @@ module For_tests = struct ; prover } ) in - let current_state_view, state_and_body_hash = + let current_state_view, state_and_body_hash, parent_protocol_state_body = let prev_state = parent_breadcrumb |> block |> Mina_block.header |> Mina_block.Header.protocol_state in let prev_state_hashes = Protocol_state.hashes prev_state in + let parent_protocol_state_body = Protocol_state.body prev_state in let current_state_view = - Protocol_state.body prev_state |> Protocol_state.Body.view + Protocol_state.Body.view parent_protocol_state_body in ( current_state_view , ( prev_state_hashes.state_hash - , Option.value_exn prev_state_hashes.state_body_hash ) ) + , Option.value_exn prev_state_hashes.state_body_hash ) + , parent_protocol_state_body ) in let current_global_slot = Mina_numbers.Global_slot_since_genesis.add @@ -428,7 +430,8 @@ module For_tests = struct ~global_slot:current_global_slot ~coinbase_receiver ~logger staged_ledger_diff ~constraint_constants:precomputed_values.constraint_constants - ~current_state_view ~state_and_body_hash ~supercharge_coinbase + ~parent_protocol_state_body ~state_and_body_hash + ~supercharge_coinbase ~zkapp_cmd_limit_hardcap: precomputed_values.genesis_constants.zkapp_cmd_limit_hardcap ~signature_kind:Testnet From 5d4fe90bdb1ebcf24a75a5d2fe139733f7a729de Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 19:22:05 +0100 Subject: [PATCH 011/122] Simplify type of init_stack in witness --- .../disk_caching_stats/disk_caching_stats.ml | 2 +- src/app/heap_usage/values.ml | 4 +- src/lib/staged_ledger/staged_ledger.ml | 6 +-- .../transaction_snark_scan_state.ml | 49 +++++++------------ .../transaction_snark_scan_state.mli | 2 +- 5 files changed, 23 insertions(+), 40 deletions(-) diff --git a/src/app/disk_caching_stats/disk_caching_stats.ml b/src/app/disk_caching_stats/disk_caching_stats.ml index b335590809b4..129b6c8b9dd4 100644 --- a/src/app/disk_caching_stats/disk_caching_stats.ml +++ b/src/app/disk_caching_stats/disk_caching_stats.ml @@ -387,7 +387,7 @@ module Values (S : Sample) = struct ; fee_excess = fee_excess () ; sok_digest = () } - ; init_stack = Base (pending_coinbase_stack ()) + ; init_stack = pending_coinbase_stack () ; first_pass_ledger_witness = witness () ; second_pass_ledger_witness = witness () ; block_global_slot = global_slot_since_genesis () (* TODO: add a value *) diff --git a/src/app/heap_usage/values.ml b/src/app/heap_usage/values.ml index 680716ab7303..fa476fd9ba64 100644 --- a/src/app/heap_usage/values.ml +++ b/src/app/heap_usage/values.ml @@ -80,9 +80,7 @@ let mk_scan_state_base_node (transaction : Mina_transaction.Transaction.t) let state_hash = get Mina_base.State_hash.gen in let state_body_hash = get Mina_base.State_body_hash.gen in let statement = get Transaction_snark.Statement.gen in - let init_stack = - Transaction_snark.Pending_coinbase_stack_state.Init_stack.Merge - in + let init_stack = Mina_base.Pending_coinbase.Stack.empty in let ledger_witness = let depth = constraint_constants.ledger_depth in let account_access_statuses = diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 2b9987e1584a..499de1e9ce51 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -31,7 +31,7 @@ module Pre_statement = struct ; first_pass_ledger_target_hash : Ledger_hash.t ; pending_coinbase_stack_source : Pending_coinbase.Stack_versioned.t ; pending_coinbase_stack_target : Pending_coinbase.Stack_versioned.t - ; init_stack : Transaction_snark.Pending_coinbase_stack_state.Init_stack.t + ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.t } end @@ -556,9 +556,7 @@ module T = struct ; first_pass_ledger_target_hash = target_ledger_hash ; pending_coinbase_stack_source = pending_coinbase_stack_state.pc.source ; pending_coinbase_stack_target = pending_coinbase_target - ; init_stack = - Transaction_snark.Pending_coinbase_stack_state.Init_stack.Base - pending_coinbase_stack_state.init_stack + ; init_stack = pending_coinbase_stack_state.init_stack } , { Stack_state_with_init_stack.pc = { source = pending_coinbase_target; target = pending_coinbase_target } 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 45c1f82dab23..9d3959b115c0 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 @@ -29,9 +29,7 @@ module Transaction_with_witness = struct Transaction.Stable.V2.t With_status.Stable.V2.t ; state_hash : State_hash.Stable.V1.t * State_body_hash.Stable.V1.t ; statement : Transaction_snark.Statement.Stable.V2.t - ; init_stack : - Transaction_snark.Pending_coinbase_stack_state.Init_stack.Stable.V1 - .t + ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.Stable.V1.t ; first_pass_ledger_witness : (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) ; second_pass_ledger_witness : @@ -80,7 +78,12 @@ module Transaction_with_witness = struct .transaction_with_status_stable transaction_with_info ; statement ; state_hash - ; init_stack + ; init_stack = + ( match init_stack with + | Base stack -> + stack + | Merge -> + failwith "Unexpected stack for witness" ) ; first_pass_ledger_witness ; second_pass_ledger_witness ; block_global_slot @@ -108,7 +111,7 @@ module Transaction_with_witness = struct { transaction_with_status : Transaction.t With_status.t ; state_hash : State_hash.t * State_body_hash.t ; statement : Transaction_snark.Statement.t - ; init_stack : Transaction_snark.Pending_coinbase_stack_state.Init_stack.t + ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.t ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t @@ -389,7 +392,7 @@ let create_expected_statement ~constraint_constants ; state_hash ; first_pass_ledger_witness ; second_pass_ledger_witness - ; init_stack + ; init_stack = pending_coinbase_before ; statement ; block_global_slot ; previous_protocol_state_body_opt @@ -444,15 +447,6 @@ let create_expected_statement ~constraint_constants , target_second_pass_merkle_root , supply_increase ) in - let%bind pending_coinbase_before = - match init_stack with - | Base source -> - Ok source - | Merge -> - Or_error.errorf - !"Invalid init stack in Pending coinbase stack state . Expected Base \ - found Merge" - in let pending_coinbase_after = let state_body_hash = snd state_hash in let pending_coinbase_with_state = @@ -1442,22 +1436,15 @@ let single_spec_of_job ~get_state : ; block_global_slot ; previous_protocol_state_body_opt } -> - let%map.Or_error witness = - let%bind.Or_error protocol_state_body = - match previous_protocol_state_body_opt with - | Some protocol_state_body -> - Ok protocol_state_body - | None -> - 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 + let%map.Or_error protocol_state_body = + match previous_protocol_state_body_opt with + | Some protocol_state_body -> + Ok protocol_state_body + | None -> + get_state (fst state_hash) + |> Or_error.map ~f:Mina_state.Protocol_state.body + in + let witness = { Transaction_witness.first_pass_ledger = first_pass_ledger_witness ; second_pass_ledger = second_pass_ledger_witness ; transaction 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 b69ddfe23ec8..0c0be771e619 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 @@ -46,7 +46,7 @@ module Transaction_with_witness : sig { transaction_with_status : Transaction.t With_status.t ; state_hash : State_hash.t * State_body_hash.t ; statement : Transaction_snark.Statement.t - ; init_stack : Transaction_snark.Pending_coinbase_stack_state.Init_stack.t + ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.t ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t From 823760de308578616c43453db113e7f766557685 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 19 Nov 2025 19:37:49 +0100 Subject: [PATCH 012/122] Add comment about future modifications of scan state --- src/lib/transaction_snark/transaction_snark.ml | 5 +++++ .../transaction_snark_scan_state.ml | 2 ++ 2 files changed, 7 insertions(+) diff --git a/src/lib/transaction_snark/transaction_snark.ml b/src/lib/transaction_snark/transaction_snark.ml index 7ee65f8663db..b2f3d934e620 100644 --- a/src/lib/transaction_snark/transaction_snark.ml +++ b/src/lib/transaction_snark/transaction_snark.ml @@ -3538,6 +3538,11 @@ module Make_str (A : Wire_types.Concrete) = struct init_stack pending_coinbase_stack_state handler let verify_impl ~f ts = + (* TODO: move this check outside of verify_impl + Let's do it in Daemon, not verifier, and skip it entirely when + validating proofs from scan state (even when received + from the network, we simply don't need sok messages anymore) + *) if List.for_all ts ~f:(fun ((p : Stable.Latest.t), m) -> Sok_message.Digest.equal (Sok_message.digest m) p.data.sok_digest ) 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 9d3959b115c0..96a4195df951 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 @@ -23,6 +23,7 @@ module Transaction_with_witness = struct module Stable = struct [@@@no_toplevel_latest_type] + (* TODO In Mesa use Transaction_snark.Statement.t * Transaction_witness.t *) module V3 = struct type t = { transaction_with_status : @@ -168,6 +169,7 @@ module Transaction_with_witness = struct end module Ledger_proof_with_sok_message = struct + (* TODO In Mesa use Ledger_proof.t, no need for sok message *) [%%versioned module Stable = struct [@@@no_toplevel_latest_type] From 6f5026ca74aa8a5b61c409f225b76108473e64da Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 00:33:23 +0100 Subject: [PATCH 013/122] Add map_result for the scan tree --- src/lib/mina_stdlib/nonempty_list.ml | 9 +++ src/lib/mina_stdlib/nonempty_list.mli | 4 ++ src/lib/parallel_scan/parallel_scan.ml | 93 +++++++++++++++++++++++++ src/lib/parallel_scan/parallel_scan.mli | 6 ++ 4 files changed, 112 insertions(+) diff --git a/src/lib/mina_stdlib/nonempty_list.ml b/src/lib/mina_stdlib/nonempty_list.ml index 7ce5f8dc1fd6..0840b518c1a0 100644 --- a/src/lib/mina_stdlib/nonempty_list.ml +++ b/src/lib/mina_stdlib/nonempty_list.ml @@ -28,6 +28,15 @@ let tail_opt t = of_list_opt (tail t) let map (x, xs) ~f = (f x, List.map ~f xs) +let map_result (x, xs) ~f = + let%bind.Result x' = f x in + let%map.Result xs' = + List.fold_result xs ~init:[] ~f:(fun acc y -> + let%map.Result y' = f y in + y' :: acc ) + in + (x', List.rev xs') + let mapi (x, xs) ~f = (f 0 x, List.mapi ~f:(fun idx x -> f (idx + 1) x) xs) let rev (x, xs) = List.fold xs ~init:(singleton x) ~f:(Fn.flip cons) diff --git a/src/lib/mina_stdlib/nonempty_list.mli b/src/lib/mina_stdlib/nonempty_list.mli index 8375053b4902..b2d7fd290bdd 100644 --- a/src/lib/mina_stdlib/nonempty_list.mli +++ b/src/lib/mina_stdlib/nonempty_list.mli @@ -46,6 +46,10 @@ val tail_opt : 'a t -> 'a t option (** Apply a function to each element of the non empty list *) val map : 'a t -> f:('a -> 'b) -> 'b t +(** Apply a function to each element of the non empty list, returning [Error] if + * any of the function applications return [Error] *) +val map_result : 'a t -> f:('a -> ('b, 'e) Result.t) -> ('b t, 'e) Result.t + (** Apply a function to each element of the non empty list, along with its index starting from 0 *) val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t diff --git a/src/lib/parallel_scan/parallel_scan.ml b/src/lib/parallel_scan/parallel_scan.ml index 3a4dac17e28c..2715c2485328 100644 --- a/src/lib/parallel_scan/parallel_scan.ml +++ b/src/lib/parallel_scan/parallel_scan.ml @@ -75,6 +75,11 @@ module Base = struct end] let map (t : 'a t) ~(f : 'a -> 'b) : 'b t = { t with job = f t.job } + + let map_result (t : 'a t) ~(f : 'a -> ('b, 'e) Result.t) : + ('b t, 'e) Result.t = + let%map.Result job = f t.job in + { t with job } end module Job = struct @@ -89,6 +94,15 @@ module Base = struct let map (t : 'a t) ~(f : 'a -> 'b) : 'b t = match t with Empty -> Empty | Full r -> Full (Record.map r ~f) + let map_result (t : 'a t) ~(f : 'a -> ('b, 'e) Result.t) : + ('b t, 'e) Result.t = + match t with + | Empty -> + Ok Empty + | Full r -> + let%map.Result r = Record.map_result r ~f in + Full r + let job_str = function Empty -> "Base.Empty" | Full _ -> "Base.Full" end @@ -101,6 +115,11 @@ module Base = struct end] let map ((x, j) : 'a t) ~(f : 'a -> 'b) : 'b t = (x, Job.map j ~f) + + let map_result ((x, j) : 'a t) ~(f : 'a -> ('b, 'e) Result.t) : + ('b t, 'e) Result.t = + let%map.Result j = Job.map_result j ~f in + (x, j) end (** For merge proofs: Merging two base proofs or two merge proofs*) @@ -121,6 +140,12 @@ module Merge = struct let map (t : 'a t) ~(f : 'a -> 'b) : 'b t = { t with left = f t.left; right = f t.right } + + let map_result (t : 'a t) ~(f : 'a -> ('b, 'e) Result.t) : + ('b t, 'e) Result.t = + let%bind.Result left = f t.left in + let%map.Result right = f t.right in + { t with left; right } end module Job = struct @@ -144,6 +169,18 @@ module Merge = struct | Full r -> Full (Record.map r ~f) + let map_result (t : 'a t) ~(f : 'a -> ('b, 'e) Result.t) : + ('b t, 'e) Result.t = + match t with + | Empty -> + Ok Empty + | Part x -> + let%map.Result x = f x in + Part x + | Full r -> + let%map.Result r = Record.map_result r ~f in + Full r + let job_str = function | Empty -> "Merge.Empty" @@ -163,6 +200,11 @@ module Merge = struct end] let map ((x, j) : 'a t) ~(f : 'a -> 'b) : 'b t = (x, Job.map j ~f) + + let map_result ((x, j) : 'a t) ~(f : 'a -> ('b, 'e) Result.t) : + ('b t, 'e) Result.t = + let%bind.Result j = Job.map_result j ~f in + Ok (x, j) end (**All the jobs on a tree that can be done. Base.Full and Merge.Full*) @@ -288,6 +330,32 @@ module Tree = struct sub_tree } + let result_pair x y = + let%bind.Result x' = x in + let%map.Result y' = y in + (x', y') + + let rec map_depth_result : + type a_merge b_merge c_base d_base e. + f_merge:(int -> a_merge -> (b_merge, e) Result.t) + -> f_base:(c_base -> (d_base, e) Result.t) + -> (a_merge, c_base) t + -> ((b_merge, d_base) t, e) Result.t = + fun ~f_merge ~f_base tree -> + match tree with + | Leaf d -> + let%map.Result d' = f_base d in + Leaf d' + | Node { depth; value; sub_tree } -> + let%bind.Result value = f_merge depth value in + let%map.Result sub_tree = + map_depth_result + ~f_merge:(fun i (x, y) -> result_pair (f_merge i x) (f_merge i y)) + ~f_base:(fun (x, y) -> result_pair (f_base x) (f_base y)) + sub_tree + in + Node { depth; value; sub_tree } + let map : type a_merge b_merge c_base d_base. f_merge:(a_merge -> b_merge) @@ -929,6 +997,31 @@ module State = struct ; acc = Option.map t.acc ~f:(fun (m, bs) -> (f1 m, List.map bs ~f:f2)) } + let map_result (type a1 a2 b1 b2 e) (t : (a1, a2) t) + ~(f1 : a1 -> (b1, e) Result.t) ~(f2 : a2 -> (b2, e) Result.t) : + ((b1, b2) t, e) Result.t = + let%bind.Result trees = + Mina_stdlib.Nonempty_list.map_result t.trees + ~f: + (Tree.map_depth_result + ~f_merge:(fun _ -> Merge.map_result ~f:f1) + ~f_base:(Base.map_result ~f:f2) ) + in + let%map.Result acc = + match t.acc with + | None -> + Ok None + | Some (m, bs) -> + let%bind.Result m = f1 m in + let%map.Result bs = + List.fold_result bs ~init:[] ~f:(fun acc x -> + let%map.Result x' = f2 x in + x' :: acc ) + in + Some (m, List.rev bs) + in + { t with trees; acc } + let hash t f_merge f_base = let { trees; acc; max_base_jobs; curr_job_seq_no; delay; _ } = with_leaner_trees t diff --git a/src/lib/parallel_scan/parallel_scan.mli b/src/lib/parallel_scan/parallel_scan.mli index c740e5a0a1c2..012101c7cf09 100644 --- a/src/lib/parallel_scan/parallel_scan.mli +++ b/src/lib/parallel_scan/parallel_scan.mli @@ -210,6 +210,12 @@ module State : sig val map : ('a1, 'a2) t -> f1:('a1 -> 'b1) -> f2:('a2 -> 'b2) -> ('b1, 'b2) t + val map_result : + ('a1, 'a2) t + -> f1:('a1 -> ('b1, 'e) Result.t) + -> f2:('a2 -> ('b2, 'e) Result.t) + -> (('b1, 'b2) t, 'e) Result.t + module Hash : sig type t = Digestif.SHA256.t end From aac6c7c90bd416670f5c014932b860fb78600d44 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 14:48:24 +0100 Subject: [PATCH 014/122] Remove unused functions --- src/lib/mina_lib/mina_lib.ml | 5 ----- src/lib/mina_lib/mina_lib.mli | 2 -- src/lib/staged_ledger/staged_ledger.ml | 5 ----- src/lib/staged_ledger/staged_ledger.mli | 3 --- 4 files changed, 15 deletions(-) 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/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 499de1e9ce51..863fdf60cf98 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -464,11 +464,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" diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 6b249b6588be..6a6e9f58ab41 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -274,9 +274,6 @@ val apply_diff_unchecked : , 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 From 248d578cd37cfb06285fd8b4bd40d2510865cbca Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 14:50:54 +0100 Subject: [PATCH 015/122] Rename latest_ledger_proof{ -> _and_txs} --- src/lib/staged_ledger/staged_ledger.ml | 6 +++--- .../transaction_snark_scan_state.ml | 16 ++++++++-------- .../transaction_snark_scan_state.mli | 2 +- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 863fdf60cf98..e3f11d060c12 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -271,7 +271,7 @@ module T = struct } let proof_txns_with_state_hashes t = - Scan_state.latest_ledger_proof t.scan_state + Scan_state.latest_ledger_proof_and_txs t.scan_state |> Option.bind ~f:(Fn.compose Mina_stdlib.Nonempty_list.of_list_opt snd) let scan_state { scan_state; _ } = scan_state @@ -304,7 +304,7 @@ module T = struct let last_proof_statement = Option.map ~f:(fun ((p, _), _) -> Ledger_proof.Cached.statement p) - (Scan_state.latest_ledger_proof scan_state) + (Scan_state.latest_ledger_proof_and_txs scan_state) in Statement_scanner.check_invariants ~constraint_constants scan_state ~statement_check ~verifier:() ~error_prefix ~registers_end @@ -402,7 +402,7 @@ module T = struct expected_merkle_root staged_ledger_hash ) in let last_proof_statement = - Scan_state.latest_ledger_proof scan_state + Scan_state.latest_ledger_proof_and_txs scan_state |> Option.map ~f:(fun ((p, _), _) -> Ledger_proof.Cached.statement p) in f ~constraint_constants ~last_proof_statement ~ledger:snarked_ledger 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 96a4195df951..63acb5445773 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 @@ -940,7 +940,7 @@ let extract_txn_and_global_slot (txn_with_witness : Transaction_with_witness.t) let global_slot = txn_with_witness.block_global_slot in (txn, state_hash, global_slot) -let latest_ledger_proof' t = +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 @@ -969,15 +969,15 @@ let latest_ledger_proof' t = in (proof, txns) -let latest_ledger_proof t = - Option.map (latest_ledger_proof' t) ~f:(fun (p, txns) -> +let latest_ledger_proof_and_txs t = + Option.map (latest_ledger_proof_and_txs' t) ~f:(fun (p, txns) -> ( p , 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 -> @@ -1318,7 +1318,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) -> @@ -1330,7 +1330,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) -> @@ -1556,10 +1556,10 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = in (*This block is for when there's a proof emitted so Option. value_exn is safe here - [latest_ledger_proof] generates ordered transactions + [latest_ledger_proof_and_txs] generates ordered transactions appropriately*) let (proof, _), txns = - Option.value_exn (latest_ledger_proof scan_state') + Option.value_exn (latest_ledger_proof_and_txs scan_state') in Ok (Some (proof, txns), scan_state') | Error e -> 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 0c0be771e619..5a567cba853d 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 @@ -133,7 +133,7 @@ val fill_work_and_enqueue_transactions : * t ) Or_error.t -val latest_ledger_proof : +val latest_ledger_proof_and_txs : t -> ( Ledger_proof_with_sok_message.t * ( Transaction.t With_status.t From 6286ccdc80f37be063b84d610acdf09e63ce7f9f Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 15:05:00 +0100 Subject: [PATCH 016/122] Introduce latest_ledger_proof and use where applicable --- src/lib/staged_ledger/staged_ledger.ml | 9 ++++----- .../transaction_snark_scan_state.ml | 6 ++++++ .../transaction_snark_scan_state.mli | 2 ++ 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index e3f11d060c12..08a7f4f1b547 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -302,9 +302,8 @@ module T = struct in let statement_check = `Partial in let last_proof_statement = - Option.map - ~f:(fun ((p, _), _) -> Ledger_proof.Cached.statement p) - (Scan_state.latest_ledger_proof_and_txs scan_state) + 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 @@ -402,8 +401,8 @@ module T = struct expected_merkle_root staged_ledger_hash ) in let last_proof_statement = - Scan_state.latest_ledger_proof_and_txs scan_state - |> Option.map ~f:(fun ((p, _), _) -> Ledger_proof.Cached.statement p) + Scan_state.latest_ledger_proof scan_state + |> Option.map ~f:Ledger_proof.Cached.statement in f ~constraint_constants ~last_proof_statement ~ledger:snarked_ledger ~scan_state ~pending_coinbase_collection:pending_coinbases 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 63acb5445773..15f98c7ea054 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 @@ -940,6 +940,12 @@ let extract_txn_and_global_slot (txn_with_witness : Transaction_with_witness.t) let global_slot = txn_with_witness.block_global_slot in (txn, state_hash, global_slot) +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 = 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 5a567cba853d..87018efe4ccc 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 @@ -133,6 +133,8 @@ val fill_work_and_enqueue_transactions : * t ) Or_error.t +val latest_ledger_proof : t -> Ledger_proof.Cached.t option + val latest_ledger_proof_and_txs : t -> ( Ledger_proof_with_sok_message.t From 6eb7c39c7a69283169d627794afeb02fc681d227 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 15:11:58 +0100 Subject: [PATCH 017/122] Simplify type of fill_work_and_enqueue_transactions --- src/lib/block_producer/block_producer.ml | 6 +++--- src/lib/mina_block/validation.ml | 2 +- src/lib/staged_ledger/staged_ledger.ml | 15 ++++----------- src/lib/staged_ledger/staged_ledger.mli | 18 ++---------------- .../transaction_snark_scan_state.ml | 5 +---- .../transaction_snark_scan_state.mli | 10 +--------- .../frontier_base/breadcrumb.ml | 3 +-- 7 files changed, 13 insertions(+), 46 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 09eec46b7e12..8a021d5111a6 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -360,7 +360,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 = @@ -375,7 +375,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 @@ -426,7 +426,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/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 48292166d860..387022ce3871 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -548,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 diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 08a7f4f1b547..8291b3338d65 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -974,7 +974,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 @@ -2711,17 +2711,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) @@ -2849,7 +2842,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 diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 6a6e9f58ab41..fa914f1f91d3 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -234,14 +234,7 @@ 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 ] @@ -260,14 +253,7 @@ 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 ] 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 15f98c7ea054..42a3ab180369 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 @@ -1564,10 +1564,7 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = value_exn is safe here [latest_ledger_proof_and_txs] generates ordered transactions appropriately*) - let (proof, _), txns = - Option.value_exn (latest_ledger_proof_and_txs 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 87018efe4ccc..a052c13e9852 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 @@ -123,15 +123,7 @@ 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 diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 8df4f624eee1..4701f8f05390 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -450,8 +450,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 = From d25221c6daaaa4406189a7d36c94ee37a3423757 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 15:17:36 +0100 Subject: [PATCH 018/122] Change function latest_ledger_proof_{and_ -> }txs --- src/lib/staged_ledger/staged_ledger.ml | 4 ++-- .../transaction_snark_scan_state.ml | 10 ++++------ .../transaction_snark_scan_state.mli | 13 ++++++------- 3 files changed, 12 insertions(+), 15 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 8291b3338d65..ef2edfc01352 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -271,8 +271,8 @@ module T = struct } let proof_txns_with_state_hashes t = - Scan_state.latest_ledger_proof_and_txs 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 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 42a3ab180369..df53d8aaf23f 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 @@ -975,11 +975,9 @@ let latest_ledger_proof_and_txs' t = in (proof, txns) -let latest_ledger_proof_and_txs t = - Option.map (latest_ledger_proof_and_txs' 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 @@ -1562,7 +1560,7 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = in (*This block is for when there's a proof emitted so Option. value_exn is safe here - [latest_ledger_proof_and_txs] generates ordered transactions + [latest_ledger_proof] generates ordered transactions appropriately*) Ok (latest_ledger_proof scan_state', scan_state') | Error e -> 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 a052c13e9852..4c8323f1b612 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 @@ -127,14 +127,13 @@ val fill_work_and_enqueue_transactions : val latest_ledger_proof : t -> Ledger_proof.Cached.t option -val latest_ledger_proof_and_txs : +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 From c2a05fa870427b018c766f4a1d3591591fb821e8 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 16:12:53 +0100 Subject: [PATCH 019/122] Move Transaction_type to a standalone module --- src/lib/snark_work_lib/metrics.ml | 17 +---------------- src/lib/transaction/transaction_type.ml | 12 ++++++++++++ 2 files changed, 13 insertions(+), 16 deletions(-) create mode 100644 src/lib/transaction/transaction_type.ml 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/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 From 2b284f949abdb5286b8082857c64683b1a5fdac7 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 16:13:08 +0100 Subject: [PATCH 020/122] Refactor first_and_second_pass_transactions_per_tree Introduce a functor to allow usage of functionality with different transactiuon representations. Rename {first_and_second_pass -> categorize}_transactions_xx --- .../transaction_snark_scan_state.ml | 189 ++++++++++-------- .../transaction_snark_scan_state.mli | 11 + 2 files changed, 119 insertions(+), 81 deletions(-) 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 df53d8aaf23f..b960601d5119 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 @@ -851,88 +851,113 @@ module Transactions_ordered = struct let init = List.fold ~init t.previous_incomplete ~f in let init = List.fold ~init t.second_pass ~f in List.fold ~init t.current_incomplete ~f +end - let first_and_second_pass_transactions_per_tree ~previous_incomplete - (txns_per_tree : Transaction_with_witness.t list) = - let complete_and_incomplete_transactions = function - | [] -> - None - | (h : Transaction_with_witness.t) :: _ as txns_with_witnesses -> - let target_first_pass_ledger = h.statement.source.first_pass_ledger in - let first_pass_txns, second_pass_txns, target_first_pass_ledger = - let first_pass_txns, second_pass_txns, target_first_pass_ledger = - List.fold ~init:([], [], target_first_pass_ledger) - txns_with_witnesses - ~f:(fun - (first_pass_txns, second_pass_txns, _old_root) - (txn_with_witness : Transaction_with_witness.t) - -> - let txn = - With_status.data txn_with_witness.transaction_with_status - in - let target_first_pass_ledger = - txn_with_witness.statement.target.first_pass_ledger - in - match txn with - | Transaction.Coinbase _ - | Fee_transfer _ - | Command (User_command.Signed_command _) -> - ( txn_with_witness :: first_pass_txns - , second_pass_txns - , target_first_pass_ledger ) - | Command (Zkapp_command _) -> - ( txn_with_witness :: first_pass_txns - , txn_with_witness :: second_pass_txns - , target_first_pass_ledger ) ) - in - ( List.rev first_pass_txns - , List.rev second_pass_txns - , target_first_pass_ledger ) - in - let second_pass_txns, incomplete_txns = - match List.hd second_pass_txns with - | None -> - ([], []) - | Some txn_with_witness -> - if - Frozen_ledger_hash.equal - txn_with_witness.statement.source.second_pass_ledger - target_first_pass_ledger - then - (*second pass completed in the same tree*) - (second_pass_txns, []) - else ([], second_pass_txns) - in - let previous_incomplete = - match previous_incomplete with - | [] -> - [] - | (t : Transaction_with_witness.t) :: _ -> - if State_hash.equal (fst t.state_hash) (fst h.state_hash) then - (*same block*) - previous_incomplete - else [] - in - Some - { Poly.first_pass = first_pass_txns - ; second_pass = second_pass_txns - ; current_incomplete = incomplete_txns - ; previous_incomplete - } +module Make_transaction_categorizer (Tx : sig + type t + + val source_first_pass_ledger : t -> Ledger_hash.t + + val source_second_pass_ledger : t -> Ledger_hash.t + + val target_first_pass_ledger : t -> Ledger_hash.t + + val transaction_type : t -> Mina_transaction.Transaction_type.t + + val of_same_block : t -> t -> bool +end) = +struct + let txns_by_block txns_per_tree = + List.group txns_per_tree ~break:(fun t1 t2 -> not (Tx.of_same_block t1 t2)) + |> List.filter_map ~f:Mina_stdlib.Nonempty_list.of_list_opt + + let fold_tx (first_pass_txns, second_pass_txns, _old_root) txn = + let target_first_pass_ledger = Tx.target_first_pass_ledger txn in + match Tx.transaction_type txn with + | `Coinbase | `Fee_transfer | `Signed_command -> + (txn :: first_pass_txns, second_pass_txns, target_first_pass_ledger) + | `Zkapp_command -> + ( txn :: first_pass_txns + , txn :: second_pass_txns + , target_first_pass_ledger ) + + (** Compoutes representation for the sequence of transactions extracted from scan state + when it emitted a proof, split into: + + * [first_pass] - transactions that went through first pass + * [second_pass] - transactions that went through second pass and correspond + to the current ledger proof (subset of first pass group) + * [current_incomplete] - transactions that went through second pass and correspond + to the the next ledger proof (subset of first pass group) + * [previous_incomplete] - leftover from previous ledger proof emitted with + the current ledger proof (not intersecting with other groups) + Received as a parameter and passed through if the first transaction in it + belongs to the same block as the first transaction in [txns_with_witnesses_non_empty]. + *) + let categorize_transactions ~previous_incomplete txns_non_empty = + let first_txn = Mina_stdlib.Nonempty_list.head txns_non_empty in + let txns = Mina_stdlib.Nonempty_list.to_list txns_non_empty in + let init = ([], [], Tx.source_first_pass_ledger first_txn) in + let first_pass_txns, second_pass_txns, target_first_pass_ledger = + let first_pass_txns_rev, second_pass_txns_rev, target_first_pass_ledger = + List.fold ~init txns ~f:fold_tx + in + ( List.rev first_pass_txns_rev + , List.rev second_pass_txns_rev + , target_first_pass_ledger ) in - let txns_by_block (txns_per_tree : Transaction_with_witness.t list) = - List.group txns_per_tree ~break:(fun t1 t2 -> - State_hash.equal (fst t1.state_hash) (fst t2.state_hash) |> not ) + let second_pass_txns, incomplete_txns = + match List.hd second_pass_txns with + | None -> + ([], []) + | Some txn -> + if + Frozen_ledger_hash.equal + (Tx.source_second_pass_ledger txn) + target_first_pass_ledger + then (*second pass completed in the same tree*) + (second_pass_txns, []) + else ([], second_pass_txns) in - List.filter_map ~f:complete_and_incomplete_transactions + let previous_incomplete = + match previous_incomplete with + | t :: _ when Tx.of_same_block t first_txn -> + previous_incomplete + | _ -> + [] + in + { Transactions_ordered.Poly.first_pass = first_pass_txns + ; second_pass = second_pass_txns + ; current_incomplete = incomplete_txns + ; previous_incomplete + } + + let categorize_transactions_per_tree ~previous_incomplete txns_per_tree = + List.map (txns_by_block txns_per_tree) + ~f:(categorize_transactions ~previous_incomplete) - let first_and_second_pass_transactions_per_forest scan_state_txns - ~previous_incomplete = + let categorize_transactions_per_forest scan_state_txns ~previous_incomplete = List.map scan_state_txns - ~f:(first_and_second_pass_transactions_per_tree ~previous_incomplete) + ~f:(categorize_transactions_per_tree ~previous_incomplete) end +module Witness_categorizer = Make_transaction_categorizer (struct + include Transaction_with_witness + + let source_first_pass_ledger t = t.statement.source.first_pass_ledger + + let source_second_pass_ledger t = t.statement.source.second_pass_ledger + + let target_first_pass_ledger t = t.statement.target.first_pass_ledger + + let transaction_type t = + Transaction_type.of_transaction (With_status.data t.transaction_with_status) + + let of_same_block t1 t2 = + State_hash.equal (fst t1.state_hash) (fst t2.state_hash) +end) + let extract_txn_and_global_slot (txn_with_witness : Transaction_with_witness.t) = let txn = txn_with_witness.transaction_with_status in @@ -957,12 +982,12 @@ let latest_ledger_proof_and_txs' t = in let txns = if continued_in_next_tree then - Transactions_ordered.first_and_second_pass_transactions_per_tree - txns_with_witnesses ~previous_incomplete + Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses + ~previous_incomplete else let txns = - Transactions_ordered.first_and_second_pass_transactions_per_tree - txns_with_witnesses ~previous_incomplete:[] + Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses + ~previous_incomplete:[] in if List.is_empty previous_incomplete then txns else @@ -987,7 +1012,9 @@ let incomplete_txns_from_recent_proof_tree t = | None -> ([], `Border_block_continued_in_the_next_tree false) | Some txns_in_last_block -> - (*First pass ledger is considered as the snarked ledger, so any account update whether completed in the same tree or not should be included in the next tree *) + (* First pass ledger is considered as the snarked ledger, + so any account update whether completed in the same tree + or not should be included in the next tree *) if not (List.is_empty txns_in_last_block.second_pass) then ( txns_in_last_block.second_pass , `Border_block_continued_in_the_next_tree false ) @@ -1007,12 +1034,12 @@ let staged_transactions t = in let txns = if continued_in_next_tree then - Transactions_ordered.first_and_second_pass_transactions_per_forest + Witness_categorizer.categorize_transactions_per_forest (Parallel_scan.pending_data t.scan_state) ~previous_incomplete else let txns = - Transactions_ordered.first_and_second_pass_transactions_per_forest + Witness_categorizer.categorize_transactions_per_forest (Parallel_scan.pending_data t.scan_state) ~previous_incomplete:[] in 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 4c8323f1b612..032fb7fa299e 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 @@ -103,6 +103,17 @@ end module Transactions_ordered : sig module Poly : sig + (** Represents sequence of transactions extracted from scan state + when it emitted a proof, split into: + + * [first_pass] - transactions that went through first pass + * [second_pass] - transactions that went through second pass and correspond + to the current ledger proof (subset of first pass group) + * [current_incomplete] - transactions that went through second pass and correspond + to the the next ledger proof (subset of first pass group) + * [previous_incomplete] - leftover from previous ledger proof emitted with + the current ledger proof (not intersecting with other groups) + *) type 'a t = { first_pass : 'a list ; second_pass : 'a list From 496b261d8faea3520f5160c7464090444707cb9b Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 16:22:39 +0100 Subject: [PATCH 021/122] Rename Transactions_{ordered -> categorized} --- src/lib/staged_ledger/staged_ledger.mli | 6 +- .../transaction_snark_scan_state.ml | 65 ++++++++++--------- .../transaction_snark_scan_state.mli | 6 +- 3 files changed, 39 insertions(+), 38 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index fa914f1f91d3..26561c437442 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -43,7 +43,7 @@ module Scan_state : sig [@@deriving sexp] end - module Transactions_ordered : sig + module Transactions_categorized : sig module Poly : sig type 'a t = { first_pass : 'a list @@ -70,7 +70,7 @@ module Scan_state : sig -> ( Transaction.t With_status.t * State_hash.t * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_ordered.Poly.t + Transactions_categorized.Poly.t list (** Statements of all the pending work. Fails if there are any invalid @@ -206,7 +206,7 @@ val proof_txns_with_state_hashes : -> ( Transaction.t With_status.t * State_hash.t * Mina_numbers.Global_slot_since_genesis.t ) - Scan_state.Transactions_ordered.Poly.t + Scan_state.Transactions_categorized.Poly.t Mina_stdlib.Nonempty_list.t option 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 b960601d5119..73af90ff67e4 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 @@ -825,7 +825,7 @@ let empty ~(constraint_constants : Genesis_constants.Constraint_constants.t) () create ~work_delay:constraint_constants.work_delay ~transaction_capacity_log_2:constraint_constants.transaction_capacity_log_2 -module Transactions_ordered = struct +module Transactions_categorized = struct module Poly = struct type 'a t = { first_pass : 'a list @@ -926,7 +926,7 @@ struct | _ -> [] in - { Transactions_ordered.Poly.first_pass = first_pass_txns + { Transactions_categorized.Poly.first_pass = first_pass_txns ; second_pass = second_pass_txns ; current_incomplete = incomplete_txns ; previous_incomplete @@ -991,7 +991,7 @@ let latest_ledger_proof_and_txs' t = in if List.is_empty previous_incomplete then txns else - { Transactions_ordered.Poly.first_pass = [] + { Transactions_categorized.Poly.first_pass = [] ; second_pass = [] ; previous_incomplete ; current_incomplete = [] @@ -1002,7 +1002,8 @@ let latest_ledger_proof_and_txs' t = 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) ) + List.map txns + ~f:(Transactions_categorized.map ~f:extract_txn_and_global_slot) ) let incomplete_txns_from_recent_proof_tree t = let open Option.Let_syntax in @@ -1045,7 +1046,7 @@ let staged_transactions t = in if List.is_empty previous_incomplete then txns else - [ { Transactions_ordered.Poly.first_pass = [] + [ { Transactions_categorized.Poly.first_pass = [] ; second_pass = [] ; previous_incomplete ; current_incomplete = [] @@ -1059,12 +1060,12 @@ let staged_transactions t = let staged_transactions_with_state_hash t = let pending_transactions_per_block = staged_transactions t in List.map pending_transactions_per_block - ~f:(Transactions_ordered.map ~f:extract_txn_and_global_slot) + ~f:(Transactions_categorized.map ~f:extract_txn_and_global_slot) (* written in continuation passing style so that implementation can be used both sync and async *) -let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns - ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass - ~apply_first_pass_sparse_ledger = +let apply_categorized_txns_stepwise ?(stop_at_first_pass = false) + categorized_txns ~ledger ~get_protocol_state ~apply_first_pass + ~apply_second_pass ~apply_first_pass_sparse_ledger = let open Or_error.Let_syntax in let module Previous_incomplete_txns = struct type t = @@ -1230,7 +1231,7 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns apply_txns_second_pass partially_applied_txns ~k in let rec apply_txns (previous_incomplete : Previous_incomplete_txns.t) - (ordered_txns : _ Transactions_ordered.Poly.t list) + (categorized_txns : _ Transactions_categorized.Poly.t list) ~first_pass_ledger_hash ~signature_kind = let previous_incomplete = (*filter out any non-zkapp transactions for second pass application*) @@ -1248,7 +1249,7 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns (List.filter txns ~f:(fun (_, t) -> match t with Zkapp_command _ -> true | _ -> false ) ) in - match ordered_txns with + match categorized_txns with | [] -> apply_previous_incomplete_txns ~signature_kind ~k:(fun () -> Ok (`Complete first_pass_ledger_hash)) @@ -1262,7 +1263,7 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns previous_incomplete txns will be applied when processing the first set. The subsequent sets shouldn’t have any previous-incomplete.*) apply_txns (Unapplied []) [] ~first_pass_ledger_hash ~signature_kind ) - | txns_per_block :: ordered_txns' -> + | txns_per_block :: categorized_txns' -> (*Apply first pass of a blocks transactions either new or continued from previous tree*) apply_txns_first_pass txns_per_block.first_pass ~k:(fun first_pass_ledger_hash partially_applied_txns -> @@ -1288,17 +1289,17 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns in if do_second_pass then apply_txns_second_pass partially_applied_txns ~k:(fun () -> - apply_txns (Unapplied []) ordered_txns' + apply_txns (Unapplied []) categorized_txns' ~first_pass_ledger_hash ~signature_kind ) else (*Transactions not completed in this tree, so second pass after first pass of remaining transactions for the same block in the next tree*) apply_txns (Partially_applied partially_applied_txns) - ordered_txns' ~first_pass_ledger_hash ~signature_kind ) ) + categorized_txns' ~first_pass_ledger_hash ~signature_kind ) ) in let previous_incomplete = - Option.value_map (List.hd ordered_txns) + Option.value_map (List.hd categorized_txns) ~default:(Previous_incomplete_txns.Unapplied []) - ~f:(fun (first_block : Transactions_ordered.t) -> + ~f:(fun (first_block : Transactions_categorized.t) -> Unapplied first_block.previous_incomplete ) in (*Assuming this function is called on snarked ledger and snarked ledger is the @@ -1306,9 +1307,9 @@ let apply_ordered_txns_stepwise ?(stop_at_first_pass = false) ordered_txns let first_pass_ledger_hash = `First_pass_ledger_hash (Ledger.merkle_root ledger) in - apply_txns previous_incomplete ordered_txns ~first_pass_ledger_hash + apply_txns previous_incomplete categorized_txns ~first_pass_ledger_hash -let apply_ordered_txns_sync ?stop_at_first_pass ordered_txns ~ledger +let apply_categorized_txns_sync ?stop_at_first_pass categorized_txns ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind = let rec run = function @@ -1320,11 +1321,11 @@ let apply_ordered_txns_sync ?stop_at_first_pass ordered_txns ~ledger Error err in run - @@ apply_ordered_txns_stepwise ?stop_at_first_pass ordered_txns ~ledger - ~get_protocol_state ~apply_first_pass ~apply_second_pass + @@ apply_categorized_txns_stepwise ?stop_at_first_pass categorized_txns + ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind -let apply_ordered_txns_async ?stop_at_first_pass ordered_txns +let apply_categorized_txns_async ?stop_at_first_pass categorized_txns ?(async_batch_size = 10) ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind = let open Deferred.Result.Let_syntax in @@ -1343,8 +1344,8 @@ let apply_ordered_txns_async ?stop_at_first_pass ordered_txns Deferred.return (Error err) in run - @@ apply_ordered_txns_stepwise ?stop_at_first_pass ordered_txns ~ledger - ~get_protocol_state ~apply_first_pass ~apply_second_pass + @@ apply_categorized_txns_stepwise ?stop_at_first_pass categorized_txns + ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind let get_snarked_ledger_sync ~ledger ~get_protocol_state ~apply_first_pass @@ -1353,8 +1354,8 @@ let get_snarked_ledger_sync ~ledger ~get_protocol_state ~apply_first_pass | None -> Or_error.errorf "No transactions found" | Some (_, txns_per_block) -> - apply_ordered_txns_sync ~stop_at_first_pass:true txns_per_block ~ledger - ~get_protocol_state ~apply_first_pass ~apply_second_pass + apply_categorized_txns_sync ~stop_at_first_pass:true txns_per_block + ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind |> Or_error.ignore_m @@ -1365,7 +1366,7 @@ let get_snarked_ledger_async ?async_batch_size ~ledger ~get_protocol_state | None -> Deferred.Or_error.errorf "No transactions found" | Some (_, txns_per_block) -> - apply_ordered_txns_async ~stop_at_first_pass:true txns_per_block + apply_categorized_txns_async ~stop_at_first_pass:true txns_per_block ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind |> Deferred.Or_error.ignore_m @@ -1374,9 +1375,9 @@ let get_staged_ledger_async ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind t = let staged_transactions_with_state_hash = staged_transactions t in - apply_ordered_txns_async staged_transactions_with_state_hash ?async_batch_size - ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass - ~apply_first_pass_sparse_ledger ~signature_kind + apply_categorized_txns_async staged_transactions_with_state_hash + ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass + ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind let free_space t = Parallel_scan.free_space t.scan_state @@ -1587,7 +1588,7 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = in (*This block is for when there's a proof emitted so Option. value_exn is safe here - [latest_ledger_proof] generates ordered transactions + [latest_ledger_proof] generates categorized transactions appropriately*) Ok (latest_ledger_proof scan_state', scan_state') | Error e -> @@ -1600,8 +1601,8 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = let required_state_hashes t = List.fold ~init:State_hash.Set.empty - ~f:(fun acc (txns : Transactions_ordered.t) -> - Transactions_ordered.fold ~init:acc txns + ~f:(fun acc (txns : Transactions_categorized.t) -> + Transactions_categorized.fold ~init:acc txns ~f:(fun acc (t : Transaction_with_witness.t) -> Set.add acc (fst t.state_hash) ) ) (staged_transactions t) 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 032fb7fa299e..2949126a433c 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 @@ -101,7 +101,7 @@ end) : sig -> (unit, Error.t) Deferred.Result.t end -module Transactions_ordered : sig +module Transactions_categorized : sig module Poly : sig (** Represents sequence of transactions extracted from scan state when it emitted a proof, split into: @@ -143,7 +143,7 @@ val latest_ledger_proof_txs : -> ( Transaction.t With_status.t * State_hash.t * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_ordered.Poly.t + Transactions_categorized.Poly.t list option @@ -252,7 +252,7 @@ val staged_transactions_with_state_hash : -> ( Transaction.t With_status.t * State_hash.t * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_ordered.Poly.t + Transactions_categorized.Poly.t list (** Available space and the corresponding required work-count in one and/or two trees (if the slots to be occupied are in two different trees)*) From d4e5065761198019678ea25ca26c85c7b4343e37 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 16:33:44 +0100 Subject: [PATCH 022/122] Simplify latest_ledger_proof_and_txs' --- .../transaction_snark_scan_state.ml | 22 ++++++++----------- 1 file changed, 9 insertions(+), 13 deletions(-) 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 73af90ff67e4..f8d828d1610b 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 @@ -981,23 +981,19 @@ let latest_ledger_proof_and_txs' t = t.previous_incomplete_zkapp_updates in let txns = - if continued_in_next_tree then + if continued_in_next_tree || List.is_empty previous_incomplete then Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses ~previous_incomplete else - let txns = - Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses - ~previous_incomplete:[] - in - if List.is_empty previous_incomplete then txns - else - { Transactions_categorized.Poly.first_pass = [] - ; second_pass = [] - ; previous_incomplete - ; current_incomplete = [] - } - :: txns + { Transactions_categorized.Poly.first_pass = [] + ; second_pass = [] + ; previous_incomplete + ; current_incomplete = [] + } + :: Witness_categorizer.categorize_transactions_per_tree + txns_with_witnesses ~previous_incomplete:[] in + (proof, txns) let latest_ledger_proof_txs t = From ec9f0015c8e3f995a6d41d8d9ab4af2b0a781bd1 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 16:51:53 +0100 Subject: [PATCH 023/122] Refactor incomplete_txns_from_recent_proof_tree --- .../transaction_snark_scan_state.ml | 31 ++++++++----------- 1 file changed, 13 insertions(+), 18 deletions(-) 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 f8d828d1610b..0e70644fb662 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 @@ -1002,24 +1002,19 @@ let latest_ledger_proof_txs t = ~f:(Transactions_categorized.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_and_txs' t in - let txns = - match List.last txns_per_block with - | None -> - ([], `Border_block_continued_in_the_next_tree false) - | Some txns_in_last_block -> - (* First pass ledger is considered as the snarked ledger, - so any account update whether completed in the same tree - or not should be included in the next tree *) - if not (List.is_empty txns_in_last_block.second_pass) then - ( txns_in_last_block.second_pass - , `Border_block_continued_in_the_next_tree false ) - else - ( txns_in_last_block.current_incomplete - , `Border_block_continued_in_the_next_tree true ) + let%bind.Option (proof, _), txns_per_block = latest_ledger_proof_and_txs' t in + let%map.Option txns_in_last_block = List.last txns_per_block in + (* First pass ledger is considered as the snarked ledger, + so any account update whether completed in the same tree + or not should be included in the next tree *) + let second_pass_is_empty = List.is_empty txns_in_last_block.second_pass in + let incomplete = + if second_pass_is_empty then txns_in_last_block.current_incomplete + else txns_in_last_block.second_pass in - (proof, txns) + ( proof + , (incomplete, `Border_block_continued_in_the_next_tree second_pass_is_empty) + ) let staged_transactions t = let ( previous_incomplete @@ -1562,7 +1557,7 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = ~default: (curr_stmt, ([], `Border_block_continued_in_the_next_tree false)) old_proof_and_incomplete_zkapp_updates - ~f:(fun ((p', _), incomplete_zkapp_updates_from_old_proof) -> + ~f:(fun (p', incomplete_zkapp_updates_from_old_proof) -> ( Ledger_proof.Cached.statement p' , incomplete_zkapp_updates_from_old_proof ) ) in From 9083e6aa10f24b2ab7d55a2ae21411459ab8c8fa Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 17:02:07 +0100 Subject: [PATCH 024/122] Simplify incomplete_txns_from_recent_proof_tree --- .../transaction_snark_scan_state.ml | 21 ++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) 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 0e70644fb662..d970d1feab8a 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 @@ -932,6 +932,13 @@ struct ; previous_incomplete } + let second_pass_last_block txns_per_tree = + let%map.Option last_group = List.last (txns_by_block txns_per_tree) in + let { Transactions_categorized.Poly.second_pass; current_incomplete; _ } = + categorize_transactions ~previous_incomplete:[] last_group + in + (`Second_pass second_pass, `Current_incomplete current_incomplete) + let categorize_transactions_per_tree ~previous_incomplete txns_per_tree = List.map (txns_by_block txns_per_tree) @@ -1002,15 +1009,19 @@ let latest_ledger_proof_txs t = ~f:(Transactions_categorized.map ~f:extract_txn_and_global_slot) ) let incomplete_txns_from_recent_proof_tree t = - let%bind.Option (proof, _), txns_per_block = latest_ledger_proof_and_txs' t in - let%map.Option txns_in_last_block = List.last txns_per_block in + let%bind.Option (proof, _), txns_with_witnesses = + Parallel_scan.last_emitted_value t.scan_state + in + let%map.Option ( `Second_pass second_pass + , `Current_incomplete current_incomplete ) = + Witness_categorizer.second_pass_last_block txns_with_witnesses + in (* First pass ledger is considered as the snarked ledger, so any account update whether completed in the same tree or not should be included in the next tree *) - let second_pass_is_empty = List.is_empty txns_in_last_block.second_pass in + let second_pass_is_empty = List.is_empty second_pass in let incomplete = - if second_pass_is_empty then txns_in_last_block.current_incomplete - else txns_in_last_block.second_pass + if second_pass_is_empty then current_incomplete else second_pass in ( proof , (incomplete, `Border_block_continued_in_the_next_tree second_pass_is_empty) From 1b0a53954728c2cd3238f03eee2b868503c4a202 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 17:36:00 +0100 Subject: [PATCH 025/122] Remove some unused functions and defs --- src/lib/staged_ledger/staged_ledger.ml | 4 -- src/lib/staged_ledger/staged_ledger.mli | 34 --------------- .../transaction_snark_scan_state.ml | 37 ++++++---------- .../transaction_snark_scan_state.mli | 43 ------------------- 4 files changed, 14 insertions(+), 104 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index ef2edfc01352..9a2899c9c8af 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -270,10 +270,6 @@ module T = struct ; pending_coinbase_collection : Pending_coinbase.t } - let proof_txns_with_state_hashes t = - 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 let all_work_pairs t diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 26561c437442..6f0e33a08455 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -43,36 +43,12 @@ module Scan_state : sig [@@deriving sexp] end - module Transactions_categorized : sig - module Poly : sig - type 'a t = - { first_pass : 'a list - ; second_pass : 'a list - ; previous_incomplete : 'a list - ; current_incomplete : 'a list - } - [@@deriving sexp, to_yojson] - end - - type t = Transaction_snark_scan_state.Transaction_with_witness.t Poly.t - end - val empty : constraint_constants:Genesis_constants.Constraint_constants.t -> unit -> t (** Statements of the required snark work *) val snark_job_list_json : t -> string - (** All the transactions with hash of the parent block in which they were - included in the order in which they were applied *) - val staged_transactions_with_state_hash : - t - -> ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_categorized.Poly.t - list - (** Statements of all the pending work. Fails if there are any invalid statements in the scan state [t] *) val all_work_statements_exn : t -> Transaction_snark_work.Statement.t list @@ -200,16 +176,6 @@ val create_exn : val replace_ledger_exn : t -> Ledger.t -> t -(** Transactions corresponding to the most recent ledger proof in t *) -val proof_txns_with_state_hashes : - t - -> ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Scan_state.Transactions_categorized.Poly.t - Mina_stdlib.Nonempty_list.t - option - val copy : t -> t val hash : t -> Staged_ledger_hash.t 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 d970d1feab8a..f7637eb81ae9 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 @@ -827,6 +827,17 @@ let empty ~(constraint_constants : Genesis_constants.Constraint_constants.t) () module Transactions_categorized = struct module Poly = struct + (** Represents sequence of transactions extracted from scan state + when it emitted a proof, split into: + + * [first_pass] - transactions that went through first pass + * [second_pass] - transactions that went through second pass and correspond + to the current ledger proof (subset of first pass group) + * [current_incomplete] - transactions that went through second pass and correspond + to the the next ledger proof (subset of first pass group) + * [previous_incomplete] - leftover from previous ledger proof emitted with + the current ledger proof (not intersecting with other groups) + *) type 'a t = { first_pass : 'a list ; second_pass : 'a list @@ -838,14 +849,6 @@ module Transactions_categorized = struct type t = Transaction_with_witness.t Poly.t - let map (t : 'a Poly.t) ~f : 'b Poly.t = - let f = List.map ~f in - { Poly.first_pass = f t.first_pass - ; second_pass = f t.second_pass - ; previous_incomplete = f t.previous_incomplete - ; current_incomplete = f t.current_incomplete - } - let fold (t : 'a Poly.t) ~f ~init = let init = List.fold ~init t.first_pass ~f in let init = List.fold ~init t.previous_incomplete ~f in @@ -1003,11 +1006,6 @@ let latest_ledger_proof_and_txs' t = (proof, txns) -let latest_ledger_proof_txs t = - Option.map (latest_ledger_proof_and_txs' t) ~f:(fun (_, txns) -> - List.map txns - ~f:(Transactions_categorized.map ~f:extract_txn_and_global_slot) ) - let incomplete_txns_from_recent_proof_tree t = let%bind.Option (proof, _), txns_with_witnesses = Parallel_scan.last_emitted_value t.scan_state @@ -1058,12 +1056,6 @@ let staged_transactions t = in List.concat txns -(*All the transactions in the order in which they were applied along with the parent protocol state of the blocks that contained them*) -let staged_transactions_with_state_hash t = - let pending_transactions_per_block = staged_transactions t in - List.map pending_transactions_per_block - ~f:(Transactions_categorized.map ~f:extract_txn_and_global_slot) - (* written in continuation passing style so that implementation can be used both sync and async *) let apply_categorized_txns_stepwise ?(stop_at_first_pass = false) categorized_txns ~ledger ~get_protocol_state ~apply_first_pass @@ -1376,10 +1368,9 @@ let get_snarked_ledger_async ?async_batch_size ~ledger ~get_protocol_state let get_staged_ledger_async ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind t = - let staged_transactions_with_state_hash = staged_transactions t in - apply_categorized_txns_async staged_transactions_with_state_hash - ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass - ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind + apply_categorized_txns_async (staged_transactions t) ?async_batch_size ~ledger + ~get_protocol_state ~apply_first_pass ~apply_second_pass + ~apply_first_pass_sparse_ledger ~signature_kind let free_space t = Parallel_scan.free_space t.scan_state 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 2949126a433c..e30b9ae5909e 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 @@ -101,31 +101,6 @@ end) : sig -> (unit, Error.t) Deferred.Result.t end -module Transactions_categorized : sig - module Poly : sig - (** Represents sequence of transactions extracted from scan state - when it emitted a proof, split into: - - * [first_pass] - transactions that went through first pass - * [second_pass] - transactions that went through second pass and correspond - to the current ledger proof (subset of first pass group) - * [current_incomplete] - transactions that went through second pass and correspond - to the the next ledger proof (subset of first pass group) - * [previous_incomplete] - leftover from previous ledger proof emitted with - the current ledger proof (not intersecting with other groups) - *) - type 'a t = - { first_pass : 'a list - ; second_pass : 'a list - ; previous_incomplete : 'a list - ; current_incomplete : 'a list - } - [@@deriving sexp, to_yojson] - end - - type t = Transaction_with_witness.t Poly.t -end - val empty : constraint_constants:Genesis_constants.Constraint_constants.t -> unit -> t @@ -138,15 +113,6 @@ val fill_work_and_enqueue_transactions : val latest_ledger_proof : t -> Ledger_proof.Cached.t option -val latest_ledger_proof_txs : - t - -> ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_categorized.Poly.t - list - option - (** Apply transactions coorresponding to the last emitted proof based on the two-pass system- first pass includes legacy transactions and zkapp payments and the second pass includes account updates. [ignore_incomplete] is to @@ -246,15 +212,6 @@ val base_jobs_on_latest_tree : t -> Transaction_with_witness.t list val base_jobs_on_earlier_tree : t -> index:int -> Transaction_with_witness.t list -(** All the transactions with hash of the parent block in which they were included in the order in which they were applied*) -val staged_transactions_with_state_hash : - t - -> ( Transaction.t With_status.t - * State_hash.t - * Mina_numbers.Global_slot_since_genesis.t ) - Transactions_categorized.Poly.t - list - (** Available space and the corresponding required work-count in one and/or two trees (if the slots to be occupied are in two different trees)*) val partition_if_overflowing : t -> Space_partition.t From 1b61bc0d095acac2d4832751ceaa8fd79a1c1351 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 17:23:41 +0100 Subject: [PATCH 026/122] Change semantics of Transaction_categorized Streamline handling of boolean determining whether transactions are continued in the next tree. --- .../transaction_snark_scan_state.ml | 56 ++++++++----------- 1 file changed, 24 insertions(+), 32 deletions(-) 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 f7637eb81ae9..16117ae17dc2 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 @@ -842,7 +842,7 @@ module Transactions_categorized = struct { first_pass : 'a list ; second_pass : 'a list ; previous_incomplete : 'a list - ; current_incomplete : 'a list + ; continued_in_the_next_tree : bool } [@@deriving sexp, to_yojson] end @@ -852,8 +852,7 @@ module Transactions_categorized = struct let fold (t : 'a Poly.t) ~f ~init = let init = List.fold ~init t.first_pass ~f in let init = List.fold ~init t.previous_incomplete ~f in - let init = List.fold ~init t.second_pass ~f in - List.fold ~init t.current_incomplete ~f + List.fold ~init t.second_pass ~f end module Make_transaction_categorizer (Tx : sig @@ -909,18 +908,14 @@ struct , List.rev second_pass_txns_rev , target_first_pass_ledger ) in - let second_pass_txns, incomplete_txns = - match List.hd second_pass_txns with - | None -> - ([], []) - | Some txn -> - if - Frozen_ledger_hash.equal - (Tx.source_second_pass_ledger txn) - target_first_pass_ledger - then (*second pass completed in the same tree*) - (second_pass_txns, []) - else ([], second_pass_txns) + (* determine whether second pass completed in the same tree *) + let continued_in_the_next_tree = + Option.value_map ~default:false ~f:(fun txn -> + not + @@ Frozen_ledger_hash.equal + (Tx.source_second_pass_ledger txn) + target_first_pass_ledger ) + @@ List.hd second_pass_txns in let previous_incomplete = match previous_incomplete with @@ -931,16 +926,20 @@ struct in { Transactions_categorized.Poly.first_pass = first_pass_txns ; second_pass = second_pass_txns - ; current_incomplete = incomplete_txns ; previous_incomplete + ; continued_in_the_next_tree } let second_pass_last_block txns_per_tree = let%map.Option last_group = List.last (txns_by_block txns_per_tree) in - let { Transactions_categorized.Poly.second_pass; current_incomplete; _ } = + let { Transactions_categorized.Poly.second_pass + ; continued_in_the_next_tree + ; _ + } = categorize_transactions ~previous_incomplete:[] last_group in - (`Second_pass second_pass, `Current_incomplete current_incomplete) + ( second_pass + , `Border_block_continued_in_the_next_tree continued_in_the_next_tree ) let categorize_transactions_per_tree ~previous_incomplete txns_per_tree = List.map @@ -998,7 +997,7 @@ let latest_ledger_proof_and_txs' t = { Transactions_categorized.Poly.first_pass = [] ; second_pass = [] ; previous_incomplete - ; current_incomplete = [] + ; continued_in_the_next_tree = false } :: Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses ~previous_incomplete:[] @@ -1010,20 +1009,13 @@ let incomplete_txns_from_recent_proof_tree t = let%bind.Option (proof, _), txns_with_witnesses = Parallel_scan.last_emitted_value t.scan_state in - let%map.Option ( `Second_pass second_pass - , `Current_incomplete current_incomplete ) = - Witness_categorizer.second_pass_last_block txns_with_witnesses - in (* First pass ledger is considered as the snarked ledger, so any account update whether completed in the same tree or not should be included in the next tree *) - let second_pass_is_empty = List.is_empty second_pass in - let incomplete = - if second_pass_is_empty then current_incomplete else second_pass + let%map.Option res = + Witness_categorizer.second_pass_last_block txns_with_witnesses in - ( proof - , (incomplete, `Border_block_continued_in_the_next_tree second_pass_is_empty) - ) + (proof, res) let staged_transactions t = let ( previous_incomplete @@ -1049,7 +1041,7 @@ let staged_transactions t = [ { Transactions_categorized.Poly.first_pass = [] ; second_pass = [] ; previous_incomplete - ; current_incomplete = [] + ; continued_in_the_next_tree = false } ] :: txns @@ -1274,11 +1266,11 @@ let apply_categorized_txns_stepwise ?(stop_at_first_pass = false) not (List.is_empty txns) in previous_not_empty - && not (List.is_empty txns_per_block.current_incomplete) + && txns_per_block.continued_in_the_next_tree in let do_second_pass = (*if transactions completed in the same tree; do second pass now*) - (not (List.is_empty txns_per_block.second_pass)) + (not txns_per_block.continued_in_the_next_tree) || continue_previous_tree's_txns in if do_second_pass then From 8333ec71be24d1a6c8cfa070732d59c69b9c7a8d Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 18:00:19 +0100 Subject: [PATCH 027/122] Rename latest_ledger_proof_and_txs' -> latest_recent_proof_txs --- .../transaction_snark_scan_state.ml | 41 +++++++++---------- 1 file changed, 19 insertions(+), 22 deletions(-) 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 16117ae17dc2..7c066df8f5d5 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 @@ -936,6 +936,8 @@ struct ; continued_in_the_next_tree ; _ } = + (* [previous_incomplete] is ok to be set empty because it affects + only the [previous_incomplete] field of the result *) categorize_transactions ~previous_incomplete:[] last_group in ( second_pass @@ -980,30 +982,25 @@ let latest_ledger_proof t = in proof -let latest_ledger_proof_and_txs' t = - let open Option.Let_syntax in - let%map proof, txns_with_witnesses = +let latest_recent_proof_txs t = + let%map.Option _, txns_with_witnesses = Parallel_scan.last_emitted_value t.scan_state in let ( previous_incomplete , `Border_block_continued_in_the_next_tree continued_in_next_tree ) = t.previous_incomplete_zkapp_updates in - let txns = - if continued_in_next_tree || List.is_empty previous_incomplete then - Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses - ~previous_incomplete - else - { Transactions_categorized.Poly.first_pass = [] - ; second_pass = [] - ; previous_incomplete - ; continued_in_the_next_tree = false - } - :: Witness_categorizer.categorize_transactions_per_tree - txns_with_witnesses ~previous_incomplete:[] - in - - (proof, txns) + if continued_in_next_tree || List.is_empty previous_incomplete then + Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses + ~previous_incomplete + else + { Transactions_categorized.Poly.first_pass = [] + ; second_pass = [] + ; previous_incomplete + ; continued_in_the_next_tree = false + } + :: Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses + ~previous_incomplete:[] let incomplete_txns_from_recent_proof_tree t = let%bind.Option (proof, _), txns_with_witnesses = @@ -1336,10 +1333,10 @@ let apply_categorized_txns_async ?stop_at_first_pass categorized_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_and_txs' t with + match latest_recent_proof_txs t with | None -> Or_error.errorf "No transactions found" - | Some (_, txns_per_block) -> + | Some txns_per_block -> apply_categorized_txns_sync ~stop_at_first_pass:true txns_per_block ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind @@ -1348,10 +1345,10 @@ 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_and_txs' t with + match latest_recent_proof_txs t with | None -> Deferred.Or_error.errorf "No transactions found" - | Some (_, txns_per_block) -> + | Some txns_per_block -> apply_categorized_txns_async ~stop_at_first_pass:true txns_per_block ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind From fb7caa57ed9186a02d752d8c2cc7b515e6dcddac Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 18:12:41 +0100 Subject: [PATCH 028/122] NIT: use Option.first_some --- src/app/delegation_verify/cassandra.ml | 2 +- src/lib/parallel_scan/parallel_scan.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/app/delegation_verify/cassandra.ml b/src/app/delegation_verify/cassandra.ml index bc4296e881e1..a603cfa25f49 100644 --- a/src/app/delegation_verify/cassandra.ml +++ b/src/app/delegation_verify/cassandra.ml @@ -35,7 +35,7 @@ let make_conf ?executable ~keyspace : conf = let conn = make_conn_conf () in let credentials = make_cred_conf () in let executable = - Option.merge executable (Sys.getenv "CQLSH") ~f:Fn.const + Option.first_some executable (Sys.getenv "CQLSH") |> Option.value ~default:"cqlsh" in { executable; connection = conn; credentials; keyspace } diff --git a/src/lib/parallel_scan/parallel_scan.ml b/src/lib/parallel_scan/parallel_scan.ml index 2715c2485328..1243e62f5471 100644 --- a/src/lib/parallel_scan/parallel_scan.ml +++ b/src/lib/parallel_scan/parallel_scan.ml @@ -1489,7 +1489,7 @@ let update_helper : (*update the latest emitted value *) let%bind () = State_or_error.put - { state with acc = Option.merge result_opt state.acc ~f:Fn.const } + { state with acc = Option.first_some result_opt state.acc } in (*Check the tree-list length is under max*) let%map () = From 3fc34a0ba3697c8496d289d7cf0ccbfb53a43e9c Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 20 Nov 2025 18:14:09 +0100 Subject: [PATCH 029/122] Fix multi_key_file_storage.mli --- src/lib/multi-key-file-storage/multi_key_file_storage.mli | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.mli b/src/lib/multi-key-file-storage/multi_key_file_storage.mli index 7d2dc8b0a91e..d5239db608db 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.mli +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.mli @@ -17,4 +17,7 @@ module Make_custom (Inputs : sig type filename_key val filename : filename_key -> string -end) : S with type filename_key = Inputs.filename_key +end) : + S + with type 'a tag = (Inputs.filename_key, 'a) Tag.t + and type filename_key = Inputs.filename_key From fb1b96c2b5950de7be9b4f79c9e72c5b8b6d56ee Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 21 Nov 2025 09:56:53 +0100 Subject: [PATCH 030/122] Remove unused base_jobs_on_latest_tree --- src/lib/parallel_scan/parallel_scan.ml | 7 ------- src/lib/parallel_scan/parallel_scan.mli | 5 ----- .../transaction_snark_scan_state.ml | 3 --- .../transaction_snark_scan_state.mli | 2 -- 4 files changed, 17 deletions(-) diff --git a/src/lib/parallel_scan/parallel_scan.ml b/src/lib/parallel_scan/parallel_scan.ml index 1243e62f5471..6df22d2355e8 100644 --- a/src/lib/parallel_scan/parallel_scan.ml +++ b/src/lib/parallel_scan/parallel_scan.ml @@ -1523,13 +1523,6 @@ let last_emitted_value t = t.acc let current_job_sequence_number t = t.curr_job_seq_no -let base_jobs_on_latest_tree t = - let depth = Int.ceil_log2 t.max_base_jobs in - List.filter_map - (Tree.jobs_on_level ~depth ~level:depth - (Mina_stdlib.Nonempty_list.head t.trees) ) - ~f:(fun job -> match job with Base d -> Some d | Merge _ -> None) - (* 0-based indexing, so 0 indicates next-to-latest tree *) let base_jobs_on_earlier_tree t ~index = let depth = Int.ceil_log2 t.max_base_jobs in diff --git a/src/lib/parallel_scan/parallel_scan.mli b/src/lib/parallel_scan/parallel_scan.mli index 012101c7cf09..dbf24ba9d299 100644 --- a/src/lib/parallel_scan/parallel_scan.mli +++ b/src/lib/parallel_scan/parallel_scan.mli @@ -294,11 +294,6 @@ val view_jobs_with_position : -> ('base -> 'c) -> 'c Job_view.t list list -(** All the base jobs that are part of the latest tree being filled - * i.e., does not include base jobs that are part of previous trees not - * promoted to the merge jobs yet*) -val base_jobs_on_latest_tree : ('merge, 'base) State.t -> 'base list - (** All the base jobs that are part of a tree before the latest tree index is 0-based, 0 is the next-to-latest tree *) 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 7c066df8f5d5..09c0980604ce 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 @@ -1368,9 +1368,6 @@ let all_jobs t = Parallel_scan.all_jobs t.scan_state let next_on_new_tree t = Parallel_scan.next_on_new_tree t.scan_state -let base_jobs_on_latest_tree t = - Parallel_scan.base_jobs_on_latest_tree t.scan_state - let base_jobs_on_earlier_tree t = Parallel_scan.base_jobs_on_earlier_tree t.scan_state 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 e30b9ae5909e..c3ab8dead576 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 @@ -206,8 +206,6 @@ val get_staged_ledger_async : val free_space : t -> int -val base_jobs_on_latest_tree : t -> Transaction_with_witness.t list - (* a 0 index means next-to-latest tree *) val base_jobs_on_earlier_tree : t -> index:int -> Transaction_with_witness.t list From 3690c0ae27789160222a8b27a10fe6234fd83364 Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 21 Nov 2025 09:57:42 +0100 Subject: [PATCH 031/122] Remove unused base_jobs_on_earlier_tree --- src/lib/parallel_scan/parallel_scan.ml | 12 ------------ src/lib/parallel_scan/parallel_scan.mli | 6 ------ .../transaction_snark_scan_state.ml | 3 --- .../transaction_snark_scan_state.mli | 4 ---- 4 files changed, 25 deletions(-) diff --git a/src/lib/parallel_scan/parallel_scan.ml b/src/lib/parallel_scan/parallel_scan.ml index 6df22d2355e8..d52ce8b4d94f 100644 --- a/src/lib/parallel_scan/parallel_scan.ml +++ b/src/lib/parallel_scan/parallel_scan.ml @@ -1523,18 +1523,6 @@ let last_emitted_value t = t.acc let current_job_sequence_number t = t.curr_job_seq_no -(* 0-based indexing, so 0 indicates next-to-latest tree *) -let base_jobs_on_earlier_tree t ~index = - let depth = Int.ceil_log2 t.max_base_jobs in - let earlier_trees = Mina_stdlib.Nonempty_list.tail t.trees in - match List.nth earlier_trees index with - | None -> - [] - | Some tree -> - let jobs = Tree.jobs_on_level ~depth ~level:depth tree in - List.filter_map jobs ~f:(fun job -> - match job with Base d -> Some d | Merge _ -> None ) - let partition_if_overflowing : ('merge, 'base) t -> Space_partition.t = fun t -> let cur_tree_space = free_space_on_current_tree t in diff --git a/src/lib/parallel_scan/parallel_scan.mli b/src/lib/parallel_scan/parallel_scan.mli index dbf24ba9d299..18dfd79ab48f 100644 --- a/src/lib/parallel_scan/parallel_scan.mli +++ b/src/lib/parallel_scan/parallel_scan.mli @@ -294,12 +294,6 @@ val view_jobs_with_position : -> ('base -> 'c) -> 'c Job_view.t list list -(** All the base jobs that are part of a tree before the latest tree - index is 0-based, 0 is the next-to-latest tree -*) -val base_jobs_on_earlier_tree : - ('merge, 'base) State.t -> index:int -> 'base list - (** Returns true only if the next 'd that could be enqueued is on a new tree*) val next_on_new_tree : ('merge, 'base) State.t -> bool 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 09c0980604ce..413bc94780fb 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 @@ -1368,9 +1368,6 @@ let all_jobs t = Parallel_scan.all_jobs t.scan_state let next_on_new_tree t = Parallel_scan.next_on_new_tree t.scan_state -let base_jobs_on_earlier_tree t = - Parallel_scan.base_jobs_on_earlier_tree t.scan_state - let partition_if_overflowing t = let bundle_count work_count = (work_count + 1) / 2 in let { Space_partition.first = slots, job_count; second } = 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 c3ab8dead576..d3aff80222e2 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 @@ -206,10 +206,6 @@ val get_staged_ledger_async : val free_space : t -> int -(* a 0 index means next-to-latest tree *) -val base_jobs_on_earlier_tree : - t -> index:int -> Transaction_with_witness.t list - (** Available space and the corresponding required work-count in one and/or two trees (if the slots to be occupied are in two different trees)*) val partition_if_overflowing : t -> Space_partition.t From be91d5a8ce11da8ce9067950c04287b2cec2a0a9 Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 21 Nov 2025 00:14:15 +0100 Subject: [PATCH 032/122] Change contents of scan state --- src/app/heap_usage/heap_usage.ml | 3 +- src/app/heap_usage/values.ml | 8 +- src/lib/block_producer/block_producer.ml | 70 +- .../bootstrap_controller.ml | 14 +- src/lib/ledger_proof/dune | 3 +- src/lib/ledger_proof/ledger_proof.ml | 20 + src/lib/ledger_proof/ledger_proof_intf.ml | 14 + src/lib/mina_base/state_hash.ml | 23 + src/lib/mina_block/validation.ml | 2 +- src/lib/mina_graphql/mina_graphql.ml | 62 +- src/lib/mina_lib/mina_lib.ml | 29 +- src/lib/mina_networking/rpcs.ml | 4 +- src/lib/multi-key-file-storage/dune | 2 +- src/lib/multi-key-file-storage/intf.mli | 5 + .../multi_key_file_storage.ml | 34 +- .../multi_key_file_storage.mli | 37 +- src/lib/staged_ledger/staged_ledger.ml | 53 +- src/lib/staged_ledger/staged_ledger.mli | 55 +- src/lib/transaction/transaction.ml | 2 +- src/lib/transaction/transaction_type.ml | 11 +- .../transaction_snark_scan_state.ml | 884 +++++++++++------- .../transaction_snark_scan_state.mli | 71 +- .../frontier_base/breadcrumb.ml | 2 +- .../frontier_base/root_data.ml | 35 +- .../frontier_base/root_data.mli | 14 - .../full_frontier/full_frontier.ml | 5 +- .../persistent_frontier/database.ml | 4 +- .../persistent_frontier.ml | 17 +- src/lib/uptime_service/uptime_service.ml | 62 +- src/lib/work_partitioner/work_partitioner.ml | 14 +- src/lib/work_partitioner/work_partitioner.mli | 2 +- src/lib/work_selector/inputs.ml | 161 ++-- src/lib/work_selector/intf.ml | 56 +- src/lib/work_selector/random.ml | 8 +- src/lib/work_selector/random_offset.ml | 8 +- src/lib/work_selector/sequence.ml | 8 +- src/lib/work_selector/test.ml | 214 ++--- src/lib/work_selector/work_lib.ml | 63 +- src/lib/work_selector/work_selector.ml | 2 +- src/lib/work_selector/work_selector.mli | 2 +- 40 files changed, 1217 insertions(+), 866 deletions(-) diff --git a/src/app/heap_usage/heap_usage.ml b/src/app/heap_usage/heap_usage.ml index c6440779d164..da1998f122c8 100644 --- a/src/app/heap_usage/heap_usage.ml +++ b/src/app/heap_usage/heap_usage.ml @@ -48,8 +48,7 @@ let main ~genesis_constants ~constraint_constants conf_dir : unit Deferred.t = scan_state_base_node_zkapp ~constraint_constants ~zkapp_command in print_heap_usage "Parallel_scan.Base.t (zkApp)" scan_state_base_node_zkapp ; - print_heap_usage "Parallel_scan.Merge.t" - (scan_state_merge_node ~proof_cache_db) ; + print_heap_usage "Parallel_scan.Merge.t" scan_state_merge_node ; print_heap_usage "Transaction_snark.Statement.t" transaction_snark_statement let () = diff --git a/src/app/heap_usage/values.ml b/src/app/heap_usage/values.ml index fa476fd9ba64..51ddc9ba1b2a 100644 --- a/src/app/heap_usage/values.ml +++ b/src/app/heap_usage/values.ml @@ -169,7 +169,7 @@ let scan_state_base_node_payment = let scan_state_base_node_zkapp ~zkapp_command = mk_scan_state_base_node (Command (Zkapp_command zkapp_command)) -let scan_state_merge_node ~proof_cache_db : +let scan_state_merge_node : Transaction_snark_scan_state.Ledger_proof_with_sok_message.t Parallel_scan.Merge.t = let weight1 : Parallel_scan.Weight.t = { base = 42; merge = 99 } in @@ -190,8 +190,7 @@ let scan_state_merge_node ~proof_cache_db : { without_sok with sok_digest = Mina_base.Sok_message.digest sok_msg } in let ledger_proof = Transaction_snark.create ~statement ~proof in - ( Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db ledger_proof - , sok_msg ) + (ledger_proof, sok_msg) in let right = let sok_msg : Mina_base.Sok_message.t = @@ -207,8 +206,7 @@ let scan_state_merge_node ~proof_cache_db : { without_sok with sok_digest = Mina_base.Sok_message.digest sok_msg } in let ledger_proof = Transaction_snark.create ~statement ~proof in - ( Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db ledger_proof - , sok_msg ) + (ledger_proof, sok_msg) in Full { left; right; seq_no = 1; status = Todo } in diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 8a021d5111a6..aceb669f8eda 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -347,7 +347,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants , next_staged_ledger_hash , ledger_proof_opt , is_new_stack - , pending_coinbase_update ) -> + , pending_coinbase_update ) -> ( let diff_unwrapped = Staged_ledger_diff.read_all_proofs_from_disk @@ Staged_ledger_diff.forget diff @@ -361,7 +361,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants let ledger_proof_statement = match ledger_proof_opt with | Some proof -> - Ledger_proof.Cached.statement proof + Ledger_proof.Tagged.statement proof | None -> let state = previous_protocol_state @@ -376,7 +376,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants let supply_increase = Option.value_map ledger_proof_opt ~f:(fun proof -> - (Ledger_proof.Cached.statement proof).supply_increase ) + (Ledger_proof.Tagged.statement proof).supply_increase ) ~default:Currency.Amount.Signed.zero in let body_reference = @@ -410,32 +410,44 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants ~genesis_ledger_hash ~supply_increase ~logger ~constraint_constants ) ) in - lift_sync (fun () -> - let snark_transition = - O1trace.sync_thread "generate_snark_transition" (fun () -> - Snark_transition.create_value - ~blockchain_state: - (Protocol_state.blockchain_state protocol_state) - ~consensus_transition:consensus_transition_data - ~pending_coinbase_update () ) - in - let internal_transition = - O1trace.sync_thread "generate_internal_transition" (fun () -> - Internal_transition.create ~snark_transition - ~prover_state: - (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 -> - Ledger_proof.Cached.read_proof_from_disk proof ) ) ) - in - let witness = - { Pending_coinbase_witness.pending_coinbases = - Staged_ledger.pending_coinbase_collection staged_ledger - ; is_new_stack - } - in - Some (protocol_state, internal_transition, witness) ) ) + let finish ledger_proof = + lift_sync (fun () -> + let snark_transition = + O1trace.sync_thread "generate_snark_transition" (fun () -> + Snark_transition.create_value + ~blockchain_state: + (Protocol_state.blockchain_state protocol_state) + ~consensus_transition:consensus_transition_data + ~pending_coinbase_update () ) + in + let internal_transition = + O1trace.sync_thread "generate_internal_transition" (fun () -> + Internal_transition.create ~snark_transition + ~prover_state: + (Consensus.Data.Block_data.prover_state block_data) + ~staged_ledger_diff:(Staged_ledger_diff.forget diff) + ~ledger_proof ) + in + let witness = + { Pending_coinbase_witness.pending_coinbases = + Staged_ledger.pending_coinbase_collection staged_ledger + ; is_new_stack + } + in + Some (protocol_state, internal_transition, witness) ) + in + Option.map ledger_proof_opt + ~f:Ledger_proof.Tagged.read_proof_from_disk + |> function + | Some (Error e) -> + [%log error] + ~metadata:[ ("error", Error_json.error_to_yojson e) ] + "Failed to read ledger proof from disk" ; + Interruptible.return None + | Some (Ok ledger_proof) -> + finish (Some ledger_proof) + | None -> + finish None ) ) let handle_block_production_errors ~logger ~rejected_blocks_logger ~time_taken:span ~previous_protocol_state ~protocol_state x = diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 9fea0140e643..34504842e1ae 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -343,18 +343,14 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier match staged_ledger_data_download_result with | Error err -> Deferred.return (staged_ledger_data_download_time, None, Error err) - | Ok - ( scan_state_uncached - , expected_merkle_root - , pending_coinbases - , protocol_states ) -> ( + | Ok (scan_state, expected_merkle_root, pending_coinbases, protocol_states) + -> ( let%map staged_ledger_construction_result = O1trace.thread "construct_root_staged_ledger" (fun () -> let open Deferred.Or_error.Let_syntax in let received_staged_ledger_hash = Staged_ledger_hash.of_aux_ledger_and_coinbase_hash - (Staged_ledger.Scan_state.Stable.Latest.hash - scan_state_uncached ) + (Staged_ledger.Scan_state.Stable.Latest.hash scan_state) expected_merkle_root pending_coinbases in [%log debug] @@ -383,10 +379,6 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier List.map protocol_states ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) in - let scan_state = - Staged_ledger.Scan_state.write_all_proofs_to_disk - ~signature_kind ~proof_cache_db scan_state_uncached - in let%bind protocol_states = Staged_ledger.Scan_state.check_required_protocol_states scan_state ~protocol_states diff --git a/src/lib/ledger_proof/dune b/src/lib/ledger_proof/dune index 571db19e7c23..e7d43923bdc5 100644 --- a/src/lib/ledger_proof/dune +++ b/src/lib/ledger_proof/dune @@ -21,4 +21,5 @@ ppx_hash ppx_compare ppx_version - ppx_deriving_yojson))) + ppx_deriving_yojson + ppx_let))) diff --git a/src/lib/ledger_proof/ledger_proof.ml b/src/lib/ledger_proof/ledger_proof.ml index 15bd6984190f..69aa0680e7e7 100644 --- a/src/lib/ledger_proof/ledger_proof.ml +++ b/src/lib/ledger_proof/ledger_proof.ml @@ -57,6 +57,26 @@ module Cached = struct { Proof_carrying_data.proof; data = { statement with sok_digest } } end +module Tagged = struct + type t = + ( Mina_state.Snarked_ledger_state.With_sok.t + , Proof.t State_hash.File_storage.tag ) + Proof_carrying_data.t + + let read_proof_from_disk ({ Proof_carrying_data.data = statement; proof } : t) + : Stable.Latest.t Or_error.t = + let%map.Or_error proof = + State_hash.File_storage.read (module Proof.Stable.Latest) proof + in + Transaction_snark.create ~statement ~proof + + let statement (t : t) = { t.data with sok_digest = () } + + let create ~(statement : Mina_state.Snarked_ledger_state.t) ~sok_digest ~proof + : t = + { Proof_carrying_data.proof; data = { statement with sok_digest } } +end + module For_tests = struct let mk_dummy_proof statement = create ~statement ~sok_digest:Sok_message.Digest.default diff --git a/src/lib/ledger_proof/ledger_proof_intf.ml b/src/lib/ledger_proof/ledger_proof_intf.ml index 008b4e210f2a..b4a744980720 100644 --- a/src/lib/ledger_proof/ledger_proof_intf.ml +++ b/src/lib/ledger_proof/ledger_proof_intf.ml @@ -64,4 +64,18 @@ module type S = sig -> proof:Proof_cache_tag.t -> t end + + module Tagged : sig + type t + + val read_proof_from_disk : t -> Stable.Latest.t Or_error.t + + val statement : t -> Mina_state.Snarked_ledger_state.t + + val create : + statement:Mina_state.Snarked_ledger_state.t + -> sok_digest:Sok_message.Digest.t + -> proof:Proof.t State_hash.File_storage.tag + -> t + end end diff --git a/src/lib/mina_base/state_hash.ml b/src/lib/mina_base/state_hash.ml index be4016dc2ca0..4876a3a3cbe0 100644 --- a/src/lib/mina_base/state_hash.ml +++ b/src/lib/mina_base/state_hash.ml @@ -61,6 +61,29 @@ module With_state_hashes = struct compute_hashes data ) end +module Tag = struct + [%%versioned + module Stable = struct + module V1 = struct + type 'a t = (Stable.V1.t, 'a) Multi_key_file_storage.Tag.Stable.V1.t + + let compare a b = Multi_key_file_storage.Tag.compare Stable.V1.compare a b + + let equal a b = Multi_key_file_storage.Tag.equal Stable.V1.equal a b + + let sexp_of_t a = + Multi_key_file_storage.Tag.sexp_of_t Stable.V1.sexp_of_t a + + let t_of_sexp sexp = + Multi_key_file_storage.Tag.t_of_sexp Stable.V1.t_of_sexp sexp + + let to_latest = Fn.id + end + end] + + [%%define_locally Stable.Latest.(compare, equal, sexp_of_t, t_of_sexp)] +end + module File_storage = Multi_key_file_storage.Make_custom (struct type filename_key = t diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 387022ce3871..30b070549549 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -550,7 +550,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger Protocol_state.snarked_ledger_hash parent_protocol_state | Some proof -> Mina_state.Snarked_ledger_state.snarked_ledger_hash - @@ Ledger_proof.Cached.statement proof + @@ Ledger_proof.Tagged.statement proof in let staged_ledger_hash_check staged_ledger_hash = if diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index 0689aa7e2d98..4c8a55b64a71 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -2381,38 +2381,40 @@ module Queries = struct ~typ:Types.Input.UInt32.arg_typ ] ~typ:(non_null @@ list @@ non_null Types.pending_work_spec) - ~resolve:(fun { ctx = mina; _ } () start_idx end_idx -> + ~resolve:(fun { ctx = mina; _ } () _start_idx _end_idx -> let snark_job_state = Mina_lib.work_selector mina in let snark_pool = Mina_lib.snark_pool mina in - let all_work = Work_selector.all_work ~snark_pool snark_job_state in - let work_size = all_work |> List.length |> Unsigned.UInt32.of_int in - let less_than uint1 uint2 = Unsigned.UInt32.compare uint1 uint2 < 0 in - let to_bundle_specs = - List.map ~f:(fun (spec, fee_prover) -> - let spec = - One_or_two.map spec - ~f: - (Snark_work_lib.Work.Single.Spec.map - ~f_proof:Ledger_proof.Cached.read_proof_from_disk - ~f_witness:Transaction_witness.read_all_proofs_from_disk ) - in - { Types.Snark_work_bundle.spec; fee_prover } ) - in - match end_idx with - | None when less_than start_idx work_size -> - (* drop handles case when start_idx is greater than pending work and is O(start_idx)*) - let start = Unsigned.UInt32.to_int start_idx in - List.drop all_work start |> to_bundle_specs - | Some end_idx - when less_than start_idx end_idx && less_than start_idx work_size -> - let pos = Unsigned.UInt32.to_int start_idx in - let len = - Unsigned.UInt32.( - min (sub end_idx start_idx) (sub work_size start_idx) |> to_int) - in - List.sub ~pos ~len all_work |> to_bundle_specs - | _ -> - [] ) + let _all_work = Work_selector.all_work ~snark_pool snark_job_state in + (* TODO uncomment *) + (* let work_size = all_work |> List.length |> Unsigned.UInt32.of_int in + let less_than uint1 uint2 = Unsigned.UInt32.compare uint1 uint2 < 0 in + let to_bundle_specs = + List.map ~f:(fun (spec, fee_prover) -> + let spec = + One_or_two.map spec + ~f: + (Snark_work_lib.Work.Single.Spec.map + ~f_proof:Ledger_proof.Cached.read_proof_from_disk + ~f_witness:Transaction_witness.read_all_proofs_from_disk ) + in + { Types.Snark_work_bundle.spec; fee_prover } ) + in + match end_idx with + | None when less_than start_idx work_size -> + (* drop handles case when start_idx is greater than pending work and is O(start_idx)*) + let start = Unsigned.UInt32.to_int start_idx in + List.drop all_work start |> to_bundle_specs + | Some end_idx + when less_than start_idx end_idx && less_than start_idx work_size -> + let pos = Unsigned.UInt32.to_int start_idx in + let len = + Unsigned.UInt32.( + min (sub end_idx start_idx) (sub work_size start_idx) |> to_int) + in + List.sub ~pos ~len all_work |> to_bundle_specs + | _ -> + [] *) + [] ) module SnarkedLedgerMembership = struct let resolve_membership : diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 9813573baa5a..7a7b9365a103 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -891,14 +891,39 @@ let request_work t = let%bind.Option prover = Option.first_some (snark_worker_key t) (snark_coordinator_key t) in + let%bind.Option frontier = + Broadcast_pipe.Reader.peek t.components.transition_frontier + in + let get_state hash = + Transition_frontier.find_protocol_state frontier hash + |> function + | Some state -> + Or_error.return state + | None -> + Or_error.error_string "Protocol state not found" + in let fee = snark_work_fee t in let sok_message = Sok_message.create ~fee ~prover in [%log' debug t.config.logger] "Received work request" ~metadata:[ ("sok_message", Sok_message.to_yojson sok_message) ] ; let work_from_selector = lazy - (Work_selection_method.work ~snark_pool:(snark_pool t) ~fee - ~logger:t.config.logger t.work_selector ) + ( Work_selection_method.work ~snark_pool:(snark_pool t) ~fee + ~logger:t.config.logger t.work_selector + |> Option.map + ~f: + (Staged_ledger.Scan_state.Available_job.single_spec_one_or_two + ~get_state ) + |> function + | Some (Error e) -> + [%log' fatal t.config.logger] + "Error occured when converting available work: $error" + ~metadata:[ ("error", Error_json.error_to_yojson e) ] ; + None + | Some (Ok x) -> + Some x + | None -> + None ) in Work_partitioner.request_partitioned_work ~work_from_selector ~sok_message ~partitioner:t.work_partitioner diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 42abfb560123..491af81fa555 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -312,7 +312,9 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct -> return (Some - ( Staged_ledger.Scan_state.read_all_proofs_from_disk scan_state + (* TODO convert to stable, current implementation is incorrect, + bootstrap won't happen *) + ( scan_state , expected_merkle_root , pending_coinbases , protocol_states ) ) diff --git a/src/lib/multi-key-file-storage/dune b/src/lib/multi-key-file-storage/dune index d417ae066710..d1dcefcfca35 100644 --- a/src/lib/multi-key-file-storage/dune +++ b/src/lib/multi-key-file-storage/dune @@ -3,7 +3,7 @@ (public_name multi_key_file_storage) (libraries core_kernel bin_prot mina_stdlib) (preprocess - (pps ppx_jane ppx_version)) + (pps ppx_mina ppx_jane ppx_version)) (modules_without_implementation intf) (instrumentation (backend bisect_ppx))) diff --git a/src/lib/multi-key-file-storage/intf.mli b/src/lib/multi-key-file-storage/intf.mli index ba64524e896b..46d088699ac6 100644 --- a/src/lib/multi-key-file-storage/intf.mli +++ b/src/lib/multi-key-file-storage/intf.mli @@ -65,4 +65,9 @@ module type S = sig (module Bin_prot.Binable.S with type t = 'a) -> 'a tag -> 'a Core_kernel.Or_error.t + + val read_many : + (module Bin_prot.Binable.S with type t = 'a) + -> 'a tag list + -> 'a list Core_kernel.Or_error.t end diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.ml b/src/lib/multi-key-file-storage/multi_key_file_storage.ml index 9876f323afc6..ffe1ed1292a7 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.ml @@ -11,9 +11,33 @@ module Tag = struct module V1 = struct type ('filename_key, 'a) t = { filename_key : 'filename_key; offset : int64; size : int } - [@@deriving sexp] + + let compare filename_key_compare t1 t2 = + let c = filename_key_compare t1.filename_key t2.filename_key in + if c <> 0 then c + else + let c' = Int64.compare t1.offset t2.offset in + if c' <> 0 then c' else Int.compare t1.size t2.size + + let equal filename_key_equal t1 t2 = + let c = filename_key_equal t1.filename_key t2.filename_key in + if c then + if Int64.equal t1.offset t2.offset then Int.equal t1.size t2.size + else false + else false + + let sexp_of_t sexp_of_filename_key t = + [%sexp_of: Sexp.t * int64 * int] + (sexp_of_filename_key t.filename_key, t.offset, t.size) + + let t_of_sexp filename_key_of_sexp sexp = + [%of_sexp: Sexp.t * int64 * int] sexp + |> fun (filename_key, offset, size) -> + { filename_key = filename_key_of_sexp filename_key; offset; size } end end] + + [%%define_locally Stable.Latest.(compare, equal, t_of_sexp, sexp_of_t)] end module Make_custom (Inputs : sig @@ -120,6 +144,14 @@ end) : In_channel.with_file (Inputs.filename tag.filename_key) ~binary:true ~f:do_reading + + let read_many (type a) (module B : Bin_prot.Binable.S with type t = a) tags = + let%map.Or_error reversed = + List.fold_result tags ~init:[] ~f:(fun acc tag -> + let%map.Or_error value = read (module B) tag in + value :: acc ) + in + List.rev reversed end include Make_custom (struct diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.mli b/src/lib/multi-key-file-storage/multi_key_file_storage.mli index d5239db608db..606ee6ce3c1e 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.mli +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.mli @@ -1,12 +1,47 @@ (** Multi-key file storage - stores multiple keys with heterogeneous types in a single file *) +open Core_kernel module Tag : sig [%%versioned: module Stable : sig module V1 : sig - type ('filename_key, 'a) t [@@deriving sexp] + type ('filename_key, 'a) t + + val compare : + ('filename_key -> 'filename_key -> int) + -> ('filename_key, 'a) t + -> ('filename_key, 'a) t + -> int + + val equal : + ('filename_key -> 'filename_key -> bool) + -> ('filename_key, 'a) t + -> ('filename_key, 'a) t + -> bool + + val sexp_of_t : + ('filename_key -> Sexp.t) -> ('filename_key, 'a) t -> Sexp.t + + val t_of_sexp : + (Sexp.t -> 'filename_key) -> Sexp.t -> ('filename_key, 'a) t end end] + + val compare : + ('filename_key -> 'filename_key -> int) + -> ('filename_key, 'a) t + -> ('filename_key, 'a) t + -> int + + val equal : + ('filename_key -> 'filename_key -> bool) + -> ('filename_key, 'a) t + -> ('filename_key, 'a) t + -> bool + + val sexp_of_t : ('filename_key -> Sexp.t) -> ('filename_key, 'a) t -> Sexp.t + + val t_of_sexp : (Sexp.t -> 'filename_key) -> Sexp.t -> ('filename_key, 'a) t end module type S = Intf.S diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 9a2899c9c8af..7819c0e83ac2 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -42,19 +42,24 @@ let persist_witnesses_and_works witnesses works writer = ( module Transaction_snark_scan_state.Transaction_with_witness.Stable .Latest ) in - let write_proof = FS.write_value writer (module Ledger_proof.Stable.Latest) in - let write_witness' = + let write_proof = FS.write_value writer (module Proof.Stable.Latest) in + let write_witness' witness = (* TODO remove read_all_proofs_from_disk *) - Fn.compose write_witness + let stable = Transaction_snark_scan_state.Transaction_with_witness - .read_all_proofs_from_disk + .read_all_proofs_from_disk witness + in + Transaction_snark_scan_state.Transaction_with_witness.Tagged.create + ~tag:(write_witness stable) stable in let write_proof' ~fee ~prover proof = (* TODO remove read_proof_from_disk *) - let proof_tag = - Ledger_proof.Cached.read_proof_from_disk proof |> write_proof - in - (proof_tag, Sok_message.create ~fee ~prover) + let stable = Ledger_proof.Cached.read_proof_from_disk proof in + let statement = Ledger_proof.statement_with_sok stable in + let proof = Ledger_proof.underlying_proof stable in + let sok_message = Sok_message.create ~fee ~prover in + Transaction_snark_scan_state.Ledger_proof_with_sok_message.Tagged.create + ~tag:(write_proof proof) ~sok_message ~statement in let tagged_witnesses = List.map ~f:write_witness' witnesses in let tagged_works = @@ -221,7 +226,7 @@ module T = struct let open Deferred.Let_syntax in match map_opt job_msg_proofs ~f:(fun (job, msg, proof) -> - Option.map (Scan_state.statement_of_job job) ~f:(fun s -> + Option.map (Scan_state.Available_job.statement job) ~f:(fun s -> (proof, s, msg) ) ) with | None -> @@ -251,10 +256,7 @@ module T = struct let verify ~verifier:{ logger; verifier } ts = verify_proofs ~logger ~verifier - (List.map ts ~f:(fun (p, m) -> - ( Ledger_proof.Cached.read_proof_from_disk p - , Ledger_proof.Cached.statement p - , m ) ) ) + (List.map ts ~f:(fun (p, m) -> (p, Ledger_proof.statement p, m))) end module Statement_scanner_with_proofs = @@ -272,10 +274,7 @@ module T = struct let scan_state { scan_state; _ } = scan_state - let all_work_pairs t - ~(get_state : State_hash.t -> Mina_state.Protocol_state.value Or_error.t) - = - Scan_state.all_work_pairs t.scan_state ~get_state + let all_work_pairs t = Scan_state.all_work_pairs t.scan_state let all_work_statements_exn t = Scan_state.all_work_statements_exn t.scan_state @@ -298,8 +297,7 @@ module T = struct in let statement_check = `Partial in let last_proof_statement = - Option.map ~f:Ledger_proof.Cached.statement - (Scan_state.latest_ledger_proof scan_state) + Scan_state.latest_ledger_proof_statement scan_state in Statement_scanner.check_invariants ~constraint_constants scan_state ~statement_check ~verifier:() ~error_prefix ~registers_end @@ -397,8 +395,7 @@ module T = struct expected_merkle_root staged_ledger_hash ) in let last_proof_statement = - Scan_state.latest_ledger_proof scan_state - |> Option.map ~f:Ledger_proof.Cached.statement + Scan_state.latest_ledger_proof_statement scan_state in f ~constraint_constants ~last_proof_statement ~ledger:snarked_ledger ~scan_state ~pending_coinbase_collection:pending_coinbases @@ -713,7 +710,7 @@ module T = struct let exception Statement_of_job_failure in let statement_of_job_exn job = Option.value_exn ~error:(Error.of_exn Statement_of_job_failure) - @@ Scan_state.statement_of_job job + @@ Scan_state.Available_job.statement job in try let job_statements = One_or_two.map ~f:statement_of_job_exn jobs in @@ -977,7 +974,7 @@ module T = struct |> to_staged_ledger_or_error in let ledger_proof_stack = - (Ledger_proof.Cached.statement proof).target.pending_coinbase_stack + (Ledger_proof.Tagged.statement proof).target.pending_coinbase_stack in let%map () = if Pending_coinbase.Stack.equal oldest_stack ledger_proof_stack then @@ -1105,7 +1102,7 @@ module T = struct } in let witnesses = List.map data ~f:to_witness in - let _tagged_witnesses, _tagged_works = + let tagged_witnesses, tagged_works = State_hash.File_storage.write_values_exn state_hash ~f:(persist_witnesses_and_works witnesses works) in @@ -1145,7 +1142,7 @@ module T = struct O1trace.thread "fill_work_and_enqueue_transactions" (fun () -> let r = Scan_state.fill_work_and_enqueue_transactions t.scan_state ~logger - witnesses works + tagged_witnesses tagged_works in Or_error.iter_error r ~f:(fun e -> let data_json = @@ -2707,11 +2704,11 @@ 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 option -> unit = + let assert_fee_excess : Ledger_proof.Tagged.t option -> unit = fun proof_opt -> let fee_excess = Option.value_map ~default:Fee_excess.zero proof_opt ~f:(fun proof -> - (Ledger_proof.Cached.statement proof).fee_excess ) + (Ledger_proof.Tagged.statement proof).fee_excess ) in assert (Fee_excess.is_zero fee_excess) @@ -2848,7 +2845,7 @@ let%test_module "staged ledger tests" = !sl.scan_state in let target_snarked_ledger = - let stmt = Ledger_proof.Cached.statement proof in + let stmt = Ledger_proof.Tagged.statement proof in stmt.target.first_pass_ledger in [%test_eq: Ledger_hash.t] target_snarked_ledger diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 6f0e33a08455..f304a0520a21 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -8,6 +8,37 @@ module Ledger = Mina_ledger.Ledger type t module Scan_state : sig + module Available_job : sig + type t + + val single_spec_one_or_two : + get_state: + ( Mina_base.State_hash.t + -> Mina_state.Protocol_state.Value.t Or_error.t ) + -> t One_or_two.t + -> ( Transaction_witness.Stable.Latest.t + , Ledger_proof.t ) + Snark_work_lib.Spec.Single.Poly.t + One_or_two.t + Or_error.t + + val statement : t -> Transaction_snark.Statement.t option + + val single_spec : + get_state: + ( Mina_base.State_hash.t + -> Mina_state.Protocol_state.Value.t Or_error.t ) + -> t + -> ( Transaction_witness.Stable.Latest.t + , Ledger_proof.t ) + Snark_work_lib.Spec.Single.Poly.t + Or_error.t + + val is_transition : t -> bool + + val target_second_pass_ledger : t -> Frozen_ledger_hash.t option + end + [%%versioned: module Stable : sig [@@@no_toplevel_latest_type] @@ -25,7 +56,7 @@ module Scan_state : sig end end] - type t + type t = Stable.V3.t module Job_view : sig type t [@@deriving sexp, to_yojson] @@ -128,13 +159,7 @@ module Scan_state : sig -> t -> unit Deferred.Or_error.t - val write_all_proofs_to_disk : - signature_kind:Mina_signature_kind.t - -> proof_cache_db:Proof_cache_tag.cache_db - -> Stable.Latest.t - -> t - - val read_all_proofs_from_disk : t -> Stable.Latest.t + (* val read_all_proofs_from_disk : t -> Stable.Latest.t Or_error.t *) end module Pre_diff_info : Pre_diff_info.S @@ -200,7 +225,7 @@ val apply : -> ?transaction_pool_proxy:Check_commands.transaction_pool_proxy -> t -> Staged_ledger_diff.t - -> ( [ `Ledger_proof of Ledger_proof.Cached.t option ] + -> ( [ `Ledger_proof of Ledger_proof.Tagged.t option ] * [ `Staged_ledger of t ] * [ `Accounts_created of Account_id.t list ] * [ `Pending_coinbase_update of bool * Pending_coinbase.Update.t ] @@ -219,7 +244,7 @@ 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 option ] + -> ( [ `Ledger_proof of Ledger_proof.Tagged.t option ] * [ `Staged_ledger of t ] * [ `Accounts_created of Account_id.t list ] * [ `Pending_coinbase_update of bool * Pending_coinbase.Update.t ] @@ -307,15 +332,7 @@ val of_scan_state_pending_coinbases_and_snarked_ledger_unchecked : -> t Or_error.t Deferred.t (** All the pending work in t and the data required to generate proofs. *) -val 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 +val all_work_pairs : t -> Scan_state.Available_job.t One_or_two.t list (** Statements of all the pending work in t*) val all_work_statements_exn : t -> Transaction_snark_work.Statement.t list diff --git a/src/lib/transaction/transaction.ml b/src/lib/transaction/transaction.ml index db52c5258e32..224ec45cadcf 100644 --- a/src/lib/transaction/transaction.ml +++ b/src/lib/transaction/transaction.ml @@ -79,7 +79,7 @@ let forget : Valid.t -> t = function | Coinbase t -> Coinbase t -let fee_excess : t -> Fee_excess.t Or_error.t = function +let fee_excess : (_, _, _) with_forest -> Fee_excess.t Or_error.t = function | Command (Signed_command t) -> Ok (Signed_command.fee_excess t) | Command (Zkapp_command ps) -> diff --git a/src/lib/transaction/transaction_type.ml b/src/lib/transaction/transaction_type.ml index 547acd0dc9ff..80a3ddfdd742 100644 --- a/src/lib/transaction/transaction_type.ml +++ b/src/lib/transaction/transaction_type.ml @@ -1,5 +1,12 @@ -type t = [ `Zkapp_command | `Signed_command | `Coinbase | `Fee_transfer ] -[@@deriving to_yojson] +[%%versioned +module Stable = struct + module V1 = struct + type t = [ `Zkapp_command | `Signed_command | `Coinbase | `Fee_transfer ] + [@@deriving to_yojson, sexp] + + let to_latest x = x + end +end] let of_transaction = function | Transaction.Command (Mina_base.User_command.Zkapp_command _) -> 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 413bc94780fb..beb7631ec2bb 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 @@ -19,106 +19,183 @@ module type Monad_with_Or_error_intf = sig end module Transaction_with_witness = struct - [%%versioned - module Stable = struct - [@@@no_toplevel_latest_type] + module T = struct + [%%versioned + module Stable = struct + [@@@no_toplevel_latest_type] - (* TODO In Mesa use Transaction_snark.Statement.t * Transaction_witness.t *) - module V3 = struct - type t = - { transaction_with_status : - Transaction.Stable.V2.t With_status.Stable.V2.t - ; state_hash : State_hash.Stable.V1.t * State_body_hash.Stable.V1.t - ; statement : Transaction_snark.Statement.Stable.V2.t - ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.Stable.V1.t - ; first_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) - ; second_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) - ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t - (* TODO: in Mesa remove the option, just have the value *) - ; previous_protocol_state_body_opt : - Mina_state.Protocol_state.Body.Value.Stable.V2.t option - } - [@@deriving sexp, to_yojson] + (* TODO In Mesa use Transaction_snark.Statement.t * Transaction_witness.t *) + module V3 = struct + type t = + { transaction_with_status : + Transaction.Stable.V2.t With_status.Stable.V2.t + ; state_hash : State_hash.Stable.V1.t * State_body_hash.Stable.V1.t + ; statement : Transaction_snark.Statement.Stable.V2.t + ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.Stable.V1.t + ; first_pass_ledger_witness : + (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; second_pass_ledger_witness : + (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; block_global_slot : + Mina_numbers.Global_slot_since_genesis.Stable.V1.t + (* TODO: in Mesa remove the option, just have the value *) + ; previous_protocol_state_body_opt : + Mina_state.Protocol_state.Body.Value.Stable.V2.t option + } + [@@deriving sexp, to_yojson] - let to_latest = Fn.id - end + let transaction_type t = + Transaction_type.of_transaction + (With_status.data t.transaction_with_status) - module V2 = struct - (* TODO: The statement is redundant here - it can be computed from the - witness and the transaction - *) - type t = - { transaction_with_info : - Mina_transaction_logic.Transaction_applied.Stable.V2.t - ; state_hash : State_hash.Stable.V1.t * State_body_hash.Stable.V1.t - ; statement : Transaction_snark.Statement.Stable.V2.t - ; init_stack : - Transaction_snark.Pending_coinbase_stack_state.Init_stack.Stable.V1 - .t - ; first_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) - ; second_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) - ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t - } - [@@deriving sexp, to_yojson] - - let to_latest : t -> V3.t = - fun { transaction_with_info - ; state_hash - ; statement - ; init_stack - ; first_pass_ledger_witness - ; second_pass_ledger_witness - ; block_global_slot - } -> - { transaction_with_status = - Mina_transaction_logic.Transaction_applied - .transaction_with_status_stable transaction_with_info - ; statement - ; state_hash - ; init_stack = - ( match init_stack with - | Base stack -> - stack - | Merge -> - failwith "Unexpected stack for witness" ) - ; first_pass_ledger_witness - ; second_pass_ledger_witness - ; block_global_slot - ; previous_protocol_state_body_opt = None - } - end - end] + let to_latest = Fn.id + end + + module V2 = struct + (* TODO: The statement is redundant here - it can be computed from the + witness and the transaction + *) + type t = + { transaction_with_info : + Mina_transaction_logic.Transaction_applied.Stable.V2.t + ; state_hash : State_hash.Stable.V1.t * State_body_hash.Stable.V1.t + ; statement : Transaction_snark.Statement.Stable.V2.t + ; init_stack : + Transaction_snark.Pending_coinbase_stack_state.Init_stack.Stable + .V1 + .t + ; first_pass_ledger_witness : + (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; second_pass_ledger_witness : + (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; block_global_slot : + Mina_numbers.Global_slot_since_genesis.Stable.V1.t + } + [@@deriving sexp, to_yojson] + + let to_latest : t -> V3.t = + fun { transaction_with_info + ; state_hash + ; statement + ; init_stack + ; first_pass_ledger_witness + ; second_pass_ledger_witness + ; block_global_slot + } -> + { transaction_with_status = + Mina_transaction_logic.Transaction_applied + .transaction_with_status_stable transaction_with_info + ; statement + ; state_hash + ; init_stack = + ( match init_stack with + | Base stack -> + stack + | Merge -> + failwith "Unexpected stack for witness" ) + ; first_pass_ledger_witness + ; second_pass_ledger_witness + ; block_global_slot + ; previous_protocol_state_body_opt = None + } + end + end] + + type t = + { transaction_with_status : Transaction.t With_status.t + ; state_hash : State_hash.t * State_body_hash.t + ; statement : Transaction_snark.Statement.t + ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.t + ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.t + ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.t + ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t + ; previous_protocol_state_body_opt : + Mina_state.Protocol_state.Body.Value.t option + } + + let source_first_pass_ledger t = t.statement.source.first_pass_ledger + + let source_second_pass_ledger t = t.statement.source.second_pass_ledger + + let target_first_pass_ledger t = t.statement.target.first_pass_ledger + + let transaction_type t = + Transaction_type.of_transaction + (With_status.data t.transaction_with_status) + + let of_same_block t1 t2 = + State_hash.equal (fst t1.state_hash) (fst t2.state_hash) + end + + include T + + module Tag = struct + [%%versioned + module Stable = struct + module V1 = struct + type t = T.Stable.V3.t State_hash.Tag.Stable.V1.t + + [%%define_locally State_hash.Tag.Stable.V1.(sexp_of_t, t_of_sexp)] + + let to_latest = Fn.id + end + end] + end module Tagged = struct [%%versioned module Stable = struct + [@@@no_toplevel_latest_type] + module V1 = struct type t = - ( State_hash.Stable.V1.t - , Stable.V2.t ) - Multi_key_file_storage.Tag.Stable.V1.t + { tag : Tag.Stable.V1.t + (* Consider removing it as well, it is used only in a handful of places *) + ; statement : Transaction_snark.Statement.Stable.V2.t + ; transaction_type : Mina_transaction.Transaction_type.Stable.V1.t + ; parent_state_hash : State_hash.Stable.V1.t + } [@@deriving sexp] let to_latest = Fn.id end end] + + let source_first_pass_ledger t = + t.Stable.Latest.statement.source.first_pass_ledger + + let source_second_pass_ledger t = + t.Stable.Latest.statement.source.second_pass_ledger + + let target_first_pass_ledger t = + t.Stable.Latest.statement.target.first_pass_ledger + + let transaction_type t = t.Stable.Latest.transaction_type + + let of_same_block t1 t2 = + State_hash.equal t1.Stable.Latest.parent_state_hash + t2.Stable.Latest.parent_state_hash + + let create ~tag (t : T.Stable.Latest.t) = + { Stable.Latest.tag + ; statement = t.statement + ; transaction_type = T.Stable.Latest.transaction_type t + ; parent_state_hash = fst @@ t.state_hash + } + + type t = Stable.Latest.t end - type t = - { transaction_with_status : Transaction.t With_status.t - ; state_hash : State_hash.t * State_body_hash.t - ; statement : Transaction_snark.Statement.t - ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.t - ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.t - ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.t - ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t - ; previous_protocol_state_body_opt : - Mina_state.Protocol_state.Body.Value.t option - } + let read_tag (tagged : Tagged.t) : Stable.Latest.t Or_error.t = + State_hash.File_storage.read (module Stable.Latest) tagged.tag + + let read_tag_exn ~error_tag tagged = + read_tag tagged |> Or_error.tag ~tag:error_tag |> Or_error.ok_exn + + let read_tags (tagged : Tagged.t list) : Stable.Latest.t list Or_error.t = + State_hash.File_storage.read_many + (module Stable.Latest) + (List.map ~f:(fun { tag; _ } -> tag) tagged) let write_all_proofs_to_disk ~signature_kind ~proof_cache_db { Stable.Latest.transaction_with_status @@ -187,25 +264,111 @@ module Ledger_proof_with_sok_message = struct module Stable = struct module V1 = struct type t = - ( State_hash.Stable.V1.t - , Ledger_proof.Stable.V2.t ) - Multi_key_file_storage.Tag.Stable.V1.t - * Sok_message.Stable.V1.t - [@@deriving sexp] + { tag : + ( State_hash.Stable.V1.t + , Proof.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t + ; sok_message : Sok_message.Stable.V1.t + ; statement : Mina_state.Snarked_ledger_state.With_sok.Stable.V2.t + } let to_latest = Fn.id end end] + + let create ~tag ~sok_message ~statement = { tag; sok_message; statement } + + let statement (t : t) = { t.statement with sok_digest = () } + + let sok_digest (t : t) = t.statement.sok_digest end - type t = Ledger_proof.Cached.t * Sok_message.t + let read_tag ({ tag; sok_message; statement } : Tagged.t) : + Stable.Latest.t Or_error.t = + let%map.Or_error proof = + State_hash.File_storage.read (module Proof.Stable.Latest) tag + in + (Transaction_snark.create ~statement ~proof, sok_message) + + let read_tag_exn ~error_tag tagged = + read_tag tagged |> Or_error.tag ~tag:error_tag |> Or_error.ok_exn + + type t = Ledger_proof.t * Sok_message.t end module Available_job = struct type t = - ( Ledger_proof_with_sok_message.t - , Transaction_with_witness.t ) + ( Ledger_proof_with_sok_message.Tagged.t + , Transaction_with_witness.Tagged.t ) Parallel_scan.Available_job.t + + let is_transition (t : t) = match t with Base _ -> true | Merge _ -> false + + let target_second_pass_ledger (t : t) = + match t with + | Base { statement = { target = { second_pass_ledger; _ }; _ }; _ } -> + Some second_pass_ledger + | Merge _ -> + None + + let single_spec ~get_state = function + | Parallel_scan.Available_job.Merge (p1, p2) -> + let%bind.Or_error merged = + Transaction_snark.Statement.merge + (Ledger_proof_with_sok_message.Tagged.statement p1) + (Ledger_proof_with_sok_message.Tagged.statement p2) + in + let%bind.Or_error p1', _ = Ledger_proof_with_sok_message.read_tag p1 in + let%map.Or_error p2', _ = Ledger_proof_with_sok_message.read_tag p2 in + Snark_work_lib.Work.Single.Spec.Stable.Latest.Merge (merged, p1', p2') + | Base tagged_witness -> + let%bind.Or_error { transaction_with_status = + { data = transaction; status } + ; statement + ; state_hash + ; first_pass_ledger_witness = first_pass_ledger + ; second_pass_ledger_witness = second_pass_ledger + ; init_stack + ; block_global_slot + ; previous_protocol_state_body_opt + } = + Transaction_with_witness.read_tag tagged_witness + in + let%map.Or_error protocol_state_body = + match previous_protocol_state_body_opt with + | Some protocol_state_body -> + Ok protocol_state_body + | None -> + get_state (fst state_hash) + |> Or_error.map ~f:Mina_state.Protocol_state.body + in + Snark_work_lib.Work.Single.Spec.Stable.Latest.Transition + ( statement + , { Transaction_witness.Stable.Latest.first_pass_ledger + ; second_pass_ledger + ; transaction + ; protocol_state_body + ; init_stack + ; status + ; block_global_slot + } ) + + let single_spec_one_or_two ~get_state = function + | `One job -> + Or_error.map ~f:(fun x -> `One x) (single_spec ~get_state job) + | `Two (job1, job2) -> + let%bind.Or_error spec1 = single_spec ~get_state job1 in + let%map.Or_error spec2 = single_spec ~get_state job2 in + `Two (spec1, spec2) + + let statement : t -> Transaction_snark.Statement.t option = function + | Base { statement; _ } -> + Some statement + | Merge (p1, p2) -> + Transaction_snark.Statement.merge + (Ledger_proof_with_sok_message.Tagged.statement p1) + (Ledger_proof_with_sok_message.Tagged.statement p2) + |> Result.ok end module Space_partition = Parallel_scan.Space_partition @@ -279,8 +442,6 @@ module Job_view = struct `List [ `Int position; job_to_yojson ] end -type job = Available_job.t - let hash_generic ~serialize_ledger_proof_with_sok_message ~serialize_transaction_with_witness scan_state previous_incomplete_zkapp_updates = @@ -311,31 +472,32 @@ let hash_generic ~serialize_ledger_proof_with_sok_message the snarked ledger*) [%%versioned module Stable = struct - [@@@no_toplevel_latest_type] - (* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) module V3 = struct type t = { scan_state : - ( Ledger_proof_with_sok_message.Stable.V2.t - , Transaction_with_witness.Stable.V3.t ) + ( Ledger_proof_with_sok_message.Tagged.Stable.V1.t + , Transaction_with_witness.Tagged.Stable.V1.t ) Parallel_scan.State.Stable.V1.t ; previous_incomplete_zkapp_updates : - Transaction_with_witness.Stable.V3.t list + Transaction_with_witness.Tagged.Stable.V1.t list * [ `Border_block_continued_in_the_next_tree of bool ] } - let serialize_ledger_proof_with_sok_message = - Binable.to_string (module Ledger_proof_with_sok_message.Stable.V2) - - let serialize_transaction_with_witness = - Binable.to_string (module Transaction_with_witness.Stable.V3) - (* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) let hash (t : t) = hash_generic t.scan_state t.previous_incomplete_zkapp_updates - ~serialize_ledger_proof_with_sok_message - ~serialize_transaction_with_witness + ~serialize_ledger_proof_with_sok_message: + ( Fn.compose + (Binable.to_string + (module Ledger_proof_with_sok_message.Stable.V2) ) + @@ Ledger_proof_with_sok_message.read_tag_exn + ~error_tag:"scan state hashing" ) + ~serialize_transaction_with_witness: + ( Fn.compose + (Binable.to_string (module Transaction_with_witness.Stable.V3)) + @@ Transaction_with_witness.read_tag_exn + ~error_tag:"scan state hashing" ) let to_latest = Fn.id end @@ -355,35 +517,39 @@ module Stable = struct fun { scan_state ; previous_incomplete_zkapp_updates = updates, continue_in_next_tree } -> - { scan_state = - Parallel_scan.State.map scan_state ~f1:ident - ~f2:Transaction_with_witness.Stable.V2.to_latest - ; previous_incomplete_zkapp_updates = - ( List.map updates ~f:Transaction_with_witness.Stable.V2.to_latest - , continue_in_next_tree ) - } + State_hash.File_storage.write_values_exn State_hash.dummy + ~f:(fun writer -> + let f1 + ((proof, sok_message) : Ledger_proof_with_sok_message.Stable.V2.t) + = + let statement = Ledger_proof.statement_with_sok proof in + let proof' = Ledger_proof.underlying_proof proof in + let tag = + State_hash.File_storage.write_value writer + (module Proof.Stable.V2) + proof' + in + Ledger_proof_with_sok_message.Tagged.create ~tag ~sok_message + ~statement + in + let f2 witness = + let stable = Transaction_with_witness.Stable.V2.to_latest witness in + let tag = + State_hash.File_storage.write_value writer + (module Transaction_with_witness.Stable.V3) + stable + in + Transaction_with_witness.Tagged.create ~tag stable + in + { V3.scan_state = Parallel_scan.State.map scan_state ~f1 ~f2 + ; previous_incomplete_zkapp_updates = + (List.map updates ~f:f2, continue_in_next_tree) + } ) end end] -type t = - { scan_state : - ( Ledger_proof_with_sok_message.t - , Transaction_with_witness.t ) - Parallel_scan.State.t - ; previous_incomplete_zkapp_updates : - Transaction_with_witness.t list - * [ `Border_block_continued_in_the_next_tree of bool ] - } - (* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) -let hash (t : t) = - hash_generic t.scan_state t.previous_incomplete_zkapp_updates - ~serialize_ledger_proof_with_sok_message: - (Fn.compose Stable.Latest.serialize_ledger_proof_with_sok_message - (Tuple2.map_fst ~f:Ledger_proof.Cached.read_proof_from_disk) ) - ~serialize_transaction_with_witness: - (Fn.compose Stable.Latest.serialize_transaction_with_witness - Transaction_with_witness.read_all_proofs_from_disk ) +let hash : t -> _ = Stable.Latest.hash (**********Helpers*************) @@ -481,8 +647,10 @@ let create_expected_statement ~constraint_constants ; sok_digest = () } -let total_proofs (works : Transaction_snark_work.t list) = - List.sum (module Int) works ~f:(fun w -> One_or_two.length w.proofs) +(* + TODO: move to a different module and use + let total_proofs (works : Transaction_snark_work.t list) = + List.sum (module Int) works ~f:(fun w -> One_or_two.length w.proofs) *) (*************exposed functions*****************) @@ -491,7 +659,7 @@ module Make_statement_scanner (Verifier : sig val verify : verifier:t - -> Ledger_proof_with_sok_message.t list + -> Ledger_proof_with_sok_message.Stable.Latest.t list -> unit Or_error.t Deferred.Or_error.t end) = struct @@ -546,9 +714,13 @@ struct "%s timing" label end + let proof_cache_db = Proof_cache_tag.create_identity_db () + (*TODO: fold over the pending_coinbase tree and validate the statements?*) let scan_statement (type merge) ~constraint_constants ~logger - ~merge_to_statement tree ~statement_check ~verify = + ~merge_to_statement + (tree : (merge, Transaction_with_witness.Tagged.t) Parallel_scan.State.t) + ~statement_check ~verify = let open Deferred.Or_error.Let_syntax in let timer = Timer.create ~logger () in let yield_occasionally = @@ -628,11 +800,20 @@ struct (acc_stmt, acc_pc) in let check_base (acc_statement, acc_pc) - (transaction : Transaction_with_witness.t) = + (tagged : Transaction_with_witness.Tagged.t) = with_error "Bad base statement" ~f:(fun () -> let%bind expected_statement = match statement_check with | `Full get_state -> + let%bind transaction_stable = + Transaction_with_witness.read_tag tagged |> Deferred.return + in + let transaction = + (* TODO: hash computation insude, remove it *) + Transaction_with_witness.write_all_proofs_to_disk + ~signature_kind:Mina_signature_kind.t_DEPRECATED + ~proof_cache_db transaction_stable + in let%bind result = Timer.time timer (sprintf "create_expected_statement:%s" __LOC__) (fun () -> @@ -646,18 +827,18 @@ struct let%map () = yield_always () in result | `Partial -> - return transaction.statement + return tagged.statement in let%bind () = yield_always () in if - Transaction_snark.Statement.equal transaction.statement + Transaction_snark.Statement.equal tagged.statement expected_statement then let%bind acc_stmt = - merge_acc ~proofs:[] acc_statement transaction.statement + merge_acc ~proofs:[] acc_statement tagged.statement in let%map acc_pc = - merge_pc acc_pc transaction.statement |> Deferred.return + merge_pc acc_pc tagged.statement |> Deferred.return in (acc_stmt, acc_pc) else @@ -666,7 +847,7 @@ struct !"Bad base statement expected: \ %{sexp:Transaction_snark.Statement.t} got: \ %{sexp:Transaction_snark.Statement.t}" - transaction.statement expected_statement ) ) + tagged.statement expected_statement ) ) in let fold_step_d (acc_statement, acc_pc) job = match job with @@ -674,7 +855,7 @@ struct return (acc_statement, acc_pc) | Full { status = Parallel_scan.Job_status.Done - ; job = (transaction : Transaction_with_witness.t) + ; job = (transaction : Transaction_with_witness.Tagged.t) ; _ } -> let%map acc_pc = @@ -717,8 +898,11 @@ struct | Error e -> Deferred.return (Error (`Error e)) - let check_invariants_impl parallel_scan_state ~merge_to_statement - ~constraint_constants ~logger ~statement_check ~verify ~error_prefix + let check_invariants_impl + (parallel_scan_state : + (_, Transaction_with_witness.Tagged.t) Parallel_scan.State.t ) + ~merge_to_statement ~constraint_constants ~logger ~statement_check ~verify + ~error_prefix ~(last_proof_statement : Transaction_snark.Statement.t option) ~(registers_end : ( Frozen_ledger_hash.t @@ -798,21 +982,23 @@ struct in () - let check_invariants (t : t) ~verifier = + let check_invariants t ~verifier = + let verify tagged_list = + let%bind.Deferred.Or_error ps = + (* Reversed list, it's ok here *) + List.fold_result tagged_list ~init:[] ~f:(fun acc tagged -> + let%map.Or_error p = + Ledger_proof_with_sok_message.read_tag tagged + in + p :: acc ) + |> Deferred.return + in + Verifier.verify ~verifier ps + in check_invariants_impl t.scan_state - ~merge_to_statement:(Fn.compose Ledger_proof.Cached.statement fst) - ~verify:(Verifier.verify ~verifier) + ~merge_to_statement:Ledger_proof_with_sok_message.Tagged.statement ~verify end -let statement_of_job : job -> Transaction_snark.Statement.t option = function - | Base { statement; _ } -> - Some statement - | Merge ((p1, _), (p2, _)) -> - Transaction_snark.Statement.merge - (Ledger_proof.Cached.statement p1) - (Ledger_proof.Cached.statement p2) - |> Result.ok - let create ~work_delay ~transaction_capacity_log_2 : t = let k = Int.pow 2 transaction_capacity_log_2 in { scan_state = Parallel_scan.empty ~delay:work_delay ~max_base_jobs:k @@ -953,21 +1139,10 @@ struct ~f:(categorize_transactions_per_tree ~previous_incomplete) end -module Witness_categorizer = Make_transaction_categorizer (struct - include Transaction_with_witness - - let source_first_pass_ledger t = t.statement.source.first_pass_ledger - - let source_second_pass_ledger t = t.statement.source.second_pass_ledger - - let target_first_pass_ledger t = t.statement.target.first_pass_ledger - - let transaction_type t = - Transaction_type.of_transaction (With_status.data t.transaction_with_status) - - let of_same_block t1 t2 = - State_hash.equal (fst t1.state_hash) (fst t2.state_hash) -end) +module Witness_categorizer = + Make_transaction_categorizer (Transaction_with_witness) +module Tagged_categorizer = + Make_transaction_categorizer (Transaction_with_witness.Tagged) let extract_txn_and_global_slot (txn_with_witness : Transaction_with_witness.t) = @@ -976,45 +1151,78 @@ let extract_txn_and_global_slot (txn_with_witness : Transaction_with_witness.t) let global_slot = txn_with_witness.block_global_slot in (txn, state_hash, global_slot) -let latest_ledger_proof t = - let%map.Option (proof, _), _ = - Parallel_scan.last_emitted_value t.scan_state - in - proof +let latest_ledger_proof_statement t = + let%map.Option tagged, _ = Parallel_scan.last_emitted_value t.scan_state in + Ledger_proof_with_sok_message.Tagged.statement tagged -let latest_recent_proof_txs t = - let%map.Option _, txns_with_witnesses = - Parallel_scan.last_emitted_value t.scan_state - in - let ( previous_incomplete - , `Border_block_continued_in_the_next_tree continued_in_next_tree ) = - t.previous_incomplete_zkapp_updates +let latest_recent_proof_txs_impl ~process ~continued_in_next_tree + ~previous_incomplete txns_with_witnesses = + let txns = + process + ~previous_incomplete: + (if continued_in_next_tree then previous_incomplete else []) + txns_with_witnesses in - if continued_in_next_tree || List.is_empty previous_incomplete then - Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses - ~previous_incomplete + if List.is_empty previous_incomplete then txns else { Transactions_categorized.Poly.first_pass = [] ; second_pass = [] ; previous_incomplete ; continued_in_the_next_tree = false } - :: Witness_categorizer.categorize_transactions_per_tree txns_with_witnesses - ~previous_incomplete:[] + :: txns + +let read_tags_and_write_proofs ~signature_kind ~proof_cache_db txns_tagged = + let%map.Or_error txns_stable = + Transaction_with_witness.read_tags txns_tagged + in + (* TODO: hash computation insude, remove it *) + List.map + ~f: + (Transaction_with_witness.write_all_proofs_to_disk ~signature_kind + ~proof_cache_db ) + txns_stable + +let latest_recent_proof_txs_untagged ~signature_kind ~proof_cache_db t = + match Parallel_scan.last_emitted_value t.scan_state |> Option.map ~f:snd with + | None -> + Or_error.return None + | Some txns_with_witnesses_tagged -> + let ( previous_incomplete_tagged + , `Border_block_continued_in_the_next_tree continued_in_next_tree ) = + t.previous_incomplete_zkapp_updates + in + let%bind.Or_error txns_with_witnesses = + read_tags_and_write_proofs ~signature_kind ~proof_cache_db + txns_with_witnesses_tagged + in + let%map.Or_error previous_incomplete = + read_tags_and_write_proofs ~signature_kind ~proof_cache_db + previous_incomplete_tagged + in + latest_recent_proof_txs_impl + ~process:Witness_categorizer.categorize_transactions_per_tree + ~continued_in_next_tree ~previous_incomplete txns_with_witnesses + |> Option.some let incomplete_txns_from_recent_proof_tree t = - let%bind.Option (proof, _), txns_with_witnesses = + let%bind.Option tagged, txns_with_witnesses = Parallel_scan.last_emitted_value t.scan_state in (* First pass ledger is considered as the snarked ledger, so any account update whether completed in the same tree or not should be included in the next tree *) let%map.Option res = - Witness_categorizer.second_pass_last_block txns_with_witnesses + Tagged_categorizer.second_pass_last_block txns_with_witnesses in - (proof, res) + (Ledger_proof_with_sok_message.Tagged.statement tagged, res) let staged_transactions t = + let process ~previous_incomplete txns = + Tagged_categorizer.categorize_transactions_per_forest ~previous_incomplete + txns + |> List.concat + in let ( previous_incomplete , `Border_block_continued_in_the_next_tree continued_in_next_tree ) = Option.value_map @@ -1022,28 +1230,40 @@ let staged_transactions t = (incomplete_txns_from_recent_proof_tree t) ~f:snd in - let txns = - if continued_in_next_tree then - Witness_categorizer.categorize_transactions_per_forest - (Parallel_scan.pending_data t.scan_state) - ~previous_incomplete - else - let txns = - Witness_categorizer.categorize_transactions_per_forest - (Parallel_scan.pending_data t.scan_state) - ~previous_incomplete:[] - in - if List.is_empty previous_incomplete then txns - else - [ { Transactions_categorized.Poly.first_pass = [] - ; second_pass = [] - ; previous_incomplete - ; continued_in_the_next_tree = false - } - ] - :: txns + let txns_with_witnesses = Parallel_scan.pending_data t.scan_state in + latest_recent_proof_txs_impl ~process ~continued_in_next_tree + ~previous_incomplete txns_with_witnesses + +let staged_transactions_untagged ~signature_kind ~proof_cache_db t = + let process ~previous_incomplete txns = + Witness_categorizer.categorize_transactions_per_forest ~previous_incomplete + txns + |> List.concat + in + let ( previous_incomplete_tagged + , `Border_block_continued_in_the_next_tree continued_in_next_tree ) = + Option.value_map + ~default:([], `Border_block_continued_in_the_next_tree false) + (incomplete_txns_from_recent_proof_tree t) + ~f:snd in - List.concat txns + let txns_with_witnesses_tagged = Parallel_scan.pending_data t.scan_state in + let%bind.Or_error txns_with_witnesses = + List.fold_result ~init:[] + ~f:(fun acc lst -> + let%map.Or_error lst' = + read_tags_and_write_proofs ~signature_kind ~proof_cache_db lst + in + lst' :: acc ) + txns_with_witnesses_tagged + |> Or_error.map ~f:List.rev + in + let%map.Or_error previous_incomplete = + read_tags_and_write_proofs ~signature_kind ~proof_cache_db + previous_incomplete_tagged + in + latest_recent_proof_txs_impl ~process ~continued_in_next_tree + ~previous_incomplete txns_with_witnesses (* written in continuation passing style so that implementation can be used both sync and async *) let apply_categorized_txns_stepwise ?(stop_at_first_pass = false) @@ -1331,9 +1551,15 @@ let apply_categorized_txns_async ?stop_at_first_pass categorized_txns ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind +(* Used in move_root if the block emitted a proof *) 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_recent_proof_txs t with + (* NOTE: data is short-lived, so it's ok to use identity cache *) + match%bind.Or_error + latest_recent_proof_txs_untagged ~signature_kind + ~proof_cache_db:(Proof_cache_tag.create_identity_db ()) + t + with | None -> Or_error.errorf "No transactions found" | Some txns_per_block -> @@ -1342,10 +1568,20 @@ let get_snarked_ledger_sync ~ledger ~get_protocol_state ~apply_first_pass ~apply_first_pass_sparse_ledger ~signature_kind |> Or_error.ignore_m +(* Used in get_snarked_ledger_full, which is used for: + - Checking membership of an account vs ledger (GraphQL) + - Client's endpoint to export ledger + - Hardfork migration *) 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_recent_proof_txs t with + (* NOTE: data is short-lived, so it's ok to use identity cache *) + match%bind.Deferred.Or_error + latest_recent_proof_txs_untagged ~signature_kind + ~proof_cache_db:(Proof_cache_tag.create_identity_db ()) + t + |> Deferred.return + with | None -> Deferred.Or_error.errorf "No transactions found" | Some txns_per_block -> @@ -1354,10 +1590,18 @@ let get_snarked_ledger_async ?async_batch_size ~ledger ~get_protocol_state ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind |> Deferred.Or_error.ignore_m +(* Used in loading the root from disk or receiving it during bootstrap *) let get_staged_ledger_async ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind t = - apply_categorized_txns_async (staged_transactions t) ?async_batch_size ~ledger + (* NOTE: data is short-lived, so it's ok to use identity cache *) + let%bind.Deferred.Or_error staged_txns = + staged_transactions_untagged ~signature_kind + ~proof_cache_db:(Proof_cache_tag.create_identity_db ()) + t + |> Deferred.return + in + apply_categorized_txns_async staged_txns ?async_batch_size ~ledger ~get_protocol_state ~apply_first_pass ~apply_second_pass ~apply_first_pass_sparse_ledger ~signature_kind @@ -1381,10 +1625,8 @@ let partition_if_overflowing t = let snark_job_list_json t = let all_jobs : Job_view.t list list = - let fa (a : Ledger_proof_with_sok_message.t) = - Ledger_proof.Cached.statement (fst a) - in - let fd (d : Transaction_with_witness.t) = d.statement in + let fa a = Ledger_proof_with_sok_message.Tagged.statement a in + let fd (d : Transaction_with_witness.Tagged.t) = d.statement in Parallel_scan.view_jobs_with_position t.scan_state fa fd in Yojson.Safe.to_string @@ -1403,7 +1645,7 @@ let all_work_statements_exn t : Transaction_snark_work.Statement.t list = List.concat_map work_seqs ~f:(fun work_seq -> One_or_two.group_list (List.map work_seq ~f:(fun job -> - match statement_of_job job with + match Available_job.statement job with | None -> assert false | Some stmt -> @@ -1421,108 +1663,63 @@ let k_work_pairs_for_new_diff t ~k = (* TODO create a function work_statements_length and use it where only the length of the list is needed *) (* Length is used in ledger application. Whole list is - needed only in a tests and in [Staged_ledger.create_diff] *) + needed only in tests and in [Staged_ledger.create_diff] *) (*Always the same pairing of jobs*) let work_statements_for_new_diff t : Transaction_snark_work.Statement.t list = let work_list = Parallel_scan.jobs_for_next_update t.scan_state in List.concat_map work_list ~f:(fun work_seq -> One_or_two.group_list (List.map work_seq ~f:(fun job -> - match statement_of_job job with + match Available_job.statement job with | None -> assert false | 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_status = { data = transaction; status } - ; statement - ; state_hash - ; first_pass_ledger_witness - ; second_pass_ledger_witness - ; init_stack - ; block_global_slot - ; previous_protocol_state_body_opt - } -> - let%map.Or_error protocol_state_body = - match previous_protocol_state_body_opt with - | Some protocol_state_body -> - Ok protocol_state_body - | None -> - get_state (fst state_hash) - |> Or_error.map ~f:Mina_state.Protocol_state.body - in - let witness = - { 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) : - Snark_work_lib.Spec.Single.t One_or_two.t list Or_error.t = - let all_jobs = all_jobs t in - List.fold_until all_jobs ~init:[] - ~finish:(fun lst -> Ok lst) - ~f:(fun acc jobs -> - let specs_list = - single_spec_one_or_twos_rev_of_job_list ~get_state jobs - in - match specs_list with - | Ok list -> - Continue (acc @ List.rev list) - | Error e -> - Stop (Error e) ) +(* 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) : + Snark_work_lib.Spec.Single.t One_or_two.t list Or_error.t = + let all_jobs = all_jobs t in + List.fold_until all_jobs ~init:[] + ~finish:(fun lst -> Ok lst) + ~f:(fun acc jobs -> + let specs_list = + single_spec_one_or_twos_rev_of_job_list ~get_state jobs + in + match specs_list with + | Ok list -> + Continue (acc @ List.rev list) + | Error e -> + Stop (Error e) ) *) + +let all_work_pairs t : Available_job.t One_or_two.t list = + all_jobs t |> List.concat_map ~f:One_or_two.group_list let update_metrics t = Parallel_scan.update_metrics t.scan_state -let fill_work_and_enqueue_transactions t ~logger transactions work = +let fill_work_and_enqueue_transactions t ~logger transactions works = let open Or_error.Let_syntax in - let deconstruct_work (w : Transaction_snark_work.t) : - Ledger_proof_with_sok_message.t list = - let fee = Transaction_snark_work.fee w in - let prover = Transaction_snark_work.prover w in - One_or_two.map (Transaction_snark_work.proofs w) ~f:(fun proof -> - (proof, Sok_message.create ~fee ~prover) ) - |> One_or_two.to_list - in (*get incomplete transactions from previous proof which will be completed in the new proof, if there's one*) let old_proof_and_incomplete_zkapp_updates = incomplete_txns_from_recent_proof_tree t in - let work_list = List.concat_map ~f:deconstruct_work work in let%bind proof_opt, updated_scan_state = - Parallel_scan.update t.scan_state ~completed_jobs:work_list - ~data:transactions + Parallel_scan.update t.scan_state ~completed_jobs:works ~data:transactions in [%log internal] "@metadata" ~metadata: - [ ("scan_state_added_works", `Int (List.length work)) - ; ("total_proofs", `Int (total_proofs work)) - ; ("merge_jobs_created", `Int (List.length work_list)) + [ ("scan_state_added_works", `Int (List.length works)) + (* TODO uncomment *) + (* ; ("total_proofs", `Int (total_proofs works)) *) + ; ("merge_jobs_created", `Int (List.length works)) ; ("emitted_proof", `Bool (Option.is_some proof_opt)) ] ; let%map result_opt, scan_state' = @@ -1535,16 +1732,17 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = t.previous_incomplete_zkapp_updates } ) ) proof_opt - ~f:(fun ((proof, _), _txns_with_witnesses) -> - let curr_stmt = Ledger_proof.Cached.statement proof in + ~f:(fun (curr_tagged, _txns_with_witnesses) -> + let curr_stmt = + Ledger_proof_with_sok_message.Tagged.statement curr_tagged + in let prev_stmt, incomplete_zkapp_updates_from_old_proof = Option.value_map ~default: (curr_stmt, ([], `Border_block_continued_in_the_next_tree false)) old_proof_and_incomplete_zkapp_updates ~f:(fun (p', incomplete_zkapp_updates_from_old_proof) -> - ( Ledger_proof.Cached.statement p' - , incomplete_zkapp_updates_from_old_proof ) ) + (p', incomplete_zkapp_updates_from_old_proof) ) in (*prev_target is connected to curr_source- Order of the arguments is important here*) @@ -1562,11 +1760,18 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = incomplete_zkapp_updates_from_old_proof } in - (*This block is for when there's a proof emitted so Option. - value_exn is safe here - [latest_ledger_proof] generates categorized transactions - appropriately*) - Ok (latest_ledger_proof scan_state', scan_state') + let proof' = + let%map.Option ({ tag; _ } as tagged), _ = + Parallel_scan.last_emitted_value scan_state'.scan_state + in + let statement = + Ledger_proof_with_sok_message.Tagged.statement tagged + in + Ledger_proof.Tagged.create ~statement ~proof:tag + ~sok_digest: + (Ledger_proof_with_sok_message.Tagged.sok_digest tagged) + in + Ok (proof', scan_state') | Error e -> Or_error.errorf "The new final statement does not connect to the previous \ @@ -1577,10 +1782,11 @@ let fill_work_and_enqueue_transactions t ~logger transactions work = let required_state_hashes t = List.fold ~init:State_hash.Set.empty - ~f:(fun acc (txns : Transactions_categorized.t) -> - Transactions_categorized.fold ~init:acc txns - ~f:(fun acc (t : Transaction_with_witness.t) -> - Set.add acc (fst t.state_hash) ) ) + ~f:(fun acc txns -> + Transactions_categorized.fold ~init:acc txns ~f:(fun acc t -> + Set.add acc + t.Transaction_with_witness.Tagged.Stable.Latest.parent_state_hash ) + ) (staged_transactions t) let check_required_protocol_states t ~protocol_states = @@ -1612,39 +1818,21 @@ let check_required_protocol_states t ~protocol_states = let%map () = check_length protocol_states_assoc in protocol_states_assoc -let write_all_proofs_to_disk ~signature_kind ~proof_cache_db - { Stable.Latest.scan_state = uncached - ; previous_incomplete_zkapp_updates = tx_list, border_status - } = - let f1 (p, v) = - (Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db p, v) - in - { scan_state = - Parallel_scan.State.map uncached ~f1 - ~f2: - (Transaction_with_witness.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) - ; previous_incomplete_zkapp_updates = - ( List.map - ~f: - (Transaction_with_witness.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) - tx_list - , border_status ) - } - -let read_all_proofs_from_disk - { scan_state = cached - ; previous_incomplete_zkapp_updates = tx_list, border_status - } = - let f1 (p, v) = (Ledger_proof.Cached.read_proof_from_disk p, v) in - let scan_state = - Parallel_scan.State.map ~f1 - ~f2:Transaction_with_witness.read_all_proofs_from_disk cached - in - Stable.Latest. - { scan_state - ; previous_incomplete_zkapp_updates = - ( List.map ~f:Transaction_with_witness.read_all_proofs_from_disk tx_list - , border_status ) - } +(* let read_all_proofs_from_disk + { scan_state = cached + ; previous_incomplete_zkapp_updates = tx_list, border_status + } = + let%bind.Result scan_state = + Parallel_scan.State.map_result ~f1:Ledger_proof_with_sok_message.read_tag + ~f2:Transaction_with_witness.read_tag cached + in + let%map.Result tx_list' = + List.fold_result tx_list ~init:[] ~f:(fun acc tx -> + let%map.Result tx' = Transaction_with_witness.read_tag tx in + tx' :: acc ) + |> Result.map ~f:List.rev + in + Stable.Latest. + { scan_state + ; previous_incomplete_zkapp_updates = (tx_list', border_status) + } *) 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 d3aff80222e2..af5a39db5867 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 @@ -6,8 +6,6 @@ module Ledger = Mina_ledger.Ledger [%%versioned: module Stable : sig - [@@@no_toplevel_latest_type] - module V3 : sig type t @@ -21,8 +19,6 @@ module Stable : sig end end] -type t - val hash : t -> Staged_ledger_hash.Aux_hash.t module Transaction_with_witness : sig @@ -41,6 +37,16 @@ module Transaction_with_witness : sig end end] + module Tag : sig + type t = Stable.Latest.t State_hash.Tag.t + end + + module Tagged : sig + type t + + val create : tag:Tag.t -> Stable.Latest.t -> t + end + (* TODO: The statement is redundant here - it can be computed from the witness and the transaction *) type t = { transaction_with_status : Transaction.t With_status.t @@ -64,11 +70,37 @@ module Transaction_with_witness : sig end module Ledger_proof_with_sok_message : sig - type t = Ledger_proof.Cached.t * Sok_message.t + type t = Ledger_proof.t * Sok_message.t + + module Tagged : sig + type t + + val create : + tag:Proof.t State_hash.Tag.t + -> sok_message:Sok_message.t + -> statement:Mina_state.Snarked_ledger_state.With_sok.t + -> t + end end module Available_job : sig type t + + val is_transition : t -> bool + + val target_second_pass_ledger : t -> Frozen_ledger_hash.t option + + val single_spec : + get_state:(State_hash.t -> Mina_state.Protocol_state.Value.t Or_error.t) + -> t + -> Snark_work_lib.Spec.Single.Stable.Latest.t Or_error.t + + val single_spec_one_or_two : + get_state:(State_hash.t -> Mina_state.Protocol_state.Value.t Or_error.t) + -> t One_or_two.t + -> Snark_work_lib.Spec.Single.Stable.Latest.t One_or_two.t Or_error.t + + val statement : t -> Transaction_snark.Statement.t option end module Space_partition : sig @@ -107,11 +139,12 @@ val empty : val fill_work_and_enqueue_transactions : t -> logger:Logger.t - -> Transaction_with_witness.t list - -> Transaction_snark_work.t list - -> (Ledger_proof.Cached.t option * t) Or_error.t + -> Transaction_with_witness.Tagged.t list + -> Ledger_proof_with_sok_message.Tagged.t list + -> (Ledger_proof.Tagged.t option * t) Or_error.t -val latest_ledger_proof : t -> Ledger_proof.Cached.t option +val latest_ledger_proof_statement : + t -> Mina_state.Snarked_ledger_state.t option (** Apply transactions coorresponding to the last emitted proof based on the two-pass system- first pass includes legacy transactions and zkapp payments @@ -209,8 +242,6 @@ val free_space : t -> int (** Available space and the corresponding required work-count in one and/or two trees (if the slots to be occupied are in two different trees)*) val partition_if_overflowing : t -> Space_partition.t -val statement_of_job : Available_job.t -> Transaction_snark.Statement.t option - val snark_job_list_json : t -> string (** All the proof bundles *) @@ -245,20 +276,6 @@ val check_required_protocol_states : Or_error.t (** All the proof bundles for snark workers*) -val 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 - -val write_all_proofs_to_disk : - signature_kind:Mina_signature_kind.t - -> proof_cache_db:Proof_cache_tag.cache_db - -> Stable.Latest.t - -> t +val all_work_pairs : t -> Available_job.t One_or_two.t list -val read_all_proofs_from_disk : t -> Stable.Latest.t +(* val read_all_proofs_from_disk : t -> Stable.Latest.t Or_error.t *) diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 4701f8f05390..a5561afa6774 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -450,7 +450,7 @@ module For_tests = struct |> Blockchain_state.ledger_proof_statement in let ledger_proof_statement = - Option.value_map ledger_proof_opt ~f:Ledger_proof.Cached.statement + Option.value_map ledger_proof_opt ~f:Ledger_proof.Tagged.statement ~default:previous_ledger_proof_stmt in let genesis_ledger_hash = diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index e077e6c48868..c5cd3551070d 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -4,8 +4,6 @@ open Mina_base module Common = struct [%%versioned module Stable = struct - [@@@no_toplevel_latest_type] - module V3 = struct type t = { scan_state : Staged_ledger.Scan_state.Stable.V3.t @@ -29,11 +27,6 @@ module Common = struct end end] - type t = - { scan_state : Staged_ledger.Scan_state.t - ; pending_coinbase : Pending_coinbase.t - } - let to_yojson { scan_state = _; pending_coinbase } = `Assoc [ ("scan_state", `String "") @@ -46,11 +39,6 @@ module Common = struct let scan_state t = t.scan_state let pending_coinbase t = t.pending_coinbase - - let read_all_proofs_from_disk { scan_state; pending_coinbase } = - { Stable.Latest.pending_coinbase - ; scan_state = Staged_ledger.Scan_state.read_all_proofs_from_disk scan_state - } end module Historical = struct @@ -157,7 +145,7 @@ module Limited = struct { Stable.Latest.transition = Mina_block.Validated.read_all_proofs_from_disk t.transition ; protocol_states = t.protocol_states - ; common = Common.read_all_proofs_from_disk t.common + ; common = t.common } end @@ -218,27 +206,6 @@ module Minimal = struct let scan_state t = Common.scan_state t.common let pending_coinbase t = Common.pending_coinbase t.common - - let write_all_proofs_to_disk ~proof_cache_db ~signature_kind - Stable.Latest.{ hash; common = { scan_state; pending_coinbase } } = - { hash - ; common = - { pending_coinbase - ; scan_state = - Staged_ledger.Scan_state.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db scan_state - } - } - - let read_all_proofs_from_disk - { hash; common = { scan_state; pending_coinbase } } = - { Stable.Latest.hash - ; common = - { pending_coinbase - ; scan_state = - Staged_ledger.Scan_state.read_all_proofs_from_disk scan_state - } - } end type t = diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 783513303356..ce16b0522d6a 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -3,8 +3,6 @@ open Mina_base module Common : sig [%%versioned: module Stable : sig - [@@@no_toplevel_latest_type] - module V3 : sig type t end @@ -15,10 +13,6 @@ module Common : sig val to_latest : t -> V3.t end end] - - type t - - val read_all_proofs_from_disk : t -> Stable.Latest.t end (* Historical root data is similar to Limited root data, except that it also @@ -158,14 +152,6 @@ module Minimal : sig -> scan_state:Staged_ledger.Scan_state.t -> pending_coinbase:Pending_coinbase.t -> t - - val read_all_proofs_from_disk : t -> Stable.Latest.t - - val write_all_proofs_to_disk : - proof_cache_db:Proof_cache_tag.cache_db - -> signature_kind:Mina_signature_kind.t - -> Stable.Latest.t - -> t end type t = diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index bd7e5d9be767..8780d4f9b306 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -353,12 +353,9 @@ module Util = struct Breadcrumb.validated_transition heir |> Mina_block.Validated.read_all_proofs_from_disk in - let new_scan_state_unwrapped = - Staged_ledger.Scan_state.read_all_proofs_from_disk new_scan_state - in let new_root_data = Root_data.Limited.Stable.Latest.create ~transition:heir_transition - ~scan_state:new_scan_state_unwrapped + ~scan_state:new_scan_state ~pending_coinbase: (Staged_ledger.pending_coinbase_collection heir_staged_ledger) ~protocol_states diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 622d4dfed809..d68414ff189f 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -387,9 +387,7 @@ let initialize t ~root_data = Batch.set batch ~key:(Arcs root_state_hash) ~data:[] ; Batch.set batch ~key:Root_hash ~data:root_state_hash ; Batch.set batch ~key:Root_common - ~data: - ( root_data |> Root_data.Limited.common - |> Root_data.Common.read_all_proofs_from_disk ) ; + ~data:(Root_data.Limited.common root_data) ; Batch.set batch ~key:Best_tip ~data:root_state_hash ; Batch.set batch ~key:Protocol_states_for_root_scan_state ~data: diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index f71692001091..d6b596364acb 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -23,16 +23,15 @@ end exception Invalid_genesis_state_hash of Mina_block.Validated.t -let construct_staged_ledger_at_root ~proof_cache_db - ~(precomputed_values : Precomputed_values.t) ~root_ledger ~root_transition - ~(root : Root_data.Minimal.Stable.Latest.t) ~protocol_states ~logger - ~signature_kind = +let construct_staged_ledger_at_root ~(precomputed_values : Precomputed_values.t) + ~root_ledger ~root_transition ~(root : Root_data.Minimal.Stable.Latest.t) + ~protocol_states ~logger ~signature_kind = let blockchain_state = root_transition |> Mina_block.Validated.forget |> With_hash.data |> Mina_block.header |> Mina_block.Header.protocol_state |> Protocol_state.blockchain_state in - let pending_coinbases, scan_state_unwrapped = + let pending_coinbases, scan_state = Root_data.Minimal.Stable.Latest.(pending_coinbase root, scan_state root) in let protocol_states_map = @@ -61,10 +60,6 @@ let construct_staged_ledger_at_root ~proof_cache_db let staged_ledger_hash = Blockchain_state.staged_ledger_hash blockchain_state in - let scan_state = - Staged_ledger.Scan_state.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db scan_state_unwrapped - in Staged_ledger.of_scan_state_pending_coinbases_and_snarked_ledger_unchecked ~snarked_local_state:local_state ~snarked_ledger:mask ~scan_state ~constraint_constants:precomputed_values.constraint_constants ~logger @@ -287,8 +282,8 @@ module Instance = struct let%bind root_staged_ledger = let open Deferred.Let_syntax in match%map - construct_staged_ledger_at_root ~proof_cache_db ~precomputed_values - ~root_ledger ~root_transition ~root ~protocol_states + construct_staged_ledger_at_root ~precomputed_values ~root_ledger + ~root_transition ~root ~protocol_states ~signature_kind:t.factory.signature_kind ~logger:t.factory.logger with | Error err -> diff --git a/src/lib/uptime_service/uptime_service.ml b/src/lib/uptime_service/uptime_service.ml index 3f53f185e433..62b1861385c6 100644 --- a/src/lib/uptime_service/uptime_service.ml +++ b/src/lib/uptime_service/uptime_service.ml @@ -241,29 +241,28 @@ let send_block_and_transaction_snark ~logger ~constraint_constants ~interruptor send_uptime_data ~logger ~interruptor ~submitter_keypair ~url ~state_hash ~produced:false block_data ) else + let get_state state_hash = + match Transition_frontier.find_protocol_state tf state_hash with + | None -> + Error + (Error.createf + "Could not find state_hash %s in transition frontier for \ + uptime service" + (State_hash.to_base58_check state_hash) ) + | Some protocol_state -> + Ok protocol_state + in let best_tip_staged_ledger = Transition_frontier.Breadcrumb.staged_ledger best_tip in - match - Staged_ledger.all_work_pairs best_tip_staged_ledger - ~get_state:(fun state_hash -> - match Transition_frontier.find_protocol_state tf state_hash with - | None -> - Error - (Error.createf - "Could not find state_hash %s in transition frontier \ - for uptime service" - (State_hash.to_base58_check state_hash) ) - | Some protocol_state -> - Ok protocol_state ) - with - | Error e -> + match Staged_ledger.all_work_pairs best_tip_staged_ledger with + (* | Error e -> [%log error] "Could not get SNARK work from best tip staged ledger for uptime \ service" ~metadata:[ ("error", Error_json.error_to_yojson e) ] ; - Interruptible.return () - | Ok [] -> + Interruptible.return () *) + | [] -> [%log info] "No SNARK jobs available for uptime service, sending just the \ block" ; @@ -281,14 +280,11 @@ let send_block_and_transaction_snark ~logger ~constraint_constants ~interruptor in send_uptime_data ~logger ~interruptor ~submitter_keypair ~url ~state_hash ~produced:false block_data - | Ok job_one_or_twos -> ( + | job_one_or_twos -> ( let transitions = List.concat_map job_one_or_twos ~f:One_or_two.to_list - |> List.filter ~f:(function - | Snark_work_lib.Work.Single.Spec.Transition _ -> - true - | Merge _ -> - false ) + |> List.filter + ~f:Staged_ledger.Scan_state.Available_job.is_transition in let staged_ledger_hash = Mina_block.header best_tip_block @@ -298,14 +294,10 @@ let send_block_and_transaction_snark ~logger ~constraint_constants ~interruptor in match List.find transitions ~f:(fun transition -> - match transition with - | Snark_work_lib.Work.Single.Spec.Transition ({ target; _ }, _) - -> - Pasta_bindings.Fp.equal target.second_pass_ledger - (Staged_ledger_hash.ledger_hash staged_ledger_hash) - | Merge _ -> - (* unreachable *) - failwith "Expected Transition work, not Merge" ) + Option.equal Frozen_ledger_hash.equal + (Some (Staged_ledger_hash.ledger_hash staged_ledger_hash)) + (Staged_ledger.Scan_state.Available_job + .target_second_pass_ledger transition ) ) with | None -> [%log info] @@ -329,9 +321,13 @@ let send_block_and_transaction_snark ~logger ~constraint_constants ~interruptor | Some single_spec -> ( match%bind make_interruptible - (Uptime_snark_worker.perform_single snark_worker - ( message - , read_all_proofs_for_work_single_spec single_spec ) ) + @@ let%bind.Deferred.Or_error single_spec' = + Staged_ledger.Scan_state.Available_job.single_spec + ~get_state single_spec + |> Deferred.return + in + Uptime_snark_worker.perform_single snark_worker + (message, single_spec') with | Error e -> (* error in submitting to process *) diff --git a/src/lib/work_partitioner/work_partitioner.ml b/src/lib/work_partitioner/work_partitioner.ml index 8156f4f098e4..d04358d8358c 100644 --- a/src/lib/work_partitioner/work_partitioner.ml +++ b/src/lib/work_partitioner/work_partitioner.ml @@ -208,8 +208,17 @@ let schedule_job_from_partitioner ~(partitioner : t) : (* WARN: this should only be called if [partitioner.tmp_slot] is None *) let consume_job_from_selector ~(partitioner : t) ~(sok_message : Mina_base.Sok_message.t) - ~(instances : Work.Spec.Single.t One_or_two.t) : + ~(instances : Work.Spec.Single.Stable.Latest.t One_or_two.t) : (Work.Spec.Partitioned.Stable.Latest.t, _) Result.t = + (* TODO: remove this conversion *) + let instances = + One_or_two.map + ~f: + (Work.Spec.Single.write_all_proofs_to_disk + ~signature_kind:Mina_signature_kind.t_DEPRECATED + ~proof_cache_db:partitioner.proof_cache_db ) + instances + in let pairing_id = Id_generator.next_id partitioner.single_id_gen () in Hashtbl.add_exn partitioner.pairing_pool ~key:pairing_id ~data:(Spec_only { spec = instances; sok_message }) ; @@ -227,7 +236,8 @@ let consume_job_from_selector ~(partitioner : t) convert_single_work_from_selector ~partitioner ~single_spec:spec2 ~sok_message ~pairing:pairing2 -type work_from_selector = Work.Spec.Single.t One_or_two.t option Lazy.t +type work_from_selector = + Work.Spec.Single.Stable.Latest.t One_or_two.t option Lazy.t let request_from_selector_and_consume_by_partitioner ~(partitioner : t) ~(work_from_selector : work_from_selector) diff --git a/src/lib/work_partitioner/work_partitioner.mli b/src/lib/work_partitioner/work_partitioner.mli index 1c7c44c03661..3bc7bbf2febb 100644 --- a/src/lib/work_partitioner/work_partitioner.mli +++ b/src/lib/work_partitioner/work_partitioner.mli @@ -30,7 +30,7 @@ val create : -> t type work_from_selector = - Snark_work_lib.Spec.Single.t One_or_two.t option Lazy.t + Snark_work_lib.Spec.Single.Stable.Latest.t One_or_two.t option Lazy.t (** [request_partitioned_work ~sok_message ~work_from_selector ~partitioner] returns a partitioned job from [partitioner], if there is one available. diff --git a/src/lib/work_selector/inputs.ml b/src/lib/work_selector/inputs.ml index 53866a870f25..768fecb19f15 100644 --- a/src/lib/work_selector/inputs.ml +++ b/src/lib/work_selector/inputs.ml @@ -1,117 +1,116 @@ open Core_kernel -open Currency -module Test_inputs = struct - module Transaction_witness = struct - type t = Int.t +(* module Test_inputs = struct + module Transaction_witness = struct + type t = Int.t - let transaction = Fn.id - end + let transaction = Fn.id + end - module Ledger_hash = Int - module Sparse_ledger = Int + module Ledger_hash = Int + module Sparse_ledger = Int - module Transaction = struct - type t = Int.t + module Transaction = struct + type t = Int.t - let yojson_summary t = `Int t - end + let yojson_summary t = `Int t + end - module Ledger_proof_statement = Fee + module Ledger_proof_statement = Fee - module Transaction_protocol_state = struct - type 'a t = 'a - end + module Transaction_protocol_state = struct + type 'a t = 'a + end - module Ledger_proof = struct - type t = Fee.t [@@deriving hash, compare, sexp] + module Ledger_proof = struct + type t = Fee.t [@@deriving hash, compare, sexp] - module Stable = struct - module Latest = struct - type nonrec t = t - end - end + module Stable = struct + module Latest = struct + type nonrec t = t + end + end - module Cached = struct - type nonrec t = t + module Cached = struct + type nonrec t = t - let read_proof_from_disk = Fn.id - end - end + let read_proof_from_disk = Fn.id + end + end - module Transaction_snark_work = struct - module Checked = struct - type t = Fee.t + module Transaction_snark_work = struct + module Checked = struct + type t = Fee.t - let fee = Fn.id + let fee = Fn.id - let prover _ = Key_gen.Sample_keypairs.genesis_winner |> fst - end + let prover _ = Key_gen.Sample_keypairs.genesis_winner |> fst + end - include Checked + include Checked - module Statement = struct - type t = Transaction_snark.Statement.t One_or_two.t - end - end + module Statement = struct + type t = Transaction_snark.Statement.t One_or_two.t + end + end - module Snark_pool = struct - [%%versioned - module Stable = struct - [@@@no_toplevel_latest_type] + module Snark_pool = struct + [%%versioned + module Stable = struct + [@@@no_toplevel_latest_type] - module V2 = struct - type t = Transaction_snark.Statement.Stable.V2.t One_or_two.Stable.V1.t - [@@deriving hash, compare, sexp] + module V2 = struct + type t = Transaction_snark.Statement.Stable.V2.t One_or_two.Stable.V1.t + [@@deriving hash, compare, sexp] - let to_latest = Fn.id - end - end] + let to_latest = Fn.id + end + end] - module Work = Hashable.Make_binable (Stable.Latest) + module Work = Hashable.Make_binable (Stable.Latest) - type t = Currency.Fee.t Work.Table.t + type t = Currency.Fee.t Work.Table.t - let get_completed_work (t : t) = Work.Table.find t + let get_completed_work (t : t) = Work.Table.find t - let create () = Work.Table.create () + let create () = Work.Table.create () - let add_snark t ~work ~fee = - Work.Table.update t work ~f:(function - | None -> - fee - | Some fee' -> - Currency.Fee.min fee fee' ) - end + let add_snark t ~work ~fee = + Work.Table.update t work ~f:(function + | None -> + fee + | Some fee' -> + Currency.Fee.min fee fee' ) + end - module Staged_ledger = struct - type t = - (int, Transaction_snark_work.t) Snark_work_lib.Work.Single.Spec.t List.t + module Staged_ledger = struct + type t = + (int, Transaction_snark_work.t) Snark_work_lib.Work.Single.Spec.t List.t - let work = Fn.id + let work = Fn.id - let all_work_pairs t ~get_state:_ = Ok (One_or_two.group_list t) - end + let all_work_pairs t = (One_or_two.group_list t) + end - module Transition_frontier = struct - type t = Staged_ledger.t + module Transition_frontier = struct + type t = Staged_ledger.t - type best_tip_view = unit + type best_tip_view = unit - let best_tip_pipe : t -> best_tip_view Pipe_lib.Broadcast_pipe.Reader.t = - fun _t -> - let reader, _writer = Pipe_lib.Broadcast_pipe.create () in - reader + let best_tip_pipe : t -> best_tip_view Pipe_lib.Broadcast_pipe.Reader.t = + fun _t -> + let reader, _writer = Pipe_lib.Broadcast_pipe.create () in + reader - let best_tip_staged_ledger = Fn.id + let best_tip_staged_ledger = Fn.id - let get_protocol_state _t _hash = - Ok - (Lazy.force Precomputed_values.for_unit_tests) - .protocol_state_with_hashes - .data - end -end + let get_protocol_state _t _hash = + Ok + (Lazy.force Precomputed_values.for_unit_tests) + .protocol_state_with_hashes + .data + end + end *) module Implementation_inputs = struct open Mina_base diff --git a/src/lib/work_selector/intf.ml b/src/lib/work_selector/intf.ml index 4a0124134099..2ac753debeb9 100644 --- a/src/lib/work_selector/intf.ml +++ b/src/lib/work_selector/intf.ml @@ -72,16 +72,36 @@ module type Inputs_intf = sig module Staged_ledger : sig type t - val all_work_pairs : - t - -> get_state: - (Mina_base.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 + module Scan_state : sig + module Available_job : sig + type t + + (* val single_spec : + get_state: + ( Mina_base.State_hash.t + -> Mina_state.Protocol_state.Value.t Or_error.t ) + -> t + -> ( Transaction_witness.Stable.Latest.t + , Ledger_proof.Stable.Latest.t ) + Snark_work_lib.Spec.Single.Poly.t + Or_error.t + + val single_spec_one_or_two : + get_state: + ( Mina_base.State_hash.t + -> Mina_state.Protocol_state.Value.t Or_error.t ) + -> t One_or_two.t + -> ( Transaction_witness.Stable.Latest.t + , Ledger_proof.t ) + Snark_work_lib.Spec.Single.Poly.t + One_or_two.t + Or_error.t + *) + val statement : t -> Transaction_snark.Statement.t option + end + end + + val all_work_pairs : t -> Scan_state.Available_job.t One_or_two.t list end module Transition_frontier : sig @@ -123,10 +143,7 @@ module type Lib_intf = sig val mark_scheduled : logger:Logger.t -> t - -> ( Transaction_witness.t - , Ledger_proof.Cached.t ) - Snark_work_lib.Work.Single.Spec.t - One_or_two.t + -> Staged_ledger.Scan_state.Available_job.t One_or_two.t -> unit (** [all_unscheduled_expensive_works ~snark_pool ~fee t] filters out all @@ -137,11 +154,7 @@ module type Lib_intf = sig snark_pool:Snark_pool.t -> fee:Fee.t -> t - -> ( Transaction_witness.t - , Ledger_proof.Cached.t ) - Snark_work_lib.Work.Single.Spec.t - One_or_two.t - list + -> Staged_ledger.Scan_state.Available_job.t One_or_two.t list end (**jobs that are not in the snark pool yet*) @@ -187,10 +200,7 @@ end module type Make_selection_method_intf = functor (Lib : Lib_intf) -> Selection_method_intf with type staged_ledger := Lib.Inputs.Staged_ledger.t - and type work := - ( Lib.Inputs.Transaction_witness.t - , Lib.Inputs.Ledger_proof.Cached.t ) - Snark_work_lib.Work.Single.Spec.t + and type work := Lib.Inputs.Staged_ledger.Scan_state.Available_job.t and type snark_pool := Lib.Inputs.Snark_pool.t and type transition_frontier := Lib.Inputs.Transition_frontier.t and module State := Lib.State diff --git a/src/lib/work_selector/random.ml b/src/lib/work_selector/random.ml index 261908beb564..90fa0d3a0569 100644 --- a/src/lib/work_selector/random.ml +++ b/src/lib/work_selector/random.ml @@ -12,7 +12,7 @@ module Make (Lib : Intf.Lib_intf) = struct Some x end -let%test_module "test" = - ( module struct - module Test = Test.Make_test (Make) - end ) +(* let%test_module "test" = + ( module struct + module Test = Test.Make_test (Make) + end ) *) diff --git a/src/lib/work_selector/random_offset.ml b/src/lib/work_selector/random_offset.ml index 09604d498638..36f103b1b83f 100644 --- a/src/lib/work_selector/random_offset.ml +++ b/src/lib/work_selector/random_offset.ml @@ -53,7 +53,7 @@ module Make (Lib : Intf.Lib_intf) = struct Some x end -let%test_module "test" = - ( module struct - module Test = Test.Make_test (Make) - end ) +(* let%test_module "test" = + ( module struct + module Test = Test.Make_test (Make) + end ) *) diff --git a/src/lib/work_selector/sequence.ml b/src/lib/work_selector/sequence.ml index b18a43564825..eb48b29b29df 100644 --- a/src/lib/work_selector/sequence.ml +++ b/src/lib/work_selector/sequence.ml @@ -8,7 +8,7 @@ module Make (Lib : Intf.Lib_intf) = struct Some x end -let%test_module "test" = - ( module struct - module Test = Test.Make_test (Make) - end ) +(* let%test_module "test" = + ( module struct + module Test = Test.Make_test (Make) + end ) *) diff --git a/src/lib/work_selector/test.ml b/src/lib/work_selector/test.ml index 5f7aaa423c24..87c3eddccff8 100644 --- a/src/lib/work_selector/test.ml +++ b/src/lib/work_selector/test.ml @@ -1,114 +1,114 @@ -open Core_kernel -open Async -open Currency -open Pipe_lib +(* open Core_kernel + open Async + open Currency + open Pipe_lib -module Make_test (Make_selection_method : Intf.Make_selection_method_intf) = -struct - module T = Inputs.Test_inputs - module Lib = Work_lib.Make (T) - module Selection_method = Make_selection_method (Lib) + module Make_test (Make_selection_method : Intf.Make_selection_method_intf) = + struct + module T = Inputs.Test_inputs + module Lib = Work_lib.Make (T) + module Selection_method = Make_selection_method (Lib) - let gen_staged_ledger = - (*Staged_ledger for tests is a list of work specs*) - Quickcheck.Generator.list - @@ Snark_work_lib.Work.Single.Spec.gen Int.quickcheck_generator Fee.gen + let gen_staged_ledger = + (*Staged_ledger for tests is a list of work specs*) + Quickcheck.Generator.list + @@ Snark_work_lib.Work.Single.Spec.gen Int.quickcheck_generator Fee.gen - let precomputed_values = Precomputed_values.for_unit_tests + let precomputed_values = Precomputed_values.for_unit_tests - let init_state sl logger = - let tf_reader, tf_writer = Broadcast_pipe.create None in - let work_state = - Lib.State.init ~frontier_broadcast_pipe:tf_reader ~logger - in - let%map () = Broadcast_pipe.Writer.write tf_writer (Some sl) in - work_state + let init_state sl logger = + let tf_reader, tf_writer = Broadcast_pipe.create None in + let work_state = + Lib.State.init ~frontier_broadcast_pipe:tf_reader ~logger + in + let%map () = Broadcast_pipe.Writer.write tf_writer (Some sl) in + work_state - let%test_unit "Workspec chunk doesn't send same things again" = - Backtrace.elide := false ; - let p = 50 in - let snark_pool = T.Snark_pool.create () in - let fee = Currency.Fee.zero in - let logger = Logger.null () in - Quickcheck.test gen_staged_ledger ~trials:100 ~f:(fun sl -> - Async.Thread_safe.block_on_async_exn (fun () -> - let open Deferred.Let_syntax in - let%bind work_state = init_state sl logger in - let rec go i = - [%test_result: Bool.t] - ~message:"Exceeded time expected to exhaust work" ~expect:true - (i <= p) ; - let stuff = - Selection_method.work ~snark_pool ~fee ~logger work_state - in - match stuff with None -> return () | _ -> go (i + 1) - in - go 0 ) ) + let%test_unit "Workspec chunk doesn't send same things again" = + Backtrace.elide := false ; + let p = 50 in + let snark_pool = T.Snark_pool.create () in + let fee = Currency.Fee.zero in + let logger = Logger.null () in + Quickcheck.test gen_staged_ledger ~trials:100 ~f:(fun sl -> + Async.Thread_safe.block_on_async_exn (fun () -> + let open Deferred.Let_syntax in + let%bind work_state = init_state sl logger in + let rec go i = + [%test_result: Bool.t] + ~message:"Exceeded time expected to exhaust work" ~expect:true + (i <= p) ; + let stuff = + Selection_method.work ~snark_pool ~fee ~logger work_state + in + match stuff with None -> return () | _ -> go (i + 1) + in + go 0 ) ) - let gen_snark_pool (works : ('a, 'b) Lib.Work_spec.t One_or_two.t list) fee = - let open Quickcheck.Generator.Let_syntax in - let cheap_work_fee = Option.value_exn Fee.(sub fee one) in - let expensive_work_fee = Option.value_exn Fee.(add fee one) in - let snark_pool = T.Snark_pool.create () in - let rec add_works = function - | [] -> - return () - | work :: rest -> - let%bind fee = - Quickcheck.Generator.of_list [ cheap_work_fee; expensive_work_fee ] - in - T.Snark_pool.add_snark snark_pool ~work ~fee ; - add_works rest - in - let%map () = - add_works (List.map ~f:(One_or_two.map ~f:Lib.Work_spec.statement) works) - in - snark_pool + let gen_snark_pool (works : ('a, 'b) Lib.Work_spec.t One_or_two.t list) fee = + let open Quickcheck.Generator.Let_syntax in + let cheap_work_fee = Option.value_exn Fee.(sub fee one) in + let expensive_work_fee = Option.value_exn Fee.(add fee one) in + let snark_pool = T.Snark_pool.create () in + let rec add_works = function + | [] -> + return () + | work :: rest -> + let%bind fee = + Quickcheck.Generator.of_list [ cheap_work_fee; expensive_work_fee ] + in + T.Snark_pool.add_snark snark_pool ~work ~fee ; + add_works rest + in + let%map () = + add_works (List.map ~f:(One_or_two.map ~f:Lib.Work_spec.statement) works) + in + snark_pool - let%test_unit "selector shouldn't get work that it cannot outbid" = - Backtrace.elide := false ; - let my_fee = Currency.Fee.of_nanomina_int_exn 2 in - let p = 50 in - let logger = Logger.null () in - let g = - let open Quickcheck.Generator.Let_syntax in - let%bind sl = gen_staged_ledger in - let%map pool = - gen_snark_pool - ( T.Staged_ledger.all_work_pairs sl ~get_state:(fun _ -> - Ok - (Lazy.force precomputed_values).protocol_state_with_hashes - .data ) - |> Or_error.ok_exn ) - (Currency.Fee.of_nanomina_int_exn 2) - in - (sl, pool) - in - Quickcheck.test g - ~sexp_of: - [%sexp_of: - (int, Fee.t) Lib.Work_spec.t list * Fee.t T.Snark_pool.Work.Table.t] - ~trials:100 ~f:(fun (sl, snark_pool) -> - Async.Thread_safe.block_on_async_exn (fun () -> - let open Deferred.Let_syntax in - let%bind work_state = init_state sl logger in - let rec go i = - [%test_result: Bool.t] - ~message:"Exceeded time expected to exhaust work" ~expect:true - (i <= p) ; - let work = - Selection_method.work ~snark_pool ~fee:my_fee work_state ~logger - in - match work with - | None -> - return () - | Some job -> - [%test_result: Bool.t] - ~message:"Should not get any cheap jobs" ~expect:true - (Lib.For_tests.does_not_have_better_fee ~snark_pool - ~fee:my_fee - (One_or_two.map job ~f:Lib.Work_spec.statement) ) ; - go (i + 1) - in - go 0 ) ) -end + let%test_unit "selector shouldn't get work that it cannot outbid" = + Backtrace.elide := false ; + let my_fee = Currency.Fee.of_nanomina_int_exn 2 in + let p = 50 in + let logger = Logger.null () in + let g = + let open Quickcheck.Generator.Let_syntax in + let%bind sl = gen_staged_ledger in + let%map pool = + gen_snark_pool + ( T.Staged_ledger.all_work_pairs sl ~get_state:(fun _ -> + Ok + (Lazy.force precomputed_values).protocol_state_with_hashes + .data ) + |> Or_error.ok_exn ) + (Currency.Fee.of_nanomina_int_exn 2) + in + (sl, pool) + in + Quickcheck.test g + ~sexp_of: + [%sexp_of: + (int, Fee.t) Lib.Work_spec.t list * Fee.t T.Snark_pool.Work.Table.t] + ~trials:100 ~f:(fun (sl, snark_pool) -> + Async.Thread_safe.block_on_async_exn (fun () -> + let open Deferred.Let_syntax in + let%bind work_state = init_state sl logger in + let rec go i = + [%test_result: Bool.t] + ~message:"Exceeded time expected to exhaust work" ~expect:true + (i <= p) ; + let work = + Selection_method.work ~snark_pool ~fee:my_fee work_state ~logger + in + match work with + | None -> + return () + | Some job -> + [%test_result: Bool.t] + ~message:"Should not get any cheap jobs" ~expect:true + (Lib.For_tests.does_not_have_better_fee ~snark_pool + ~fee:my_fee + (One_or_two.map job ~f:Lib.Work_spec.statement) ) ; + go (i + 1) + in + go 0 ) ) + end *) diff --git a/src/lib/work_selector/work_lib.ml b/src/lib/work_selector/work_lib.ml index 08f4bae28aa5..6070b78fc57b 100644 --- a/src/lib/work_selector/work_lib.ml +++ b/src/lib/work_selector/work_lib.ml @@ -6,15 +6,22 @@ module Make (Inputs : Intf.Inputs_intf) = struct module Inputs = Inputs module Work_spec = Snark_work_lib.Work.Single.Spec - let yojson_summary t = - let f = function - | Work_spec.Merge _ -> - `List [ `String "merge" ] - | Transition (_, witness) -> - Inputs.Transaction.yojson_summary - (Inputs.Transaction_witness.transaction witness) - in - `List (One_or_two.map ~f t |> One_or_two.to_list) + let yojson_summary _t = + (* TODO uncomment *) + (* let f = function + | Work_spec.Merge _ -> + `List [ `String "merge" ] + | Transition (_, _witness) -> + Inputs.Transaction.yojson_summary + (Inputs.Transaction_witness.transaction witness) + in + `List (One_or_two.map ~f t |> One_or_two.to_list) *) + `List [] + + let statement_of_job_exn job = + Inputs.Staged_ledger.Scan_state.Available_job.statement job + |> Option.value_exn + ~message:"unexpected failure to extract statement from job" module State = struct module Job_key = struct @@ -22,7 +29,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct type t = Transaction_snark.Statement.t One_or_two.t [@@deriving compare, sexp, to_yojson, hash] - let of_job x = One_or_two.map ~f:Work_spec.statement x + let of_job x = One_or_two.map ~f:statement_of_job_exn x end include T @@ -31,11 +38,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct type t = { mutable available_jobs : - ( Inputs.Transaction_witness.t - , Inputs.Ledger_proof.Cached.t ) - Work_spec.t - One_or_two.t - list + Inputs.Staged_ledger.Scan_state.Available_job.t One_or_two.t list (** Jobs received from [frontier_broadcast_pipe], would be updated whenever the pipe has broadcasted new frontier. The works between consecutive frontier broadcasts should be largely @@ -56,6 +59,9 @@ module Make (Inputs : Intf.Inputs_intf) = struct [%log debug] "No frontier, setting available work to be empty" ; t.available_jobs <- [] | Some frontier -> + (* let get_state = + Inputs.Transition_frontier.get_protocol_state frontier + in *) Pipe_lib.Broadcast_pipe.Reader.iter (Inputs.Transition_frontier.best_tip_pipe frontier) ~f:(fun _ -> let best_tip_staged_ledger = @@ -64,15 +70,12 @@ module Make (Inputs : Intf.Inputs_intf) = struct let start_time = Time.now () in ( match Inputs.Staged_ledger.all_work_pairs best_tip_staged_ledger - ~get_state: - (Inputs.Transition_frontier.get_protocol_state - frontier ) with - | Error e -> + (* | Error e -> [%log fatal] "Error occured when updating available work: $error" - ~metadata:[ ("error", Error_json.error_to_yojson e) ] - | Ok new_available_jobs -> + ~metadata:[ ("error", Error_json.error_to_yojson e) ] *) + | new_available_jobs -> let end_time = Time.now () in [%log info] "Updating new available work took $time ms" ~metadata: @@ -128,7 +131,11 @@ module Make (Inputs : Intf.Inputs_intf) = struct t let mark_scheduled ~logger t job = - let statement = One_or_two.map ~f:Work_spec.statement job in + let statement_exn j = + Inputs.Staged_ledger.Scan_state.Available_job.statement j + |> Option.value_exn + in + let statement = One_or_two.map ~f:statement_exn job in (* Log to internal trace all of the newly available jobs. *) [%log internal] "Snark_work_scheduled" ~metadata: @@ -156,12 +163,12 @@ module Make (Inputs : Intf.Inputs_intf) = struct end let get_expensive_work ~snark_pool ~fee - (jobs : ('a, 'b) Work_spec.t One_or_two.t list) : - ('a, 'b) Work_spec.t One_or_two.t list = + (jobs : Inputs.Staged_ledger.Scan_state.Available_job.t One_or_two.t list) + : Inputs.Staged_ledger.Scan_state.Available_job.t One_or_two.t list = O1trace.sync_thread "work_lib_get_expensive_work" (fun () -> List.filter jobs ~f:(fun job -> State.does_not_have_better_fee ~snark_pool ~fee - (One_or_two.map job ~f:Work_spec.statement) ) ) + (One_or_two.map job ~f:statement_of_job_exn) ) ) let all_pending_work ~snark_pool statements = List.filter statements ~f:(fun st -> @@ -170,7 +177,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct let all_work ~snark_pool (state : State.t) = O1trace.sync_thread "work_lib_all_unseen_works" (fun () -> List.map state.available_jobs ~f:(fun job -> - let statement = One_or_two.map ~f:Work_spec.statement job in + let statement = One_or_two.map ~f:statement_of_job_exn job in let fee_prover_opt = Option.map (Inputs.Snark_pool.get_completed_work snark_pool statement) @@ -187,7 +194,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct (*Seen/Unseen jobs that are not in the snark pool yet*) let pending_work_statements ~snark_pool ~fee_opt (state : State.t) = let all_todo_statements = - List.map state.available_jobs ~f:(One_or_two.map ~f:Work_spec.statement) + List.map state.available_jobs ~f:(One_or_two.map ~f:statement_of_job_exn) in let expensive_work statements ~fee = List.filter statements @@ -201,7 +208,7 @@ module Make (Inputs : Intf.Inputs_intf) = struct let completed_work_statements ~snark_pool (state : State.t) = let all_todo_statements = - List.map state.available_jobs ~f:(One_or_two.map ~f:Work_spec.statement) + List.map state.available_jobs ~f:(One_or_two.map ~f:statement_of_job_exn) in all_completed_work ~snark_pool all_todo_statements diff --git a/src/lib/work_selector/work_selector.ml b/src/lib/work_selector/work_selector.ml index fc1e52b95551..72368a25b000 100644 --- a/src/lib/work_selector/work_selector.ml +++ b/src/lib/work_selector/work_selector.ml @@ -1,7 +1,7 @@ module Lib = Work_lib.Make (Inputs.Implementation_inputs) module State = Lib.State -type work = Snark_work_lib.Selector.Single.Spec.t +type work = Staged_ledger.Scan_state.Available_job.t type in_memory_work = Snark_work_lib.Selector.Single.Spec.Stable.Latest.t diff --git a/src/lib/work_selector/work_selector.mli b/src/lib/work_selector/work_selector.mli index 9ac64dd0f8d3..e9cebe8588be 100644 --- a/src/lib/work_selector/work_selector.mli +++ b/src/lib/work_selector/work_selector.mli @@ -1,7 +1,7 @@ module State : Intf.State_intf with type transition_frontier := Transition_frontier.t -type work = Snark_work_lib.Selector.Single.Spec.t +type work = Staged_ledger.Scan_state.Available_job.t type in_memory_work = Snark_work_lib.Selector.Single.Spec.Stable.Latest.t From c70a1d9794835202725f5d3053cf26e8d36d9d67 Mon Sep 17 00:00:00 2001 From: georgeee Date: Sat, 22 Nov 2025 19:17:34 +0100 Subject: [PATCH 033/122] Use stable types in work partitioner --- src/lib/mina_lib/mina_lib.ml | 12 ++--- src/lib/snark_work_lib/combined_result.mli | 3 +- src/lib/snark_work_lib/metrics.ml | 5 ++- src/lib/snark_work_lib/partitioned_spec.ml | 26 ----------- src/lib/snark_work_lib/partitioned_spec.mli | 8 ---- src/lib/snark_work_lib/selector.ml | 20 +-------- src/lib/snark_work_lib/single_result.ml | 13 +----- src/lib/snark_work_lib/single_result.mli | 10 +---- src/lib/snark_work_lib/single_spec.ml | 14 +----- src/lib/snark_work_lib/single_spec.mli | 10 +---- src/lib/snark_work_lib/sub_zkapp_spec.ml | 39 ++-------------- src/lib/snark_work_lib/sub_zkapp_spec.mli | 13 ++---- src/lib/work_partitioner/combining_result.ml | 2 +- src/lib/work_partitioner/combining_result.mli | 3 +- src/lib/work_partitioner/work_partitioner.ml | 45 +++++-------------- src/lib/work_partitioner/work_partitioner.mli | 1 - 16 files changed, 32 insertions(+), 192 deletions(-) diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 7a7b9365a103..97b24b6dbcc0 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -933,7 +933,7 @@ let work_selection_method t = t.config.work_selection_method let add_complete_work ~logger ~fee ~prover ~(results : ( Snark_work_lib.Spec.Single.t - , Ledger_proof.Cached.t ) + , Ledger_proof.t ) Snark_work_lib.Result.Single.Poly.t One_or_two.t ) t = let update_metrics () = @@ -968,12 +968,8 @@ let add_complete_work ~logger ~fee ~prover Local_sink.push t.pipes.snark_local_sink ( Add_solved_work ( stmts - , Network_pool.Priced_proof. - { proof = - proofs - |> One_or_two.map ~f:Ledger_proof.Cached.read_proof_from_disk - ; fee = fee_with_prover - } ) + , Network_pool.Priced_proof.{ proof = proofs; fee = fee_with_prover } + ) , Result.iter_error ~f:(fun err -> (* Possible reasons of failure: receiving pipe's capacity exceeded, fee that isn't the lowest, failure in verification or application to the pool *) @@ -2187,7 +2183,7 @@ let create ~commit_id ?wallets (config : Config.t) = Work_partitioner.create ~signature_kind ~reassignment_timeout: (Time.Span.of_ms (Float.of_int config.work_reassignment_wait)) - ~logger:config.logger ~proof_cache_db + ~logger:config.logger in let sinks = (block_sink, tx_remote_sink, snark_remote_sink) in let%bind net = diff --git a/src/lib/snark_work_lib/combined_result.mli b/src/lib/snark_work_lib/combined_result.mli index 63d2fa8d8bc9..9394d6e061dd 100644 --- a/src/lib/snark_work_lib/combined_result.mli +++ b/src/lib/snark_work_lib/combined_result.mli @@ -1,6 +1,5 @@ type t = - { results : - (Single_spec.t, Ledger_proof.Cached.t) Single_result.Poly.t One_or_two.t + { results : (Single_spec.t, Ledger_proof.t) Single_result.Poly.t One_or_two.t ; fee : Currency.Fee.t ; prover : Signature_lib.Public_key.Compressed.t } diff --git a/src/lib/snark_work_lib/metrics.ml b/src/lib/snark_work_lib/metrics.ml index 8af3c436bb31..5957fdbdcada 100644 --- a/src/lib/snark_work_lib/metrics.ml +++ b/src/lib/snark_work_lib/metrics.ml @@ -39,8 +39,9 @@ let emit_single_metrics ~logger ~(single_spec : _ Single_spec.Poly.t) = emit_single_metrics_impl ~logger ~single_spec: (Single_spec.Poly.map ~f_proof:Fn.id - ~f_witness:(fun { Transaction_witness.transaction = tx; _ } -> - Transaction_type.of_transaction tx ) + ~f_witness:(fun { Transaction_witness.Stable.Latest.transaction = tx + ; _ + } -> Transaction_type.of_transaction tx ) single_spec ) let emit_single_metrics_stable ~logger ~(single_spec : _ Single_spec.Poly.t) = diff --git a/src/lib/snark_work_lib/partitioned_spec.ml b/src/lib/snark_work_lib/partitioned_spec.ml index bac7330e675f..cb1f11ac79ac 100644 --- a/src/lib/snark_work_lib/partitioned_spec.ml +++ b/src/lib/snark_work_lib/partitioned_spec.ml @@ -58,29 +58,3 @@ module Stable = struct end] type t = (Single_spec.t, Sub_zkapp_spec.t) Poly.t - -let read_all_proofs_from_disk : t -> Stable.Latest.t = function - | Single job -> - Single - (With_job_meta.map ~f_spec:Single_spec.read_all_proofs_from_disk job) - | Sub_zkapp_command job -> - Sub_zkapp_command - (With_job_meta.map ~f_spec:Sub_zkapp_spec.read_all_proofs_from_disk job) - -let write_all_proofs_to_disk ~signature_kind - ~(proof_cache_db : Proof_cache_tag.cache_db) : Stable.Latest.t -> t = - function - | Single job -> - Single - (With_job_meta.map - ~f_spec: - (Single_spec.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) - job ) - | Sub_zkapp_command job -> - Sub_zkapp_command - (With_job_meta.map - ~f_spec: - (Sub_zkapp_spec.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) - job ) diff --git a/src/lib/snark_work_lib/partitioned_spec.mli b/src/lib/snark_work_lib/partitioned_spec.mli index afc094fee8c8..742881a9ddb3 100644 --- a/src/lib/snark_work_lib/partitioned_spec.mli +++ b/src/lib/snark_work_lib/partitioned_spec.mli @@ -44,11 +44,3 @@ module Stable : sig end] type t = (Single_spec.t, Sub_zkapp_spec.t) Poly.t - -val read_all_proofs_from_disk : t -> Stable.Latest.t - -val write_all_proofs_to_disk : - signature_kind:Mina_signature_kind.t - -> proof_cache_db:Proof_cache_tag.cache_db - -> Stable.Latest.t - -> t diff --git a/src/lib/snark_work_lib/selector.ml b/src/lib/snark_work_lib/selector.ml index 33d2672e129e..b9f6712d69d3 100644 --- a/src/lib/snark_work_lib/selector.ml +++ b/src/lib/snark_work_lib/selector.ml @@ -32,14 +32,6 @@ module Spec = struct end] type t = Single.Spec.t Work.Spec.t - - let read_all_proofs_from_disk : t -> Stable.Latest.t = - Work.Spec.map ~f:Single.Spec.read_all_proofs_from_disk - - let write_all_proofs_to_disk ~signature_kind - ~(proof_cache_db : Proof_cache_tag.cache_db) : Stable.Latest.t -> t = - Work.Spec.map - ~f:(Single.Spec.write_all_proofs_to_disk ~signature_kind ~proof_cache_db) end module Result = struct @@ -59,15 +51,5 @@ module Result = struct end end] - type t = (Spec.t, Ledger_proof.Cached.t) Work.Result.Stable.V1.t - - let read_all_proofs_from_disk : t -> Stable.Latest.t = - Work.Result.map ~f_spec:Spec.read_all_proofs_from_disk - ~f_single:Ledger_proof.Cached.read_proof_from_disk - - let write_all_proofs_to_disk ~signature_kind - ~(proof_cache_db : Proof_cache_tag.cache_db) : Stable.Latest.t -> t = - Work.Result.map - ~f_spec:(Spec.write_all_proofs_to_disk ~signature_kind ~proof_cache_db) - ~f_single:(Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db) + type t = (Spec.t, Ledger_proof.t) Work.Result.Stable.V1.t end diff --git a/src/lib/snark_work_lib/single_result.ml b/src/lib/snark_work_lib/single_result.ml index 0548704ffd73..dad4ea64079c 100644 --- a/src/lib/snark_work_lib/single_result.ml +++ b/src/lib/snark_work_lib/single_result.ml @@ -30,15 +30,4 @@ module Stable = struct end end] -type t = (Single_spec.t, Ledger_proof.Cached.t) Poly.t - -let read_all_proofs_from_disk : t -> Stable.Latest.t = - Poly.map ~f_spec:Single_spec.read_all_proofs_from_disk - ~f_proof:Ledger_proof.Cached.read_proof_from_disk - -let write_all_proofs_to_disk ~signature_kind - ~(proof_cache_db : Proof_cache_tag.cache_db) : Stable.Latest.t -> t = - Poly.map - ~f_spec: - (Single_spec.write_all_proofs_to_disk ~signature_kind ~proof_cache_db) - ~f_proof:(Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db) +type t = (Single_spec.t, Ledger_proof.t) Poly.t diff --git a/src/lib/snark_work_lib/single_result.mli b/src/lib/snark_work_lib/single_result.mli index 009be32149fc..c10f49cdaacf 100644 --- a/src/lib/snark_work_lib/single_result.mli +++ b/src/lib/snark_work_lib/single_result.mli @@ -28,12 +28,4 @@ module Stable : sig end end] -type t = (Single_spec.t, Ledger_proof.Cached.t) Poly.t - -val read_all_proofs_from_disk : t -> Stable.Latest.t - -val write_all_proofs_to_disk : - signature_kind:Mina_signature_kind.t - -> proof_cache_db:Proof_cache_tag.cache_db - -> Stable.Latest.t - -> t +type t = (Single_spec.t, Ledger_proof.t) Poly.t diff --git a/src/lib/snark_work_lib/single_spec.ml b/src/lib/snark_work_lib/single_spec.ml index 428e2ea584c4..c4bc304255d2 100644 --- a/src/lib/snark_work_lib/single_spec.ml +++ b/src/lib/snark_work_lib/single_spec.ml @@ -65,16 +65,4 @@ module Stable = struct end end] -type t = (Transaction_witness.t, Ledger_proof.Cached.t) Poly.t - -let read_all_proofs_from_disk : t -> Stable.Latest.t = - Poly.map ~f_witness:Transaction_witness.read_all_proofs_from_disk - ~f_proof:Ledger_proof.Cached.read_proof_from_disk - -let write_all_proofs_to_disk ~signature_kind - ~(proof_cache_db : Proof_cache_tag.cache_db) : Stable.Latest.t -> t = - Poly.map - ~f_witness: - (Transaction_witness.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) - ~f_proof:(Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db) +type t = Stable.Latest.t diff --git a/src/lib/snark_work_lib/single_spec.mli b/src/lib/snark_work_lib/single_spec.mli index f9175235a5bd..18e02413b181 100644 --- a/src/lib/snark_work_lib/single_spec.mli +++ b/src/lib/snark_work_lib/single_spec.mli @@ -44,12 +44,4 @@ module Stable : sig end end] -type t = (Transaction_witness.t, Ledger_proof.Cached.t) Poly.t - -val read_all_proofs_from_disk : t -> Stable.Latest.t - -val write_all_proofs_to_disk : - signature_kind:Mina_signature_kind.t - -> proof_cache_db:Proof_cache_tag.cache_db - -> Stable.Latest.t - -> t +type t = Stable.Latest.t diff --git a/src/lib/snark_work_lib/sub_zkapp_spec.ml b/src/lib/snark_work_lib/sub_zkapp_spec.ml index 07f7c9237014..0b395ecf6613 100644 --- a/src/lib/snark_work_lib/sub_zkapp_spec.ml +++ b/src/lib/snark_work_lib/sub_zkapp_spec.ml @@ -40,41 +40,8 @@ end] type t = | Segment of { statement : Transaction_snark.Statement.With_sok.t - ; witness : Transaction_snark.Zkapp_command_segment.Witness.t + ; witness : + Transaction_snark.Zkapp_command_segment.Witness.Stable.Latest.t ; spec : Transaction_snark.Zkapp_command_segment.Basic.t } - | Merge of { proof1 : Ledger_proof.Cached.t; proof2 : Ledger_proof.Cached.t } - -let read_all_proofs_from_disk : t -> Stable.Latest.t = function - | Segment { statement; witness; spec } -> - Segment - { statement - ; witness = - Transaction_snark.Zkapp_command_segment.Witness - .read_all_proofs_from_disk witness - ; spec - } - | Merge { proof1; proof2 } -> - Merge - { proof1 = Ledger_proof.Cached.read_proof_from_disk proof1 - ; proof2 = Ledger_proof.Cached.read_proof_from_disk proof2 - } - -let write_all_proofs_to_disk ~signature_kind - ~(proof_cache_db : Proof_cache_tag.cache_db) : Stable.Latest.t -> t = - function - | Segment { statement; witness; spec } -> - Segment - { statement - ; witness = - Transaction_snark.Zkapp_command_segment.Witness - .write_all_proofs_to_disk ~signature_kind ~proof_cache_db witness - ; spec - } - | Merge { proof1; proof2 } -> - Merge - { proof1 = - Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db proof1 - ; proof2 = - Ledger_proof.Cached.write_proof_to_disk ~proof_cache_db proof2 - } + | Merge of { proof1 : Ledger_proof.t; proof2 : Ledger_proof.t } diff --git a/src/lib/snark_work_lib/sub_zkapp_spec.mli b/src/lib/snark_work_lib/sub_zkapp_spec.mli index 38a6dfdc9759..a462266dec31 100644 --- a/src/lib/snark_work_lib/sub_zkapp_spec.mli +++ b/src/lib/snark_work_lib/sub_zkapp_spec.mli @@ -27,15 +27,8 @@ end] type t = | Segment of { statement : Transaction_snark.Statement.With_sok.t - ; witness : Transaction_snark.Zkapp_command_segment.Witness.t + ; witness : + Transaction_snark.Zkapp_command_segment.Witness.Stable.Latest.t ; spec : Transaction_snark.Zkapp_command_segment.Basic.t } - | Merge of { proof1 : Ledger_proof.Cached.t; proof2 : Ledger_proof.Cached.t } - -val read_all_proofs_from_disk : t -> Stable.Latest.t - -val write_all_proofs_to_disk : - signature_kind:Mina_signature_kind.t - -> proof_cache_db:Proof_cache_tag.cache_db - -> Stable.Latest.t - -> t + | Merge of { proof1 : Ledger_proof.t; proof2 : Ledger_proof.t } diff --git a/src/lib/work_partitioner/combining_result.ml b/src/lib/work_partitioner/combining_result.ml index b117231ad524..4c1c01d20a49 100644 --- a/src/lib/work_partitioner/combining_result.ml +++ b/src/lib/work_partitioner/combining_result.ml @@ -50,7 +50,7 @@ let finalize_two ~submitted_result ~other_spec ~in_pool_result ~submitted_half let merge_single_result ~(submitted_result : - (unit, Ledger_proof.Cached.t) Snark_work_lib.Result.Single.Poly.t ) + (unit, Ledger_proof.t) Snark_work_lib.Result.Single.Poly.t ) ~(submitted_half : submitted_half) (current : t) : merge_outcome = match (current, submitted_half) with | Spec_only { spec = `One spec; sok_message = { fee; prover } }, `One -> diff --git a/src/lib/work_partitioner/combining_result.mli b/src/lib/work_partitioner/combining_result.mli index ef6d4760de3d..cc6b34487f55 100644 --- a/src/lib/work_partitioner/combining_result.mli +++ b/src/lib/work_partitioner/combining_result.mli @@ -45,8 +45,7 @@ type merge_outcome = to combine what we have in pool, [t], with the incoming single result [submitted_result] corresponding to incoming half [submitted_half] *) val merge_single_result : - submitted_result: - (unit, Ledger_proof.Cached.t) Snark_work_lib.Result.Single.Poly.t + submitted_result:(unit, Ledger_proof.t) Snark_work_lib.Result.Single.Poly.t -> submitted_half:submitted_half -> t -> merge_outcome diff --git a/src/lib/work_partitioner/work_partitioner.ml b/src/lib/work_partitioner/work_partitioner.ml index d04358d8358c..1a2fd1561c7e 100644 --- a/src/lib/work_partitioner/work_partitioner.ml +++ b/src/lib/work_partitioner/work_partitioner.ml @@ -27,11 +27,9 @@ type t = (Work.Spec.Single.t * Work.Id.Single.t * Mina_base.Sok_message.t) option (** When receving a `Two works from the underlying Work_selector, store one of them here, so we could schedule them to another worker. *) - ; proof_cache_db : Proof_cache_tag.cache_db } let create ~(reassignment_timeout : Time.Span.t) ~(logger : Logger.t) - ~(proof_cache_db : Proof_cache_tag.cache_db) ~(signature_kind : Mina_signature_kind.t) : t = let module T = Transaction_snark.Make (struct let constraint_constants = Genesis_constants.Compiled.constraint_constants @@ -49,7 +47,6 @@ let create ~(reassignment_timeout : Time.Span.t) ~(logger : Logger.t) ; zkapp_jobs_sent_by_partitioner = Sent_zkapp_job_pool.create () ; single_jobs_sent_by_partitioner = Sent_single_job_pool.create () ; tmp_slot = None - ; proof_cache_db } (* TODO: Consider remove all works no longer relevant for current frontier, @@ -157,20 +154,22 @@ let convert_single_work_from_selector ~(partitioner : t) | Transition (input, witness) -> ( match witness.transaction with | Command (Zkapp_command zkapp_command) -> + (* TODO: remove this conversion *) + let zkapp_command = + Mina_base.Zkapp_command.write_all_proofs_to_disk + ~signature_kind:Mina_signature_kind.t_DEPRECATED + ~proof_cache_db:(Proof_cache_tag.create_identity_db ()) + zkapp_command + in (* TODO: we have read from disk followed by write to disk in shared function followed by read from disk again. Should consider refactor this. *) - let witness = Transaction_witness.read_all_proofs_from_disk witness in Snark_worker_shared.extract_zkapp_segment_works ~m:partitioner.transaction_snark ~input ~witness ~zkapp_command |> Result.map ~f: (convert_zkapp_command_from_selector ~partitioner ~job ~pairing) | Command (Signed_command _) | Fee_transfer _ | Coinbase _ -> - let job = - Work.With_job_meta.map - ~f_spec:Work.Spec.Single.read_all_proofs_from_disk job - in Sent_single_job_pool.add_now_exn ~id:pairing ~job ~message: "Id generator generated a repeated Id that happens to be \ @@ -178,10 +177,6 @@ let convert_single_work_from_selector ~(partitioner : t) partitioner.single_jobs_sent_by_partitioner ; Ok (Single job) ) | Merge _ -> - let job = - Work.With_job_meta.map - ~f_spec:Work.Spec.Single.read_all_proofs_from_disk job - in Sent_single_job_pool.add_now_exn ~id:pairing ~job ~message: "Id generator generated a repeated Id that happens to be occupied by \ @@ -210,15 +205,6 @@ let consume_job_from_selector ~(partitioner : t) ~(sok_message : Mina_base.Sok_message.t) ~(instances : Work.Spec.Single.Stable.Latest.t One_or_two.t) : (Work.Spec.Partitioned.Stable.Latest.t, _) Result.t = - (* TODO: remove this conversion *) - let instances = - One_or_two.map - ~f: - (Work.Spec.Single.write_all_proofs_to_disk - ~signature_kind:Mina_signature_kind.t_DEPRECATED - ~proof_cache_db:partitioner.proof_cache_db ) - instances - in let pairing_id = Id_generator.next_id partitioner.single_id_gen () in Hashtbl.add_exn partitioner.pairing_pool ~key:pairing_id ~data:(Spec_only { spec = instances; sok_message }) ; @@ -262,16 +248,9 @@ type submit_result = let submit_into_combining_result ~submitted_result ~partitioner ~combining_result ~submitted_half = - let submitted_result_cached = - Snark_work_lib.Result.Single.Poly.map ~f_spec:Fn.id - ~f_proof: - (Ledger_proof.Cached.write_proof_to_disk - ~proof_cache_db:partitioner.proof_cache_db ) - submitted_result - in match - Combining_result.merge_single_result - ~submitted_result:submitted_result_cached ~submitted_half combining_result + Combining_result.merge_single_result ~submitted_result ~submitted_half + combining_result with | Pending new_combining_result -> `Pending new_combining_result @@ -299,10 +278,8 @@ let submit_into_combining_result ~submitted_result ~partitioner pool, ignoring" ~metadata: [ ( "spec" - , One_or_two.to_yojson - Work.Spec.Single.( - Fn.compose Stable.Latest.to_yojson read_all_proofs_from_disk) - spec ) + , One_or_two.to_yojson Work.Spec.Single.Stable.Latest.to_yojson spec + ) ; ( "result" , Work.Result.Single.Poly.to_yojson (fun () -> `Null) diff --git a/src/lib/work_partitioner/work_partitioner.mli b/src/lib/work_partitioner/work_partitioner.mli index 3bc7bbf2febb..5e7d122ed909 100644 --- a/src/lib/work_partitioner/work_partitioner.mli +++ b/src/lib/work_partitioner/work_partitioner.mli @@ -25,7 +25,6 @@ type t val create : reassignment_timeout:Time.Span.t -> logger:Logger.t - -> proof_cache_db:Proof_cache_tag.cache_db -> signature_kind:Mina_signature_kind.t -> t From 3c4fa1505a404585199e5a24e0f01b7ce7a39006 Mon Sep 17 00:00:00 2001 From: georgeee Date: Sun, 23 Nov 2025 23:43:29 +0100 Subject: [PATCH 034/122] Remove unused iter function --- src/lib/transition_frontier/frontier_base/frontier_intf.ml | 3 +-- src/lib/transition_frontier/full_frontier/full_frontier.ml | 6 +----- src/lib/transition_frontier/transition_frontier.ml | 2 -- 3 files changed, 2 insertions(+), 9 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/frontier_intf.ml b/src/lib/transition_frontier/frontier_base/frontier_intf.ml index fabe984061a1..f1a67ebc2c71 100644 --- a/src/lib/transition_frontier/frontier_base/frontier_intf.ml +++ b/src/lib/transition_frontier/frontier_base/frontier_intf.ml @@ -14,6 +14,7 @@ module type S = sig val root_length : t -> int + (* Primary needed for consensus state *) val root : t -> Breadcrumb.t val best_tip : t -> Breadcrumb.t @@ -32,8 +33,6 @@ module type S = sig val successors : t -> Breadcrumb.t -> Breadcrumb.t list - val iter : t -> f:(Breadcrumb.t -> unit) -> unit - val best_tip_path_length_exn : t -> int val visualize_to_string : t -> string diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 8780d4f9b306..1d84f8e534ad 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -115,9 +115,7 @@ let find_protocol_state (t : t) hash = in With_hash.data s | Some breadcrumb -> - Some - ( breadcrumb |> Breadcrumb.block |> Mina_block.header - |> Mina_block.Header.protocol_state ) + Some (Breadcrumb.protocol_state breadcrumb) let root t = find_exn ~message:"root" t t.root @@ -235,8 +233,6 @@ let precomputed_values { context = (module Context); _ } = let genesis_constants { context = (module Context); _ } = Context.precomputed_values.genesis_constants -let iter t ~f = Hashtbl.iter t.table ~f:(fun n -> f n.breadcrumb) - let best_tip_path_length_exn { table; root; best_tip; _ } = let open Option.Let_syntax in let result = diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index e70ef06f8aa9..bd71e243acc6 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -535,8 +535,6 @@ include struct let visualize_to_string = proxy1 visualize_to_string - let iter = proxy1 iter - let successors = proxy1 successors let hash_path = proxy1 hash_path From 58623d1852654e6a9ae35b2fbddd34949a5db645 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 12:13:58 +0100 Subject: [PATCH 035/122] Return all breadcrumbs in Transition_frontier.For_tests.gen --- .../bootstrap_controller.ml | 5 ++--- src/lib/fake_network/fake_network.ml | 2 +- .../transaction_inclusion_status.ml | 5 +++-- .../transition_frontier.ml | 19 +++++++++++-------- .../transition_frontier.mli | 2 +- 5 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 34504842e1ae..96826376aca3 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -982,11 +982,10 @@ let%test_module "Bootstrap_controller tests" = Quickcheck.test ~trials:1 (Transition_frontier.For_tests.gen ~precomputed_values ~verifier ~max_length:max_frontier_length ~size:max_frontier_length () ) - ~f:(fun frontier -> + ~f:(fun (frontier, breadcrumbs) -> Thread_safe.block_on_async_exn @@ fun () -> - Deferred.List.iter (Transition_frontier.all_breadcrumbs frontier) - ~f:(fun breadcrumb -> + Deferred.List.iter breadcrumbs ~f:(fun breadcrumb -> let staged_ledger = Transition_frontier.Breadcrumb.staged_ledger breadcrumb in diff --git a/src/lib/fake_network/fake_network.ml b/src/lib/fake_network/fake_network.ml index 15399b3ee583..30187df0a3db 100644 --- a/src/lib/fake_network/fake_network.ml +++ b/src/lib/fake_network/fake_network.ml @@ -242,7 +242,7 @@ module Generator = struct precomputed_values.protocol_state_with_hashes.hash.state_hash ~epoch_ledger_backing_type:Stable_db in - let%map frontier = + let%map frontier, _ = Transition_frontier.For_tests.gen ~precomputed_values ~verifier ~consensus_local_state ~max_length:max_frontier_length ~size:0 () in diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml index a7c1384e11cf..a84f6de7ad55 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml @@ -108,8 +108,9 @@ let%test_module "transaction_status" = (Option.value_exn random_key_opt) ) let gen_frontier = - Transition_frontier.For_tests.gen ~logger ~precomputed_values ~verifier - ~trust_system ~max_length ~size:frontier_size () + Quickcheck.Generator.map ~f:fst + @@ Transition_frontier.For_tests.gen ~logger ~precomputed_values ~verifier + ~trust_system ~max_length ~size:frontier_size () (* TODO: Generate zkApps txns *) let gen_user_command = diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index bd71e243acc6..a40daab45a73 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -582,10 +582,6 @@ module For_tests = struct let equal = proxy2 equal - let rec deferred_rose_tree_iter (Mina_stdlib.Rose_tree.T (root, trees)) ~f = - let%bind () = f root in - Deferred.List.iter trees ~f:(deferred_rose_tree_iter ~f) - (* a helper quickcheck generator which always returns the genesis breadcrumb *) let gen_genesis_breadcrumb ?(logger = Logger.null ()) ~verifier ~(precomputed_values : Precomputed_values.t) () = @@ -788,8 +784,10 @@ module For_tests = struct frontier in Async.Thread_safe.block_on_async_exn (fun () -> - Deferred.List.iter ~how:`Sequential branches - ~f:(deferred_rose_tree_iter ~f:(add_breadcrumb_exn frontier)) ) ; + Deferred.List.iter branches ~how:`Sequential + ~f: + (Mina_stdlib.Rose_tree.Deferred.iter + ~f:(add_breadcrumb_exn frontier) ) ) ; Core.Gc.Expert.add_finalizer_exn consensus_local_state (fun consensus_local_state -> Consensus.Data.Local_state.( @@ -798,7 +796,12 @@ module For_tests = struct Consensus.Data.Local_state.( Snapshot.Ledger_snapshot.close @@ next_epoch_ledger consensus_local_state) ) ; - frontier + let all_breadcrumbs = ref [] in + List.iter branches + ~f: + (Mina_stdlib.Rose_tree.iter ~f:(fun b -> + all_breadcrumbs := b :: !all_breadcrumbs ) ) ; + (frontier, !all_breadcrumbs) let gen_with_branch ?logger ~verifier ?trust_system ?consensus_local_state ~precomputed_values @@ -808,7 +811,7 @@ module For_tests = struct ?gen_root_breadcrumb ?(get_branch_root = root) ~max_length ~frontier_size ~branch_size () = let open Quickcheck.Generator.Let_syntax in - let%bind frontier = + let%bind frontier, _ = gen ?logger ~verifier ?trust_system ?consensus_local_state ~precomputed_values ?gen_root_breadcrumb ~create_root_and_accounts ~max_length ~size:frontier_size () diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 7a818656797d..0065914b89e5 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -159,7 +159,7 @@ module For_tests : sig -> max_length:int -> size:int -> unit - -> t Quickcheck.Generator.t + -> (t * Breadcrumb.t list) Quickcheck.Generator.t val gen_with_branch : ?logger:Logger.t From 4d59903a39bcd87918232109a977c175acf9cba5 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 12:18:54 +0100 Subject: [PATCH 036/122] Remove unused test function --- .../full_frontier/full_frontier.ml | 22 ------------------- .../full_frontier/full_frontier.mli | 2 -- .../transition_frontier.ml | 5 ----- .../transition_frontier.mli | 2 -- 4 files changed, 31 deletions(-) diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 1d84f8e534ad..59fd9287d80d 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -939,28 +939,6 @@ module For_tests = struct !"Protocol state with hash %s not found" (State_body_hash.to_yojson hash |> Yojson.Safe.to_string) ) - let equal t1 t2 = - let sort_breadcrumbs = List.sort ~compare:Breadcrumb.compare in - let equal_breadcrumb breadcrumb1 breadcrumb2 = - let open Breadcrumb in - let open Option.Let_syntax in - let get_successor_nodes frontier breadcrumb = - let%map node = Hashtbl.find frontier.table @@ state_hash breadcrumb in - Node.successor_hashes node - in - equal breadcrumb1 breadcrumb2 - && State_hash.equal (parent_hash breadcrumb1) (parent_hash breadcrumb2) - && (let%bind successors1 = get_successor_nodes t1 breadcrumb1 in - let%map successors2 = get_successor_nodes t2 breadcrumb2 in - List.equal State_hash.equal - (successors1 |> List.sort ~compare:State_hash.compare) - (successors2 |> List.sort ~compare:State_hash.compare) ) - |> Option.value_map ~default:false ~f:Fn.id - in - List.equal equal_breadcrumb - (all_breadcrumbs t1 |> sort_breadcrumbs) - (all_breadcrumbs t2 |> sort_breadcrumbs) - (* TODO: Don't force here!! *) let precomputed_values = Lazy.force Precomputed_values.for_unit_tests diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index 23d38e87e3f2..017f32708789 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -88,8 +88,6 @@ module Util : sig end module For_tests : sig - val equal : t -> t -> bool - val find_protocol_state_exn : t -> State_hash.t -> Mina_state.Protocol_state.value diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index a40daab45a73..83efb9dbbedb 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -576,11 +576,6 @@ module For_tests = struct Mina_ledger.Ledger_transfer.Make (Mina_ledger.Ledger) (Mina_ledger.Ledger.Db) - open Full_frontier.For_tests - - let proxy2 f { full_frontier = x; _ } { full_frontier = y; _ } = f x y - - let equal = proxy2 equal (* a helper quickcheck generator which always returns the genesis breadcrumb *) let gen_genesis_breadcrumb ?(logger = Logger.null ()) ~verifier diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 0065914b89e5..84c5c339f121 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -122,8 +122,6 @@ module For_tests : sig open Core_kernel open Signature_lib - val equal : t -> t -> bool - val gen_genesis_breadcrumb : ?logger:Logger.t -> verifier:Verifier.t From 5cf700a29fe850264cfe2295f7673c570d237f09 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 13:36:40 +0100 Subject: [PATCH 037/122] Introduce all_state_hashes and size funs to frontier --- src/lib/ledger_catchup/super_catchup.ml | 5 +---- .../transition_frontier/frontier_base/frontier_intf.ml | 2 ++ .../transition_frontier/full_frontier/full_frontier.ml | 6 ++++++ .../transition_frontier/full_frontier/full_frontier.mli | 2 ++ src/lib/transition_frontier/transition_frontier.ml | 8 ++++---- 5 files changed, 15 insertions(+), 8 deletions(-) diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index 56a160061424..1ef7faec74f6 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -381,10 +381,7 @@ let try_to_connect_hash_chain t hashes ~frontier let module T = struct type t = State_hash.t list [@@deriving to_yojson] end in - let all_hashes = - List.map (Transition_frontier.all_breadcrumbs frontier) ~f:(fun b -> - Frontier_base.Breadcrumb.state_hash b ) - in + let all_hashes = Transition_frontier.all_state_hashes frontier in [%log debug] ~metadata: [ ("n", `Int (List.length acc)) diff --git a/src/lib/transition_frontier/frontier_base/frontier_intf.ml b/src/lib/transition_frontier/frontier_base/frontier_intf.ml index f1a67ebc2c71..2aadc5013861 100644 --- a/src/lib/transition_frontier/frontier_base/frontier_intf.ml +++ b/src/lib/transition_frontier/frontier_base/frontier_intf.ml @@ -10,6 +10,8 @@ module type S = sig val consensus_local_state : t -> Consensus.Data.Local_state.t + val all_state_hashes : t -> State_hash.t list + val all_breadcrumbs : t -> Breadcrumb.t list val root_length : t -> int diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 59fd9287d80d..41360842d491 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -92,6 +92,12 @@ let consensus_local_state { consensus_local_state; _ } = consensus_local_state let all_breadcrumbs t = List.map (Hashtbl.data t.table) ~f:(fun { breadcrumb; _ } -> breadcrumb) +let size t = Hashtbl.length t.table + +let all_state_hashes t = + List.map (Hashtbl.data t.table) ~f:(fun { breadcrumb; _ } -> + Breadcrumb.state_hash breadcrumb ) + let find t hash = let open Option.Let_syntax in let%map node = Hashtbl.find t.table hash in diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index 017f32708789..f011a7971237 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -64,6 +64,8 @@ val apply_diffs : -> [ `New_root_and_diffs_with_mutants of Root_identifier.t option * Diff.Full.With_mutant.t list ] +val size : t -> int + val common_ancestor : t -> Breadcrumb.t diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 83efb9dbbedb..643fce8363c9 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -449,8 +449,7 @@ let add_breadcrumb_exn t breadcrumb = [ ( "state_hash" , State_hash.to_yojson (Breadcrumb.state_hash (Full_frontier.best_tip t.full_frontier)) ) - ; ( "n" - , `Int (List.length @@ Full_frontier.all_breadcrumbs t.full_frontier) ) + ; ("n", `Int (Full_frontier.size t.full_frontier)) ] "PRE: ($state_hash, $n)" ; [%str_log' trace t.logger] @@ -475,8 +474,7 @@ let add_breadcrumb_exn t breadcrumb = [ ( "state_hash" , State_hash.to_yojson (Breadcrumb.state_hash @@ Full_frontier.best_tip t.full_frontier) ) - ; ( "n" - , `Int (List.length @@ Full_frontier.all_breadcrumbs t.full_frontier) ) + ; ("n", `Int (Full_frontier.size t.full_frontier)) ] "POST: ($state_hash, $n)" ; let user_cmds = @@ -531,6 +529,8 @@ include struct let all_breadcrumbs = proxy1 all_breadcrumbs + let all_state_hashes = proxy1 all_state_hashes + let visualize ~filename = proxy1 (visualize ~filename) let visualize_to_string = proxy1 visualize_to_string From e9a229ec70ef21b76de9621c4c051a8cc7185dc1 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 15:06:07 +0100 Subject: [PATCH 038/122] Extract Application_state out of staged_ledger.ml --- src/lib/staged_ledger/application_state.ml | 94 +++++++++++++++++++ src/lib/staged_ledger/staged_ledger.ml | 93 ++---------------- src/lib/staged_ledger/staged_ledger.mli | 30 +----- .../test/txn_application_test.ml | 12 ++- 4 files changed, 115 insertions(+), 114 deletions(-) create mode 100644 src/lib/staged_ledger/application_state.ml diff --git a/src/lib/staged_ledger/application_state.ml b/src/lib/staged_ledger/application_state.ml new file mode 100644 index 000000000000..83f50afe413f --- /dev/null +++ b/src/lib/staged_ledger/application_state.ml @@ -0,0 +1,94 @@ +open Core_kernel +open Mina_base +open Mina_transaction + +module Make (Txn : sig + type t [@@deriving to_yojson] + + val key : t -> Account_id.t + + val is_zkapp_command : t -> bool + + val to_user_command : t -> User_command.t +end) = +struct + type t = + { valid_seq : Txn.t Sequence.t + ; invalid : (Txn.t * Error.t) list + ; skipped_by_fee_payer : Txn.t list Account_id.Map.t + ; zkapp_space_remaining : int option + ; total_space_remaining : int + } + + let init ?zkapp_limit ~total_limit = + { valid_seq = Sequence.empty + ; invalid = [] + ; skipped_by_fee_payer = Account_id.Map.empty + ; zkapp_space_remaining = zkapp_limit + ; total_space_remaining = total_limit + } + + let add_skipped_txn t (txn : Txn.t) = + Account_id.Map.update t.skipped_by_fee_payer (Txn.key txn) + ~f:(Option.value_map ~default:[ txn ] ~f:(List.cons txn)) + + let dependency_skipped txn t = + Account_id.Map.mem t.skipped_by_fee_payer (Txn.key txn) + + let try_applying_txn ?logger ~apply (state : t) (txn : Txn.t) = + let open Continue_or_stop in + match state.zkapp_space_remaining with + | _ when state.total_space_remaining < 1 -> + Stop (state.valid_seq, state.invalid) + | Some zkapp_limit when Txn.is_zkapp_command txn && zkapp_limit < 1 -> + Continue { state with skipped_by_fee_payer = add_skipped_txn state txn } + | Some _ when dependency_skipped txn state -> + Continue { state with skipped_by_fee_payer = add_skipped_txn state txn } + | _ -> ( + match + O1trace.sync_thread "validate_transaction_against_staged_ledger" + (fun () -> apply (Transaction.Command (Txn.to_user_command txn))) + with + | Error e -> + Option.iter logger ~f:(fun logger -> + [%log error] + ~metadata: + [ ("user_command", Txn.to_yojson txn) + ; ("error", Error_json.error_to_yojson e) + ] + "Staged_ledger_diff creation: Skipping user command: \ + $user_command due to error: $error" ) ; + Continue { state with invalid = (txn, e) :: state.invalid } + | Ok _txn_partially_applied -> + let valid_seq = + Sequence.append (Sequence.singleton txn) state.valid_seq + in + let zkapp_space_remaining = + Option.map state.zkapp_space_remaining ~f:(fun limit -> + if Txn.is_zkapp_command txn then limit - 1 else limit ) + in + Continue + { state with + valid_seq + ; zkapp_space_remaining + ; total_space_remaining = state.total_space_remaining - 1 + } ) +end + +module Valid_user_command = Make (struct + type t = User_command.Valid.t [@@deriving to_yojson] + + let key = function + | User_command.Zkapp_command cmd -> + Zkapp_command.(Valid.forget cmd |> fee_payer) + | Signed_command cmd -> + Signed_command.(forget_check cmd |> fee_payer) + + let is_zkapp_command = function + | User_command.Zkapp_command _ -> + true + | Signed_command _ -> + false + + let to_user_command = User_command.forget_check +end) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 7819c0e83ac2..7076012cc333 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -2051,88 +2051,6 @@ module T = struct : Ledger.unattached_mask ) ; r - module Application_state = struct - type txn = - ( Signed_command.With_valid_signature.t - , Zkapp_command.Valid.t ) - User_command.t_ - - type t = - { valid_seq : txn Sequence.t - ; invalid : (txn * Error.t) list - ; skipped_by_fee_payer : txn list Account_id.Map.t - ; zkapp_space_remaining : int option - ; total_space_remaining : int - } - - let init ?zkapp_limit ~total_limit = - { valid_seq = Sequence.empty - ; invalid = [] - ; skipped_by_fee_payer = Account_id.Map.empty - ; zkapp_space_remaining = zkapp_limit - ; total_space_remaining = total_limit - } - - let txn_key = function - | User_command.Zkapp_command cmd -> - Zkapp_command.(Valid.forget cmd |> fee_payer) - | User_command.Signed_command cmd -> - Signed_command.(forget_check cmd |> fee_payer) - - let add_skipped_txn t (txn : txn) = - Account_id.Map.update t.skipped_by_fee_payer (txn_key txn) - ~f:(Option.value_map ~default:[ txn ] ~f:(List.cons txn)) - - let dependency_skipped txn t = - Account_id.Map.mem t.skipped_by_fee_payer (txn_key txn) - - let try_applying_txn ?logger ~apply (state : t) (txn : txn) = - let open Continue_or_stop in - match (state.zkapp_space_remaining, txn) with - | _ when state.total_space_remaining < 1 -> - Stop (state.valid_seq, state.invalid) - | Some zkapp_limit, User_command.Zkapp_command _ when zkapp_limit < 1 -> - Continue - { state with skipped_by_fee_payer = add_skipped_txn state txn } - | Some _, _ when dependency_skipped txn state -> - Continue - { state with skipped_by_fee_payer = add_skipped_txn state txn } - | _ -> ( - match - O1trace.sync_thread "validate_transaction_against_staged_ledger" - (fun () -> - apply (Transaction.Command (User_command.forget_check txn)) ) - with - | Error e -> - Option.iter logger ~f:(fun logger -> - [%log error] - ~metadata: - [ ("user_command", User_command.Valid.to_yojson txn) - ; ("error", Error_json.error_to_yojson e) - ] - "Staged_ledger_diff creation: Skipping user command: \ - $user_command due to error: $error" ) ; - Continue { state with invalid = (txn, e) :: state.invalid } - | Ok _txn_partially_applied -> - let valid_seq = - Sequence.append (Sequence.singleton txn) state.valid_seq - in - let zkapp_space_remaining = - Option.map state.zkapp_space_remaining ~f:(fun limit -> - match txn with - | Zkapp_command _ -> - limit - 1 - | Signed_command _ -> - limit ) - in - Continue - { state with - valid_seq - ; zkapp_space_remaining - ; total_space_remaining = state.total_space_remaining - 1 - } ) - end - let create_diff ~(constraint_constants : Genesis_constants.Constraint_constants.t) ~(global_slot : Mina_numbers.Global_slot_since_genesis.t) @@ -2251,9 +2169,12 @@ module T = struct let valid_on_this_ledger, invalid_on_this_ledger = Sequence.fold_until transactions_by_fee ~init: - (Application_state.init ?zkapp_limit:zkapp_cmd_limit + (Application_state.Valid_user_command.init + ?zkapp_limit:zkapp_cmd_limit ~total_limit:(Scan_state.free_space t.scan_state) ) - ~f:(Application_state.try_applying_txn ~apply ~logger) + ~f: + (Application_state.Valid_user_command.try_applying_txn ~apply + ~logger ) ~finish:(fun state -> (state.valid_seq, state.invalid)) in [%log internal] "Generate_staged_ledger_diff" ; @@ -2316,6 +2237,10 @@ end include T +module For_tests = struct + module Application_state = Application_state +end + module Test_helpers = struct let constraint_constants = Genesis_constants.For_unit_tests.Constraint_constants.t diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index f304a0520a21..35f0dddc5b58 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -251,32 +251,6 @@ val apply_diff_unchecked : , Staged_ledger_error.t ) Deferred.Result.t -(* Internals of the txn application. This is only exposed to facilitate - writing unit tests. *) -module Application_state : sig - type txn = - ( Signed_command.With_valid_signature.t - , Zkapp_command.Valid.t ) - User_command.t_ - - type t = - { valid_seq : txn Sequence.t - ; invalid : (txn * Error.t) list - ; skipped_by_fee_payer : txn list Account_id.Map.t - ; zkapp_space_remaining : int option - ; total_space_remaining : int - } - - val init : ?zkapp_limit:int -> total_limit:int -> t - - val try_applying_txn : - ?logger:Logger.t - -> apply:(User_command.t Transaction.t_ -> ('a, Error.t) Result.t) - -> t - -> txn - -> (t, txn Sequence.t * (txn * Error.t) list) Continue_or_stop.t -end - (* This should memoize the snark verifications *) val create_diff : @@ -343,6 +317,10 @@ val all_work_statements_exn : t -> Transaction_snark_work.Statement.t list val convert_and_apply_all_masks_to_ledger : hardfork_db:Ledger.Hardfork_db.t -> t -> unit +module For_tests : sig + module Application_state = Application_state +end + module Test_helpers : sig val dummy_state_and_view : ?global_slot:Mina_numbers.Global_slot_since_genesis.t diff --git a/src/lib/staged_ledger/test/txn_application_test.ml b/src/lib/staged_ledger/test/txn_application_test.ml index 20571d5e7cad..ee91f8369eed 100644 --- a/src/lib/staged_ledger/test/txn_application_test.ml +++ b/src/lib/staged_ledger/test/txn_application_test.ml @@ -3,13 +3,15 @@ open Mina_base open Mina_generators open Mina_numbers open Mina_transaction -open Staged_ledger + +module Application_state = + Staged_ledger.For_tests.Application_state.Valid_user_command type apply = User_command.t Transaction.t_ - -> Ledger.Transaction_partially_applied.t Or_error.t + -> Staged_ledger.Ledger.Transaction_partially_applied.t Or_error.t -let gen_apply_and_txn : (apply * Application_state.txn) Quickcheck.Generator.t = +let gen_apply_and_txn : (apply * User_command.Valid.t) Quickcheck.Generator.t = let open Quickcheck.Generator in let open Let_syntax in let constraint_constants = @@ -20,7 +22,9 @@ let gen_apply_and_txn : (apply * Application_state.txn) Quickcheck.Generator.t = ~genesis_constants:Genesis_constants.For_unit_tests.t () in let%map global_slot = Global_slot_since_genesis.gen in - let current_state_view = Test_helpers.dummy_state_view ~global_slot () in + let current_state_view = + Staged_ledger.Test_helpers.dummy_state_view ~global_slot () + in let apply = Transaction_snark.Transaction_validator.apply_transaction_first_pass ~constraint_constants ~global_slot validating_ledger From 3160e246be403bb4dc964d9007dc9466130f44f2 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 16:42:39 +0100 Subject: [PATCH 039/122] Store command hashes in the diff --- .../cli/src/init/test_submit_to_archive.ml | 8 +- src/lib/block_producer/block_producer.ml | 7 +- src/lib/staged_ledger/application_state.ml | 65 ++++-- src/lib/staged_ledger/diff_creation_log.ml | 22 +- src/lib/staged_ledger/pre_diff_info.ml | 98 +++++--- src/lib/staged_ledger/staged_ledger.ml | 140 +++++++++--- src/lib/staged_ledger/staged_ledger.mli | 5 +- .../test/txn_application_test.ml | 11 +- src/lib/staged_ledger_diff/diff.ml | 214 ++++++++++-------- src/lib/staged_ledger_diff/diff.mli | 58 ++++- .../frontier_base/breadcrumb.ml | 5 +- 11 files changed, 425 insertions(+), 208 deletions(-) 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 1b2d97a813bd..34173b261a05 100644 --- a/src/app/cli/src/init/test_submit_to_archive.ml +++ b/src/app/cli/src/init/test_submit_to_archive.ml @@ -415,7 +415,10 @@ let mk_payment ~(valid_until : Mina_numbers.Global_slot_since_genesis.t) { Signed_command.Poly.signer = signer_keypair.public_key; signature; payload } let generate_txs ~valid_until ~init_nonce ~n_zkapp_txs ~n_payments ~n_blocks - ~constraint_constants keypair : User_command.Valid.t Sequence.t list = + ~constraint_constants keypair : + Mina_transaction.Transaction_hash.User_command_with_valid_signature.t + Sequence.t + list = let signer_pk = Public_key.compress keypair.Keypair.public_key in let event_elements = 12 in let action_elements = 12 in @@ -444,7 +447,8 @@ let generate_txs ~valid_until ~init_nonce ~n_zkapp_txs ~n_payments ~n_blocks valid_command ) = User_command.to_valid_unsafe command in - valid_command ) + Mina_transaction.Transaction_hash.User_command_with_valid_signature + .create valid_command ) in List.init n_blocks ~f:generate_payments diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index aceb669f8eda..ff7be4e69faa 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -152,7 +152,10 @@ let report_transaction_inclusion_failures ~commit_id ~logger failed_txns = | (txn, error) :: remaining_failures -> let element = `Assoc - [ ("transaction", User_command.Valid.to_yojson txn) + [ ( "transaction_hash" + , Transaction_hash.to_yojson + @@ Transaction_hash.User_command_with_valid_signature + .transaction_hash txn ) ; ("error", Error_json.error_to_yojson error) ] in @@ -798,8 +801,6 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover let transactions = Network_pool.Transaction_pool.Resource_pool.transactions transaction_resource_pool - |> Sequence.map - ~f:Transaction_hash.User_command_with_valid_signature.data in let%bind () = Interruptible.lift (Deferred.return ()) (Ivar.read ivar) in [%log internal] "Generate_next_state" ; diff --git a/src/lib/staged_ledger/application_state.ml b/src/lib/staged_ledger/application_state.ml index 83f50afe413f..4cab981c5d00 100644 --- a/src/lib/staged_ledger/application_state.ml +++ b/src/lib/staged_ledger/application_state.ml @@ -2,6 +2,22 @@ open Core_kernel open Mina_base open Mina_transaction +type 'txn t = + { valid_seq : 'txn Sequence.t + ; invalid : ('txn * Error.t) list + ; skipped_by_fee_payer : 'txn list Account_id.Map.t + ; zkapp_space_remaining : int option + ; total_space_remaining : int + } + +let init ?zkapp_limit ~total_limit = + { valid_seq = Sequence.empty + ; invalid = [] + ; skipped_by_fee_payer = Account_id.Map.empty + ; zkapp_space_remaining = zkapp_limit + ; total_space_remaining = total_limit + } + module Make (Txn : sig type t [@@deriving to_yojson] @@ -10,24 +26,16 @@ module Make (Txn : sig val is_zkapp_command : t -> bool val to_user_command : t -> User_command.t -end) = -struct - type t = - { valid_seq : Txn.t Sequence.t - ; invalid : (Txn.t * Error.t) list - ; skipped_by_fee_payer : Txn.t list Account_id.Map.t - ; zkapp_space_remaining : int option - ; total_space_remaining : int - } - - let init ?zkapp_limit ~total_limit = - { valid_seq = Sequence.empty - ; invalid = [] - ; skipped_by_fee_payer = Account_id.Map.empty - ; zkapp_space_remaining = zkapp_limit - ; total_space_remaining = total_limit - } - +end) : sig + val try_applying_txn : + ?logger:Logger.t + -> apply: + ( User_command.t Transaction.t_ + -> ('any_application_result, Error.t) result ) + -> Txn.t t + -> Txn.t + -> (Txn.t t, Txn.t Sequence.t * (Txn.t * Error.t) list) Continue_or_stop.t +end = struct let add_skipped_txn t (txn : Txn.t) = Account_id.Map.update t.skipped_by_fee_payer (Txn.key txn) ~f:(Option.value_map ~default:[ txn ] ~f:(List.cons txn)) @@ -35,7 +43,7 @@ struct let dependency_skipped txn t = Account_id.Map.mem t.skipped_by_fee_payer (Txn.key txn) - let try_applying_txn ?logger ~apply (state : t) (txn : Txn.t) = + let try_applying_txn ?logger ~apply (state : Txn.t t) (txn : Txn.t) = let open Continue_or_stop in match state.zkapp_space_remaining with | _ when state.total_space_remaining < 1 -> @@ -75,7 +83,7 @@ struct } ) end -module Valid_user_command = Make (struct +module Valid_user_command_inputs = struct type t = User_command.Valid.t [@@deriving to_yojson] let key = function @@ -91,4 +99,21 @@ module Valid_user_command = Make (struct false let to_user_command = User_command.forget_check +end + +module Valid_user_command = Make (Valid_user_command_inputs) + +module Valid_user_command_with_hash = Make (struct + type t = Transaction_hash.User_command_with_valid_signature.t + + let proxy1 f = + Fn.compose f Transaction_hash.User_command_with_valid_signature.data + + let key = proxy1 Valid_user_command_inputs.key + + let is_zkapp_command = proxy1 Valid_user_command_inputs.is_zkapp_command + + let to_user_command = proxy1 Valid_user_command_inputs.to_user_command + + let to_yojson = Transaction_hash.User_command_with_valid_signature.to_yojson end) diff --git a/src/lib/staged_ledger/diff_creation_log.ml b/src/lib/staged_ledger/diff_creation_log.ml index 0bbe21f9ffe8..4867e664369e 100644 --- a/src/lib/staged_ledger/diff_creation_log.ml +++ b/src/lib/staged_ledger/diff_creation_log.ml @@ -1,5 +1,6 @@ open Core_kernel open Mina_base +open Mina_transaction type count_and_fee = int * Currency.Fee.t [@@deriving sexp, to_yojson] @@ -58,7 +59,8 @@ module Summary = struct let init_resources ~(completed_work : Transaction_snark_work.Checked.t Sequence.t) - ~(commands : User_command.Valid.t Sequence.t) + ~(commands : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ) ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) = let completed_work = ( Sequence.length completed_work @@ -71,13 +73,17 @@ module Summary = struct , Sequence.sum (module Fee_Summable) commands - ~f:(fun cmd -> User_command.fee (User_command.forget_check cmd)) ) + ~f:(fun cmd -> + User_command.fee + (Transaction_hash.User_command_with_valid_signature.command cmd) + ) ) in let coinbase_work_fees = coinbase_fees coinbase in { completed_work; commands; coinbase_work_fees } let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t) - ~(commands : User_command.Valid.t Sequence.t) + ~(commands : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ) ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) ~partition ~available_slots ~required_work_count = let start_resources = init_resources ~completed_work ~commands ~coinbase in @@ -101,7 +107,8 @@ module Summary = struct } let end_log t ~(completed_work : Transaction_snark_work.Checked.t Sequence.t) - ~(commands : User_command.Valid.t Sequence.t) + ~(commands : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ) ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) = end_resources.set (init_resources ~completed_work ~commands ~coinbase) t @@ -147,7 +154,8 @@ module Detail = struct type t = line list [@@deriving sexp, to_yojson] let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t) - ~(commands : User_command.Valid.t Sequence.t) + ~(commands : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ) ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) = let init = Summary.init_resources ~completed_work ~commands ~coinbase in [ { reason = `Init @@ -207,7 +215,7 @@ type summary_list = Summary.t list [@@deriving sexp, to_yojson] type detail_list = Detail.t list [@@deriving sexp, to_yojson] let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t) - ~(commands : User_command.Valid.t Sequence.t) + ~(commands : Transaction_hash.User_command_with_valid_signature.t Sequence.t) ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) ~partition ~available_slots ~required_work_count = let summary = @@ -228,7 +236,7 @@ let discard_completed_work why completed_work t = (summary, detailed) let end_log ~(completed_work : Transaction_snark_work.Checked.t Sequence.t) - ~(commands : User_command.Valid.t Sequence.t) + ~(commands : Transaction_hash.User_command_with_valid_signature.t Sequence.t) ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) t = let summary = Summary.end_log (fst t) ~completed_work ~commands ~coinbase in let detailed = Detail.end_log coinbase (snd t) in diff --git a/src/lib/staged_ledger/pre_diff_info.ml b/src/lib/staged_ledger/pre_diff_info.ml index ee8398f4e081..1e70e64bb1fb 100644 --- a/src/lib/staged_ledger/pre_diff_info.ml +++ b/src/lib/staged_ledger/pre_diff_info.ml @@ -339,16 +339,11 @@ let get_individual_info (type c) List.map coinbase_parts ~f:(fun Coinbase.{ amount; _ } -> amount) } -let check_coinbase - (diff : - _ Staged_ledger_diff.Pre_diff_two.t - * _ Staged_ledger_diff.Pre_diff_one.t option ) = - match - ( (fst diff).coinbase - , Option.value_map ~default:Staged_ledger_diff.At_most_one.Zero (snd diff) - ~f:(fun d -> d.coinbase) ) - with - | Zero, Zero | Zero, One _ | One _, Zero | Two _, Zero -> +let check_coinbase = function + | Staged_ledger_diff.At_most_two.Zero, Staged_ledger_diff.At_most_one.Zero + | Zero, One _ + | One _, Zero + | Two _, Zero -> Ok () | x, y -> Error @@ -451,7 +446,8 @@ let compute_statuses let get_impl (type c) ~get_transaction_data ~(constraint_constants : Genesis_constants.Constraint_constants.t) ~(to_user_command : c With_status.t -> (_, _, _) User_command.with_forest) - ~diff ~coinbase_receiver ~coinbase_amount = + ~diff ~coinbase_receiver ~coinbase_amount ~extract_prediff_two + ~extract_prediff_one = let open Result.Let_syntax in let%bind coinbase_amount = Option.value_map coinbase_amount @@ -466,37 +462,61 @@ let get_impl (type c) ~get_transaction_data constraint_constants.coinbase_amount ) ) ) ~f:(fun x -> Ok x) in - let apply_pre_diff_with_at_most_two (t1 : _ Staged_ledger_diff.Pre_diff_two.t) - = + let apply_pre_diff_with_at_most_two ~constraint_constants t1 = + let completed_works, commands, coinbases, internal_command_statuses = + extract_prediff_two t1 + in let coinbase_parts = - match t1.coinbase with Zero -> `Zero | One x -> `One x | Two x -> `Two x + match coinbases with + | Staged_ledger_diff.At_most_two.Zero -> + `Zero + | One x -> + `One x + | Two x -> + `Two x + in + let%map p = + get_individual_info ~get_transaction_data coinbase_parts + ~receiver:coinbase_receiver commands completed_works ~coinbase_amount + ~internal_command_statuses ~to_user_command ~constraint_constants in - get_individual_info ~get_transaction_data coinbase_parts - ~receiver:coinbase_receiver t1.commands t1.completed_works - ~coinbase_amount ~internal_command_statuses:t1.internal_command_statuses - ~to_user_command + (coinbases, p) in - let apply_pre_diff_with_at_most_one (t2 : _ Staged_ledger_diff.Pre_diff_one.t) - = + let apply_pre_diff_with_at_most_one ~constraint_constants t2 = + let completed_works, commands, coinbases, internal_command_statuses = + extract_prediff_one t2 + in let coinbase_added = - match t2.coinbase with Zero -> `Zero | One x -> `One x + match coinbases with + | Staged_ledger_diff.At_most_one.Zero -> + `Zero + | One x -> + `One x + in + let%map p = + get_individual_info ~get_transaction_data coinbase_added + ~receiver:coinbase_receiver commands completed_works ~coinbase_amount + ~internal_command_statuses ~to_user_command ~constraint_constants in - get_individual_info ~get_transaction_data coinbase_added - ~receiver:coinbase_receiver t2.commands t2.completed_works - ~coinbase_amount ~internal_command_statuses:t2.internal_command_statuses - ~to_user_command + (coinbases, p) in - let%bind () = check_coinbase diff in - let%bind p1 = + let%bind cb1, p1 = apply_pre_diff_with_at_most_two ~constraint_constants (fst diff) in - let%map p2 = + let%bind cb2, p2 = Option.value_map - ~f:(fun d -> apply_pre_diff_with_at_most_one ~constraint_constants d) + ~f:(apply_pre_diff_with_at_most_one ~constraint_constants) (snd diff) ~default: - (Ok { transactions = []; work = []; commands_count = 0; coinbases = [] }) + (Ok + ( Staged_ledger_diff.At_most_one.Zero + , { transactions = [] + ; work = [] + ; commands_count = 0 + ; coinbases = [] + } ) ) in + let%map () = check_coinbase (cb1, cb2) in ( p1.transactions @ p2.transactions , p1.work @ p2.work , p1.commands_count + p2.commands_count @@ -519,6 +539,8 @@ let get ~check ~constraint_constants ~coinbase_receiver ~supercharge_coinbase t ~coinbase_amount: (Staged_ledger_diff.With_valid_signatures.coinbase ~constraint_constants ~supercharge_coinbase diff ) + ~extract_prediff_two:Staged_ledger_diff.Pre_diff_generic.extract_prediff + ~extract_prediff_one:Staged_ledger_diff.Pre_diff_generic.extract_prediff let get_unchecked ~constraint_constants ~coinbase_receiver ~supercharge_coinbase (t : Staged_ledger_diff.With_valid_signatures_and_proofs.t) = @@ -530,17 +552,26 @@ let get_unchecked ~constraint_constants ~coinbase_receiver ~supercharge_coinbase ~coinbase_amount: (Staged_ledger_diff.With_valid_signatures.coinbase ~constraint_constants ~supercharge_coinbase t ) + ~extract_prediff_two:Staged_ledger_diff.Pre_diff_generic.extract_prediff + ~extract_prediff_one:Staged_ledger_diff.Pre_diff_generic.extract_prediff let get_transactions_stable ~constraint_constants ~coinbase_receiver ~supercharge_coinbase ({ diff } : Staged_ledger_diff.Stable.Latest.t) = let open Result.Let_syntax in let open Transaction_data_getter_stable in + let extract_prediff_two x = + Staged_ledger_diff.Pre_diff_generic.Stable.Latest.extract_prediff x + in + let extract_prediff_one x = + Staged_ledger_diff.Pre_diff_generic.Stable.Latest.extract_prediff x + in let%map transactions, _, _, _ = get_impl ~get_transaction_data ~constraint_constants ~to_user_command:With_status.data ~diff ~coinbase_receiver ~coinbase_amount: (Staged_ledger_diff.Diff.Stable.Latest.coinbase ~constraint_constants ~supercharge_coinbase diff ) + ~extract_prediff_two ~extract_prediff_one in transactions @@ -548,11 +579,18 @@ let get_transactions ~constraint_constants ~coinbase_receiver ~supercharge_coinbase ({ diff } : Staged_ledger_diff.t) = let open Result.Let_syntax in let open Transaction_data_getter_unchecked in + let extract_prediff_two x = + Staged_ledger_diff.Pre_diff_generic.extract_prediff x + in + let extract_prediff_one x = + Staged_ledger_diff.Pre_diff_generic.extract_prediff x + in let%map transactions, _, _, _ = get_impl ~get_transaction_data ~constraint_constants ~to_user_command:With_status.data ~diff ~coinbase_receiver ~coinbase_amount: (Staged_ledger_diff.Diff.coinbase ~constraint_constants ~supercharge_coinbase diff ) + ~extract_prediff_two ~extract_prediff_one in transactions diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 7076012cc333..8891592617ba 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1335,7 +1335,8 @@ module T = struct module Resources = struct module Discarded = struct type t = - { commands_rev : User_command.Valid.t Sequence.t + { commands_rev : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ; completed_work : Transaction_snark_work.Checked.t Sequence.t } @@ -1355,7 +1356,8 @@ module T = struct { max_space : int (*max space available currently*) ; max_jobs : int (*Required amount of work for max_space that can be purchased*) - ; commands_rev : User_command.Valid.t Sequence.t + ; commands_rev : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ; completed_work_rev : Transaction_snark_work.Checked.t Sequence.t ; fee_transfers : Fee.t Public_key.Compressed.Map.t ; add_coinbase : bool @@ -1508,7 +1510,9 @@ module T = struct in (coinbase, singles) - let init ~constraint_constants (uc_seq : User_command.Valid.t Sequence.t) + let init ~constraint_constants + (uc_seq : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ) (cw_seq : Transaction_snark_work.Checked.t Sequence.t) (slots, job_count) ~receiver_pk ~add_coinbase ~supercharge_coinbase logger ~is_coinbase_receiver_new = @@ -1534,7 +1538,9 @@ module T = struct let budget = Or_error.map2 (sum_fees (Sequence.to_list uc_seq) ~f:(fun t -> - User_command.fee (User_command.forget_check t) ) ) + User_command.fee + (Transaction_hash.User_command_with_valid_signature.command t) ) + ) (sum_fees (List.filter ~f:(fun (k, _) -> @@ -1551,11 +1557,11 @@ module T = struct in { max_space = slots ; max_jobs = job_count - ; commands_rev = - uc_seq + ; commands_rev = uc_seq + ; completed_work_rev = + seq_rev cw_seq (* Completed work in reverse order for faster removal of proofs if budget doesn't suffice *) - ; completed_work_rev = seq_rev cw_seq ; fee_transfers ; add_coinbase ; supercharge_coinbase @@ -1617,7 +1623,8 @@ module T = struct let open Or_error.Let_syntax in let payment_fees = sum_fees (Sequence.to_list t.commands_rev) ~f:(fun t -> - User_command.(fee (forget_check t)) ) + User_command.fee + (Transaction_hash.User_command_with_valid_signature.command t) ) in let prover_fee_others = Public_key.Compressed.Map.fold t.fee_transfers ~init:(Ok Fee.zero) @@ -1751,7 +1758,11 @@ module T = struct match t.budget with | Ok b -> option "Fee insufficient" - (Fee.sub b User_command.(fee (forget_check uc))) + (Fee.sub b + User_command.( + fee + (Transaction_hash.User_command_with_valid_signature + .command uc )) ) | _ -> rebudget new_t in @@ -1842,7 +1853,8 @@ module T = struct check_constraints_and_update ~constraint_constants resources' (Option.value_map uc_opt ~default:log ~f:(fun uc -> Diff_creation_log.discard_command `No_space - (User_command.forget_check uc) + (Transaction_hash.User_command_with_valid_signature.command + uc ) log ) ) else (* insufficient budget; reduce the cost*) @@ -1860,7 +1872,7 @@ module T = struct check_constraints_and_update ~constraint_constants resources' (Option.value_map uc_opt ~default:log ~f:(fun uc -> Diff_creation_log.discard_command `No_work - (User_command.forget_check uc) + (Transaction_hash.User_command_with_valid_signature.command uc) log ) ) let one_prediff ~constraint_constants cw_seq ts_seq ~receiver ~add_coinbase @@ -1901,25 +1913,42 @@ module T = struct coinbase in the second pre_diff" ; Zero in + let command_lst = Sequence.to_list res.commands_rev in (* We have to reverse here because we only know they work in THIS order *) - { Staged_ledger_diff.Pre_diff_one.commands = - Sequence.to_list_rev res.commands_rev + { Staged_ledger_diff.Pre_diff_generic.commands = + List.rev_map + ~f:Transaction_hash.User_command_with_valid_signature.data + command_lst ; completed_works = Sequence.to_list_rev res.completed_work_rev ; coinbase = to_at_most_one res.coinbase ; internal_command_statuses = [] (*updated later based on application result*) + ; command_hashes = + List.rev_map + ~f: + Transaction_hash.User_command_with_valid_signature + .transaction_hash command_lst } ) in let pre_diff_with_two (res : Resources.t) : ( Transaction_snark_work.Checked.t , User_command.Valid.t ) Staged_ledger_diff.Pre_diff_two.t = + let command_lst = Sequence.to_list res.commands_rev in (* We have to reverse here because we only know they work in THIS order *) - { commands = Sequence.to_list_rev res.commands_rev + { commands = + List.rev_map + ~f:Transaction_hash.User_command_with_valid_signature.data + command_lst ; completed_works = Sequence.to_list_rev res.completed_work_rev ; coinbase = res.coinbase ; internal_command_statuses = [] (*updated later based on application result*) + ; command_hashes = + List.rev_map + ~f: + Transaction_hash.User_command_with_valid_signature + .transaction_hash command_lst } in let end_log ((res : Resources.t), (log : Diff_creation_log.t)) = @@ -2056,7 +2085,8 @@ module T = struct ~(global_slot : Mina_numbers.Global_slot_since_genesis.t) ?(log_block_creation = false) t ~coinbase_receiver ~logger ~current_state_view ~zkapp_cmd_limit - ~(transactions_by_fee : User_command.Valid.t Sequence.t) + ~(transactions_by_fee : + Transaction_hash.User_command_with_valid_signature.t Sequence.t ) ~(get_completed_work : Transaction_snark_work.Statement.t -> Transaction_snark_work.Checked.t option ) ~supercharge_coinbase = @@ -2169,12 +2199,11 @@ module T = struct let valid_on_this_ledger, invalid_on_this_ledger = Sequence.fold_until transactions_by_fee ~init: - (Application_state.Valid_user_command.init - ?zkapp_limit:zkapp_cmd_limit + (Application_state.init ?zkapp_limit:zkapp_cmd_limit ~total_limit:(Scan_state.free_space t.scan_state) ) ~f: - (Application_state.Valid_user_command.try_applying_txn ~apply - ~logger ) + (Application_state.Valid_user_command_with_hash + .try_applying_txn ~apply ~logger ) ~finish:(fun state -> (state.valid_seq, state.invalid)) in [%log internal] "Generate_staged_ledger_diff" ; @@ -2369,9 +2398,13 @@ let%test_module "staged ledger tests" = let current_state_view = Mina_state.Protocol_state.(Body.view parent_protocol_state_body) in + let transactions_by_fee = + Sequence.map txns + ~f:Transaction_hash.User_command_with_valid_signature.create + in let diff = Sl.create_diff ~constraint_constants ~global_slot !sl ~logger - ~current_state_view ~transactions_by_fee:txns + ~current_state_view ~transactions_by_fee ~get_completed_work:stmt_to_work ~supercharge_coinbase ~coinbase_receiver ~zkapp_cmd_limit in @@ -3274,7 +3307,10 @@ let%test_module "staged ledger tests" = @@ ( { completed_works = List.take completed_works job_count1 ; commands = List.take txns slots ; coinbase = Zero - ; internal_command_statuses = [] + ; internal_command_statuses = + [] + (* Skipping hash computation, as they shouldn't affect status computation *) + ; command_hashes = [] } , None ) | Some (_, _) -> @@ -3283,7 +3319,10 @@ let%test_module "staged ledger tests" = ( { completed_works = List.take completed_works job_count1 ; commands = List.take txns slots ; coinbase = Zero - ; internal_command_statuses = [] + ; internal_command_statuses = + [] + (* Skipping hash computation, as they shouldn't affect status computation *) + ; command_hashes = [] } , Some { completed_works = @@ -3291,7 +3330,10 @@ let%test_module "staged ledger tests" = else List.drop completed_works job_count1 ) ; commands = txns_in_second_diff ; coinbase = Zero - ; internal_command_statuses = [] + ; internal_command_statuses = + [] + (* Skipping hash computation, as they shouldn't affect status computation *) + ; command_hashes = [] } ) in let empty_diff = Staged_ledger_diff.empty_diff in @@ -3419,10 +3461,15 @@ let%test_module "staged ledger tests" = Mina_numbers.Global_slot_since_genesis.of_int global_slot in let current_state_view = dummy_state_view ~global_slot () in + let transactions_by_fee = + Sequence.map cmds_this_iter + ~f: + Transaction_hash.User_command_with_valid_signature + .create + in let diff_result = Sl.create_diff ~constraint_constants ~global_slot !sl - ~logger ~current_state_view - ~transactions_by_fee:cmds_this_iter + ~logger ~current_state_view ~transactions_by_fee ~get_completed_work:stmt_to_work ~coinbase_receiver ~supercharge_coinbase:true ~zkapp_cmd_limit:None in @@ -4268,7 +4315,11 @@ let%test_module "staged ledger tests" = let diff_result = Sl.create_diff ~constraint_constants ~global_slot !sl ~logger ~current_state_view - ~transactions_by_fee:(Sequence.of_list [ invalid_command ]) + ~transactions_by_fee: + (Sequence.singleton + ( invalid_command + |> Transaction_hash.User_command_with_valid_signature + .create ) ) ~get_completed_work:(stmt_to_work_zero_fee ~prover:self_pk) ~coinbase_receiver ~supercharge_coinbase:false ~zkapp_cmd_limit:None @@ -4361,7 +4412,11 @@ let%test_module "staged ledger tests" = let diff_result = Sl.create_diff ~constraint_constants ~global_slot !sl ~logger ~current_state_view - ~transactions_by_fee:(Sequence.of_list [ valid_command ]) + ~transactions_by_fee: + (Sequence.singleton + ( valid_command + |> Transaction_hash.User_command_with_valid_signature + .create ) ) ~get_completed_work:(stmt_to_work_zero_fee ~prover:self_pk) ~coinbase_receiver ~supercharge_coinbase:false ~zkapp_cmd_limit:None @@ -4573,15 +4628,19 @@ let%test_module "staged ledger tests" = Sl.create_diff ~constraint_constants ~global_slot sl ~logger ~current_state_view ~transactions_by_fee: - (Sequence.of_list - [ valid_command_1 - ; valid_command_2 - ; invalid_command_3 - ; invalid_command_4 - ; valid_command_5 - ; invalid_command_6 - ; valid_command_7 - ] ) + ( Sequence.of_list + [ valid_command_1 + ; valid_command_2 + ; invalid_command_3 + ; invalid_command_4 + ; valid_command_5 + ; invalid_command_6 + ; valid_command_7 + ] + |> Sequence.map + ~f: + Transaction_hash.User_command_with_valid_signature.create + ) ~get_completed_work:(stmt_to_work_zero_fee ~prover:self_pk) ~coinbase_receiver ~supercharge_coinbase:false ~zkapp_cmd_limit:None @@ -4732,6 +4791,11 @@ let%test_module "staged ledger tests" = ; commands = cmds ; coinbase = Zero ; internal_command_statuses = [ Applied ] + ; command_hashes = + List.map cmds + ~f: + (Fn.compose Transaction_hash.hash_command_with_hashes + With_status.data ) } in { diff = (pre_diff, None) } @@ -5175,7 +5239,9 @@ let%test_module "staged ledger tests" = ~logger ~current_state_view ~transactions_by_fee: (Sequence.singleton - (User_command.Zkapp_command invalid_zkapp_command) ) + ( User_command.Zkapp_command invalid_zkapp_command + |> Transaction_hash.User_command_with_valid_signature + .create ) ) ~get_completed_work: (stmt_to_work_zero_fee ~prover:self_pk) ~coinbase_receiver ~supercharge_coinbase:false diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 35f0dddc5b58..83d8d5f0e4b1 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -262,13 +262,14 @@ val create_diff : -> logger:Logger.t -> current_state_view:Zkapp_precondition.Protocol_state.View.t -> zkapp_cmd_limit:int option - -> transactions_by_fee:User_command.Valid.t Sequence.t + -> transactions_by_fee: + Transaction_hash.User_command_with_valid_signature.t Sequence.t -> get_completed_work: ( Transaction_snark_work.Statement.t -> Transaction_snark_work.Checked.t option ) -> supercharge_coinbase:bool -> ( Staged_ledger_diff.With_valid_signatures_and_proofs.t - * (User_command.Valid.t * Error.t) list + * (Transaction_hash.User_command_with_valid_signature.t * Error.t) list , Pre_diff_info.Error.t ) Result.t diff --git a/src/lib/staged_ledger/test/txn_application_test.ml b/src/lib/staged_ledger/test/txn_application_test.ml index ee91f8369eed..4b3e14cb2ca1 100644 --- a/src/lib/staged_ledger/test/txn_application_test.ml +++ b/src/lib/staged_ledger/test/txn_application_test.ml @@ -3,9 +3,7 @@ open Mina_base open Mina_generators open Mina_numbers open Mina_transaction - -module Application_state = - Staged_ledger.For_tests.Application_state.Valid_user_command +module Application_state = Staged_ledger.For_tests.Application_state type apply = User_command.t Transaction.t_ @@ -33,7 +31,8 @@ let gen_apply_and_txn : (apply * User_command.Valid.t) Quickcheck.Generator.t = in (apply, txn) -let gen_application_state : Application_state.t Quickcheck.Generator.t = +let gen_application_state : + User_command.Valid.t Application_state.t Quickcheck.Generator.t = let open Application_state in let open Quickcheck.Generator in let open Let_syntax in @@ -54,7 +53,9 @@ let apply_against_non_empty_scan_state () = Quickcheck.test (Quickcheck.Generator.tuple2 gen_apply_and_txn gen_application_state) ~f:(fun ((apply, txn), state) -> - match Application_state.try_applying_txn ~apply state txn with + match + Application_state.Valid_user_command.try_applying_txn ~apply state txn + with | Continue state' when state.total_space_remaining > 0 -> [%test_pred: int] (fun delta -> delta = 0 || delta = 1) diff --git a/src/lib/staged_ledger_diff/diff.ml b/src/lib/staged_ledger_diff/diff.ml index ffa5755d9cf1..534383d80f9a 100644 --- a/src/lib/staged_ledger_diff/diff.ml +++ b/src/lib/staged_ledger_diff/diff.ml @@ -74,68 +74,119 @@ module Ft = struct type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson] end -module Pre_diff_two = struct +module Pre_diff_generic = struct [%%versioned module Stable = struct [@@@no_toplevel_latest_type] module V2 = struct - type ('a, 'b) t = + type ('a, 'b, 'coinbase) t = { completed_works : 'a list ; commands : 'b list - ; coinbase : Ft.Stable.V1.t At_most_two.Stable.V1.t + ; coinbase : 'coinbase ; internal_command_statuses : Transaction_status.Stable.V2.t list } [@@deriving equal, compare, sexp, yojson] + + let extract_prediff t = + (t.completed_works, t.commands, t.coinbase, t.internal_command_statuses) end end] - type ('a, 'b) t = ('a, 'b) Stable.Latest.t = - { completed_works : 'a list + type ('a, 'b, 'coinbase) t = + { command_hashes : Mina_transaction.Transaction_hash.t list [@sexp.opaque] + ; completed_works : 'a list ; commands : 'b list - ; coinbase : Ft.t At_most_two.t + ; coinbase : 'coinbase ; internal_command_statuses : Transaction_status.t list } - [@@deriving equal, compare, sexp, yojson] + [@@deriving equal, compare, sexp_of, to_yojson] + + let extract_prediff t = + (t.completed_works, t.commands, t.coinbase, t.internal_command_statuses) + + let write_all_proofs_to_disk ~signature_kind ~proof_cache_db + ({ commands; completed_works; coinbase; internal_command_statuses } : + ( Transaction_snark_work.Stable.Latest.t + , User_command.Stable.Latest.t With_status.Stable.Latest.t + , 'c ) + Stable.Latest.t ) : + (Transaction_snark_work.t, User_command.t With_status.t, 'c) t = + let write_sw = + Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db + in + let write_tx = + With_status.map + ~f: + (User_command.write_all_proofs_to_disk ~signature_kind ~proof_cache_db) + in + let hash_command = + Fn.compose Mina_transaction.Transaction_hash.hash_command With_status.data + in + { commands = List.map ~f:write_tx commands + ; completed_works = List.map ~f:write_sw completed_works + ; coinbase + ; internal_command_statuses + ; command_hashes = List.map ~f:hash_command commands + } - let map t ~f1 ~f2 = - { completed_works = List.map t.completed_works ~f:f1 - ; commands = List.map t.commands ~f:f2 - ; coinbase = t.coinbase - ; internal_command_statuses = t.internal_command_statuses + let read_all_proofs_from_disk + ({ commands + ; completed_works + ; coinbase + ; internal_command_statuses + ; command_hashes = _ + } : + (Transaction_snark_work.t, User_command.t With_status.t, 'c) t ) : + ( Transaction_snark_work.Stable.Latest.t + , User_command.Stable.Latest.t With_status.Stable.Latest.t + , 'c ) + Stable.Latest.t = + let read_sw = Transaction_snark_work.read_all_proofs_from_disk in + let read_tx = With_status.map ~f:User_command.read_all_proofs_from_disk in + { commands = List.map ~f:read_tx commands + ; completed_works = List.map ~f:read_sw completed_works + ; coinbase + ; internal_command_statuses } end -module Pre_diff_one = struct +module Pre_diff_two = struct [%%versioned module Stable = struct [@@@no_toplevel_latest_type] module V2 = struct type ('a, 'b) t = - { completed_works : 'a list - ; commands : 'b list - ; coinbase : Ft.Stable.V1.t At_most_one.Stable.V1.t - ; internal_command_statuses : Transaction_status.Stable.V2.t list - } + ( 'a + , 'b + , Ft.Stable.V1.t At_most_two.Stable.V1.t ) + Pre_diff_generic.Stable.V2.t [@@deriving equal, compare, sexp, yojson] end end] - type ('a, 'b) t = ('a, 'b) Stable.Latest.t = - { completed_works : 'a list - ; commands : 'b list - ; coinbase : Ft.t At_most_one.t - ; internal_command_statuses : Transaction_status.t list - } - [@@deriving equal, compare, sexp, yojson] + type ('a, 'b) t = ('a, 'b, Ft.t At_most_two.t) Pre_diff_generic.t + [@@deriving equal, compare, sexp_of, to_yojson] +end - let map t ~f1 ~f2 = - { completed_works = List.map t.completed_works ~f:f1 - ; commands = List.map t.commands ~f:f2 - ; coinbase = t.coinbase - ; internal_command_statuses = t.internal_command_statuses - } +module Pre_diff_one = struct + [%%versioned + module Stable = struct + [@@@no_toplevel_latest_type] + + module V2 = struct + type ('a, 'b) t = + ( 'a + , 'b + , Ft.Stable.V1.t At_most_one.Stable.V1.t ) + Pre_diff_generic.Stable.V2.t + [@@deriving equal, compare, sexp, yojson] + end + end] + + type ('a, 'b) t = ('a, 'b, Ft.t At_most_one.t) Pre_diff_generic.t + [@@deriving equal, compare, sexp_of, to_yojson] end module Pre_diff_with_at_most_two_coinbase = struct @@ -157,19 +208,8 @@ module Pre_diff_with_at_most_two_coinbase = struct type t = (Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_two.t - let write_all_proofs_to_disk ~signature_kind ~proof_cache_db : - Stable.Latest.t -> t = - Pre_diff_two.map - ~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db) - ~f2: - (With_status.map - ~f: - (User_command.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) ) - - let read_all_proofs_from_disk : t -> Stable.Latest.t = - Pre_diff_two.map ~f1:Transaction_snark_work.read_all_proofs_from_disk - ~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk) + [%%define_locally + Pre_diff_generic.(read_all_proofs_from_disk, write_all_proofs_to_disk)] end module Pre_diff_with_at_most_one_coinbase = struct @@ -191,19 +231,8 @@ module Pre_diff_with_at_most_one_coinbase = struct type t = (Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_one.t - let write_all_proofs_to_disk ~signature_kind ~proof_cache_db : - Stable.Latest.t -> t = - Pre_diff_one.map - ~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db) - ~f2: - (With_status.map - ~f: - (User_command.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) ) - - let read_all_proofs_from_disk : t -> Stable.Latest.t = - Pre_diff_one.map ~f1:Transaction_snark_work.read_all_proofs_from_disk - ~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk) + [%%define_locally + Pre_diff_generic.(read_all_proofs_from_disk, write_all_proofs_to_disk)] end module Diff = struct @@ -222,9 +251,9 @@ module Diff = struct coinbase_amount ~constraint_constants ~supercharge_coinbase in match - ( first_pre_diff.Pre_diff_two.coinbase + ( first_pre_diff.Pre_diff_generic.coinbase , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero - ~f:(fun d -> d.Pre_diff_one.coinbase) ) + ~f:(fun d -> d.Pre_diff_generic.coinbase) ) with | At_most_two.Zero, At_most_one.Zero -> Some Currency.Amount.zero @@ -243,7 +272,21 @@ module Diff = struct let to_latest = Fn.id - let coinbase = coinbase + let coinbase + ~(constraint_constants : Genesis_constants.Constraint_constants.t) + ~supercharge_coinbase (first_pre_diff, second_pre_diff_opt) = + let coinbase_amount = + coinbase_amount ~constraint_constants ~supercharge_coinbase + in + match + ( first_pre_diff.Pre_diff_generic.Stable.Latest.coinbase + , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero + ~f:(fun d -> d.Pre_diff_generic.Stable.Latest.coinbase) ) + with + | At_most_two.Zero, At_most_one.Zero -> + Some Currency.Amount.zero + | _ -> + coinbase_amount end end] @@ -332,6 +375,7 @@ module With_valid_signatures_and_proofs = struct ; commands = [] ; coinbase = At_most_two.Zero ; internal_command_statuses = [] + ; command_hashes = [] } , None ) } @@ -363,19 +407,7 @@ module With_valid_signatures = struct let coinbase ~(constraint_constants : Genesis_constants.Constraint_constants.t) ~supercharge_coinbase (t : t) = - let first_pre_diff, second_pre_diff_opt = t.diff in - let coinbase_amount = - Diff.coinbase_amount ~constraint_constants ~supercharge_coinbase - in - match - ( first_pre_diff.coinbase - , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero - ~f:(fun d -> d.coinbase) ) - with - | At_most_two.Zero, At_most_one.Zero -> - Some Currency.Amount.zero - | _ -> - coinbase_amount + Diff.coinbase ~constraint_constants ~supercharge_coinbase t.diff end let validate_commands (t : t) @@ -403,15 +435,17 @@ let validate_commands (t : t) ; commands = commands1 ; coinbase = d1.coinbase ; internal_command_statuses = d1.internal_command_statuses + ; command_hashes = d1.command_hashes } in let p2 = Option.value_map ~default:None d2 ~f:(fun d2 -> Some - { Pre_diff_one.completed_works = d2.completed_works + { Pre_diff_generic.completed_works = d2.completed_works ; commands = commands2 ; coinbase = d2.coinbase ; internal_command_statuses = d2.internal_command_statuses + ; command_hashes = d2.command_hashes } ) in ({ diff = (p1, p2) } : With_valid_signatures.t) ) @@ -424,6 +458,7 @@ let forget_proof_checks (d : With_valid_signatures_and_proofs.t) : ; commands = d1.commands ; coinbase = d1.coinbase ; internal_command_statuses = d1.internal_command_statuses + ; command_hashes = d1.command_hashes } in let p2 = @@ -433,14 +468,21 @@ let forget_proof_checks (d : With_valid_signatures_and_proofs.t) : ; commands = d2.commands ; coinbase = d2.coinbase ; internal_command_statuses = d2.internal_command_statuses + ; command_hashes = d2.command_hashes } ) in { diff = (p1, p2) } -let forget_pre_diff_with_at_most_two +let forget_pre_diff (pre_diff : - With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) : - Pre_diff_with_at_most_two_coinbase.t = + ( Transaction_snark_work.Checked.t + , User_command.Valid.t With_status.t + , 'c ) + Pre_diff_generic.t ) : + ( Transaction_snark_work.t + , User_command.t With_status.t + , 'c ) + Pre_diff_generic.t = { completed_works = forget_cw pre_diff.completed_works ; commands = List.map @@ -448,24 +490,12 @@ let forget_pre_diff_with_at_most_two pre_diff.commands ; coinbase = pre_diff.coinbase ; internal_command_statuses = pre_diff.internal_command_statuses - } - -let forget_pre_diff_with_at_most_one - (pre_diff : - With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) = - { Pre_diff_one.completed_works = forget_cw pre_diff.completed_works - ; commands = - List.map - ~f:(With_status.map ~f:User_command.forget_check) - pre_diff.commands - ; coinbase = pre_diff.coinbase - ; internal_command_statuses = pre_diff.internal_command_statuses + ; command_hashes = pre_diff.command_hashes } let forget (t : With_valid_signatures_and_proofs.t) = { diff = - ( forget_pre_diff_with_at_most_two (fst t.diff) - , Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one ) + (forget_pre_diff (fst t.diff), Option.map (snd t.diff) ~f:forget_pre_diff) } let commands (t : t) = @@ -505,6 +535,7 @@ let empty_diff : t = ; commands = [] ; coinbase = At_most_two.Zero ; internal_command_statuses = [] + ; command_hashes = [] } , None ) } @@ -515,6 +546,7 @@ let is_empty = function ; commands = [] ; coinbase = At_most_two.Zero ; internal_command_statuses = [] + ; command_hashes = [] } , None ) } -> diff --git a/src/lib/staged_ledger_diff/diff.mli b/src/lib/staged_ledger_diff/diff.mli index a139c3e0aded..3cd25e0e4f3b 100644 --- a/src/lib/staged_ledger_diff/diff.mli +++ b/src/lib/staged_ledger_diff/diff.mli @@ -31,38 +31,76 @@ module At_most_one : sig val increase : 'a t -> 'a list -> 'a t Or_error.t end -module Pre_diff_two : sig +module Pre_diff_generic : sig [%%versioned: module Stable : sig + [@@@no_toplevel_latest_type] + module V2 : sig - type ('a, 'b) t = + type ('a, 'b, 'coinbase) t = { completed_works : 'a list ; commands : 'b list - ; coinbase : Coinbase.Fee_transfer.Stable.V1.t At_most_two.Stable.V1.t + ; coinbase : 'coinbase ; internal_command_statuses : Transaction_status.Stable.V2.t list } + + val extract_prediff : + ('a, 'b, 'coinbase) t + -> 'a list * 'b list * 'coinbase * Transaction_status.Stable.V2.t list + end + end] + + type ('a, 'b, 'coinbase) t = + { command_hashes : Mina_transaction.Transaction_hash.t list [@sexp.opaque] + ; completed_works : 'a list + ; commands : 'b list + ; coinbase : 'coinbase + ; internal_command_statuses : Transaction_status.t list + } + + val extract_prediff : + ('a, 'b, 'coinbase) t + -> 'a list * 'b list * 'coinbase * Transaction_status.t list +end + +module Pre_diff_two : sig + [%%versioned: + module Stable : sig + [@@@no_toplevel_latest_type] + + module V2 : sig + type ('a, 'b) t = + ( 'a + , 'b + , Coinbase.Fee_transfer.Stable.V1.t At_most_two.Stable.V1.t ) + Pre_diff_generic.Stable.V2.t [@@deriving equal, compare, sexp, yojson] end end] - val map : ('a, 'b) t -> f1:('a -> 'c) -> f2:('b -> 'd) -> ('c, 'd) t + type ('a, 'b) t = + ('a, 'b, Coinbase.Fee_transfer.t At_most_two.t) Pre_diff_generic.t + [@@deriving equal, compare, sexp_of, to_yojson] end module Pre_diff_one : sig [%%versioned: module Stable : sig + [@@@no_toplevel_latest_type] + module V2 : sig type ('a, 'b) t = - { completed_works : 'a list - ; commands : 'b list - ; coinbase : Coinbase.Fee_transfer.Stable.V1.t At_most_one.Stable.V1.t - ; internal_command_statuses : Transaction_status.Stable.V2.t list - } + ( 'a + , 'b + , Coinbase.Fee_transfer.Stable.V1.t At_most_one.Stable.V1.t ) + Pre_diff_generic.Stable.V2.t [@@deriving equal, compare, sexp, yojson] end end] - val map : ('a, 'b) t -> f1:('a -> 'c) -> f2:('b -> 'd) -> ('c, 'd) t + type ('a, 'b) t = + ('a, 'b, Coinbase.Fee_transfer.t At_most_one.t) Pre_diff_generic.t + [@@deriving equal, compare, sexp_of, to_yojson] end module Pre_diff_with_at_most_two_coinbase : sig diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index a5561afa6774..bcd27fb858ff 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -366,7 +366,10 @@ module For_tests = struct let transactions = gen_payments ~send_to_random_pk parent_staged_ledger accounts_with_secret_keys - |> Sequence.map ~f:(fun x -> User_command.Signed_command x) + |> Sequence.map ~f:(fun x -> + Mina_transaction.Transaction_hash + .User_command_with_valid_signature + .create @@ User_command.Signed_command x ) in let _, largest_account = List.max_elt accounts_with_secret_keys From 8464d9e32a69215e479c481ec38ed80580e44348 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 18:46:08 +0100 Subject: [PATCH 040/122] Use transaction hashes from breadcrumb --- src/lib/staged_ledger_diff/diff.ml | 4 ++++ src/lib/staged_ledger_diff/diff.mli | 2 ++ .../frontier_base/breadcrumb.ml | 11 +++++++++++ .../frontier_base/breadcrumb.mli | 2 ++ src/lib/transition_frontier/transition_frontier.ml | 14 ++++---------- 5 files changed, 23 insertions(+), 10 deletions(-) diff --git a/src/lib/staged_ledger_diff/diff.ml b/src/lib/staged_ledger_diff/diff.ml index 534383d80f9a..b511106c67d2 100644 --- a/src/lib/staged_ledger_diff/diff.ml +++ b/src/lib/staged_ledger_diff/diff.ml @@ -502,6 +502,10 @@ let commands (t : t) = (fst t.diff).commands @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands) +let command_hashes (t : t) = + (fst t.diff).command_hashes + @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.command_hashes) + let completed_works (t : t) = (fst t.diff).completed_works @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works) diff --git a/src/lib/staged_ledger_diff/diff.mli b/src/lib/staged_ledger_diff/diff.mli index 3cd25e0e4f3b..5c9b40ee33cd 100644 --- a/src/lib/staged_ledger_diff/diff.mli +++ b/src/lib/staged_ledger_diff/diff.mli @@ -256,6 +256,8 @@ val forget : With_valid_signatures_and_proofs.t -> t val commands : t -> User_command.t With_status.t list +val command_hashes : t -> Mina_transaction.Transaction_hash.t list + val completed_works : t -> Transaction_snark_work.t list val net_return : diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index bcd27fb858ff..9c26609fe407 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -83,6 +83,17 @@ T. , staged_ledger_hash , accounts_created )] +let command_hashes + { T.validated_transition + ; staged_ledger = _ + ; just_emitted_a_proof = _ + ; transition_receipt_time = _ + ; staged_ledger_hash = _ + ; accounts_created = _ + } = + Mina_block.Validated.body validated_transition + |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes + include Allocation_functor.Make.Basic (T) let compute_block_trace_metadata transition_with_validation = diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index e9d5875dbf85..db8bb836bf53 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -50,6 +50,8 @@ val build : Result.t Deferred.t +val command_hashes : t -> Mina_transaction.Transaction_hash.t list + val validated_transition : t -> Mina_block.Validated.t val block_with_hash : t -> Mina_block.with_hash diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 643fce8363c9..9a4ad463586d 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -477,19 +477,13 @@ let add_breadcrumb_exn t breadcrumb = ; ("n", `Int (Full_frontier.size t.full_frontier)) ] "POST: ($state_hash, $n)" ; - let user_cmds = - Mina_block.Validated.valid_commands - @@ Breadcrumb.validated_transition breadcrumb - in - let tx_hash_json command = - User_command.forget_check command - |> Mina_transaction.Transaction_hash.hash_command_with_hashes - |> Mina_transaction.Transaction_hash.to_yojson - in + let user_cmd_hashes = Breadcrumb.command_hashes breadcrumb in [%str_log' trace t.logger] Added_breadcrumb_user_commands ~metadata: [ ( "user_commands" - , `List (List.map user_cmds ~f:(With_status.to_yojson tx_hash_json)) ) + , `List + (List.map user_cmd_hashes + ~f:Mina_transaction.Transaction_hash.to_yojson ) ) ; ("state_hash", State_hash.to_yojson (Breadcrumb.state_hash breadcrumb)) ] ; let lite_diffs = From 8be945e94edcdbdfdda15a05132023e2400087df Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 19:06:12 +0100 Subject: [PATCH 041/122] Use transaction hashes in inclusion status --- src/lib/mina_graphql/mina_graphql.ml | 2 +- .../transaction_inclusion_status.ml | 29 +++++++++---------- .../transaction_inclusion_status.mli | 3 +- .../frontier_base/breadcrumb.ml | 8 +++++ .../frontier_base/breadcrumb.mli | 3 ++ 5 files changed, 26 insertions(+), 19 deletions(-) diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index 4c8a55b64a71..2c86506c14f1 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -2070,7 +2070,7 @@ module Queries = struct let transaction_pool = Mina_lib.transaction_pool mina in (* TODO: do not compute hashes to just get the status *) Transaction_inclusion_status.get_status ~frontier_broadcast_pipe - ~transaction_pool txn.data ) + ~transaction_pool txn.hash ) let current_snark_worker = field "currentSnarkWorker" ~typ:Types.snark_worker diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml index a84f6de7ad55..263c5111d2c2 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml @@ -24,7 +24,7 @@ module State = struct end (* TODO: this is extremely expensive as implemented and needs to be replaced with an extension *) -let get_status ~frontier_broadcast_pipe ~transaction_pool cmd = +let get_status ~frontier_broadcast_pipe ~transaction_pool cmd_hash = let resource_pool = Transaction_pool.resource_pool transaction_pool in match Broadcast_pipe.Reader.peek frontier_broadcast_pipe with | None -> @@ -33,22 +33,17 @@ let get_status ~frontier_broadcast_pipe ~transaction_pool cmd = let best_tip_path = Transition_frontier.best_tip_path transition_frontier in - let in_breadcrumb breadcrumb = - breadcrumb |> Transition_frontier.Breadcrumb.validated_transition - |> Mina_block.Validated.valid_commands - |> List.exists ~f:(fun { data = found; _ } -> - let found' = User_command.forget_check found in - User_command.equal_ignoring_proofs_and_hashes_and_aux cmd found' ) + let in_breadcrumb = + Fn.flip Transition_frontier.Breadcrumb.contains_transaction_by_hash + cmd_hash in if List.exists ~f:in_breadcrumb best_tip_path then State.Included else if List.exists ~f:in_breadcrumb (Transition_frontier.all_breadcrumbs transition_frontier) then State.Pending - else if - Transaction_pool.Resource_pool.member resource_pool - (Transaction_hash.hash_command cmd) - then State.Pending + else if Transaction_pool.Resource_pool.member resource_pool cmd_hash then + State.Pending else State.Unknown let%test_module "transaction_status" = @@ -167,8 +162,9 @@ let%test_module "transaction_status" = let%map () = Async.Scheduler.yield_until_no_jobs_remain () in [%log info] "Checking status" ; [%test_eq: State.t] ~equal:State.equal State.Unknown - (get_status ~frontier_broadcast_pipe ~transaction_pool - (Signed_command user_command) ) ) ) + ( get_status ~frontier_broadcast_pipe ~transaction_pool + @@ Transaction_hash.hash_command (Signed_command user_command) + ) ) ) let%test_unit "A pending transaction is either in the transition frontier \ or transaction pool, but not in the best path of the \ @@ -190,7 +186,7 @@ let%test_module "transaction_status" = let%map () = Async.Scheduler.yield_until_no_jobs_remain () in let status = get_status ~frontier_broadcast_pipe ~transaction_pool - (Signed_command user_command) + @@ Transaction_hash.hash_command (Signed_command user_command) in [%log info] "Computing status" ; [%test_eq: State.t] ~equal:State.equal State.Pending status ) ) @@ -228,6 +224,7 @@ let%test_module "transaction_status" = let%map () = Async.Scheduler.yield_until_no_jobs_remain () in [%log info] "Computing status" ; [%test_eq: State.t] ~equal:State.equal State.Unknown - (get_status ~frontier_broadcast_pipe ~transaction_pool - (Signed_command unknown_user_command) ) ) ) + ( get_status ~frontier_broadcast_pipe ~transaction_pool + @@ Transaction_hash.hash_command + (Signed_command unknown_user_command) ) ) ) end ) diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.mli b/src/lib/transaction_inclusion_status/transaction_inclusion_status.mli index 22770d3406f7..ab6ca46a83f2 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.mli +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.mli @@ -1,6 +1,5 @@ open Core_kernel open Pipe_lib -open Mina_base module State : sig module Stable : sig @@ -22,5 +21,5 @@ val get_status : frontier_broadcast_pipe: Transition_frontier.t Option.t Broadcast_pipe.Reader.t -> transaction_pool:Network_pool.Transaction_pool.t - -> User_command.Stable.Latest.t + -> Mina_transaction.Transaction_hash.t -> State.t diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 9c26609fe407..5829c3c2bf28 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -94,6 +94,14 @@ let command_hashes Mina_block.Validated.body validated_transition |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes +(* TODO: for better efficiency, add set of tx hashes to `maps_t` + and use existing mechanism of mask handling to get accumulated lookups, + then in transaction_status it will be necessary to only traverse + all of the tips instead of all of the breadcrumbs. *) +let contains_transaction_by_hash t hash = + List.exists (command_hashes t) + ~f:(Mina_transaction.Transaction_hash.equal hash) + include Allocation_functor.Make.Basic (T) let compute_block_trace_metadata transition_with_validation = diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index db8bb836bf53..0c018869f9b8 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -52,6 +52,9 @@ val build : val command_hashes : t -> Mina_transaction.Transaction_hash.t list +val contains_transaction_by_hash : + t -> Mina_transaction.Transaction_hash.t -> bool + val validated_transition : t -> Mina_block.Validated.t val block_with_hash : t -> Mina_block.with_hash From bafccae57038f53b6a23ebee8e3ea2b6154ab841 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 19:47:30 +0100 Subject: [PATCH 042/122] Tx pool: don't recompute hashes in best tip handling --- src/lib/network_pool/transaction_pool.ml | 83 +++++++++++-------- .../extensions/best_tip_diff.ml | 23 +++-- .../extensions/best_tip_diff.mli | 10 ++- .../frontier_base/breadcrumb.ml | 9 ++ .../frontier_base/breadcrumb.mli | 6 ++ 5 files changed, 86 insertions(+), 45 deletions(-) diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 1d9c1926da47..60185fcaf8a5 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -25,8 +25,10 @@ module type Transition_frontier_intf = sig end type best_tip_diff = - { new_commands : User_command.Valid.t With_status.t list - ; removed_commands : User_command.Valid.t With_status.t list + { new_commands : + Transaction_hash.User_command_with_valid_signature.t With_status.t list + ; removed_commands : + Transaction_hash.User_command_with_valid_signature.t With_status.t list ; reorg_best_tip : bool } @@ -531,8 +533,13 @@ struct (diff_error_of_indexed_pool_error e) , indexed_pool_error_metadata e ) - let handle_transition_frontier_diff_inner ~new_commands ~removed_commands - ~best_tip_ledger t = + let handle_transition_frontier_diff_inner + ~(new_commands : + Transaction_hash.User_command_with_valid_signature.t With_status.t + list ) + ~(removed_commands : + Transaction_hash.User_command_with_valid_signature.t With_status.t + list ) ~best_tip_ledger t = (* This runs whenever the best tip changes. The simple case is when the new best tip is an extension of the old one. There, we just remove any user commands that were included in it from the transaction pool. @@ -554,10 +561,13 @@ struct let vk_table_dec t ~account_id ~(vk : Verification_key_wire.t) = Vk_refcount_table.dec t ~account_id ~vk_hash:vk.hash in - let vk_table_lift = Vk_refcount_table.lift t.verification_key_table in let vk_table_lift_hashed = Vk_refcount_table.lift_hashed t.verification_key_table in + let vk_table_lift_hashed_with_status f tx = + Vk_refcount_table.lift_hashed t.verification_key_table f + (With_status.data tx) + in let global_slot = Indexed_pool.global_slot_since_genesis t.pool in t.best_tip_ledger <- Some best_tip_ledger ; let pool_max_size = t.config.pool_max_size in @@ -573,30 +583,24 @@ struct ] @ metadata ) in - List.iter new_commands ~f:(vk_table_lift vk_table_inc) ; - List.iter removed_commands ~f:(vk_table_lift vk_table_dec) ; - let compact_json = - Fn.compose User_command.fee_payer_summary_json User_command.forget_check + List.iter new_commands ~f:(vk_table_lift_hashed_with_status vk_table_inc) ; + List.iter removed_commands + ~f:(vk_table_lift_hashed_with_status vk_table_dec) ; + let hash_json = + With_status.to_yojson + (Fn.compose Transaction_hash.to_yojson + Transaction_hash.User_command_with_valid_signature.transaction_hash ) in [%log' trace t.logger] ~metadata: - [ ( "removed" - , `List - (List.map removed_commands - ~f:(With_status.to_yojson compact_json) ) ) - ; ( "added" - , `List - (List.map new_commands ~f:(With_status.to_yojson compact_json)) - ) + [ ("removed", `List (List.map removed_commands ~f:hash_json)) + ; ("added", `List (List.map new_commands ~f:hash_json)) ] "Diff: removed: $removed added: $added from best tip" ; let pool', dropped_backtrack = List.fold (List.rev removed_commands) ~init:(t.pool, Sequence.empty) - ~f:(fun (pool, dropped_so_far) unhashed_cmd -> - let cmd = - Transaction_hash.User_command_with_valid_signature.create - unhashed_cmd.data - in + ~f:(fun (pool, dropped_so_far) cmd_with_status -> + let cmd = With_status.data cmd_with_status in ( match Locally_generated.find_and_remove t.locally_generated_committed cmd @@ -606,11 +610,7 @@ struct | Some time_added -> [%log' info t.logger] "Locally generated command $cmd committed in a block!" - ~metadata: - [ ( "cmd" - , With_status.to_yojson User_command.Valid.to_yojson - unhashed_cmd ) - ] ; + ~metadata:[ ("cmd", hash_json cmd_with_status) ] ; Locally_generated.add_exn t.locally_generated_uncommitted ~key:cmd ~data:time_added ) ; let pool', dropped_seq = @@ -649,7 +649,8 @@ struct List.fold (new_commands @ removed_commands) ~init:Account_id.Set.empty ~f:(fun set cmd -> let set' = - With_status.data cmd |> User_command.forget_check + With_status.data cmd + |> Transaction_hash.User_command_with_valid_signature.command |> User_command.accounts_referenced |> Account_id.Set.of_list in Set.union set set' ) @@ -678,7 +679,6 @@ struct ~f:(fun set cmd -> let cmd_hash = With_status.data cmd - |> Transaction_hash.User_command_with_valid_signature.create |> Transaction_hash.User_command_with_valid_signature .transaction_hash in @@ -1641,8 +1641,16 @@ include include Transition_frontier type best_tip_diff = Extensions.Best_tip_diff.view = - { new_commands : User_command.Valid.t With_status.t list - ; removed_commands : User_command.Valid.t With_status.t list + { new_commands : + Mina_transaction.Transaction_hash.User_command_with_valid_signature + .t + With_status.t + list + ; removed_commands : + Mina_transaction.Transaction_hash.User_command_with_valid_signature + .t + With_status.t + list ; reorg_best_tip : bool } @@ -1732,8 +1740,12 @@ let%test_module _ = end type best_tip_diff = - { new_commands : User_command.Valid.t With_status.t list - ; removed_commands : User_command.Valid.t With_status.t list + { new_commands : + Transaction_hash.User_command_with_valid_signature.t With_status.t + list + ; removed_commands : + Transaction_hash.User_command_with_valid_signature.t With_status.t + list ; reorg_best_tip : bool } @@ -2207,7 +2219,10 @@ let%test_module _ = expected_commands ) ) let mk_with_status (cmd : User_command.Valid.t) = - { With_status.data = cmd; status = Applied } + { With_status.data = + Transaction_hash.User_command_with_valid_signature.create cmd + ; status = Applied + } let add_commands ?(local = true) test cs = let sender = diff --git a/src/lib/transition_frontier/extensions/best_tip_diff.ml b/src/lib/transition_frontier/extensions/best_tip_diff.ml index eeff93b828aa..c7a1d9939bcc 100644 --- a/src/lib/transition_frontier/extensions/best_tip_diff.ml +++ b/src/lib/transition_frontier/extensions/best_tip_diff.ml @@ -6,8 +6,14 @@ module T = struct type t = { logger : Logger.t; best_tip_diff_logger : Logger.t } type view = - { new_commands : User_command.Valid.t With_status.t list - ; removed_commands : User_command.Valid.t With_status.t list + { new_commands : + Mina_transaction.Transaction_hash.User_command_with_valid_signature.t + With_status.t + list + ; removed_commands : + Mina_transaction.Transaction_hash.User_command_with_valid_signature.t + With_status.t + list ; reorg_best_tip : bool } @@ -32,16 +38,13 @@ module T = struct [@@deriving register_event { msg = "Formed a new best tip" }] end - let breadcrumb_commands = - Fn.compose Mina_block.Validated.valid_commands - Breadcrumb.validated_transition - let create ~logger frontier = let best_tip_diff_logger = Logger.create ~id:Logger.Logger_id.best_tip_diff () in ( { logger; best_tip_diff_logger } - , { new_commands = breadcrumb_commands (Full_frontier.root frontier) + , { new_commands = + Breadcrumb.valid_commands_hashed (Full_frontier.root frontier) ; removed_commands = [] ; reorg_best_tip = false } ) @@ -137,11 +140,13 @@ module T = struct |> Or_error.ok_exn in let new_commands = - List.bind added_to_best_tip_path ~f:breadcrumb_commands + List.bind added_to_best_tip_path + ~f:Breadcrumb.valid_commands_hashed @ new_commands in let removed_commands = - List.bind removed_from_best_tip_path ~f:breadcrumb_commands + List.bind removed_from_best_tip_path + ~f:Breadcrumb.valid_commands_hashed @ removed_commands in let reorg_best_tip = diff --git a/src/lib/transition_frontier/extensions/best_tip_diff.mli b/src/lib/transition_frontier/extensions/best_tip_diff.mli index 799a55b654bf..43d8ea5a8558 100644 --- a/src/lib/transition_frontier/extensions/best_tip_diff.mli +++ b/src/lib/transition_frontier/extensions/best_tip_diff.mli @@ -1,8 +1,14 @@ open Mina_base type view = - { new_commands : User_command.Valid.t With_status.t list - ; removed_commands : User_command.Valid.t With_status.t list + { new_commands : + Mina_transaction.Transaction_hash.User_command_with_valid_signature.t + With_status.t + list + ; removed_commands : + Mina_transaction.Transaction_hash.User_command_with_valid_signature.t + With_status.t + list ; reorg_best_tip : bool } diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 5829c3c2bf28..2050477462cb 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -94,6 +94,15 @@ let command_hashes Mina_block.Validated.body validated_transition |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes +let valid_commands_hashed (t : T.t) = + List.map2_exn (Mina_block.Validated.valid_commands t.validated_transition) + (command_hashes t) ~f:(fun command hash -> + With_status.map command + ~f: + (Fn.flip + Mina_transaction.Transaction_hash.User_command_with_valid_signature + .make hash ) ) + (* TODO: for better efficiency, add set of tx hashes to `maps_t` and use existing mechanism of mask handling to get accumulated lookups, then in transaction_status it will be necessary to only traverse diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index 0c018869f9b8..cfeff6448cbf 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -52,6 +52,12 @@ val build : val command_hashes : t -> Mina_transaction.Transaction_hash.t list +val valid_commands_hashed : + t + -> Mina_transaction.Transaction_hash.User_command_with_valid_signature.t + With_status.t + list + val contains_transaction_by_hash : t -> Mina_transaction.Transaction_hash.t -> bool From 8f5bf7e66239e126afad1ad463e7b496fef23091 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 20:08:49 +0100 Subject: [PATCH 043/122] Don't recompute hashes in block verification --- src/lib/staged_ledger/check_commands.ml | 19 +++++++------------ src/lib/staged_ledger/check_commands.mli | 1 + src/lib/staged_ledger_diff/diff.ml | 9 ++++++--- src/lib/staged_ledger_diff/diff.mli | 1 + 4 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/lib/staged_ledger/check_commands.ml b/src/lib/staged_ledger/check_commands.ml index d27c7225e538..7fd3deb83813 100644 --- a/src/lib/staged_ledger/check_commands.ml +++ b/src/lib/staged_ledger/check_commands.ml @@ -1,6 +1,5 @@ open Core_kernel open Mina_base -open Mina_transaction open Mina_stdlib module Ledger = Mina_ledger.Ledger @@ -19,14 +18,8 @@ let dummy_transaction_pool_proxy : transaction_pool_proxy = command verification *) let verify_command_with_transaction_pool_proxy ~(transaction_pool_proxy : transaction_pool_proxy) + ~(cmd_hash : Mina_transaction.Transaction_hash.t) (cmd_with_status : User_command.Verifiable.t With_status.t) = - let With_status.{ data = verifiable_cmd; _ } = cmd_with_status in - let cmd_hash = - (* PERF: `hash_command` is slow, so we may need to investigate if we could - reuse hashes from transition verification. *) - User_command.of_verifiable verifiable_cmd - |> Transaction_hash.hash_command_with_hashes - in match transaction_pool_proxy.find_by_hash cmd_hash with | None -> `No_fast_forward @@ -35,7 +28,8 @@ let verify_command_with_transaction_pool_proxy let check_commands ledger ~verifier ~(transaction_pool_proxy : transaction_pool_proxy) - (cs : User_command.t With_status.t list) = + (cs : User_command.t With_status.t list) + (hashes : Mina_transaction.Transaction_hash.t list) = let open Deferred.Or_error.Let_syntax in let%bind cs = User_command.Applied_sequence.to_all_verifiable cs @@ -46,10 +40,11 @@ let check_commands ledger ~verifier ~get_batch:(Ledger.get_batch ledger) ) |> Deferred.return in - let partitioner cmd = + let partitioner (cmd, cmd_hash) = let open Core_kernel.Either in match - verify_command_with_transaction_pool_proxy ~transaction_pool_proxy cmd + verify_command_with_transaction_pool_proxy ~transaction_pool_proxy + ~cmd_hash cmd with | `No_fast_forward -> Second cmd @@ -63,7 +58,7 @@ let check_commands ledger ~verifier ~finalizer:(fun left right_m ~f -> let%map.Deferred.Or_error right = right_m in f left right ) - cs + (List.zip_exn cs hashes) in Result.all (List.map xs ~f:(function diff --git a/src/lib/staged_ledger/check_commands.mli b/src/lib/staged_ledger/check_commands.mli index 367aadb4c0f2..1223c0679ecd 100644 --- a/src/lib/staged_ledger/check_commands.mli +++ b/src/lib/staged_ledger/check_commands.mli @@ -15,6 +15,7 @@ val check_commands : -> verifier:Verifier.t -> transaction_pool_proxy:transaction_pool_proxy -> User_command.t With_status.t list + -> Mina_transaction.Transaction_hash.t list -> ( ( Signed_command.With_valid_signature.t , Zkapp_command.Valid.t ) User_command.t_ diff --git a/src/lib/staged_ledger_diff/diff.ml b/src/lib/staged_ledger_diff/diff.ml index b511106c67d2..895ccb3c84d9 100644 --- a/src/lib/staged_ledger_diff/diff.ml +++ b/src/lib/staged_ledger_diff/diff.ml @@ -413,11 +413,12 @@ end let validate_commands (t : t) ~(check : User_command.t With_status.t list + -> Mina_transaction.Transaction_hash.t list -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t ) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t = let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in - let validate cs = - map (check cs) + let validate cs hashes = + map (check cs hashes) ~f: (List.map2_exn cs ~f:(fun c data -> { With_status.data; status = c.status } ) ) @@ -425,7 +426,9 @@ let validate_commands (t : t) let d1, d2 = t.diff in map (validate - (d1.commands @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands)) ) + (d1.commands @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands)) + ( d1.command_hashes + @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.command_hashes) ) ) ~f:(fun commands_all -> let commands1, commands2 = List.split_n commands_all (List.length d1.commands) diff --git a/src/lib/staged_ledger_diff/diff.mli b/src/lib/staged_ledger_diff/diff.mli index 5c9b40ee33cd..7bdeaf4d6af5 100644 --- a/src/lib/staged_ledger_diff/diff.mli +++ b/src/lib/staged_ledger_diff/diff.mli @@ -249,6 +249,7 @@ val validate_commands : t -> check: ( User_command.t With_status.t list + -> Mina_transaction.Transaction_hash.t list -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t ) -> (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t From 7ef773868537f0ef557e2f68aea73a35b8dae8c5 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 22:00:36 +0100 Subject: [PATCH 044/122] Reduce requirements for root data in validation --- src/app/cli/src/init/test_submit_to_archive.ml | 5 ++++- src/lib/block_producer/block_producer.ml | 8 ++++---- src/lib/mina_block/validation.ml | 11 ++--------- src/lib/mina_block/validation.mli | 3 ++- src/lib/transition_handler/processor.ml | 11 ++++++----- 5 files changed, 18 insertions(+), 20 deletions(-) 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 34173b261a05..ebeb56a58994 100644 --- a/src/app/cli/src/init/test_submit_to_archive.ml +++ b/src/app/cli/src/init/test_submit_to_archive.ml @@ -101,6 +101,9 @@ module Block = struct let protocol_state t = Frontier_base.Breadcrumb.protocol_state t.breadcrumb + let consensus_state_with_hashes t = + Frontier_base.Breadcrumb.consensus_state_with_hashes t.breadcrumb + let state_timestamp t = Blockchain_state.timestamp @@ Protocol_state.blockchain_state @@ protocol_state t @@ -365,7 +368,7 @@ let build_breadcrumb ~transactions ~context ~precomputed_values ~verifier ~state_hash:(Some previous_state_hash) previous_protocol_state ) >>| V.skip_proof_validation `This_block_was_generated_internally >>= V.validate_frontier_dependencies ~to_header:Mina_block.header ~context - ~root_block:(Block.block_with_hash previous) + ~root_consensus_state:(Block.consensus_state_with_hashes previous) ~is_block_in_frontier:(State_hash.equal previous_state_hash) |> Result.map_error ~f:(const (Error.of_string "failed to validate just created block")) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index ff7be4e69faa..32e9812ac9e2 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -927,9 +927,9 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover >>= Validation.validate_frontier_dependencies ~to_header:Mina_block.header ~context:(module Context) - ~root_block: + ~root_consensus_state: ( Transition_frontier.root frontier - |> Breadcrumb.block_with_hash ) + |> Breadcrumb.consensus_state_with_hashes ) ~is_block_in_frontier: (Fn.compose Option.is_some (Transition_frontier.find frontier) ) @@ -1502,9 +1502,9 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system >>= Validation.validate_frontier_dependencies ~to_header:Mina_block.header ~context:(module Context) - ~root_block: + ~root_consensus_state: ( Transition_frontier.root frontier - |> Breadcrumb.block_with_hash ) + |> Breadcrumb.consensus_state_with_hashes ) ~is_block_in_frontier: (Fn.compose Option.is_some (Transition_frontier.find frontier) ) diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 30b070549549..9f0cca5f0427 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -399,8 +399,8 @@ let skip_delta_block_chain_validation `This_block_was_not_received_via_gossip (Mina_stdlib.Nonempty_list.singleton previous_protocol_state_hash) ) let validate_frontier_dependencies ~to_header - ~context:(module Context : CONTEXT) ~root_block ~is_block_in_frontier - (t, validation) = + ~context:(module Context : CONTEXT) ~root_consensus_state + ~is_block_in_frontier (t, validation) = let module Context = struct include Context @@ -413,13 +413,6 @@ let validate_frontier_dependencies ~to_header let open Result.Let_syntax in let hash = State_hash.With_state_hashes.state_hash t in let protocol_state = Fn.compose Header.protocol_state to_header in - let root_consensus_state = - With_hash.map - ~f: - (Fn.compose Protocol_state.consensus_state - (Fn.compose Header.protocol_state Block.header) ) - root_block - in let parent_hash = Protocol_state.previous_state_hash (protocol_state @@ With_hash.data t) in diff --git a/src/lib/mina_block/validation.mli b/src/lib/mina_block/validation.mli index f8d681e60e70..798a6bb97ec7 100644 --- a/src/lib/mina_block/validation.mli +++ b/src/lib/mina_block/validation.mli @@ -283,7 +283,8 @@ val skip_delta_block_chain_validation : val validate_frontier_dependencies : to_header:('a -> Header.t) -> context:(module CONTEXT) - -> root_block:Block.with_hash + -> root_consensus_state: + Consensus.Data.Consensus_state.Value.t State_hash.With_state_hashes.t -> is_block_in_frontier:(Frozen_ledger_hash.t -> bool) -> ('a, State_hash.State_hashes.t) With_hash.t * ( 'b diff --git a/src/lib/transition_handler/processor.ml b/src/lib/transition_handler/processor.ml index e46e3fa20cd5..655cd6842254 100644 --- a/src/lib/transition_handler/processor.ml +++ b/src/lib/transition_handler/processor.ml @@ -132,8 +132,9 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system let parent_hash = Protocol_state.previous_state_hash (Header.protocol_state header) in - let root_block = - Transition_frontier.(Breadcrumb.block_with_hash @@ root frontier) + let root_consensus_state = + Transition_frontier.( + Breadcrumb.consensus_state_with_hashes @@ root frontier) in let metadata = [ ("state_hash", State_hash.to_yojson transition_hash) ] in let state_hash = transition_hash in @@ -162,7 +163,7 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system match Mina_block.Validation.validate_frontier_dependencies ~context:(module Context) - ~root_block ~is_block_in_frontier ~to_header:ident + ~root_consensus_state ~is_block_in_frontier ~to_header:ident (Envelope.Incoming.data env) with | Ok _ | Error `Parent_missing_from_frontier -> @@ -193,8 +194,8 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system match Mina_block.Validation.validate_frontier_dependencies ~context:(module Context) - ~root_block ~is_block_in_frontier ~to_header:Mina_block.header - initially_validated_transition + ~root_consensus_state ~is_block_in_frontier + ~to_header:Mina_block.header initially_validated_transition with | Ok t -> return (Ok t) From 2121f0ad90f6db35b73f8d8737c79aca4a19f9e8 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 22:41:12 +0100 Subject: [PATCH 045/122] Best_tip_prover: return breadcrumb instead of block --- src/lib/best_tip_prover/best_tip_prover.ml | 9 +---- .../transition_frontier_components_intf.ml | 8 ++--- src/lib/mina_networking/rpcs.ml | 36 +++++++++---------- src/lib/sync_handler/sync_handler.ml | 6 ++-- 4 files changed, 24 insertions(+), 35 deletions(-) diff --git a/src/lib/best_tip_prover/best_tip_prover.ml b/src/lib/best_tip_prover/best_tip_prover.ml index 82eed13fe0b4..393e0d8694fe 100644 --- a/src/lib/best_tip_prover/best_tip_prover.ml +++ b/src/lib/best_tip_prover/best_tip_prover.ml @@ -68,11 +68,6 @@ module Make (Inputs : Inputs_intf) : let best_verified_tip = Transition_frontier.Breadcrumb.validated_transition best_tip_breadcrumb in - let best_tip = Mina_block.Validated.forget best_verified_tip in - let root = - Transition_frontier.root frontier - |> Transition_frontier.Breadcrumb.validated_transition - in let _, merkle_list = Merkle_list_prover.prove ~context:frontier best_verified_tip in @@ -83,9 +78,7 @@ module Make (Inputs : Inputs_intf) : ] "Best tip prover produced a merkle list of $merkle_list" ; Proof_carrying_data. - { data = best_tip - ; proof = (merkle_list, With_hash.data @@ Mina_block.Validated.forget root) - } + { data = best_tip_breadcrumb; proof = (merkle_list, root) } let validate_proof ~verifier ~genesis_state_hash (header_hashed : Mina_block.Header.with_hash) : diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index 262087bddcd4..7ad7814e3f08 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -181,8 +181,8 @@ module type Best_tip_prover_intf = sig val prove : context:(module CONTEXT) -> transition_frontier - -> ( Mina_block.t State_hash.With_state_hashes.t - , State_body_hash.t list * Mina_block.t ) + -> ( Frontier_base.Breadcrumb.t + , State_body_hash.t list * Frontier_base.Breadcrumb.t ) Proof_carrying_data.t option @@ -208,8 +208,8 @@ module type Consensus_best_tip_prover_intf = sig context:(module CONTEXT) -> frontier:transition_frontier -> Consensus.Data.Consensus_state.Value.t State_hash.With_state_hashes.t - -> ( Mina_block.t - , State_body_hash.t list * Mina_block.t ) + -> ( Frontier_base.Breadcrumb.t + , State_body_hash.t list * Frontier_base.Breadcrumb.t ) Proof_carrying_data.t option diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 491af81fa555..a1f3baf146c8 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -47,24 +47,23 @@ end type ctx = (module CONTEXT) -let validate_protocol_versions ~logger ~trust_system ~rpc_name ~sender blocks = +let validate_protocol_versions ~logger ~trust_system ~rpc_name ~sender headers = let version_errors = let invalid_current_versions = - List.filter blocks ~f:(fun block -> - Mina_block.header block |> Mina_block.Header.current_protocol_version + List.filter headers ~f:(fun header -> + Mina_block.Header.current_protocol_version header |> Protocol_version.is_valid |> not ) in let invalid_next_versions = - List.filter blocks ~f:(fun block -> - Mina_block.header block - |> Mina_block.Header.proposed_protocol_version_opt + List.filter headers ~f:(fun header -> + Mina_block.Header.proposed_protocol_version_opt header |> Option.for_all ~f:Protocol_version.is_valid |> not ) in let current_version_mismatches = - List.filter blocks ~f:(fun block -> - Mina_block.header block |> Mina_block.Header.current_protocol_version + List.filter headers ~f:(fun header -> + Mina_block.Header.current_protocol_version header |> Protocol_version.compatible_with_daemon |> not ) in List.map invalid_current_versions ~f:(fun x -> @@ -77,8 +76,7 @@ let validate_protocol_versions ~logger ~trust_system ~rpc_name ~sender blocks = (* NB: these errors aren't always accurate... sometimes we are calling this when we were requested to serve an outdated block (requested vs sent) *) Deferred.List.iter version_errors ~how:`Parallel - ~f:(fun (version_error, block) -> - let header = Mina_block.header block in + ~f:(fun (version_error, header) -> let block_protocol_version = Mina_block.Header.current_protocol_version header in @@ -584,7 +582,7 @@ module Get_transition_chain = struct validate_protocol_versions ~logger ~trust_system ~rpc_name:"Get_transition_chain" ~sender:(Envelope.Incoming.sender request) - blocks + (List.map blocks ~f:Mina_block.header) in Option.some_if valid_versions @@ List.map ~f:Mina_block.read_all_proofs_from_disk blocks @@ -996,11 +994,13 @@ module Get_ancestry = struct in None | Some { proof = chain, base_block; data = block } -> + let block = Frontier_base.Breadcrumb.block block in + let base_block = Frontier_base.Breadcrumb.block base_block in let%map valid_versions = validate_protocol_versions ~logger ~trust_system ~rpc_name:"Get_ancestry" ~sender:(Envelope.Incoming.sender request) - [ base_block ] + [ Mina_block.header base_block ] in Option.some_if valid_versions { Proof_carrying_data.proof = @@ -1182,11 +1182,7 @@ module Get_best_tip = struct let result = let open Option.Let_syntax in let%bind frontier = get_transition_frontier () in - let%map proof_with_data = - Best_tip_prover.prove ~context:(module Context) frontier - in - (* strip hash from proof data *) - Proof_carrying_data.map proof_with_data ~f:With_hash.data + Best_tip_prover.prove ~context:(module Context) frontier in match result with | None -> @@ -1199,16 +1195,18 @@ module Get_best_tip = struct in None | Some { data = data_block; proof = chain, proof_block } -> + let data_block = Frontier_base.Breadcrumb.block data_block in + let proof_block = Frontier_base.Breadcrumb.block proof_block in let%map data_valid_versions = validate_protocol_versions ~logger ~trust_system ~rpc_name:"Get_best_tip (data)" ~sender:(Envelope.Incoming.sender request) - [ data_block ] + [ Mina_block.header data_block ] and proof_valid_versions = validate_protocol_versions ~logger ~trust_system ~rpc_name:"Get_best_tip (proof)" ~sender:(Envelope.Incoming.sender request) - [ proof_block ] + [ Mina_block.header proof_block ] in Option.some_if (data_valid_versions && proof_valid_versions) diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 71f25bad8ab8..0b63c12d77e6 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -223,15 +223,13 @@ module Make (Inputs : Inputs_intf) : (Consensus.Hooks.select ~context:(module Context) ~existing: - (With_hash.map ~f:Mina_block.consensus_state + (Breadcrumb.consensus_state_with_hashes best_tip_with_witness.data ) ~candidate:seen_consensus_state ) `Keep in let%map () = Option.some_if is_tip_better () in - { best_tip_with_witness with - data = With_hash.data best_tip_with_witness.data - } + best_tip_with_witness let verify ~context:(module Context : CONTEXT) ~verifier observed_state peer_root = From 094b60f6e94e35c05cebd48350cb169444be1d55 Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 24 Nov 2025 23:21:52 +0100 Subject: [PATCH 046/122] Simplify merkle list prover implementations --- src/lib/best_tip_prover/best_tip_prover.ml | 22 +++++------- .../transition_chain_prover.ml | 35 ++++++++++--------- 2 files changed, 27 insertions(+), 30 deletions(-) diff --git a/src/lib/best_tip_prover/best_tip_prover.ml b/src/lib/best_tip_prover/best_tip_prover.ml index 393e0d8694fe..4806237b4469 100644 --- a/src/lib/best_tip_prover/best_tip_prover.ml +++ b/src/lib/best_tip_prover/best_tip_prover.ml @@ -17,23 +17,20 @@ module Make (Inputs : Inputs_intf) : end module Merkle_list_prover = Merkle_list_prover.Make_ident (struct - type value = Mina_block.Validated.t + type value = Frontier_base.Breadcrumb.t type context = Transition_frontier.t type proof_elem = State_body_hash.t - let to_proof_elem = Mina_block.Validated.state_body_hash + let to_proof_elem b = + Frontier_base.Breadcrumb.protocol_state_with_hashes b + |> State_hash.With_state_hashes.state_body_hash + ~compute_hashes:Mina_state.Protocol_state.hashes let get_previous ~context transition = - let parent_hash = - transition |> Mina_block.Validated.header - |> Mina_block.Header.protocol_state - |> Protocol_state.previous_state_hash - in - let open Option.Let_syntax in - let%map breadcrumb = Transition_frontier.find context parent_hash in - Transition_frontier.Breadcrumb.validated_transition breadcrumb + let parent_hash = transition |> Frontier_base.Breadcrumb.parent_hash in + Transition_frontier.find context parent_hash end) module Merkle_list_verifier = Merkle_list_verifier.Make (struct @@ -65,11 +62,8 @@ module Make (Inputs : Inputs_intf) : () in let best_tip_breadcrumb = Transition_frontier.best_tip frontier in - let best_verified_tip = - Transition_frontier.Breadcrumb.validated_transition best_tip_breadcrumb - in let _, merkle_list = - Merkle_list_prover.prove ~context:frontier best_verified_tip + Merkle_list_prover.prove ~context:frontier best_tip_breadcrumb in [%log debug] ~metadata: diff --git a/src/lib/transition_chain_prover/transition_chain_prover.ml b/src/lib/transition_chain_prover/transition_chain_prover.ml index d71bcbffc6a0..7b8b46f14059 100644 --- a/src/lib/transition_chain_prover/transition_chain_prover.ml +++ b/src/lib/transition_chain_prover/transition_chain_prover.ml @@ -18,44 +18,47 @@ module Make (Inputs : Inputs_intf) : get_extension (Transition_frontier.extensions frontier) Root_history in let%map root_data = Root_history.lookup root_history state_hash in - Frontier_base.Root_data.Historical.transition root_data + let validated_block = + Frontier_base.Root_data.Historical.transition root_data + in + Mina_block.Validated.forget validated_block + |> With_hash.map + ~f:(Fn.compose Mina_block.Header.protocol_state Mina_block.header) module Merkle_list = Merkle_list_prover.Make_ident (struct - type value = Mina_block.Validated.t + type value = + Mina_state.Protocol_state.Value.t State_hash.With_state_hashes.t type context = Transition_frontier.t type proof_elem = State_body_hash.t - let to_proof_elem = Mina_block.Validated.state_body_hash + let to_proof_elem = + State_hash.With_state_hashes.state_body_hash + ~compute_hashes:Mina_state.Protocol_state.hashes let get_previous ~context transition = let parent_hash = - transition |> Mina_block.Validated.forget |> With_hash.data - |> Mina_block.header |> Mina_block.Header.protocol_state - |> Protocol_state.previous_state_hash + With_hash.data transition |> Protocol_state.previous_state_hash in - let open Option.Let_syntax in - Option.merge - Transition_frontier.( - find context parent_hash >>| Breadcrumb.validated_transition) + Option.first_some + ( Option.map ~f:Frontier_base.Breadcrumb.protocol_state_with_hashes + @@ Transition_frontier.find context parent_hash ) (find_in_root_history context parent_hash) - ~f:Fn.const end) let prove ?length ~frontier state_hash = let open Option.Let_syntax in let%map requested_transition = - Option.merge - Transition_frontier.( - find frontier state_hash >>| Breadcrumb.validated_transition) + Option.first_some + ( Option.map ~f:Frontier_base.Breadcrumb.protocol_state_with_hashes + @@ Transition_frontier.find frontier state_hash ) (find_in_root_history frontier state_hash) - ~f:Fn.const in let first_transition, merkle_list = Merkle_list.prove ?length ~context:frontier requested_transition in - (Mina_block.Validated.state_hash first_transition, merkle_list) + (State_hash.With_state_hashes.state_hash first_transition, merkle_list) end include Make (struct From d6542f3b3170e7ee92a0e5730f318e15eda78397 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 11:43:47 +0100 Subject: [PATCH 047/122] Extract apply_to_scan_state out of apply_diff --- src/lib/staged_ledger/staged_ledger.ml | 173 ++++++++++++++----------- 1 file changed, 95 insertions(+), 78 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 8891592617ba..481124443936 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1024,6 +1024,91 @@ module T = struct (Pre_diff_info.Error.Coinbase_error "More than two coinbase parts") ) + let log_scan_state_update_error ~logger ~witnesses ~previous_scan_state + ~log_prefix e = + let data_json = + `List + (List.map witnesses + ~f:(fun { Scan_state.Transaction_with_witness.statement; _ } -> + Transaction_snark.Statement.to_yojson statement ) ) + in + [%log error] + ~metadata: + [ ( "scan_state" + , `String (Scan_state.snark_job_list_json previous_scan_state) ) + ; ("data", data_json) + ; ("error", Error_json.error_to_yojson e) + ; ("prefix", `String log_prefix) + ] + !"$prefix: Unexpected error when applying diff data $data to the \ + scan_state $scan_state: $error" + + let apply_to_scan_state ~logger ~skip_verification ~log_prefix + ~state_and_body_hash ~ledger ~previous_pending_coinbase_collection + ~previous_scan_state ~constraint_constants ~is_new_stack ~stack_update + ~first_pass_ledger_end works witnesses = + let open Deferred.Result.Let_syntax 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 + [%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 previous_scan_state + ~logger tagged_witnesses tagged_works + in + Or_error.iter_error r + ~f: + (log_scan_state_update_error ~logger ~witnesses ~previous_scan_state + ~log_prefix ) ; + Deferred.return (to_staged_ledger_or_error r) + in + let%bind () = yield_result () in + [%log internal] "Update_pending_coinbase_collection" ; + let%bind pending_coinbase_collection = + O1trace.thread "update_pending_coinbase_collection" (fun () -> + update_pending_coinbase_collection + ~depth: + constraint_constants + .Genesis_constants.Constraint_constants.pending_coinbase_depth + previous_pending_coinbase_collection stack_update ~is_new_stack + ~ledger_proof:res_opt + |> Deferred.return ) + in + let%bind () = yield_result () in + let%map () = + if skip_verification || List.is_empty witnesses then + Deferred.return (Ok ()) + else ( + [%log internal] "Verify_scan_state_after_apply" ; + O1trace.thread "verify_scan_state_after_apply" (fun () -> + let%bind pending_coinbase_stack = + Pending_coinbase.latest_stack ~is_new_stack:false + pending_coinbase_collection + |> to_staged_ledger_or_error |> Deferred.return + in + Deferred.( + verify_scan_state_after_apply ~constraint_constants ~logger + ~first_pass_ledger_end + ~second_pass_ledger_end: + (Frozen_ledger_hash.of_ledger_hash + (Ledger.merkle_root ledger) ) + ~pending_coinbase_stack scan_state + >>| to_staged_ledger_or_error) ) ) + in + ( { scan_state; ledger; constraint_constants; pending_coinbase_collection } + , res_opt ) + + (* TODO Remove hashing from first & second passes and then + remove Deferred.t from [apply_diff], now it's there only for yielding *) let apply_diff ?(skip_verification = false) ~logger ~constraint_constants ~global_slot ~parent_protocol_state_body ~state_and_body_hash ~log_prefix ~zkapp_cmd_limit_hardcap ~signature_kind t pre_diff_info = @@ -1090,11 +1175,6 @@ module T = struct t.pending_coinbase_collection transactions current_state_view state_and_body_hash ) 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 to_witness (witness, _) = { witness with Transaction_snark_scan_state.Transaction_with_witness @@ -1102,11 +1182,6 @@ module T = struct } in let witnesses = List.map data ~f:to_witness in - let tagged_witnesses, tagged_works = - State_hash.File_storage.write_values_exn state_hash - ~f:(persist_witnesses_and_works witnesses works) - in - let accounts_created = List.concat_map data ~f:snd 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 @@ -1122,7 +1197,7 @@ module T = struct let required = List.length required_pairs in if work_count < required - && List.length data + && slots > Scan_state.free_space t.scan_state - required + work_count then Deferred.Result.fail @@ -1137,67 +1212,12 @@ module T = struct 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 - tagged_witnesses tagged_works - in - Or_error.iter_error r ~f:(fun e -> - let data_json = - `List - (List.map witnesses - ~f:(fun - { Scan_state.Transaction_with_witness.statement; _ } - -> Transaction_snark.Statement.to_yojson statement ) ) - in - [%log error] - ~metadata: - [ ( "scan_state" - , `String (Scan_state.snark_job_list_json t.scan_state) ) - ; ("data", data_json) - ; ("error", Error_json.error_to_yojson e) - ; ("prefix", `String log_prefix) - ] - !"$prefix: Unexpected error when applying diff data $data to \ - the scan_state $scan_state: $error" ) ; - Deferred.return (to_staged_ledger_or_error r) ) - in - let%bind () = yield_result () in - [%log internal] "Update_pending_coinbase_collection" ; - let%bind updated_pending_coinbase_collection' = - O1trace.thread "update_pending_coinbase_collection" (fun () -> - update_pending_coinbase_collection - ~depth:t.constraint_constants.pending_coinbase_depth - t.pending_coinbase_collection stack_update ~is_new_stack - ~ledger_proof:res_opt - |> Deferred.return ) - in - let%bind () = yield_result () in - let%bind coinbase_amount = - Deferred.return (coinbase_for_blockchain_snark coinbases) - in - let%bind latest_pending_coinbase_stack = - Pending_coinbase.latest_stack ~is_new_stack:false - updated_pending_coinbase_collection' - |> to_staged_ledger_or_error |> Deferred.return - in - let%bind () = yield_result () in - let%map () = - if skip_verification || List.is_empty data then Deferred.return (Ok ()) - else ( - [%log internal] "Verify_scan_state_after_apply" ; - O1trace.thread "verify_scan_state_after_apply" (fun () -> - Deferred.( - verify_scan_state_after_apply ~constraint_constants ~logger - ~first_pass_ledger_end - ~second_pass_ledger_end: - (Frozen_ledger_hash.of_ledger_hash - (Ledger.merkle_root new_ledger) ) - ~pending_coinbase_stack:latest_pending_coinbase_stack - scan_state' - >>| to_staged_ledger_or_error) ) ) + let%bind new_staged_ledger, res_opt = + apply_to_scan_state ~logger ~skip_verification ~log_prefix + ~state_and_body_hash ~ledger:new_ledger + ~previous_pending_coinbase_collection:t.pending_coinbase_collection + ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack + ~stack_update ~first_pass_ledger_end works witnesses in [%log debug] ~metadata: @@ -1213,12 +1233,9 @@ module T = struct \ Coinbase parts:$coinbase_count Spots\n\ \ available:$spots_available Pending work in the \ scan-state:$proof_bundles_waiting Work included:$work_count" ; - let new_staged_ledger = - { scan_state = scan_state' - ; ledger = new_ledger - ; constraint_constants = t.constraint_constants - ; pending_coinbase_collection = updated_pending_coinbase_collection' - } + let accounts_created = List.concat_map data ~f:snd in + let%map coinbase_amount = + Deferred.return (coinbase_for_blockchain_snark coinbases) in ( `Ledger_proof res_opt , `Staged_ledger new_staged_ledger From b2e744b9e2d1a9314c05b7f7edda456803e977e1 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 12:30:14 +0100 Subject: [PATCH 048/122] Move scan state application one layer up --- src/lib/staged_ledger/staged_ledger.ml | 117 ++++++++++++++++++------- 1 file changed, 83 insertions(+), 34 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 481124443936..35a93b1811bd 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1109,20 +1109,25 @@ module T = struct (* TODO Remove hashing from first & second passes and then remove Deferred.t from [apply_diff], now it's there only for yielding *) - let apply_diff ?(skip_verification = false) ~logger ~constraint_constants - ~global_slot ~parent_protocol_state_body ~state_and_body_hash ~log_prefix - ~zkapp_cmd_limit_hardcap ~signature_kind t pre_diff_info = + let apply_diff ~logger ~constraint_constants ~global_slot + ~parent_protocol_state_body ~state_and_body_hash ~log_prefix + ~zkapp_cmd_limit_hardcap ~signature_kind ~previous_scan_state + ~previous_pending_coinbase_collection ~previous_ledger pre_diff_info = let open Deferred.Result.Let_syntax in let max_throughput = - Int.pow 2 t.constraint_constants.transaction_capacity_log_2 + Int.pow 2 + constraint_constants + .Genesis_constants.Constraint_constants.transaction_capacity_log_2 in let spots_available, proofs_waiting = - let jobs = Scan_state.all_work_statements_exn t.scan_state in - ( Int.min (Scan_state.free_space t.scan_state) max_throughput + let jobs = Scan_state.all_work_statements_exn previous_scan_state in + ( Int.min (Scan_state.free_space previous_scan_state) max_throughput , List.length jobs ) in - let new_mask = Ledger.Mask.create ~depth:(Ledger.depth t.ledger) () in - let new_ledger = Ledger.register_mask t.ledger new_mask in + let new_mask = + Ledger.Mask.create ~depth:(Ledger.depth previous_ledger) () + in + let new_ledger = Ledger.register_mask previous_ledger new_mask in let transactions, works, commands_count, coinbases = pre_diff_info in let accounts_accessed = List.fold_left ~init:Account_id.Set.empty transactions ~f:(fun set txn -> @@ -1171,8 +1176,8 @@ module T = struct , `First_pass_ledger_end first_pass_ledger_end ) = O1trace.thread "update_coinbase_stack_start_time" (fun () -> update_coinbase_stack_and_get_data ~logger ~constraint_constants - ~global_slot ~signature_kind t.scan_state new_ledger - t.pending_coinbase_collection transactions current_state_view + ~global_slot ~signature_kind previous_scan_state new_ledger + previous_pending_coinbase_collection transactions current_state_view state_and_body_hash ) in let to_witness (witness, _) = @@ -1184,13 +1189,15 @@ module T = struct let witnesses = List.map data ~f:to_witness 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 + let required_pairs = + Scan_state.work_statements_for_new_diff previous_scan_state + in [%log internal] "Check_for_sufficient_snark_work" ~metadata: [ ("required_pairs", `Int (List.length required_pairs)) ; ("work_count", `Int work_count) ; ("slots", `Int slots) - ; ("free_space", `Int (Scan_state.free_space t.scan_state)) + ; ("free_space", `Int (Scan_state.free_space previous_scan_state)) ] ; let%bind () = O1trace.thread "check_for_sufficient_snark_work" (fun () -> @@ -1198,7 +1205,8 @@ module T = struct if work_count < required && slots - > Scan_state.free_space t.scan_state - required + work_count + > Scan_state.free_space previous_scan_state + - required + work_count then Deferred.Result.fail (Staged_ledger_error.Insufficient_work @@ -1210,14 +1218,7 @@ module T = struct in [%log internal] "Check_zero_fee_excess" ; let%bind () = - Deferred.return (check_zero_fee_excess t.scan_state witnesses) - in - let%bind new_staged_ledger, res_opt = - apply_to_scan_state ~logger ~skip_verification ~log_prefix - ~state_and_body_hash ~ledger:new_ledger - ~previous_pending_coinbase_collection:t.pending_coinbase_collection - ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack - ~stack_update ~first_pass_ledger_end works witnesses + Deferred.return (check_zero_fee_excess previous_scan_state witnesses) in [%log debug] ~metadata: @@ -1237,9 +1238,12 @@ module T = struct let%map coinbase_amount = Deferred.return (coinbase_for_blockchain_snark coinbases) in - ( `Ledger_proof res_opt - , `Staged_ledger new_staged_ledger + ( `Ledger new_ledger , `Accounts_created accounts_created + , `Stack_update stack_update + , `First_pass_ledger_end first_pass_ledger_end + , `Witnesses witnesses + , `Works works , `Pending_coinbase_update ( is_new_stack , { Pending_coinbase.Update.Poly.action = stack_update_in_snark @@ -1306,15 +1310,32 @@ 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) = - apply_diff - ~skip_verification: - ([%equal: [ `All | `Proofs ] option] skip_verification (Some `All)) - ~constraint_constants ~global_slot t + let%bind ( `Ledger new_ledger + , `Accounts_created accounts_created + , `Stack_update stack_update + , `First_pass_ledger_end first_pass_ledger_end + , `Witnesses witnesses + , `Works works + , `Pending_coinbase_update + (is_new_stack, pending_coinbase_update_action) ) = + apply_diff ~constraint_constants ~global_slot + ~previous_scan_state:t.scan_state + ~previous_pending_coinbase_collection:t.pending_coinbase_collection + ~previous_ledger:t.ledger (forget_prediff_info prediff) ~logger ~parent_protocol_state_body ~state_and_body_hash ~log_prefix:"apply_diff" ~zkapp_cmd_limit_hardcap ~signature_kind in + let%map new_staged_ledger, res_opt = + let skip_verification = + [%equal: [ `All | `Proofs ] option] skip_verification (Some `All) + in + apply_to_scan_state ~logger ~skip_verification ~log_prefix:"apply_diff" + ~state_and_body_hash ~ledger:new_ledger + ~previous_pending_coinbase_collection:t.pending_coinbase_collection + ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack + ~stack_update ~first_pass_ledger_end works witnesses + in [%log internal] "Diff_applied" ; [%log debug] ~metadata: @@ -1330,7 +1351,10 @@ module T = struct ~metadata:[ ("error", Error_json.error_to_yojson e) ] !"Error updating metrics after applying staged_ledger diff: $error" ) in - res + ( `Ledger_proof res_opt + , `Staged_ledger new_staged_ledger + , `Accounts_created accounts_created + , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) ) let apply_diff_unchecked ~constraint_constants ~global_slot ~logger ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver @@ -1343,11 +1367,36 @@ module T = struct ~supercharge_coinbase sl_diff |> Deferred.return in - apply_diff t - (forget_prediff_info prediff) - ~constraint_constants ~global_slot ~logger ~parent_protocol_state_body - ~state_and_body_hash ~log_prefix:"apply_diff_unchecked" - ~zkapp_cmd_limit_hardcap ~signature_kind + let%bind ( `Ledger new_ledger + , `Accounts_created accounts_created + , `Stack_update stack_update + , `First_pass_ledger_end first_pass_ledger_end + , `Witnesses witnesses + , `Works works + , `Pending_coinbase_update + (is_new_stack, pending_coinbase_update_action) ) = + apply_diff ~constraint_constants ~global_slot + ~previous_scan_state:t.scan_state + ~previous_pending_coinbase_collection:t.pending_coinbase_collection + ~previous_ledger:t.ledger + (forget_prediff_info prediff) + ~logger ~parent_protocol_state_body ~state_and_body_hash + ~log_prefix:"apply_diff_unchecked" ~zkapp_cmd_limit_hardcap + ~signature_kind + in + let%map new_staged_ledger, res_opt = + (* TODO consider skipping verification *) + apply_to_scan_state ~logger ~skip_verification:false + ~log_prefix:"apply_diff_unchecked" ~state_and_body_hash + ~ledger:new_ledger + ~previous_pending_coinbase_collection:t.pending_coinbase_collection + ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack + ~stack_update ~first_pass_ledger_end works witnesses + in + ( `Ledger_proof res_opt + , `Staged_ledger new_staged_ledger + , `Accounts_created accounts_created + , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) ) module Resources = struct module Discarded = struct From a15a46fc1335a453d49b6f15dae27750a396177b Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 12:38:32 +0100 Subject: [PATCH 049/122] Rename apply_diff{ -> _impl} Rename internal function inside staged_ledger.ml --- src/lib/staged_ledger/staged_ledger.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 35a93b1811bd..c95432a68689 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1109,7 +1109,7 @@ module T = struct (* TODO Remove hashing from first & second passes and then remove Deferred.t from [apply_diff], now it's there only for yielding *) - let apply_diff ~logger ~constraint_constants ~global_slot + let apply_diff_impl ~logger ~constraint_constants ~global_slot ~parent_protocol_state_body ~state_and_body_hash ~log_prefix ~zkapp_cmd_limit_hardcap ~signature_kind ~previous_scan_state ~previous_pending_coinbase_collection ~previous_ledger pre_diff_info = @@ -1318,7 +1318,7 @@ module T = struct , `Works works , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) ) = - apply_diff ~constraint_constants ~global_slot + apply_diff_impl ~constraint_constants ~global_slot ~previous_scan_state:t.scan_state ~previous_pending_coinbase_collection:t.pending_coinbase_collection ~previous_ledger:t.ledger @@ -1375,7 +1375,7 @@ module T = struct , `Works works , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) ) = - apply_diff ~constraint_constants ~global_slot + apply_diff_impl ~constraint_constants ~global_slot ~previous_scan_state:t.scan_state ~previous_pending_coinbase_collection:t.pending_coinbase_collection ~previous_ledger:t.ledger From f8de7a1231f58b0a284b7bbbdf92136881a01007 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 12:42:53 +0100 Subject: [PATCH 050/122] Rename apply{ -> _diff} --- src/app/replayer/sql.ml | 2 +- src/lib/mina_block/validation.ml | 4 ++-- src/lib/staged_ledger/staged_ledger.ml | 16 ++++++++-------- src/lib/staged_ledger/staged_ledger.mli | 2 +- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/app/replayer/sql.ml b/src/app/replayer/sql.ml index 160e21318772..396bfaf28134 100644 --- a/src/app/replayer/sql.ml +++ b/src/app/replayer/sql.ml @@ -344,7 +344,7 @@ module Internal_command = struct Caqti_type.[ string; int; int64; int; int64; int64; int; int ] (* the transaction global slot since genesis is taken from the internal command's current block, mirroring - the call to Staged_ledger.apply in Block_producer + the call to Staged_ledger.apply_diff in Block_producer *) let query = Mina_caqti.collect_req diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 9f0cca5f0427..9e6d725849f7 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -496,7 +496,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger , `Staged_ledger transitioned_staged_ledger , `Accounts_created accounts_created , `Pending_coinbase_update _ ) = - Staged_ledger.apply ?skip_verification:skip_staged_ledger_verification + Staged_ledger.apply_diff ?skip_verification:skip_staged_ledger_verification ~get_completed_work ~constraint_constants: precomputed_values.Precomputed_values.constraint_constants ~global_slot @@ -535,7 +535,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger [ ( "time_elapsed" , `Float Core.Time.(Span.to_ms @@ diff (now ()) apply_start_time) ) ] - "Staged_ledger.apply takes $time_elapsed" ; + "Staged_ledger.apply_diff takes $time_elapsed" ; let snarked_ledger_hash = match proof_opt with | None -> diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index c95432a68689..b90c14f064ae 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1277,7 +1277,7 @@ module T = struct type transaction_pool_proxy = Check_commands.transaction_pool_proxy - let apply ?skip_verification ~constraint_constants ~global_slot + let apply_diff ?skip_verification ~constraint_constants ~global_slot ~get_completed_work ~logger ~verifier ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind @@ -2487,7 +2487,7 @@ let%test_module "staged ledger tests" = , `Accounts_created _ , `Pending_coinbase_update (is_new_stack, pc_update) ) = match%map - Sl.apply ~constraint_constants ~global_slot !sl diff' ~logger + Sl.apply_diff ~constraint_constants ~global_slot !sl diff' ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind @@ -3451,7 +3451,7 @@ let%test_module "staged ledger tests" = Mina_state.Protocol_state.hashes current_state in let%bind apply_res = - Sl.apply ~constraint_constants ~global_slot !sl diff + Sl.apply_diff ~constraint_constants ~global_slot !sl diff ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash: @@ -4514,7 +4514,7 @@ let%test_module "staged ledger tests" = } in match%map - Sl.apply ~constraint_constants ~global_slot !sl + Sl.apply_diff ~constraint_constants ~global_slot !sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash @@ -4731,7 +4731,7 @@ let%test_module "staged ledger tests" = |> List.map ~f:(fun cmd -> User_command.forget_check cmd) ) ) ; assert (List.length invalid_txns = 3) ; match%bind - Sl.apply ~constraint_constants ~global_slot sl + Sl.apply_diff ~constraint_constants ~global_slot sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash @@ -4778,7 +4778,7 @@ let%test_module "staged ledger tests" = } in match%map - Sl.apply ~constraint_constants ~global_slot sl + Sl.apply_diff ~constraint_constants ~global_slot sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash @@ -4881,7 +4881,7 @@ let%test_module "staged ledger tests" = , state_hashes.state_body_hash |> Option.value_exn ) in let%map result = - apply ~logger ~constraint_constants ~global_slot + apply_diff ~logger ~constraint_constants ~global_slot ~get_completed_work:(Fn.const None) ~verifier ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase:false sl diff @@ -5327,7 +5327,7 @@ let%test_module "staged ledger tests" = ~proof_level:Full () in match%map - Sl.apply ~constraint_constants ~global_slot !sl + Sl.apply_diff ~constraint_constants ~global_slot !sl (Staged_ledger_diff.forget diff) ~get_completed_work:(Fn.const None) ~logger ~verifier:verifier_full ~parent_protocol_state_body diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 83d8d5f0e4b1..be3c1ce0bf2d 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -207,7 +207,7 @@ val hash : t -> Staged_ledger_hash.t type transaction_pool_proxy = Check_commands.transaction_pool_proxy -val apply : +val apply_diff : ?skip_verification:[ `Proofs | `All ] -> constraint_constants:Genesis_constants.Constraint_constants.t -> global_slot:Mina_numbers.Global_slot_since_genesis.t From 811d9615a38e558ef55fa84f796315a325fb2180 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 12:51:57 +0100 Subject: [PATCH 051/122] Split staged ledger metrics reporting --- src/lib/staged_ledger/staged_ledger.ml | 46 +++++++++++++++----------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index b90c14f064ae..7e2097ba23a2 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1250,15 +1250,23 @@ module T = struct ; coinbase_amount } ) ) - let update_metrics (t : t) (witness : Staged_ledger_diff.t) = - let open Or_error.Let_syntax in + let update_scan_state_metrics scan_state = + let%bind.Or_error () = Scan_state.update_metrics scan_state in + Or_error.try_with (fun () -> + let open Mina_metrics in + Gauge.set Scan_state_metrics.snark_work_required + (Float.of_int + (List.length (Scan_state.all_work_statements_exn scan_state)) ) ) + + let update_diff_metrics (witness : Staged_ledger_diff.t) = let commands = Staged_ledger_diff.commands witness in let work = Staged_ledger_diff.completed_works witness in - let%bind total_txn_fee = + let%bind.Or_error total_txn_fee = sum_fees commands ~f:(fun { data = cmd; _ } -> User_command.fee cmd) in - let%bind total_snark_fee = sum_fees work ~f:Transaction_snark_work.fee in - let%bind () = Scan_state.update_metrics t.scan_state in + let%bind.Or_error total_snark_fee = + sum_fees work ~f:Transaction_snark_work.fee + in Or_error.try_with (fun () -> let open Mina_metrics in Gauge.set Scan_state_metrics.snark_fee_per_block @@ -1266,10 +1274,7 @@ module T = struct Gauge.set Scan_state_metrics.transaction_fees_per_block (Int.to_float @@ Fee.to_nanomina_int total_txn_fee) ; Gauge.set Scan_state_metrics.purchased_snark_work_per_block - (Float.of_int @@ List.length work) ; - Gauge.set Scan_state_metrics.snark_work_required - (Float.of_int - (List.length (Scan_state.all_work_statements_exn t.scan_state)) ) ) + (Float.of_int @@ List.length work) ) let forget_prediff_info ((a : Transaction.Valid.t With_status.t list), b, c, d) = @@ -1282,9 +1287,9 @@ module T = struct ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind ?(transaction_pool_proxy = Check_commands.dummy_transaction_pool_proxy) t - (witness : Staged_ledger_diff.t) = + (staged_ledger_diff : Staged_ledger_diff.t) = let open Deferred.Result.Let_syntax in - let work = Staged_ledger_diff.completed_works witness in + let work = Staged_ledger_diff.completed_works staged_ledger_diff in let%bind () = O1trace.thread "check_completed_works" (fun () -> match skip_verification with @@ -1298,8 +1303,8 @@ module T = struct in [%log internal] "Prediff" ; let%bind prediff = - Pre_diff_info.get witness ~constraint_constants ~coinbase_receiver - ~supercharge_coinbase + Pre_diff_info.get staged_ledger_diff ~constraint_constants + ~coinbase_receiver ~supercharge_coinbase ~check: (Check_commands.check_commands t.ledger ~verifier ~transaction_pool_proxy ) @@ -1326,6 +1331,10 @@ module T = struct ~logger ~parent_protocol_state_body ~state_and_body_hash ~log_prefix:"apply_diff" ~zkapp_cmd_limit_hardcap ~signature_kind in + Or_error.iter_error (update_diff_metrics staged_ledger_diff) ~f:(fun e -> + [%log error] + ~metadata:[ ("error", Error_json.error_to_yojson e) ] + !"Error updating metrics after applying diff: $error" ) ; let%map new_staged_ledger, res_opt = let skip_verification = [%equal: [ `All | `Proofs ] option] skip_verification (Some `All) @@ -1344,13 +1353,10 @@ module T = struct ) ] "Staged_ledger.apply_diff take $time_elapsed" ; - let () = - Or_error.iter_error (update_metrics new_staged_ledger witness) - ~f:(fun e -> - [%log error] - ~metadata:[ ("error", Error_json.error_to_yojson e) ] - !"Error updating metrics after applying staged_ledger diff: $error" ) - in + Or_error.iter_error (update_scan_state_metrics t.scan_state) ~f:(fun e -> + [%log error] + ~metadata:[ ("error", Error_json.error_to_yojson e) ] + !"Error updating metrics after applying scan state: $error" ) ; ( `Ledger_proof res_opt , `Staged_ledger new_staged_ledger , `Accounts_created accounts_created From ff89065de770ee08963afa582a06616ed04ab9d0 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 13:33:39 +0100 Subject: [PATCH 052/122] Separate diff and scan state application --- src/lib/block_producer/block_producer.ml | 51 +++++--- src/lib/mina_block/validation.ml | 84 +++++++++---- src/lib/staged_ledger/staged_ledger.ml | 116 ++++++++---------- src/lib/staged_ledger/staged_ledger.mli | 51 +++++++- .../frontier_base/breadcrumb.ml | 26 +++- 5 files changed, 212 insertions(+), 116 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 32e9812ac9e2..5a604df18b1b 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -283,22 +283,45 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants diff_result ) in [%log internal] "Apply_staged_ledger_diff" ; - match%map + let application_res = let%bind.Deferred.Result diff = return diff in - Staged_ledger.apply_diff_unchecked staged_ledger - ~constraint_constants ~global_slot diff ~logger - ~parent_protocol_state_body:previous_protocol_state_body - ~state_and_body_hash: - (previous_protocol_state_hash, previous_protocol_state_body_hash) - ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap - ~signature_kind - with + let state_and_body_hash = + (previous_protocol_state_hash, previous_protocol_state_body_hash) + in + let%bind.Deferred.Result ( `Ledger new_ledger + , `Accounts_created _ + , `Stack_update stack_update + , `First_pass_ledger_end + first_pass_ledger_end + , `Witnesses witnesses + , `Works works + , `Pending_coinbase_update + (is_new_stack, pcu_action) ) = + Staged_ledger.apply_diff_unchecked staged_ledger + ~constraint_constants ~global_slot diff ~logger + ~parent_protocol_state_body:previous_protocol_state_body + ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase + ~zkapp_cmd_limit_hardcap ~signature_kind + in + (* TODO consider skipping verification (i.e. ~skip_verification:true) *) + let%map.Deferred.Result new_staged_ledger, ledger_proof_opt = + Staged_ledger.apply_to_scan_state ~logger ~skip_verification:false + ~log_prefix:"apply_diff_unchecked" ~state_and_body_hash + ~ledger:new_ledger + ~previous_pending_coinbase_collection: + (Staged_ledger.pending_coinbase_collection staged_ledger) + ~previous_scan_state:(Staged_ledger.scan_state staged_ledger) + ~constraint_constants ~is_new_stack ~stack_update + ~first_pass_ledger_end works witnesses + in + (new_staged_ledger, ledger_proof_opt, is_new_stack, pcu_action) + in + match%map application_res with | Ok - ( `Ledger_proof ledger_proof_opt - , `Staged_ledger transitioned_staged_ledger - , `Accounts_created _ - , `Pending_coinbase_update (is_new_stack, pending_coinbase_update) - ) -> + ( transitioned_staged_ledger + , ledger_proof_opt + , is_new_stack + , pending_coinbase_update ) -> [%log internal] "Hash_new_staged_ledger" ; let staged_ledger_hash = Staged_ledger.hash transitioned_staged_ledger diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 9e6d725849f7..c86ae7aef94c 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -492,34 +492,66 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger else Deferred.Result.fail `Invalid_body_reference in let parent_protocol_state_body = Protocol_state.body parent_protocol_state in - let%bind.Deferred.Result ( `Ledger_proof proof_opt - , `Staged_ledger transitioned_staged_ledger - , `Accounts_created accounts_created - , `Pending_coinbase_update _ ) = - Staged_ledger.apply_diff ?skip_verification:skip_staged_ledger_verification - ~get_completed_work - ~constraint_constants: - precomputed_values.Precomputed_values.constraint_constants ~global_slot - ~logger ~verifier parent_staged_ledger - (Staged_ledger_diff.Body.staged_ledger_diff body) - ~parent_protocol_state_body - ~state_and_body_hash: - (let body_hash = - Protocol_state.(Body.hash @@ body parent_protocol_state) + [%log internal] "Apply_diff" ; + let state_and_body_hash = + let body_hash = Protocol_state.(Body.hash @@ body parent_protocol_state) in + ( (Protocol_state.hashes_with_body parent_protocol_state ~body_hash) + .state_hash + , body_hash ) + in + let constraint_constants = + precomputed_values.Precomputed_values.constraint_constants + in + let%bind.Deferred.Result ( transitioned_staged_ledger + , proof_opt + , accounts_created ) = + Deferred.Result.map_error ~f:(fun e -> `Staged_ledger_application_failed e) + @@ let%bind.Deferred.Result ( `Ledger new_ledger + , `Accounts_created accounts_created + , `Stack_update stack_update + , `First_pass_ledger_end first_pass_ledger_end + , `Witnesses witnesses + , `Works works + , `Pending_coinbase_update (is_new_stack, _) ) = + Staged_ledger.apply_diff + ?skip_verification:skip_staged_ledger_verification + ~get_completed_work ~constraint_constants ~global_slot ~logger + ~verifier parent_staged_ledger + (Staged_ledger_diff.Body.staged_ledger_diff body) + ~parent_protocol_state_body ~state_and_body_hash + ~coinbase_receiver: + (Consensus_state.coinbase_receiver consensus_state) + ~supercharge_coinbase: + (Consensus_state.supercharge_coinbase consensus_state) + ~zkapp_cmd_limit_hardcap: + precomputed_values.Precomputed_values.genesis_constants + .zkapp_cmd_limit_hardcap + ~signature_kind:Mina_signature_kind.t_DEPRECATED + ?transaction_pool_proxy + in + let%map.Deferred.Result new_staged_ledger, res_opt = + let skip_verification = + [%equal: [ `All | `Proofs ] option] skip_staged_ledger_verification + (Some `All) in - ( (Protocol_state.hashes_with_body parent_protocol_state ~body_hash) - .state_hash - , body_hash ) ) - ~coinbase_receiver:(Consensus_state.coinbase_receiver consensus_state) - ~supercharge_coinbase: - (Consensus_state.supercharge_coinbase consensus_state) - ~zkapp_cmd_limit_hardcap: - precomputed_values.Precomputed_values.genesis_constants - .zkapp_cmd_limit_hardcap - ~signature_kind:Mina_signature_kind.t_DEPRECATED ?transaction_pool_proxy - |> Deferred.Result.map_error ~f:(fun e -> - `Staged_ledger_application_failed e ) + Staged_ledger.apply_to_scan_state ~logger ~skip_verification + ~log_prefix:"apply_diff" ~state_and_body_hash ~ledger:new_ledger + ~previous_pending_coinbase_collection: + (Staged_ledger.pending_coinbase_collection parent_staged_ledger) + ~previous_scan_state:(Staged_ledger.scan_state parent_staged_ledger) + ~constraint_constants ~is_new_stack ~stack_update + ~first_pass_ledger_end works witnesses + in + Or_error.iter_error + ( Staged_ledger.update_scan_state_metrics + @@ Staged_ledger.scan_state new_staged_ledger ) + ~f:(fun e -> + [%log error] + ~metadata:[ ("error", Error_json.error_to_yojson e) ] + !"Error updating metrics after applying scan state: $error" ) ; + (new_staged_ledger, res_opt, accounts_created) in + [%log internal] "Diff_applied" ; let staged_ledger_hash_opt = match skip_staged_ledger_verification with | Some `All -> diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 7e2097ba23a2..03d0b0a0a2bb 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1314,15 +1314,7 @@ module T = struct Staged_ledger_error.Pre_diff error ) ) in let apply_diff_start_time = Core.Time.now () in - [%log internal] "Apply_diff" ; - let%bind ( `Ledger new_ledger - , `Accounts_created accounts_created - , `Stack_update stack_update - , `First_pass_ledger_end first_pass_ledger_end - , `Witnesses witnesses - , `Works works - , `Pending_coinbase_update - (is_new_stack, pending_coinbase_update_action) ) = + let%map res = apply_diff_impl ~constraint_constants ~global_slot ~previous_scan_state:t.scan_state ~previous_pending_coinbase_collection:t.pending_coinbase_collection @@ -1335,17 +1327,6 @@ module T = struct [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] !"Error updating metrics after applying diff: $error" ) ; - let%map new_staged_ledger, res_opt = - let skip_verification = - [%equal: [ `All | `Proofs ] option] skip_verification (Some `All) - in - apply_to_scan_state ~logger ~skip_verification ~log_prefix:"apply_diff" - ~state_and_body_hash ~ledger:new_ledger - ~previous_pending_coinbase_collection:t.pending_coinbase_collection - ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack - ~stack_update ~first_pass_ledger_end works witnesses - in - [%log internal] "Diff_applied" ; [%log debug] ~metadata: [ ( "time_elapsed" @@ -1353,14 +1334,7 @@ module T = struct ) ] "Staged_ledger.apply_diff take $time_elapsed" ; - Or_error.iter_error (update_scan_state_metrics t.scan_state) ~f:(fun e -> - [%log error] - ~metadata:[ ("error", Error_json.error_to_yojson e) ] - !"Error updating metrics after applying scan state: $error" ) ; - ( `Ledger_proof res_opt - , `Staged_ledger new_staged_ledger - , `Accounts_created accounts_created - , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) ) + res let apply_diff_unchecked ~constraint_constants ~global_slot ~logger ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver @@ -1373,36 +1347,14 @@ module T = struct ~supercharge_coinbase sl_diff |> Deferred.return in - let%bind ( `Ledger new_ledger - , `Accounts_created accounts_created - , `Stack_update stack_update - , `First_pass_ledger_end first_pass_ledger_end - , `Witnesses witnesses - , `Works works - , `Pending_coinbase_update - (is_new_stack, pending_coinbase_update_action) ) = - apply_diff_impl ~constraint_constants ~global_slot - ~previous_scan_state:t.scan_state - ~previous_pending_coinbase_collection:t.pending_coinbase_collection - ~previous_ledger:t.ledger - (forget_prediff_info prediff) - ~logger ~parent_protocol_state_body ~state_and_body_hash - ~log_prefix:"apply_diff_unchecked" ~zkapp_cmd_limit_hardcap - ~signature_kind - in - let%map new_staged_ledger, res_opt = - (* TODO consider skipping verification *) - apply_to_scan_state ~logger ~skip_verification:false - ~log_prefix:"apply_diff_unchecked" ~state_and_body_hash - ~ledger:new_ledger - ~previous_pending_coinbase_collection:t.pending_coinbase_collection - ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack - ~stack_update ~first_pass_ledger_end works witnesses - in - ( `Ledger_proof res_opt - , `Staged_ledger new_staged_ledger - , `Accounts_created accounts_created - , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) ) + apply_diff_impl ~constraint_constants ~global_slot + ~previous_scan_state:t.scan_state + ~previous_pending_coinbase_collection:t.pending_coinbase_collection + ~previous_ledger:t.ledger + (forget_prediff_info prediff) + ~logger ~parent_protocol_state_body ~state_and_body_hash + ~log_prefix:"apply_diff_unchecked" ~zkapp_cmd_limit_hardcap + ~signature_kind module Resources = struct module Discarded = struct @@ -2458,6 +2410,37 @@ let%test_module "staged ledger tests" = in Sl.can_apply_supercharged_coinbase_exn ~winner ~global_slot ~epoch_ledger + let apply_diff_full ~constraint_constants ~global_slot t diff ~logger + ~verifier ~get_completed_work ~parent_protocol_state_body + ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase + ~zkapp_cmd_limit_hardcap ~signature_kind = + let%bind.Deferred.Result ( `Ledger new_ledger + , `Accounts_created accounts_created + , `Stack_update stack_update + , `First_pass_ledger_end first_pass_ledger_end + , `Witnesses witnesses + , `Works works + , `Pending_coinbase_update + (is_new_stack, pending_coinbase_update_action) + ) = + Sl.apply_diff ~constraint_constants ~global_slot t diff ~logger + ~verifier ~get_completed_work ~parent_protocol_state_body + ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase + ~zkapp_cmd_limit_hardcap ~signature_kind + in + let%map.Deferred.Result new_staged_ledger, res_opt = + apply_to_scan_state ~logger ~skip_verification:false + ~log_prefix:"apply_diff" ~state_and_body_hash ~ledger:new_ledger + ~previous_pending_coinbase_collection:t.pending_coinbase_collection + ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack + ~stack_update ~first_pass_ledger_end works witnesses + in + ( `Ledger_proof res_opt + , `Staged_ledger new_staged_ledger + , `Accounts_created accounts_created + , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) + ) + (* Functor for testing with different instantiated staged ledger modules. *) let create_and_apply_with_state_body_hash ~parent_protocol_state_body ~global_slot ~state_and_body_hash ~signature_kind ?zkapp_cmd_limit @@ -2493,7 +2476,7 @@ let%test_module "staged ledger tests" = , `Accounts_created _ , `Pending_coinbase_update (is_new_stack, pc_update) ) = match%map - Sl.apply_diff ~constraint_constants ~global_slot !sl diff' ~logger + apply_diff_full ~constraint_constants ~global_slot !sl diff' ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind @@ -3457,8 +3440,9 @@ let%test_module "staged ledger tests" = Mina_state.Protocol_state.hashes current_state in let%bind apply_res = - Sl.apply_diff ~constraint_constants ~global_slot !sl diff - ~logger ~verifier ~get_completed_work:(Fn.const None) + apply_diff_full ~constraint_constants ~global_slot !sl + diff ~logger ~verifier + ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash: ( state_hashes.state_hash @@ -4520,7 +4504,7 @@ let%test_module "staged ledger tests" = } in match%map - Sl.apply_diff ~constraint_constants ~global_slot !sl + apply_diff_full ~constraint_constants ~global_slot !sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash @@ -4737,7 +4721,7 @@ let%test_module "staged ledger tests" = |> List.map ~f:(fun cmd -> User_command.forget_check cmd) ) ) ; assert (List.length invalid_txns = 3) ; match%bind - Sl.apply_diff ~constraint_constants ~global_slot sl + apply_diff_full ~constraint_constants ~global_slot sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash @@ -4784,7 +4768,7 @@ let%test_module "staged ledger tests" = } in match%map - Sl.apply_diff ~constraint_constants ~global_slot sl + apply_diff_full ~constraint_constants ~global_slot sl (Staged_ledger_diff.forget diff) ~logger ~verifier ~get_completed_work:(Fn.const None) ~parent_protocol_state_body ~state_and_body_hash @@ -4887,7 +4871,7 @@ let%test_module "staged ledger tests" = , state_hashes.state_body_hash |> Option.value_exn ) in let%map result = - apply_diff ~logger ~constraint_constants ~global_slot + apply_diff_full ~logger ~constraint_constants ~global_slot ~get_completed_work:(Fn.const None) ~verifier ~parent_protocol_state_body ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase:false sl diff @@ -5333,7 +5317,7 @@ let%test_module "staged ledger tests" = ~proof_level:Full () in match%map - Sl.apply_diff ~constraint_constants ~global_slot !sl + apply_diff_full ~constraint_constants ~global_slot !sl (Staged_ledger_diff.forget diff) ~get_completed_work:(Fn.const None) ~logger ~verifier:verifier_full ~parent_protocol_state_body diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index be3c1ce0bf2d..777b3d7bcc29 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -39,6 +39,10 @@ module Scan_state : sig val target_second_pass_ledger : t -> Frozen_ledger_hash.t option end + module Transaction_with_witness : sig + type t + end + [%%versioned: module Stable : sig [@@@no_toplevel_latest_type] @@ -207,6 +211,8 @@ val hash : t -> Staged_ledger_hash.t type transaction_pool_proxy = Check_commands.transaction_pool_proxy +val update_scan_state_metrics : Scan_state.t -> unit Or_error.t + val apply_diff : ?skip_verification:[ `Proofs | `All ] -> constraint_constants:Genesis_constants.Constraint_constants.t @@ -225,9 +231,17 @@ val apply_diff : -> ?transaction_pool_proxy:Check_commands.transaction_pool_proxy -> t -> Staged_ledger_diff.t - -> ( [ `Ledger_proof of Ledger_proof.Tagged.t option ] - * [ `Staged_ledger of t ] + -> ( [ `Ledger of Ledger.t ] * [ `Accounts_created of Account_id.t list ] + * [ `Stack_update of + [ `Update_none + | `Update_one of Pending_coinbase.Stack_versioned.t + | `Update_two of + Pending_coinbase.Stack_versioned.t + * Pending_coinbase.Stack_versioned.t ] ] + * [ `First_pass_ledger_end of Frozen_ledger_hash.t ] + * [ `Witnesses of Scan_state.Transaction_with_witness.t list ] + * [ `Works of Transaction_snark_work.t list ] * [ `Pending_coinbase_update of bool * Pending_coinbase.Update.t ] , Staged_ledger_error.t ) Deferred.Result.t @@ -244,13 +258,42 @@ 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.Tagged.t option ] - * [ `Staged_ledger of t ] + -> ( [ `Ledger of Ledger.t ] * [ `Accounts_created of Account_id.t list ] + * [ `Stack_update of + [ `Update_none + | `Update_one of Pending_coinbase.Stack_versioned.t + | `Update_two of + Pending_coinbase.Stack_versioned.t + * Pending_coinbase.Stack_versioned.t ] ] + * [ `First_pass_ledger_end of Frozen_ledger_hash.t ] + * [ `Witnesses of Scan_state.Transaction_with_witness.t list ] + * [ `Works of Transaction_snark_work.t list ] * [ `Pending_coinbase_update of bool * Pending_coinbase.Update.t ] , Staged_ledger_error.t ) Deferred.Result.t +val apply_to_scan_state : + logger:Logger.t + -> skip_verification:bool + -> log_prefix:string + -> state_and_body_hash:Frozen_ledger_hash.t * Frozen_ledger_hash.t + -> ledger:Ledger.t + -> previous_pending_coinbase_collection:Pending_coinbase.t + -> previous_scan_state:Scan_state.t + -> constraint_constants:Genesis_constants.Constraint_constants.t + -> is_new_stack:bool + -> stack_update: + [< `Update_none + | `Update_one of Pending_coinbase.Stack_versioned.t + | `Update_two of + Pending_coinbase.Stack_versioned.t * Pending_coinbase.Stack_versioned.t + ] + -> first_pass_ledger_end:Frozen_ledger_hash.t + -> Transaction_snark_work.t list + -> Scan_state.Transaction_with_witness.t list + -> (t * Ledger_proof.Tagged.t option, Staged_ledger_error.t) Deferred.Result.t + (* This should memoize the snark verifications *) val create_diff : diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 2050477462cb..c6cbfdd81614 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -452,11 +452,15 @@ module For_tests = struct let body = Mina_block.Body.create @@ Staged_ledger_diff.forget staged_ledger_diff in - let%bind ( `Ledger_proof ledger_proof_opt - , `Staged_ledger transitioned_staged_ledger - , `Accounts_created _ - , `Pending_coinbase_update _ ) = - match%bind + let ledger_and_proof = + let%bind.Deferred.Result ( `Ledger new_ledger + , `Accounts_created _ + , `Stack_update stack_update + , `First_pass_ledger_end first_pass_ledger_end + , `Witnesses witnesses + , `Works works + , `Pending_coinbase_update (is_new_stack, _) ) + = Staged_ledger.apply_diff_unchecked parent_staged_ledger ~global_slot:current_global_slot ~coinbase_receiver ~logger staged_ledger_diff @@ -466,7 +470,17 @@ module For_tests = struct ~zkapp_cmd_limit_hardcap: precomputed_values.genesis_constants.zkapp_cmd_limit_hardcap ~signature_kind:Testnet - with + in + Staged_ledger.apply_to_scan_state ~logger ~skip_verification:false + ~log_prefix:"apply_diff" ~state_and_body_hash ~ledger:new_ledger + ~previous_pending_coinbase_collection: + (Staged_ledger.pending_coinbase_collection parent_staged_ledger) + ~previous_scan_state:(Staged_ledger.scan_state parent_staged_ledger) + ~constraint_constants:precomputed_values.constraint_constants + ~is_new_stack ~stack_update ~first_pass_ledger_end works witnesses + in + let%bind transitioned_staged_ledger, ledger_proof_opt = + match%bind ledger_and_proof with | Ok r -> return r | Error e -> From 15724371f3e18aaacf9e5263a8130cf181df2e8f Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 14:25:46 +0100 Subject: [PATCH 053/122] Split persist_witnesses_and_works --- src/lib/staged_ledger/staged_ledger.ml | 24 ++++++++++--------- .../extensions/root_history.ml | 10 +++----- .../frontier_base/root_data.ml | 6 +++++ .../frontier_base/root_data.mli | 4 ++++ 4 files changed, 26 insertions(+), 18 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 03d0b0a0a2bb..4a8cd60dbb11 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -35,14 +35,13 @@ module Pre_statement = struct } end -let persist_witnesses_and_works witnesses works writer = +let persist_witnesses witnesses writer = let module FS = State_hash.File_storage in let write_witness = FS.write_value writer ( module Transaction_snark_scan_state.Transaction_with_witness.Stable .Latest ) in - let write_proof = FS.write_value writer (module Proof.Stable.Latest) in let write_witness' witness = (* TODO remove read_all_proofs_from_disk *) let stable = @@ -52,6 +51,11 @@ let persist_witnesses_and_works witnesses works writer = Transaction_snark_scan_state.Transaction_with_witness.Tagged.create ~tag:(write_witness stable) stable in + List.map ~f:write_witness' witnesses + +let persist_works works writer = + let module FS = State_hash.File_storage in + let write_proof = FS.write_value writer (module Proof.Stable.Latest) in let write_proof' ~fee ~prover proof = (* TODO remove read_proof_from_disk *) let stable = Ledger_proof.Cached.read_proof_from_disk proof in @@ -61,13 +65,9 @@ let persist_witnesses_and_works witnesses works writer = Transaction_snark_scan_state.Ledger_proof_with_sok_message.Tagged.create ~tag:(write_proof proof) ~sok_message ~statement in - let tagged_witnesses = List.map ~f:write_witness' witnesses in - let tagged_works = - List.concat_map works - ~f:(fun { Transaction_snark_work.proofs; fee; prover } -> - One_or_two.to_list proofs |> List.map ~f:(write_proof' ~fee ~prover) ) - in - (tagged_witnesses, tagged_works) + List.concat_map works + ~f:(fun { Transaction_snark_work.proofs; fee; prover } -> + One_or_two.to_list proofs |> List.map ~f:(write_proof' ~fee ~prover) ) module T = struct module Scan_state = Transaction_snark_scan_state @@ -1054,8 +1054,10 @@ module T = struct ~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) + State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> + let witnesses' = persist_witnesses witnesses writer in + let works' = persist_works works writer in + (witnesses', works') ) in [%log internal] "Fill_work_and_enqueue_transactions" ; let%bind res_opt, scan_state = diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index e909343ed31c..033fb4f2baf3 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -44,7 +44,7 @@ module T = struct Full_frontier.Protocol_states_for_root_scan_state .protocol_states_for_next_root_scan_state t.protocol_states_for_root_scan_state - ~new_scan_state:(scan_state new_oldest_root) + ~new_scan_state:(Root_data.Historical.scan_state new_oldest_root) ~old_root_state: ( transition oldest_root |> Mina_block.Validated.forget |> With_hash.map ~f:(fun block -> @@ -98,11 +98,9 @@ let protocol_states_for_scan_state t state_hash = t.protocol_states_for_root_scan_state in let open Option.Let_syntax in - let open Root_data.Historical in let%bind data = Queue.lookup history state_hash in let required_state_hashes = - Staged_ledger.Scan_state.required_state_hashes (scan_state data) - |> State_hash.Set.to_list + Root_data.Historical.required_state_hashes data |> State_hash.Set.to_list in List.fold_until ~init:[] ~finish:(fun lst -> Some lst) @@ -111,9 +109,7 @@ let protocol_states_for_scan_state t state_hash = let res = match Queue.lookup history hash with | Some data -> - Some - ( transition data |> Mina_block.Validated.forget |> With_hash.data - |> Mina_block.header |> Mina_block.Header.protocol_state ) + Some (Root_data.Historical.protocol_state data) | None -> (*Not present in the history queue, check in the protocol states map that has all the protocol states required for transactions in the root*) let%map.Option state_with_hash = diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index c5cd3551070d..68a9afced28d 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -56,6 +56,12 @@ module Historical = struct let pending_coinbase t = Common.pending_coinbase t.common + let protocol_state t = + Mina_block.Validated.header t.transition |> Mina_block.Header.protocol_state + + let required_state_hashes t = + Staged_ledger.Scan_state.required_state_hashes t.common.scan_state + let of_breadcrumb breadcrumb = let transition = Breadcrumb.validated_transition breadcrumb in let staged_ledger = Breadcrumb.staged_ledger breadcrumb in diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index ce16b0522d6a..0fee719815f4 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -30,6 +30,10 @@ module Historical : sig val staged_ledger_target_ledger_hash : t -> Ledger_hash.t + val protocol_state : t -> Mina_state.Protocol_state.Value.t + + val required_state_hashes : t -> State_hash.Set.t + val of_breadcrumb : Breadcrumb.t -> t end From 1db1f13ab66c133a5f86df6ca6e2de76e5846884 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 14:30:04 +0100 Subject: [PATCH 054/122] Move persist_works to scan state module --- src/lib/staged_ledger/staged_ledger.ml | 20 +++---------------- src/lib/staged_ledger/staged_ledger.mli | 11 ++++++++++ .../transaction_snark_scan_state.ml | 15 ++++++++++++++ .../transaction_snark_scan_state.mli | 5 +++++ 4 files changed, 34 insertions(+), 17 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 4a8cd60dbb11..7367bbfe2e28 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -53,22 +53,6 @@ let persist_witnesses witnesses writer = in List.map ~f:write_witness' witnesses -let persist_works works writer = - let module FS = State_hash.File_storage in - let write_proof = FS.write_value writer (module Proof.Stable.Latest) in - let write_proof' ~fee ~prover proof = - (* TODO remove read_proof_from_disk *) - let stable = Ledger_proof.Cached.read_proof_from_disk proof in - let statement = Ledger_proof.statement_with_sok stable in - let proof = Ledger_proof.underlying_proof stable in - let sok_message = Sok_message.create ~fee ~prover in - Transaction_snark_scan_state.Ledger_proof_with_sok_message.Tagged.create - ~tag:(write_proof proof) ~sok_message ~statement - in - List.concat_map works - ~f:(fun { Transaction_snark_work.proofs; fee; prover } -> - One_or_two.to_list proofs |> List.map ~f:(write_proof' ~fee ~prover) ) - module T = struct module Scan_state = Transaction_snark_scan_state module Pre_diff_info = Pre_diff_info @@ -1056,7 +1040,9 @@ module T = struct let tagged_witnesses, tagged_works = State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> let witnesses' = persist_witnesses witnesses writer in - let works' = persist_works works writer in + let works' = + Scan_state.Ledger_proof_with_sok_message.persist_many works writer + in (witnesses', works') ) in [%log internal] "Fill_work_and_enqueue_transactions" ; diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 777b3d7bcc29..719ea0194541 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -39,6 +39,17 @@ module Scan_state : sig val target_second_pass_ledger : t -> Frozen_ledger_hash.t option end + module Ledger_proof_with_sok_message : sig + module Tagged : sig + type t + end + + val persist_many : + Transaction_snark_work.t list + -> State_hash.File_storage.writer_t + -> Tagged.t list + end + module Transaction_with_witness : sig type t end 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 beb7631ec2bb..493e2047614b 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 @@ -283,6 +283,21 @@ module Ledger_proof_with_sok_message = struct let sok_digest (t : t) = t.statement.sok_digest end + let persist_many works writer = + let module FS = State_hash.File_storage in + let write_proof = FS.write_value writer (module Proof.Stable.Latest) in + let write_proof' ~fee ~prover proof = + (* TODO remove read_proof_from_disk *) + let stable = Ledger_proof.Cached.read_proof_from_disk proof in + let statement = Ledger_proof.statement_with_sok stable in + let proof = Ledger_proof.underlying_proof stable in + let sok_message = Sok_message.create ~fee ~prover in + Tagged.create ~tag:(write_proof proof) ~sok_message ~statement + in + List.concat_map works + ~f:(fun { Transaction_snark_work.proofs; fee; prover } -> + One_or_two.to_list proofs |> List.map ~f:(write_proof' ~fee ~prover) ) + let read_tag ({ tag; sok_message; statement } : Tagged.t) : Stable.Latest.t Or_error.t = let%map.Or_error proof = 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 af5a39db5867..8b2c7b453f52 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 @@ -81,6 +81,11 @@ module Ledger_proof_with_sok_message : sig -> statement:Mina_state.Snarked_ledger_state.With_sok.t -> t end + + val persist_many : + Transaction_snark_work.t list + -> State_hash.File_storage.writer_t + -> Tagged.t list end module Available_job : sig From f0ced76c964d153735f20a8e9b661334d4927d8e Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 14:34:26 +0100 Subject: [PATCH 055/122] Move persist_witnesses to scan state module --- src/lib/staged_ledger/staged_ledger.ml | 22 +++---------------- src/lib/staged_ledger/staged_ledger.mli | 7 ++++++ .../transaction_snark_scan_state.ml | 10 +++++++++ .../transaction_snark_scan_state.mli | 2 ++ 4 files changed, 22 insertions(+), 19 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 7367bbfe2e28..9c2aba8268c9 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -35,24 +35,6 @@ module Pre_statement = struct } end -let persist_witnesses witnesses writer = - let module FS = State_hash.File_storage in - let write_witness = - FS.write_value writer - ( module Transaction_snark_scan_state.Transaction_with_witness.Stable - .Latest ) - in - let write_witness' witness = - (* TODO remove read_all_proofs_from_disk *) - let stable = - Transaction_snark_scan_state.Transaction_with_witness - .read_all_proofs_from_disk witness - in - Transaction_snark_scan_state.Transaction_with_witness.Tagged.create - ~tag:(write_witness stable) stable - in - List.map ~f:write_witness' witnesses - module T = struct module Scan_state = Transaction_snark_scan_state module Pre_diff_info = Pre_diff_info @@ -1039,7 +1021,9 @@ module T = struct in let tagged_witnesses, tagged_works = State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> - let witnesses' = persist_witnesses witnesses writer in + let witnesses' = + Scan_state.Transaction_with_witness.persist_many witnesses writer + in let works' = Scan_state.Ledger_proof_with_sok_message.persist_many works writer in diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index 719ea0194541..cfc3b48dff9a 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -52,6 +52,13 @@ module Scan_state : sig module Transaction_with_witness : sig type t + + module Tagged : sig + type t + end + + val persist_many : + t list -> State_hash.File_storage.writer_t -> Tagged.t list end [%%versioned: 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 493e2047614b..d812ae7ce537 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 @@ -243,6 +243,16 @@ module Transaction_with_witness = struct ; block_global_slot ; previous_protocol_state_body_opt } + + let persist_many witnesses writer = + let module FS = State_hash.File_storage in + let write_witness = FS.write_value writer (module Stable.Latest) in + let write_witness' witness = + (* TODO remove read_all_proofs_from_disk *) + let stable = read_all_proofs_from_disk witness in + Tagged.create ~tag:(write_witness stable) stable + in + List.map ~f:write_witness' witnesses end module Ledger_proof_with_sok_message = struct 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 8b2c7b453f52..e328d2eaf17d 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 @@ -67,6 +67,8 @@ module Transaction_with_witness : sig -> t val read_all_proofs_from_disk : t -> Stable.Latest.t + + val persist_many : t list -> State_hash.File_storage.writer_t -> Tagged.t list end module Ledger_proof_with_sok_message : sig From d69748651a3cd184ca13f7c15e1a1d937f229a1e Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 15:12:15 +0100 Subject: [PATCH 056/122] Move work/witness persistence up --- src/lib/block_producer/block_producer.ml | 24 +++++++-- src/lib/mina_block/validation.ml | 17 ++++++- src/lib/staged_ledger/staged_ledger.ml | 51 +++++++++---------- src/lib/staged_ledger/staged_ledger.mli | 5 +- .../transaction_snark_scan_state.ml | 2 + .../transaction_snark_scan_state.mli | 2 + .../frontier_base/breadcrumb.ml | 19 ++++++- 7 files changed, 83 insertions(+), 37 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 5a604df18b1b..c8c4a01d1762 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -303,16 +303,34 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind in + (* TODO this is wrong to write to the previous state hash *) + let prev_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 prev_state_hash + ~f:(fun writer -> + let witnesses' = + Staged_ledger.Scan_state.Transaction_with_witness + .persist_many witnesses writer + in + let works' = + Staged_ledger.Scan_state.Ledger_proof_with_sok_message + .persist_many works writer + in + (witnesses', works') ) + in (* TODO consider skipping verification (i.e. ~skip_verification:true) *) let%map.Deferred.Result new_staged_ledger, ledger_proof_opt = Staged_ledger.apply_to_scan_state ~logger ~skip_verification:false - ~log_prefix:"apply_diff_unchecked" ~state_and_body_hash - ~ledger:new_ledger + ~log_prefix:"apply_diff_unchecked" ~ledger:new_ledger ~previous_pending_coinbase_collection: (Staged_ledger.pending_coinbase_collection staged_ledger) ~previous_scan_state:(Staged_ledger.scan_state staged_ledger) ~constraint_constants ~is_new_stack ~stack_update - ~first_pass_ledger_end works witnesses + ~first_pass_ledger_end tagged_works tagged_witnesses in (new_staged_ledger, ledger_proof_opt, is_new_stack, pcu_action) in diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index c86ae7aef94c..02aa08196da4 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -479,6 +479,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger let consensus_state = Protocol_state.consensus_state protocol_state in let global_slot = Consensus_state.global_slot_since_genesis consensus_state in let body = Block.body block in + let state_hash = State_hash.With_state_hashes.state_hash t in let apply_start_time = Core.Time.now () in let body_ref_from_header = Blockchain_state.body_reference blockchain_state in let body_ref_computed = @@ -529,18 +530,30 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger ~signature_kind:Mina_signature_kind.t_DEPRECATED ?transaction_pool_proxy in + let tagged_witnesses, tagged_works = + State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> + let witnesses' = + Staged_ledger.Scan_state.Transaction_with_witness.persist_many + witnesses writer + in + let works' = + Staged_ledger.Scan_state.Ledger_proof_with_sok_message + .persist_many works writer + in + (witnesses', works') ) + in let%map.Deferred.Result new_staged_ledger, res_opt = let skip_verification = [%equal: [ `All | `Proofs ] option] skip_staged_ledger_verification (Some `All) in Staged_ledger.apply_to_scan_state ~logger ~skip_verification - ~log_prefix:"apply_diff" ~state_and_body_hash ~ledger:new_ledger + ~log_prefix:"apply_diff" ~ledger:new_ledger ~previous_pending_coinbase_collection: (Staged_ledger.pending_coinbase_collection parent_staged_ledger) ~previous_scan_state:(Staged_ledger.scan_state parent_staged_ledger) ~constraint_constants ~is_new_stack ~stack_update - ~first_pass_ledger_end works witnesses + ~first_pass_ledger_end tagged_works tagged_witnesses in Or_error.iter_error ( Staged_ledger.update_scan_state_metrics diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 9c2aba8268c9..2dad34fd4b79 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -994,9 +994,9 @@ module T = struct ~log_prefix e = let data_json = `List - (List.map witnesses - ~f:(fun { Scan_state.Transaction_with_witness.statement; _ } -> - Transaction_snark.Statement.to_yojson statement ) ) + (List.map witnesses ~f:(fun tagged -> + Transaction_snark.Statement.to_yojson + @@ Scan_state.Transaction_with_witness.Tagged.statement tagged ) ) in [%log error] ~metadata: @@ -1009,26 +1009,11 @@ module T = struct !"$prefix: Unexpected error when applying diff data $data to the \ scan_state $scan_state: $error" - let apply_to_scan_state ~logger ~skip_verification ~log_prefix - ~state_and_body_hash ~ledger ~previous_pending_coinbase_collection - ~previous_scan_state ~constraint_constants ~is_new_stack ~stack_update - ~first_pass_ledger_end works witnesses = + let apply_to_scan_state ~logger ~skip_verification ~log_prefix ~ledger + ~previous_pending_coinbase_collection ~previous_scan_state + ~constraint_constants ~is_new_stack ~stack_update ~first_pass_ledger_end + tagged_works tagged_witnesses = let open Deferred.Result.Let_syntax 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:(fun writer -> - let witnesses' = - Scan_state.Transaction_with_witness.persist_many witnesses writer - in - let works' = - Scan_state.Ledger_proof_with_sok_message.persist_many works writer - in - (witnesses', works') ) - in [%log internal] "Fill_work_and_enqueue_transactions" ; let%bind res_opt, scan_state = O1trace.thread "fill_work_and_enqueue_transactions" @@ -1039,8 +1024,8 @@ module T = struct in Or_error.iter_error r ~f: - (log_scan_state_update_error ~logger ~witnesses ~previous_scan_state - ~log_prefix ) ; + (log_scan_state_update_error ~logger ~witnesses:tagged_witnesses + ~previous_scan_state ~log_prefix ) ; Deferred.return (to_staged_ledger_or_error r) in let%bind () = yield_result () in @@ -1057,7 +1042,7 @@ module T = struct in let%bind () = yield_result () in let%map () = - if skip_verification || List.is_empty witnesses then + if skip_verification || List.is_empty tagged_witnesses then Deferred.return (Ok ()) else ( [%log internal] "Verify_scan_state_after_apply" ; @@ -2400,12 +2385,24 @@ let%test_module "staged ledger tests" = ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind in + (* For test it is not important which file to write to *) + let state_hash = Quickcheck.random_value State_hash.gen in + let tagged_witnesses, tagged_works = + State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> + let witnesses' = + Scan_state.Transaction_with_witness.persist_many witnesses writer + in + let works' = + Scan_state.Ledger_proof_with_sok_message.persist_many works writer + in + (witnesses', works') ) + in let%map.Deferred.Result new_staged_ledger, res_opt = apply_to_scan_state ~logger ~skip_verification:false - ~log_prefix:"apply_diff" ~state_and_body_hash ~ledger:new_ledger + ~log_prefix:"apply_diff" ~ledger:new_ledger ~previous_pending_coinbase_collection:t.pending_coinbase_collection ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack - ~stack_update ~first_pass_ledger_end works witnesses + ~stack_update ~first_pass_ledger_end tagged_works tagged_witnesses in ( `Ledger_proof res_opt , `Staged_ledger new_staged_ledger diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index cfc3b48dff9a..ca91d26f6d27 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -295,7 +295,6 @@ val apply_to_scan_state : logger:Logger.t -> skip_verification:bool -> log_prefix:string - -> state_and_body_hash:Frozen_ledger_hash.t * Frozen_ledger_hash.t -> ledger:Ledger.t -> previous_pending_coinbase_collection:Pending_coinbase.t -> previous_scan_state:Scan_state.t @@ -308,8 +307,8 @@ val apply_to_scan_state : Pending_coinbase.Stack_versioned.t * Pending_coinbase.Stack_versioned.t ] -> first_pass_ledger_end:Frozen_ledger_hash.t - -> Transaction_snark_work.t list - -> Scan_state.Transaction_with_witness.t list + -> Scan_state.Ledger_proof_with_sok_message.Tagged.t list + -> Scan_state.Transaction_with_witness.Tagged.t list -> (t * Ledger_proof.Tagged.t option, Staged_ledger_error.t) Deferred.Result.t (* This should memoize the snark verifications *) 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 d812ae7ce537..bac71dc7791b 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 @@ -183,6 +183,8 @@ module Transaction_with_witness = struct ; parent_state_hash = fst @@ t.state_hash } + let statement t = t.Stable.Latest.statement + type t = Stable.Latest.t end 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 e328d2eaf17d..711550281124 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 @@ -45,6 +45,8 @@ module Transaction_with_witness : sig type t val create : tag:Tag.t -> Stable.Latest.t -> t + + val statement : t -> Transaction_snark.Statement.t end (* TODO: The statement is redundant here - it can be computed from the witness and the transaction *) diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index c6cbfdd81614..d521379dde4e 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -471,13 +471,28 @@ module For_tests = struct precomputed_values.genesis_constants.zkapp_cmd_limit_hardcap ~signature_kind:Testnet in + (* For test it is not important which file to write to *) + let state_hash = Quickcheck.random_value State_hash.gen in + let tagged_witnesses, tagged_works = + State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> + let witnesses' = + Staged_ledger.Scan_state.Transaction_with_witness.persist_many + witnesses writer + in + let works' = + Staged_ledger.Scan_state.Ledger_proof_with_sok_message + .persist_many works writer + in + (witnesses', works') ) + in Staged_ledger.apply_to_scan_state ~logger ~skip_verification:false - ~log_prefix:"apply_diff" ~state_and_body_hash ~ledger:new_ledger + ~log_prefix:"apply_diff" ~ledger:new_ledger ~previous_pending_coinbase_collection: (Staged_ledger.pending_coinbase_collection parent_staged_ledger) ~previous_scan_state:(Staged_ledger.scan_state parent_staged_ledger) ~constraint_constants:precomputed_values.constraint_constants - ~is_new_stack ~stack_update ~first_pass_ledger_end works witnesses + ~is_new_stack ~stack_update ~first_pass_ledger_end tagged_works + tagged_witnesses in let%bind transitioned_staged_ledger, ledger_proof_opt = match%bind ledger_and_proof with From 9d2a8de5667716a580c5c43f68c5a3325c54f63c Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 15:51:02 +0100 Subject: [PATCH 057/122] Don't use parent state hash for persistance --- src/lib/block_producer/block_producer.ml | 43 +++++++++++++++++++----- 1 file changed, 35 insertions(+), 8 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index c8c4a01d1762..ec87124ce5b6 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -6,6 +6,27 @@ open Mina_transaction open Mina_state open Mina_block +(** State hash that is temporarily used in block creation + to be able to write work/witness tags before passing them + on to scan state construction. It's safe to use hardcoded value, given + that block production is single threaded and state hash is not used + in any other place. *) +let temp_state_hash = + (* TODO don't use quick check for generating this value: + 1. Define min/max bounds for big number in state hash module (extract it out of + [State_hash.gen]) + 2. Compute hash the same way it's done now + 3. Take necessary number of bits (use hash of the hash if more bits needed) + + I.e. this value should be computed once but shouldn't be prone to manipulation + *) + lazy + (Quickcheck.random_value + ~seed: + (`Deterministic + Blake2.(digest_string "temporary state hash" |> to_raw_string) ) + State_hash.gen ) + module type CONTEXT = sig val logger : Logger.t @@ -303,15 +324,9 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind in - (* TODO this is wrong to write to the previous state hash *) - let prev_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 prev_state_hash - ~f:(fun writer -> + State_hash.File_storage.write_values_exn + (Lazy.force temp_state_hash) ~f:(fun writer -> let witnesses' = Staged_ledger.Scan_state.Transaction_with_witness .persist_many witnesses writer @@ -345,6 +360,18 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants Staged_ledger.hash transitioned_staged_ledger in [%log internal] "Hash_new_staged_ledger_done" ; + (* TODO instead of throwing the new staged ledger away: + 1. Construct new block + 2. Replace [temp_state_hash] with the new state hash by traversing + the new scan state and checking equality of state hash against + every entry + 3. Use the new staged ledger with fixed-up scan state in breadcrumb + building + 4. Move the state hash file from [temp_state_hash]'s location to + a new location + 5. Append necessary serializations (e.g. block's raw data) at the + new location + *) (*staged_ledger remains unchanged and transitioned_staged_ledger is discarded because the external transtion created out of this diff will be applied in Transition_frontier*) ignore @@ Mina_ledger.Ledger.unregister_mask_exn ~loc:__LOC__ From 34e5ab97d887a2493aad3e3587aef2068593dcda Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 16:36:35 +0100 Subject: [PATCH 058/122] Preserve serialized block --- src/lib/mina_block/block.mli | 3 +++ src/lib/mina_block/validation.ml | 21 +++++++++++++------ src/lib/mina_block/validation.mli | 1 + .../frontier_base/breadcrumb.ml | 3 ++- 4 files changed, 21 insertions(+), 7 deletions(-) diff --git a/src/lib/mina_block/block.mli b/src/lib/mina_block/block.mli index 36034f638977..1f17f6c44fe8 100644 --- a/src/lib/mina_block/block.mli +++ b/src/lib/mina_block/block.mli @@ -16,6 +16,9 @@ module Stable : sig constraint_constants:Genesis_constants.Constraint_constants.t -> t -> Transaction.Stable.V2.t With_status.t list + + val create : + header:Header.Stable.V2.t -> body:Staged_ledger_diff.Body.Stable.V1.t -> t end end] diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 02aa08196da4..c3157db8db4c 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -482,10 +482,12 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger let state_hash = State_hash.With_state_hashes.state_hash t in let apply_start_time = Core.Time.now () in let body_ref_from_header = Blockchain_state.body_reference blockchain_state in + let body_stable = Staged_ledger_diff.Body.read_all_proofs_from_disk body in + let block_stable = Block.Stable.Latest.create ~header ~body:body_stable in let body_ref_computed = Staged_ledger_diff.Body.compute_reference ~tag:Mina_net2.Bitswap_tag.(to_enum Body) - @@ Staged_ledger_diff.Body.read_all_proofs_from_disk body + body_stable in let%bind.Deferred.Result () = if Blake2.equal body_ref_computed body_ref_from_header then @@ -505,7 +507,8 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger in let%bind.Deferred.Result ( transitioned_staged_ledger , proof_opt - , accounts_created ) = + , accounts_created + , tagged_block ) = Deferred.Result.map_error ~f:(fun e -> `Staged_ledger_application_failed e) @@ let%bind.Deferred.Result ( `Ledger new_ledger , `Accounts_created accounts_created @@ -530,7 +533,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger ~signature_kind:Mina_signature_kind.t_DEPRECATED ?transaction_pool_proxy in - let tagged_witnesses, tagged_works = + let tagged_witnesses, tagged_works, tagged_block = State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> let witnesses' = Staged_ledger.Scan_state.Transaction_with_witness.persist_many @@ -540,7 +543,12 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger Staged_ledger.Scan_state.Ledger_proof_with_sok_message .persist_many works writer in - (witnesses', works') ) + let block' = + State_hash.File_storage.write_value writer + (module Block.Stable.Latest) + block_stable + in + (witnesses', works', block') ) in let%map.Deferred.Result new_staged_ledger, res_opt = let skip_verification = @@ -562,7 +570,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] !"Error updating metrics after applying scan state: $error" ) ; - (new_staged_ledger, res_opt, accounts_created) + (new_staged_ledger, res_opt, accounts_created, tagged_block) in [%log internal] "Diff_applied" ; let staged_ledger_hash_opt = @@ -620,7 +628,8 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger , `Block_with_validation (t, Unsafe.set_valid_staged_ledger_diff validation) , `Staged_ledger transitioned_staged_ledger - , `Accounts_created accounts_created ) + , `Accounts_created accounts_created + , `Block_serialized tagged_block ) | 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 798a6bb97ec7..a1e50634c394 100644 --- a/src/lib/mina_block/validation.mli +++ b/src/lib/mina_block/validation.mli @@ -380,6 +380,7 @@ val validate_staged_ledger_diff : with_block ] * [ `Staged_ledger of Staged_ledger.t ] * [ `Accounts_created of Account_id.t list ] + * [ `Block_serialized of Block.Stable.V2.t State_hash.File_storage.tag ] , [> `Staged_ledger_application_failed of Staged_ledger.Staged_ledger_error.t | `Invalid_body_reference diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index d521379dde4e..ab601266b85e 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -165,7 +165,8 @@ let build ?skip_staged_ledger_verification ?transaction_pool_proxy ~logger ( `Just_emitted_a_proof just_emitted_a_proof , `Block_with_validation fully_valid_block , `Staged_ledger transitioned_staged_ledger - , `Accounts_created accounts_created ) -> + , `Accounts_created accounts_created + , _ ) -> [%log internal] "Create_breadcrumb" ; Deferred.Result.return (create From d1fd9fe0c20b1094aeef1067ed35f529eaff08e3 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 18:12:22 +0100 Subject: [PATCH 059/122] Store block tag in breadcrumb --- src/app/archive/lib/processor.ml | 3 +- .../cli/src/init/test_submit_to_archive.ml | 8 ++--- src/lib/mina_block/mina_block.ml | 18 +++++++++-- src/lib/mina_lib/mina_lib.ml | 3 +- src/lib/mina_lib/tests/tests.ml | 3 +- .../frontier_base/breadcrumb.ml | 31 +++++++++---------- .../frontier_base/breadcrumb.mli | 3 ++ .../frontier_base/root_data.ml | 5 +-- .../frontier_base/root_data.mli | 1 + .../full_frontier/full_frontier.ml | 11 +++---- .../persistent_frontier.ml | 21 +++++++++++++ .../transition_frontier.ml | 11 +++---- 12 files changed, 75 insertions(+), 43 deletions(-) diff --git a/src/app/archive/lib/processor.ml b/src/app/archive/lib/processor.ml index caad5467425c..ea54cbf78b4a 100644 --- a/src/app/archive/lib/processor.ml +++ b/src/app/archive/lib/processor.ml @@ -4653,8 +4653,9 @@ let add_genesis_accounts ~logger ~(runtime_config_opt : Runtime_config.t option) Account_id.Set.to_list account_id_set in let genesis_block = - let With_hash.{ data = block; hash = the_hash }, _ = + let With_hash.{ data = block; hash = the_hash } = Mina_block.genesis ~precomputed_values + |> fst |> Mina_block.Validated.forget in With_hash.{ data = block; hash = the_hash } in 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 ebeb56a58994..0dff561a1b31 100644 --- a/src/app/cli/src/init/test_submit_to_archive.ml +++ b/src/app/cli/src/init/test_submit_to_archive.ml @@ -113,12 +113,9 @@ module Block = struct let compute_genesis ~logger ~precomputed_values (module Keys : Keys_S) = (* Generate genesis block, used in a bunch of other places (including block producer and tests) *) - let genesis_block_with_hash, genesis_validation = + let genesis_block, genesis_block_tag = Mina_block.genesis ~precomputed_values in - let validated = - Mina_block.Validated.lift (genesis_block_with_hash, genesis_validation) - in let constraint_constants = precomputed_values.constraint_constants in (* Create a staged ledger out of genesis ledger. Fresh code, not copied from anywhere else. *) @@ -140,10 +137,11 @@ module Block = struct in [%log info] "Generating genesis breadcrumb" ; let breadcrumb = - Frontier_base.Breadcrumb.create ~validated_transition:validated + Frontier_base.Breadcrumb.create ~validated_transition:genesis_block ~staged_ledger ~transition_receipt_time:(Some (Time.now ())) ~just_emitted_a_proof:false ~accounts_created:[] + ~block_tag:genesis_block_tag 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/lib/mina_block/mina_block.ml b/src/lib/mina_block/mina_block.ml index bc0a651b0b52..107fa4ebd84e 100644 --- a/src/lib/mina_block/mina_block.ml +++ b/src/lib/mina_block/mina_block.ml @@ -21,7 +21,8 @@ type almost_valid_header = Validation.almost_valid_with_header type fully_valid_block = Validation.fully_valid_with_block -let genesis ~precomputed_values : Block.with_hash * Validation.fully_valid = +let genesis ~precomputed_values : + Validated_block.t * Block.Stable.Latest.t State_hash.File_storage.tag = let genesis_state = Precomputed_values.genesis_state_with_hashes precomputed_values in @@ -38,6 +39,15 @@ let genesis ~precomputed_values : Block.with_hash * Validation.fully_valid = let block = Block.create ~header ~body in With_hash.map genesis_state ~f:(Fn.const block) in + let state_hash = State_hash.With_state_hashes.state_hash genesis_state in + let block_tag = + (* TODO write only if file is not existent, otherwise just create a tag + using file size as data length and position 0 *) + State_hash.File_storage.write_values_exn state_hash ~f:(fun writer -> + State_hash.File_storage.write_value writer + (module Block.Stable.Latest) + (With_hash.data block_with_hash |> Block.read_all_proofs_from_disk) ) + in let validation = ( (`Time_received, Mina_stdlib.Truth.True ()) , (`Genesis_state, Mina_stdlib.Truth.True ()) @@ -50,11 +60,13 @@ let genesis ~precomputed_values : Block.with_hash * Validation.fully_valid = , (`Staged_ledger_diff, Mina_stdlib.Truth.True ()) , (`Protocol_versions, Mina_stdlib.Truth.True ()) ) in - (block_with_hash, validation) + (Validated_block.lift (block_with_hash, validation), block_tag) let genesis_header ~precomputed_values = - let b, v = genesis ~precomputed_values in + let validated, _ = genesis ~precomputed_values in + let b, v = Validated_block.remember validated in (With_hash.map ~f:Block.header b, v) + |> Validation.reset_staged_ledger_diff_validation let handle_dropped_transition ?pipe_name ?valid_cb ~logger block = [%log warn] "Dropping state_hash $state_hash from $pipe transition pipe" diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 97b24b6dbcc0..5b743dc51b2a 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -2244,8 +2244,7 @@ let create ~commit_id ?wallets (config : Config.t) = Broadcast_pipe.create ( Mina_block.genesis_header ~precomputed_values:config.precomputed_values - |> Validation.reset_frontier_dependencies_validation - |> Validation.reset_staged_ledger_diff_validation ) + |> Validation.reset_frontier_dependencies_validation ) in let get_most_recent_valid_block () = Broadcast_pipe.Reader.peek most_recent_valid_block_reader diff --git a/src/lib/mina_lib/tests/tests.ml b/src/lib/mina_lib/tests/tests.ml index d843cd88b9c5..636f7bdfd53b 100644 --- a/src/lib/mina_lib/tests/tests.ml +++ b/src/lib/mina_lib/tests/tests.ml @@ -341,8 +341,7 @@ let%test_module "Epoch ledger sync tests" = let most_recent_valid_block_reader, most_recent_valid_block_writer = Broadcast_pipe.create ( Mina_block.genesis_header ~precomputed_values - |> Mina_block.Validation.reset_frontier_dependencies_validation - |> Mina_block.Validation.reset_staged_ledger_diff_validation ) + |> Mina_block.Validation.reset_frontier_dependencies_validation ) in let get_current_frontier () = Broadcast_pipe.Reader.peek frontier_broadcast_pipe_r diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index ab601266b85e..7c89dd889d20 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -15,6 +15,7 @@ module T = struct ; transition_receipt_time : Time.t option ; staged_ledger_hash : Staged_ledger_hash.t ; accounts_created : Account_id.t list + ; block_tag : Mina_block.Stable.Latest.t State_hash.File_storage.tag } [@@deriving fields] @@ -24,16 +25,18 @@ module T = struct -> just_emitted_a_proof:bool -> transition_receipt_time:Time.t option -> accounts_created:Account_id.t list + -> block_tag:Mina_block.Stable.Latest.t State_hash.File_storage.tag -> 'a let map_creator creator ~f ~validated_transition ~staged_ledger - ~just_emitted_a_proof ~transition_receipt_time ~accounts_created = + ~just_emitted_a_proof ~transition_receipt_time ~accounts_created + ~block_tag = f (creator ~validated_transition ~staged_ledger ~just_emitted_a_proof - ~transition_receipt_time ~accounts_created ) + ~transition_receipt_time ~accounts_created ~block_tag ) let create ~validated_transition ~staged_ledger ~just_emitted_a_proof - ~transition_receipt_time ~accounts_created = + ~transition_receipt_time ~accounts_created ~block_tag = (* 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 *) @@ -51,6 +54,7 @@ module T = struct ; transition_receipt_time ; staged_ledger_hash ; accounts_created + ; block_tag } let to_yojson @@ -60,6 +64,7 @@ module T = struct ; transition_receipt_time ; staged_ledger_hash = _ ; accounts_created = _ + ; block_tag = _ } = `Assoc [ ( "validated_transition" @@ -81,17 +86,11 @@ T. , transition_receipt_time , to_yojson , staged_ledger_hash - , accounts_created )] - -let command_hashes - { T.validated_transition - ; staged_ledger = _ - ; just_emitted_a_proof = _ - ; transition_receipt_time = _ - ; staged_ledger_hash = _ - ; accounts_created = _ - } = - Mina_block.Validated.body validated_transition + , accounts_created + , block_tag )] + +let command_hashes t = + T.validated_transition t |> Mina_block.Validated.body |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes let valid_commands_hashed (t : T.t) = @@ -166,14 +165,14 @@ let build ?skip_staged_ledger_verification ?transaction_pool_proxy ~logger , `Block_with_validation fully_valid_block , `Staged_ledger transitioned_staged_ledger , `Accounts_created accounts_created - , _ ) -> + , `Block_serialized block_tag ) -> [%log internal] "Create_breadcrumb" ; Deferred.Result.return (create ~validated_transition: (Mina_block.Validated.lift fully_valid_block) ~staged_ledger:transitioned_staged_ledger ~accounts_created - ~just_emitted_a_proof ~transition_receipt_time ) + ~just_emitted_a_proof ~transition_receipt_time ~block_tag ) | Error `Invalid_body_reference -> let message = "invalid body reference" in let%map () = diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index cfeff6448cbf..268b36c87fdc 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -26,6 +26,7 @@ val create : -> just_emitted_a_proof:bool -> transition_receipt_time:Time.t option -> accounts_created:Account_id.t list + -> block_tag:Mina_block.Stable.Latest.t State_hash.File_storage.tag -> t val build : @@ -63,6 +64,8 @@ val contains_transaction_by_hash : val validated_transition : t -> Mina_block.Validated.t +val block_tag : t -> Mina_block.Stable.Latest.t State_hash.File_storage.tag + val block_with_hash : t -> Mina_block.with_hash val block : t -> Mina_block.t diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 68a9afced28d..c678b40f8b75 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -220,9 +220,10 @@ type t = ; protocol_states : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list + ; block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag } -let minimize { transition; staged_ledger; protocol_states = _ } = +let minimize { transition; staged_ledger; protocol_states = _; block_tag = _ } = let scan_state = Staged_ledger.scan_state staged_ledger in let pending_coinbase = Staged_ledger.pending_coinbase_collection staged_ledger @@ -230,7 +231,7 @@ let minimize { transition; staged_ledger; protocol_states = _ } = let common = Common.create ~scan_state ~pending_coinbase in { Minimal.hash = Mina_block.Validated.state_hash transition; common } -let limit { transition; staged_ledger; protocol_states } = +let limit { transition; staged_ledger; protocol_states; block_tag = _ } = let scan_state = Staged_ledger.scan_state staged_ledger in let pending_coinbase = Staged_ledger.pending_coinbase_collection staged_ledger diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 0fee719815f4..3265840c0977 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -164,6 +164,7 @@ type t = ; protocol_states : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list + ; block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag } val minimize : t -> Minimal.t diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 41360842d491..57c0ee6aa021 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -170,7 +170,7 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger ~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:[] + ~accounts_created:[] ~block_tag:root_data.block_tag in let root_node = { Node.breadcrumb = root_breadcrumb; successor_hashes = []; length = 0 } @@ -196,6 +196,7 @@ let root_data t = { transition = Breadcrumb.validated_transition root ; staged_ledger = Breadcrumb.staged_ledger root ; protocol_states = State_hash.Map.data t.protocol_states_for_root_scan_state + ; block_tag = Breadcrumb.block_tag root } let max_length { max_length; _ } = max_length @@ -563,6 +564,7 @@ let move_root ({ context = (module Context); _ } as t) ~new_root_hash (Breadcrumb.transition_receipt_time new_root_node.breadcrumb) (* accounts created shouldn't be used for the root *) ~accounts_created:[] + ~block_tag:(Breadcrumb.block_tag new_root_node.breadcrumb) 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) @@ -1018,11 +1020,8 @@ module For_tests = struct in let root_data = let open Root_data in - { transition = - Mina_block.Validated.lift @@ Mina_block.genesis ~precomputed_values - ; staged_ledger - ; protocol_states = [] - } + let transition, block_tag = Mina_block.genesis ~precomputed_values in + { transition; staged_ledger; protocol_states = []; block_tag } in let persistent_root = Persistent_root.create ~logger ~backing_type:Stable_db diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index d6b596364acb..7bebaaf5a4ca 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -7,6 +7,17 @@ open Frontier_base module Database = Database module Root_ledger = Mina_ledger.Root +(* TODO get rid of the hack, preserve block tag in database + instead of the full transition *) +let temp_state_hash = + lazy + (Quickcheck.random_value + ~seed: + (`Deterministic + Blake2.( + digest_string "temporary state hash for root" |> to_raw_string) ) + State_hash.gen ) + module type CONTEXT = sig val logger : Logger.t @@ -291,6 +302,15 @@ module Instance = struct | Ok staged_ledger -> Ok staged_ledger in + (* TODO remove the hack *) + let root_block_tag = + State_hash.File_storage.write_values_exn (Lazy.force temp_state_hash) + ~f:(fun writer -> + State_hash.File_storage.write_value writer + (module Mina_block.Stable.Latest) + @@ Mina_block.read_all_proofs_from_disk @@ With_hash.data + @@ Mina_block.Validated.forget root_transition ) + in (* initialize the new in memory frontier and extensions *) let frontier = Full_frontier.create @@ -302,6 +322,7 @@ module Instance = struct ; protocol_states = List.map protocol_states ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) + ; block_tag = root_block_tag } ~root_ledger:(Root_ledger.as_unmasked root_ledger) ~consensus_local_state ~max_length ~persistent_root_instance diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 9a4ad463586d..67df02555a3c 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -82,9 +82,7 @@ type Structured_log_events.t += Persisted_frontier_dropped [@@deriving register_event { msg = "Persistent frontier dropped" }] let genesis_root_data ~precomputed_values = - let transition = - Mina_block.Validated.lift @@ Mina_block.genesis ~precomputed_values - in + let transition, _ = Mina_block.genesis ~precomputed_values in let constraint_constants = precomputed_values.constraint_constants in let scan_state = Staged_ledger.Scan_state.empty ~constraint_constants () in (*if scan state is empty the protocol states required is also empty*) @@ -577,8 +575,8 @@ module For_tests = struct let constraint_constants = precomputed_values.constraint_constants in Quickcheck.Generator.create (fun ~size:_ ~random:_ -> let transition_receipt_time = Some (Time.now ()) in - let genesis_transition = - Mina_block.Validated.lift (Mina_block.genesis ~precomputed_values) + let genesis_transition, genesis_block_tag = + Mina_block.genesis ~precomputed_values in let genesis_ledger = Lazy.force (Precomputed_values.genesis_ledger precomputed_values) @@ -611,7 +609,8 @@ module For_tests = struct in Breadcrumb.create ~validated_transition:genesis_transition ~staged_ledger:genesis_staged_ledger ~just_emitted_a_proof:false - ~transition_receipt_time ~accounts_created:[] ) + ~transition_receipt_time ~accounts_created:[] + ~block_tag:genesis_block_tag ) let gen_persistence ?(logger = Logger.null ()) ~verifier ~(precomputed_values : Precomputed_values.t) () = From 72b5d198a777b679c594a4c738efbe206bd4b679 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 20:53:12 +0100 Subject: [PATCH 060/122] Move a function to transition frontier --- src/lib/mina_networking/rpcs.ml | 18 ++----- src/lib/sync_handler/sync_handler.ml | 51 +++++-------------- .../transition_frontier.ml | 30 +++++++++++ .../transition_frontier.mli | 10 ++++ 4 files changed, 58 insertions(+), 51 deletions(-) diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index a1f3baf146c8..117666c3a262 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -298,24 +298,16 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct Sync_handler.get_staged_ledger_aux_and_pending_coinbases_at_hash ~logger ~frontier hash in - match result with - | None -> + let%map () = + if Option.is_none result then Trust_system.( record_envelope_sender trust_system logger (Envelope.Incoming.sender request) Actions. (Requested_unknown_item, Some (receipt_trust_action_message hash))) - >>| const None - | Some (scan_state, expected_merkle_root, pending_coinbases, protocol_states) - -> - return - (Some - (* TODO convert to stable, current implementation is incorrect, - bootstrap won't happen *) - ( scan_state - , expected_merkle_root - , pending_coinbases - , protocol_states ) ) + else Deferred.unit + in + result let rate_limit_budget = (4, `Per Time.Span.minute) diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 0b63c12d77e6..1519575003da 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -116,49 +116,24 @@ module Make (Inputs : Inputs_intf) : let get_staged_ledger_aux_and_pending_coinbases_at_hash ~logger ~frontier state_hash = - let open Option.Let_syntax in - let protocol_states scan_state = - Staged_ledger.Scan_state.required_state_hashes scan_state - |> State_hash.Set.to_list - |> List.fold_until ~init:(Some []) - ~f:(fun acc hash -> - match - Option.map2 - (Transition_frontier.find_protocol_state frontier hash) - acc ~f:List.cons - with - | None -> - Stop None - | Some acc' -> - Continue (Some acc') ) - ~finish:Fn.id - in match - let%bind breadcrumb = Transition_frontier.find frontier state_hash in - let staged_ledger = - Transition_frontier.Breadcrumb.staged_ledger breadcrumb - in - let scan_state = Staged_ledger.scan_state staged_ledger in - let staged_ledger_hash = Breadcrumb.staged_ledger_hash breadcrumb in - let merkle_root = Staged_ledger_hash.ledger_hash staged_ledger_hash in - let%map scan_state_protocol_states = protocol_states scan_state in - let pending_coinbase = - Staged_ledger.pending_coinbase_collection staged_ledger - in - [%log debug] - ~metadata: - [ ( "staged_ledger_hash" - , Staged_ledger_hash.to_yojson staged_ledger_hash ) - ] - "sending scan state and pending coinbase" ; - (scan_state, merkle_root, pending_coinbase, scan_state_protocol_states) + Transition_frontier.staged_ledger_aux_and_pending_coinbases_at_hash + frontier state_hash with - | Some res -> + | Some (res, staged_ledger_hash) -> + [%log debug] + ~metadata: + [ ( "staged_ledger_hash" + , Staged_ledger_hash.to_yojson staged_ledger_hash ) + ; ("state_hash", State_hash.to_yojson state_hash) + ] + "sending scan state and pending coinbase" ; + (* TODO: CAUTION we don't convert the scan state to serialized format *) Some res | None -> let open Root_data.Historical in - let%bind root = find_in_root_history frontier state_hash in - let%map scan_state_protocol_states = + let%bind.Option root = find_in_root_history frontier state_hash in + let%map.Option scan_state_protocol_states = protocol_states_in_root_history frontier state_hash in ( scan_state root diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 67df02555a3c..c3a205c70aa2 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -562,6 +562,36 @@ include struct proxy1 protocol_states_for_root_scan_state end +let protocol_states_of_scan_state ~frontier scan_state = + Staged_ledger.Scan_state.required_state_hashes scan_state + |> State_hash.Set.to_list + |> List.fold_until ~init:(Some []) + ~f:(fun acc hash -> + match + Option.map2 (find_protocol_state frontier hash) acc ~f:List.cons + with + | None -> + Stop None + | Some acc' -> + Continue (Some acc') ) + ~finish:Fn.id + +let staged_ledger_aux_and_pending_coinbases_at_hash frontier state_hash = + let%bind.Option breadcrumb = find frontier state_hash in + let staged_ledger = Breadcrumb.staged_ledger breadcrumb in + let scan_state = Staged_ledger.scan_state staged_ledger in + let staged_ledger_hash = Breadcrumb.staged_ledger_hash breadcrumb in + let merkle_root = Staged_ledger_hash.ledger_hash staged_ledger_hash in + let%map.Option scan_state_protocol_states = + protocol_states_of_scan_state ~frontier scan_state + in + let pending_coinbase = + Staged_ledger.pending_coinbase_collection staged_ledger + in + (* Cache in frontier and return tag *) + ( (scan_state, merkle_root, pending_coinbase, scan_state_protocol_states) + , staged_ledger_hash ) + module For_tests = struct open Signature_lib module Ledger_transfer = diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 84c5c339f121..6265465e5aa4 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -118,6 +118,16 @@ val rejected_blocks : val validated_blocks : (State_hash.t * Network_peer.Envelope.Sender.t * Block_time.t) Core.Queue.t +val staged_ledger_aux_and_pending_coinbases_at_hash : + t + -> State_hash.t + -> ( ( Staged_ledger.Scan_state.t + * Ledger_hash.t + * Pending_coinbase.t + * Mina_state.Protocol_state.value list ) + * Staged_ledger_hash.t ) + option + module For_tests : sig open Core_kernel open Signature_lib From 6a4b0a734d6e5dae990c3a21ed8c5d752adf16cf Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 22:17:06 +0100 Subject: [PATCH 061/122] Enhance multi-key-file tests: detect a bug --- .../tests/test_multi_key_file_storage.ml | 20 ++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml b/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml index 4a2cb6fd8db8..56cd0fffe9d8 100644 --- a/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml @@ -112,9 +112,13 @@ let triple gen = let%map.Q gen3 = gen in (gen1, gen2, gen3) -let expanded_read_ops_group = +let expanded_read_ops_group ?length () = let module Q = Base_quickcheck.Generator in - let%bind.Q group = Q.list_non_empty @@ Write_and_test_later.gen in + let list_gen = + Option.value_map length ~default:Q.list_non_empty ~f:(fun length -> + Q.list_with_length ~length ) + in + let%bind.Q group = list_gen Write_and_test_later.gen in let sz = List.length group in let%map.Q expansions = Q.list_with_length ~length:sz @@ Q.int_inclusive 1 4 in let expansions_total = List.sum (module Int) ~f:ident expansions in @@ -125,10 +129,10 @@ let expanded_read_ops_group = ~f:(fun (n, op) -> List.init n ~f:(const op)) (List.zip_exn expansions read_ops) ) -let three_op_groups = +let three_op_groups ?length () = let module Q = Base_quickcheck.Generator in let%bind.Q (sz1, group1), (sz2, group2), (sz3, group3) = - triple expanded_read_ops_group + triple (expanded_read_ops_group ?length ()) in let%map.Q permutation = Q.list_permutations (List.init (sz1 + sz2 + sz3) ~f:ident) @@ -143,14 +147,14 @@ let three_op_groups = Write three files with different write operations. Read the values back (some repeatedly) in a random order. Check that the values retrieved are correct. *) -let test_property () = +let test_property ?length () = let file1 = temp_filename "file1" in let file2 = temp_filename "file2" in let file3 = temp_filename "file3" in let res = Or_error.try_with @@ fun () -> - Quickcheck.test three_op_groups ~f:(fun write_three_groups -> + Quickcheck.test (three_op_groups ?length ()) ~f:(fun write_three_groups -> let read_ops = write_values_exn file1 ~f:(fun writer1 -> write_values_exn file2 ~f:(fun writer2 -> @@ -173,6 +177,8 @@ let () = ; Alcotest.test_case "Multiple same type" `Quick test_multiple_same_type ; Alcotest.test_case "Custom filename key" `Quick test_custom_filename_key - ; Alcotest.test_case "Property test" `Quick test_property + ; Alcotest.test_case "Property test" `Quick (test_property ?length:None) + ; Alcotest.test_case "Property test (big lists)" `Quick + (test_property ~length:64000) ] ) ] From 87546ec072eef84cded87b80689c4de0ace4177d Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 25 Nov 2025 22:30:12 +0100 Subject: [PATCH 062/122] Fix a bug in multi-key file storage --- .../multi-key-file-storage/multi_key_file_storage.ml | 12 ++++++------ .../tests/test_multi_key_file_storage.ml | 5 ++++- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.ml b/src/lib/multi-key-file-storage/multi_key_file_storage.ml index ffe1ed1292a7..4705eeda9ef7 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.ml @@ -62,7 +62,8 @@ end) : Out_channel.output_string oc (Buffer.contents buffer) (* Write key function provided to the callback *) - let make_writer ~oc ~filename_key ~buffer : writer_t = + let make_writer ~init_offset ~oc ~filename_key ~buffer : writer_t = + let offset = ref init_offset in { f = (fun (type a) (module B : Bin_prot.Binable.S with type t = a) (value : a) -> @@ -77,12 +78,11 @@ end) : (* Create tag before writing *) let tag = - { Tag.filename_key - ; offset = Int64.of_int @@ Buffer.length buffer - ; size = serialized_size - } + { Tag.filename_key; offset = !offset; size = serialized_size } in + (offset := Int64.(!offset + of_int serialized_size)) ; + (* Add to buffer *) Buffer.add_string buffer data ; @@ -98,7 +98,7 @@ end) : let do_writing oc = (* Buffer for accumulating writes *) let buffer = Buffer.create buffer_size in - let writer = make_writer ~oc ~filename_key ~buffer in + let writer = make_writer ~init_offset:0L ~oc ~filename_key ~buffer in (* Call user function with write_value *) let result = f writer in diff --git a/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml b/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml index 56cd0fffe9d8..68cc4eb0553e 100644 --- a/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml @@ -154,7 +154,10 @@ let test_property ?length () = let res = Or_error.try_with @@ fun () -> - Quickcheck.test (three_op_groups ?length ()) ~f:(fun write_three_groups -> + Quickcheck.test + ?trials:(Option.map ~f:(const 1) length) + (three_op_groups ?length ()) + ~f:(fun write_three_groups -> let read_ops = write_values_exn file1 ~f:(fun writer1 -> write_values_exn file2 ~f:(fun writer2 -> From 2d7571d86c1b6810aea0f3a25478505a71688e13 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 00:21:55 +0100 Subject: [PATCH 063/122] Add append_values_exn and enhance tests --- src/lib/multi-key-file-storage/intf.mli | 26 +++- .../multi_key_file_storage.ml | 36 +++++- .../tests/test_multi_key_file_storage.ml | 120 ++++++++++++------ 3 files changed, 141 insertions(+), 41 deletions(-) diff --git a/src/lib/multi-key-file-storage/intf.mli b/src/lib/multi-key-file-storage/intf.mli index 46d088699ac6..975f34e61fb8 100644 --- a/src/lib/multi-key-file-storage/intf.mli +++ b/src/lib/multi-key-file-storage/intf.mli @@ -45,7 +45,31 @@ module type S = sig ) ]} *) - val write_values_exn : f:(writer_t -> 'a) -> filename_key -> 'a + val write_values_exn : + ?buffer_size:int -> f:(writer_t -> 'a) -> filename_key -> 'a + + (** Append multiple keys to an existing database file. + + The [filename] parameter specifies the target file. + The file must exist; values will be appended to the end of the file. + + The [f] parameter is a callback that receives a [write_value] function which can be + called multiple times to append different key-value pairs to the database. + + Each call to [write_value bin_prot_module value] serializes [value] using the + provided bin_prot serializer and returns a [tag] that can be used to read the value later. + Tags will have offsets adjusted to account for the existing file content. + + Example (assuming the default implementation with [type filename_key = string]): + {[ + append_values_exn "my.db" ~f:(fun writer -> + let tag3 = write_value writer (module Int) 99 in + (* ... store tags for later use ... *) + ) + ]} +*) + val append_values_exn : + ?buffer_size:int -> f:(writer_t -> 'a) -> filename_key -> 'a (** Read a value from the database using a tag. diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.ml b/src/lib/multi-key-file-storage/multi_key_file_storage.ml index 4705eeda9ef7..e36c64789fdf 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.ml @@ -1,7 +1,7 @@ open Core_kernel (** Buffer size for writing: 128 KB *) -let buffer_size = 131072 +let default_buffer_size = 131072 module type S = Intf.S @@ -62,7 +62,8 @@ end) : Out_channel.output_string oc (Buffer.contents buffer) (* Write key function provided to the callback *) - let make_writer ~init_offset ~oc ~filename_key ~buffer : writer_t = + let make_writer ~buffer_size ~init_offset ~oc ~filename_key ~buffer : writer_t + = let offset = ref init_offset in { f = (fun (type a) (module B : Bin_prot.Binable.S with type t = a) @@ -94,11 +95,13 @@ end) : } (** Write multiple keys to a database file with buffered I/O *) - let write_values_exn ~f filename_key = + let write_values_exn ?(buffer_size = default_buffer_size) ~f filename_key = let do_writing oc = (* Buffer for accumulating writes *) let buffer = Buffer.create buffer_size in - let writer = make_writer ~init_offset:0L ~oc ~filename_key ~buffer in + let writer = + make_writer ~buffer_size ~init_offset:0L ~oc ~filename_key ~buffer + in (* Call user function with write_value *) let result = f writer in @@ -112,6 +115,31 @@ end) : (Inputs.filename filename_key) ~binary:true ~f:do_writing + (** Append multiple keys to an existing database file with buffered I/O *) + let append_values_exn ?(buffer_size = default_buffer_size) ~f filename_key = + let filename = Inputs.filename filename_key in + let do_appending oc = + (* Get current file size to calculate offset for new writes *) + let init_offset = Out_channel.length oc in + + (* Buffer for accumulating writes *) + let buffer = Buffer.create buffer_size in + + (* Create a modified writer that accounts for the initial file offset *) + let writer = + make_writer ~buffer_size ~init_offset ~oc ~filename_key ~buffer + in + + (* Call user function with write_value *) + let result = f writer in + + (* Flush any remaining data *) + if Buffer.length buffer > 0 then flush_buffer oc buffer ; + + result + in + Out_channel.with_file filename ~binary:true ~append:true ~f:do_appending + (** Read a value from the database using a tag *) let read : type a. diff --git a/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml b/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml index 68cc4eb0553e..6adecf394d3a 100644 --- a/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/tests/test_multi_key_file_storage.ml @@ -12,6 +12,7 @@ let simplest_test (type fkey) (module M : S with type filename_key = fkey) (filename_key : fkey) = let int_value = 42 in let string_value = "hello world" in + let appended_int_value = 99 in let int_tag, string_tag = M.write_values_exn @@ -22,12 +23,24 @@ let simplest_test (type fkey) (module M : S with type filename_key = fkey) filename_key in + (* Append a third value to the file *) + let appended_int_tag = + M.append_values_exn + ~f:(fun writer -> M.write_value writer (module Int) appended_int_value) + filename_key + in + + (* Read all three values and verify *) let int_result = M.read (module Int) int_tag |> Or_error.ok_exn in let string_result = M.read (module String) string_tag |> Or_error.ok_exn in + let appended_int_result = + M.read (module Int) appended_int_tag |> Or_error.ok_exn + in - Alcotest.(check int) "Single int value round-trip" int_value int_result ; - Alcotest.(check string) - "Single string value round-trip" string_value string_result + Alcotest.(check int) "First int value round-trip" int_value int_result ; + Alcotest.(check string) "String value round-trip" string_value string_result ; + Alcotest.(check int) + "Appended int value round-trip" appended_int_value appended_int_result (* Test basic write and read with a single value *) let test_single_values () = @@ -105,13 +118,6 @@ module Write_and_test_later = struct Q.map ~f:bool Q.bool end -let triple gen = - let module Q = Base_quickcheck.Generator in - let%bind.Q gen1 = gen in - let%bind.Q gen2 = gen in - let%map.Q gen3 = gen in - (gen1, gen2, gen3) - let expanded_read_ops_group ?length () = let module Q = Base_quickcheck.Generator in let list_gen = @@ -129,47 +135,87 @@ let expanded_read_ops_group ?length () = ~f:(fun (n, op) -> List.init n ~f:(const op)) (List.zip_exn expansions read_ops) ) -let three_op_groups ?length () = +module Writer_consumer = struct + type t = + { consumers : + (writer_t -> Write_and_test_later.read_and_check_t list) + Mina_stdlib.Nonempty_list.t + ; actions_accumulator : Write_and_test_later.read_and_check_t list list + ; permutation : int list + } + + type t_ = (t, Write_and_test_later.read_and_check_t list) Either.t + + let consume writer + { consumers = prev_consumers + ; actions_accumulator = prev_accum + ; permutation + } = + let func, crest = Mina_stdlib.Nonempty_list.uncons prev_consumers in + let actions_accumulator = func writer :: prev_accum in + match Mina_stdlib.Nonempty_list.of_list_opt crest with + | Some crest -> + Either.First { consumers = crest; actions_accumulator; permutation } + | None -> + let actions = List.concat actions_accumulator |> Array.of_list in + assert (Array.length actions = List.length permutation) ; + Either.Second (List.map permutation ~f:(fun i -> actions.(i))) + + let consume_exn writer : t_ -> t_ = function + | First data -> + consume writer data + | Second _ -> + failwith "consumed all" + + let extract_result_exn : t_ -> Write_and_test_later.read_and_check_t list = + function + | Second res -> + res + | First _ -> + failwith "unconsumed" +end + +let op_groups ?length n = let module Q = Base_quickcheck.Generator in - let%bind.Q (sz1, group1), (sz2, group2), (sz3, group3) = - triple (expanded_read_ops_group ?length ()) + let%bind.Q size_and_group_lst = + Q.list_with_length ~length:n @@ expanded_read_ops_group ?length () in - let%map.Q permutation = - Q.list_permutations (List.init (sz1 + sz2 + sz3) ~f:ident) + let total_size = List.sum (module Int) ~f:fst size_and_group_lst in + let%map.Q permutation = Q.list_permutations (List.init total_size ~f:ident) in + let consumers = + List.map ~f:snd size_and_group_lst + |> Mina_stdlib.Nonempty_list.of_list_opt + |> Option.value_exn ~message:"unexpected empty list from quickcheck's gen" in - fun (writer1, writer2, writer3) -> - let read_ops = - group1 writer1 @ group2 writer2 @ group3 writer3 |> Array.of_list - in - List.map permutation ~f:(fun i -> read_ops.(i)) + { Writer_consumer.consumers; permutation; actions_accumulator = [] } (** Property test: Write three files with different write operations. Read the values back (some repeatedly) in a random order. Check that the values retrieved are correct. *) -let test_property ?length () = - let file1 = temp_filename "file1" in - let file2 = temp_filename "file2" in - let file3 = temp_filename "file3" in +let test_property ?buffer_size ?length () = + let files = List.init 3 ~f:(fun i -> temp_filename @@ sprintf "file%d" i) in + let consume_files ~f init = + List.fold files ~init ~f:(fun unconsumed file -> + f ~f:(fun writer -> Writer_consumer.consume_exn writer unconsumed) file ) + in let res = Or_error.try_with @@ fun () -> Quickcheck.test ?trials:(Option.map ~f:(const 1) length) - (three_op_groups ?length ()) - ~f:(fun write_three_groups -> + (op_groups ?length @@ (List.length files * 3)) + ~f:(fun groups -> let read_ops = - write_values_exn file1 ~f:(fun writer1 -> - write_values_exn file2 ~f:(fun writer2 -> - write_values_exn file3 ~f:(fun writer3 -> - write_three_groups (writer1, writer2, writer3) ) ) ) + consume_files (Either.First groups) ~f:(write_values_exn ?buffer_size) + |> consume_files ~f:(append_values_exn ?buffer_size) + |> consume_files ~f:(append_values_exn ?buffer_size) + |> Writer_consumer.extract_result_exn in List.iter read_ops ~f:(fun { Write_and_test_later.read_and_check } -> read_and_check () ) ) in - cleanup_file file1 ; - cleanup_file file2 ; - cleanup_file file3 ; + List.iter ~f:cleanup_file files ; Or_error.ok_exn res (* Main test suite *) @@ -180,8 +226,10 @@ let () = ; Alcotest.test_case "Multiple same type" `Quick test_multiple_same_type ; Alcotest.test_case "Custom filename key" `Quick test_custom_filename_key - ; Alcotest.test_case "Property test" `Quick (test_property ?length:None) - ; Alcotest.test_case "Property test (big lists)" `Quick - (test_property ~length:64000) + ; Alcotest.test_case "Property test" `Quick + (test_property ?buffer_size:None ?length:None) + ; Alcotest.test_case + "Property test (enough values to exceeed the buffer)" `Quick + (test_property ~buffer_size:128 ~length:128) ] ) ] From 8dc8775a9f20a3f3aa8b078543124060f12f3dbb Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 12:55:28 +0100 Subject: [PATCH 064/122] Cache staged_ledger_aux_and_.._at_hash result Cache result of the query Get_staged_ledger_aux_and_pending_coinbases_at_hash used in bootstrap. Store cache on disk with the reference kept in the breadcrumb. --- src/lib/sync_handler/sync_handler.ml | 21 ++++++- .../frontier_base/breadcrumb.ml | 50 ++++++++++++++- .../frontier_base/breadcrumb.mli | 15 +++++ .../frontier_base/network_types.ml | 61 +++++++++++++++++++ .../transition_frontier.ml | 18 ++---- .../transition_frontier.mli | 6 +- 6 files changed, 151 insertions(+), 20 deletions(-) create mode 100644 src/lib/transition_frontier/frontier_base/network_types.ml diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 1519575003da..221be46bbc83 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -115,7 +115,14 @@ module Make (Inputs : Inputs_intf) : Sync_ledger.Any_ledger.Responder.answer_query responder query let get_staged_ledger_aux_and_pending_coinbases_at_hash ~logger ~frontier - state_hash = + state_hash : + Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest + .t + option = match Transition_frontier.staged_ledger_aux_and_pending_coinbases_at_hash frontier state_hash @@ -127,9 +134,17 @@ module Make (Inputs : Inputs_intf) : , Staged_ledger_hash.to_yojson staged_ledger_hash ) ; ("state_hash", State_hash.to_yojson state_hash) ] - "sending scan state and pending coinbase" ; + "sending scan state and pending coinbase generated from frontier" ; (* TODO: CAUTION we don't convert the scan state to serialized format *) - Some res + (* TODO: don't deserialize it here, return a tag *) + Option.some @@ Or_error.ok_exn + @@ State_hash.File_storage.read + ( module Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest ) + res | None -> let open Root_data.Historical in let%bind.Option root = find_in_root_history frontier state_hash in diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 7c89dd889d20..e2c80047f4bc 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -16,6 +16,10 @@ module T = struct ; staged_ledger_hash : Staged_ledger_hash.t ; accounts_created : Account_id.t list ; block_tag : Mina_block.Stable.Latest.t State_hash.File_storage.tag + ; mutable staged_ledger_aux_and_pending_coinbases_at_hash_cached : + Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag + option } [@@deriving fields] @@ -55,6 +59,7 @@ module T = struct ; staged_ledger_hash ; accounts_created ; block_tag + ; staged_ledger_aux_and_pending_coinbases_at_hash_cached = None } let to_yojson @@ -65,6 +70,7 @@ module T = struct ; staged_ledger_hash = _ ; accounts_created = _ ; block_tag = _ + ; staged_ledger_aux_and_pending_coinbases_at_hash_cached = _ } = `Assoc [ ( "validated_transition" @@ -87,7 +93,8 @@ T. , to_yojson , staged_ledger_hash , accounts_created - , block_tag )] + , block_tag + , staged_ledger_aux_and_pending_coinbases_at_hash_cached )] let command_hashes t = T.validated_transition t |> Mina_block.Validated.body @@ -313,6 +320,47 @@ let display t = ; parent } +let staged_ledger_aux_and_pending_coinbases_at_hash_compute + ~scan_state_protocol_states breadcrumb = + let staged_ledger = staged_ledger breadcrumb in + let scan_state = Staged_ledger.scan_state staged_ledger in + let%map.Option protocol_states = scan_state_protocol_states scan_state in + let staged_ledger_hash = staged_ledger_hash breadcrumb in + let merkle_root = Staged_ledger_hash.ledger_hash staged_ledger_hash in + let pending_coinbase = + Staged_ledger.pending_coinbase_collection staged_ledger + in + let module Data = + Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest + in + (* Cache in frontier and return tag *) + State_hash.File_storage.append_values_exn (state_hash breadcrumb) + ~f:(fun writer -> + State_hash.File_storage.write_value writer + (module Data) + (scan_state, merkle_root, pending_coinbase, protocol_states) ) + +let staged_ledger_aux_and_pending_coinbases_at_hash ~scan_state_protocol_states + breadcrumb : + Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag + option = + match staged_ledger_aux_and_pending_coinbases_at_hash_cached breadcrumb with + | Some res -> + Some res + | None -> + let res = + staged_ledger_aux_and_pending_coinbases_at_hash_compute + ~scan_state_protocol_states breadcrumb + in + Option.iter res ~f:(fun tag -> + breadcrumb.staged_ledger_aux_and_pending_coinbases_at_hash_cached <- + Some tag ) ; + res + module For_tests = struct open Currency open Signature_lib diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index 268b36c87fdc..cda25d283653 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -104,6 +104,21 @@ val staged_ledger_hash : t -> Staged_ledger_hash.t For convenience of implementation, it's by definition an empty list for the root *) val accounts_created : t -> Account_id.t list +val staged_ledger_aux_and_pending_coinbases_at_hash_cached : + t + -> Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag + option + +val staged_ledger_aux_and_pending_coinbases_at_hash : + scan_state_protocol_states: + ( Staged_ledger.Scan_state.t + -> Mina_state.Protocol_state.Value.t list option ) + -> t + -> Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag + option + module For_tests : sig val gen : ?logger:Logger.t diff --git a/src/lib/transition_frontier/frontier_base/network_types.ml b/src/lib/transition_frontier/frontier_base/network_types.ml new file mode 100644 index 000000000000..e39b205f6041 --- /dev/null +++ b/src/lib/transition_frontier/frontier_base/network_types.ml @@ -0,0 +1,61 @@ +open Core_kernel +open Mina_base + +module Get_staged_ledger_aux_and_pending_coinbases_at_hash_result = struct + module Data = struct + [%%versioned + module Stable = struct + [@@@no_toplevel_latest_type] + + module V1 = struct + type t = + (* TODO replace with V2 to fix the incorrect serialization issue *) + Staged_ledger.Scan_state.Stable.V3.t + * Ledger_hash.Stable.V1.t + * Pending_coinbase.Stable.V2.t + * Mina_state.Protocol_state.Value.Stable.V2.t list + + let to_latest = Fn.id + end + end] + end + + type data_tag = Data.Stable.Latest.t State_hash.File_storage.tag + + [%%versioned_binable + module Stable = struct + module V1 = struct + module T = struct + type t = + | Tag of Data.Stable.Latest.t State_hash.File_storage.tag + | Data of Data.Stable.Latest.t + + let to_latest = Fn.id + end + + include T + + include + Binable.Of_binable_without_uuid + (Data.Stable.V1) + (struct + type t = T.t + + let to_binable = function + | Tag x -> + (* TODO This code deserializes the data stored in the file + and serializes it back. This is a bad thing to do. + But in future we will have a special communication + protocol between libp2p helper and daemon to push file reading + to the helper, and then we won't have deserialization anymore. + *) + State_hash.File_storage.read (module Data.Stable.Latest) x + |> Or_error.ok_exn + | Data x -> + x + + let of_binable x = Data x + end) + end + end] +end diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index c3a205c70aa2..f73fb6f775e0 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -578,19 +578,13 @@ let protocol_states_of_scan_state ~frontier scan_state = let staged_ledger_aux_and_pending_coinbases_at_hash frontier state_hash = let%bind.Option breadcrumb = find frontier state_hash in - let staged_ledger = Breadcrumb.staged_ledger breadcrumb in - let scan_state = Staged_ledger.scan_state staged_ledger in - let staged_ledger_hash = Breadcrumb.staged_ledger_hash breadcrumb in - let merkle_root = Staged_ledger_hash.ledger_hash staged_ledger_hash in - let%map.Option scan_state_protocol_states = - protocol_states_of_scan_state ~frontier scan_state - in - let pending_coinbase = - Staged_ledger.pending_coinbase_collection staged_ledger + let scan_state_protocol_states = protocol_states_of_scan_state ~frontier in + let%map.Option res = + Breadcrumb.staged_ledger_aux_and_pending_coinbases_at_hash + ~scan_state_protocol_states breadcrumb in - (* Cache in frontier and return tag *) - ( (scan_state, merkle_root, pending_coinbase, scan_state_protocol_states) - , staged_ledger_hash ) + let staged_ledger_hash = Breadcrumb.staged_ledger_hash breadcrumb in + (res, staged_ledger_hash) module For_tests = struct open Signature_lib diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 6265465e5aa4..745befa70ecf 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -121,10 +121,8 @@ val validated_blocks : val staged_ledger_aux_and_pending_coinbases_at_hash : t -> State_hash.t - -> ( ( Staged_ledger.Scan_state.t - * Ledger_hash.t - * Pending_coinbase.t - * Mina_state.Protocol_state.value list ) + -> ( Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag * Staged_ledger_hash.t ) option From b871c24d2f40f3e441cb0c0fb4e065539887d9d1 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 15:16:13 +0100 Subject: [PATCH 065/122] Move bootstrap's query impl to Root_history --- src/lib/sync_handler/sync_handler.ml | 20 +++++-------------- .../extensions/root_history.ml | 18 +++++++++++++++++ .../extensions/root_history.mli | 12 +++++++++-- 3 files changed, 33 insertions(+), 17 deletions(-) diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 221be46bbc83..7dee57457b7f 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -43,13 +43,6 @@ module Make (Inputs : Inputs_intf) : in Root_history.lookup root_history state_hash - let protocol_states_in_root_history frontier state_hash = - let open Transition_frontier.Extensions in - let root_history = - get_extension (Transition_frontier.extensions frontier) Root_history - in - Root_history.protocol_states_for_scan_state root_history state_hash - let get_ledger_by_hash ~frontier ledger_hash = let root_ledger = Root_ledger.as_unmasked @@ -146,15 +139,12 @@ module Make (Inputs : Inputs_intf) : .Latest ) res | None -> - let open Root_data.Historical in - let%bind.Option root = find_in_root_history frontier state_hash in - let%map.Option scan_state_protocol_states = - protocol_states_in_root_history frontier state_hash + let open Transition_frontier.Extensions in + let root_history = + get_extension (Transition_frontier.extensions frontier) Root_history in - ( scan_state root - , staged_ledger_target_ledger_hash root - , pending_coinbase root - , scan_state_protocol_states ) + Root_history.get_staged_ledger_aux_and_pending_coinbases_at_hash + root_history state_hash let get_transition_chain ~frontier hashes = let open Option.Let_syntax in diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index 033fb4f2baf3..7a596b7f9115 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -136,3 +136,21 @@ let oldest { history; _ } = Queue.first history let is_empty { history; _ } = Queue.is_empty history let to_list { history; _ } = Queue.to_list history + +let get_staged_ledger_aux_and_pending_coinbases_at_hash t state_hash : + Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest + .t + option = + let%bind.Option root = lookup t state_hash in + let%map.Option scan_state_protocol_states = + protocol_states_for_scan_state t state_hash + in + Root_data.Historical. + ( scan_state root + , staged_ledger_target_ledger_hash root + , pending_coinbase root + , scan_state_protocol_states ) diff --git a/src/lib/transition_frontier/extensions/root_history.mli b/src/lib/transition_frontier/extensions/root_history.mli index 46459f015f47..ee7d1e63d58f 100644 --- a/src/lib/transition_frontier/extensions/root_history.mli +++ b/src/lib/transition_frontier/extensions/root_history.mli @@ -22,5 +22,13 @@ val oldest : t -> Root_data.Historical.t option val to_list : t -> Root_data.Historical.t list -val protocol_states_for_scan_state : - t -> State_hash.t -> Mina_state.Protocol_state.value list option +val get_staged_ledger_aux_and_pending_coinbases_at_hash : + t + -> State_hash.t + -> Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest + .t + option From f2a37877d433a7bd6c40f0011e12b3d7aae04003 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 15:44:19 +0100 Subject: [PATCH 066/122] Refactor protocol_states_for_scan_state --- .../extensions/root_history.ml | 46 +++++++++++-------- 1 file changed, 27 insertions(+), 19 deletions(-) diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index 7a596b7f9115..c2354569b8fa 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -92,33 +92,41 @@ let lookup { history; _ } = Queue.lookup history let mem { history; _ } = Queue.mem history +(** Looks up values by key using the lookup function and returns + obtained values in reverse order or None if any of the lookups fail *) +let lookup_all_reversed ~lookup = + List.fold_until ~init:[] ~finish:Option.some ~f:(fun acc key -> + match lookup key with + | Some value -> + Continue (value :: acc) + | None -> + Stop None ) + let protocol_states_for_scan_state t state_hash = let history = t.history in - let protocol_states_for_root_scan_state = - t.protocol_states_for_root_scan_state + let lookup_in_scan_states hash = + let%map.Option state_with_hash = + State_hash.Map.find t.protocol_states_for_root_scan_state hash + in + With_hash.data state_with_hash + in + let lookup_in_root_history hash = + Option.map ~f:Root_data.Historical.protocol_state + (Queue.lookup t.history hash) + in + let lookup hash = + match lookup_in_root_history hash with + | Some value -> + Some value + | None -> + lookup_in_scan_states hash in let open Option.Let_syntax in let%bind data = Queue.lookup history state_hash in let required_state_hashes = Root_data.Historical.required_state_hashes data |> State_hash.Set.to_list in - List.fold_until ~init:[] - ~finish:(fun lst -> Some lst) - required_state_hashes - ~f:(fun acc hash -> - let res = - match Queue.lookup history hash with - | Some data -> - Some (Root_data.Historical.protocol_state data) - | None -> - (*Not present in the history queue, check in the protocol states map that has all the protocol states required for transactions in the root*) - let%map.Option state_with_hash = - State_hash.Map.find protocol_states_for_root_scan_state hash - in - With_hash.data state_with_hash - in - match res with None -> Stop None | Some state -> Continue (state :: acc) - ) + lookup_all_reversed ~lookup required_state_hashes let most_recent { history; _ } = (* unfortunately, there is not function to inspect the last element in the queue, From 5f144a7a426f01230e24cc2602762b78df6d985d Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 15:49:03 +0100 Subject: [PATCH 067/122] Replace Root_data.Historical.{of_breadcrumb -> create} --- .../extensions/root_history.ml | 20 ++++++++++++++----- .../frontier_base/root_data.ml | 12 ++--------- .../frontier_base/root_data.mli | 7 ++++++- 3 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index c2354569b8fa..c918f927175c 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -3,6 +3,19 @@ open Mina_base open Frontier_base module Queue = Hash_queue.Make (State_hash) +let historical_of_breadcrumb breadcrumb = + let transition = Breadcrumb.validated_transition breadcrumb in + let staged_ledger = Breadcrumb.staged_ledger breadcrumb in + let scan_state = Staged_ledger.scan_state staged_ledger in + let pending_coinbase = + Staged_ledger.pending_coinbase_collection staged_ledger + in + let staged_ledger_target_ledger_hash = + Breadcrumb.staged_ledger_hash breadcrumb |> Staged_ledger_hash.ledger_hash + in + Root_data.Historical.create ~transition ~scan_state ~pending_coinbase + ~staged_ledger_target_ledger_hash + module T = struct type t = { history : Root_data.Historical.t Queue.t @@ -19,9 +32,7 @@ module T = struct let create ~logger:_ frontier = let capacity = 2 * Full_frontier.max_length frontier in let history = Queue.create () in - let current_root = - Root_data.Historical.of_breadcrumb (Full_frontier.root frontier) - in + let current_root = historical_of_breadcrumb (Full_frontier.root frontier) in let t = { history ; capacity @@ -72,8 +83,7 @@ module T = struct in match Full_frontier.find frontier state_hash with | Some breadcrumb -> - enqueue root_history - (Root_data.Historical.of_breadcrumb breadcrumb) ; + enqueue root_history (historical_of_breadcrumb breadcrumb) ; true | None -> failwithf "root_history: new root %s not found in frontier" diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index c678b40f8b75..0fda694704f5 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -62,16 +62,8 @@ module Historical = struct let required_state_hashes t = Staged_ledger.Scan_state.required_state_hashes t.common.scan_state - let of_breadcrumb breadcrumb = - let transition = Breadcrumb.validated_transition breadcrumb in - let staged_ledger = Breadcrumb.staged_ledger breadcrumb in - let scan_state = Staged_ledger.scan_state staged_ledger in - let pending_coinbase = - Staged_ledger.pending_coinbase_collection staged_ledger - in - let staged_ledger_target_ledger_hash = - Breadcrumb.staged_ledger_hash breadcrumb |> Staged_ledger_hash.ledger_hash - in + let create ~transition ~scan_state ~pending_coinbase + ~staged_ledger_target_ledger_hash = let common = Common.create ~scan_state ~pending_coinbase in { transition; common; staged_ledger_target_ledger_hash } end diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 3265840c0977..3cc84ed6994b 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -34,7 +34,12 @@ module Historical : sig val required_state_hashes : t -> State_hash.Set.t - val of_breadcrumb : Breadcrumb.t -> t + val create : + transition:Mina_block.Validated.t + -> scan_state:Staged_ledger.Scan_state.t + -> pending_coinbase:Pending_coinbase.t + -> staged_ledger_target_ledger_hash:Ledger_hash.t + -> t end (* Limited root data is similar to Minimal root data, except that it contains From 00bee2269b545539ed9c4ad363266dca77dddc45 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 17:29:46 +0100 Subject: [PATCH 068/122] Don't store scan state in historical root data --- src/lib/sync_handler/sync_handler.ml | 15 +- .../extensions/root_history.ml | 250 ++++++++++-------- .../extensions/root_history.mli | 11 - .../frontier_base/root_data.ml | 28 +- .../frontier_base/root_data.mli | 19 +- .../full_frontier/full_frontier.ml | 14 +- .../full_frontier/full_frontier.mli | 2 +- 7 files changed, 189 insertions(+), 150 deletions(-) diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 7dee57457b7f..6e59a26b69eb 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -143,8 +143,19 @@ module Make (Inputs : Inputs_intf) : let root_history = get_extension (Transition_frontier.extensions frontier) Root_history in - Root_history.get_staged_ledger_aux_and_pending_coinbases_at_hash - root_history state_hash + let%map.Option historical = + Root_history.lookup root_history state_hash + in + (* TODO: don't deserialize it here, return a tag *) + Or_error.ok_exn + @@ State_hash.File_storage.read + ( module Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest ) + @@ Root_data.Historical.staged_ledger_aux_and_pending_coinbases + historical let get_transition_chain ~frontier hashes = let open Option.Let_syntax in diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index c918f927175c..8ce3e9571839 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -3,28 +3,125 @@ open Mina_base open Frontier_base module Queue = Hash_queue.Make (State_hash) -let historical_of_breadcrumb breadcrumb = - let transition = Breadcrumb.validated_transition breadcrumb in +type t = + { history : Root_data.Historical.t Queue.t + ; capacity : int + ; mutable current_root : Root_data.Historical.t + ; mutable protocol_states_for_root_scan_state : + Full_frontier.Protocol_states_for_root_scan_state.t + } + +let lookup { history; _ } = Queue.lookup history + +let mem { history; _ } = Queue.mem history + +(** Looks up values by key using the lookup function and returns + obtained values in reverse order or None if any of the lookups fail *) +let lookup_all_reversed ~lookup = + List.fold_until ~init:[] ~finish:Option.some ~f:(fun acc key -> + match lookup key with + | Some value -> + Continue (value :: acc) + | None -> + Stop None ) + +let protocol_states_for_scan_state ~protocol_states_for_root_scan_state ~history + required_state_hashes = + let lookup_in_scan_states hash = + let%map.Option state_with_hash = + State_hash.Map.find protocol_states_for_root_scan_state hash + in + With_hash.data state_with_hash + in + let lookup_in_root_history hash = + Option.map ~f:Root_data.Historical.protocol_state + (Queue.lookup history hash) + in + let lookup hash = + match lookup_in_root_history hash with + | Some value -> + Some value + | None -> + lookup_in_scan_states hash + in + lookup_all_reversed ~lookup required_state_hashes + +let most_recent { history; _ } = + (* unfortunately, there is not function to inspect the last element in the queue, + * so we need to remove it and reinsert it instead *) + let open Option.Let_syntax in + let%map state_hash, breadcrumb = Queue.dequeue_back_with_key history in + (* should never return `Key_already_present since we just removed it *) + assert ( + [%equal: [ `Ok | `Key_already_present ]] `Ok + (Queue.enqueue_back history state_hash breadcrumb) ) ; + breadcrumb + +let oldest { history; _ } = Queue.first history + +let is_empty { history; _ } = Queue.is_empty history + +let to_list { history; _ } = Queue.to_list history + +let staged_ledger_aux_and_pending_coinbases_of_breadcrumb + ~protocol_states_for_root_scan_state ~history breadcrumb = let staged_ledger = Breadcrumb.staged_ledger breadcrumb in let scan_state = Staged_ledger.scan_state staged_ledger in + let required_state_hashes = + Staged_ledger.Scan_state.required_state_hashes scan_state + |> State_hash.Set.to_list + in + let%map.Option scan_state_protocol_states = + protocol_states_for_scan_state ~protocol_states_for_root_scan_state ~history + required_state_hashes + in let pending_coinbase = Staged_ledger.pending_coinbase_collection staged_ledger in let staged_ledger_target_ledger_hash = Breadcrumb.staged_ledger_hash breadcrumb |> Staged_ledger_hash.ledger_hash in - Root_data.Historical.create ~transition ~scan_state ~pending_coinbase - ~staged_ledger_target_ledger_hash + let data = + ( scan_state + , staged_ledger_target_ledger_hash + , pending_coinbase + , scan_state_protocol_states ) + in + let module Data = + Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest + in + (* Cache in frontier and return tag *) + State_hash.File_storage.append_values_exn (Breadcrumb.state_hash breadcrumb) + ~f:(fun writer -> + State_hash.File_storage.write_value writer (module Data) data ) + +let historical_of_breadcrumb ~protocol_states_for_root_scan_state ~history + breadcrumb = + let cached_opt = + Breadcrumb.staged_ledger_aux_and_pending_coinbases_at_hash_cached breadcrumb + in + let transition = Breadcrumb.validated_transition breadcrumb in + let%map.Option staged_ledger_aux_and_pending_coinbases = + match cached_opt with + | Some value -> + Some value + | None -> + staged_ledger_aux_and_pending_coinbases_of_breadcrumb + ~protocol_states_for_root_scan_state ~history breadcrumb + in + let scan_state = + Staged_ledger.scan_state (Breadcrumb.staged_ledger breadcrumb) + in + let required_state_hashes = + Staged_ledger.Scan_state.required_state_hashes scan_state + in + Root_data.Historical.create ~transition + ~staged_ledger_aux_and_pending_coinbases ~required_state_hashes module T = struct - type t = - { history : Root_data.Historical.t Queue.t - ; capacity : int - ; mutable current_root : Root_data.Historical.t - ; mutable protocol_states_for_root_scan_state : - Full_frontier.Protocol_states_for_root_scan_state.t - } - type view = t let name = "root_registry" @@ -32,14 +129,17 @@ module T = struct let create ~logger:_ frontier = let capacity = 2 * Full_frontier.max_length frontier in let history = Queue.create () in - let current_root = historical_of_breadcrumb (Full_frontier.root frontier) in + let protocol_states_for_root_scan_state = + Full_frontier.protocol_states_for_root_scan_state frontier + in + let current_root = + historical_of_breadcrumb ~protocol_states_for_root_scan_state ~history + (Full_frontier.root frontier) + |> Option.value_exn + ~message:"root_history: can't compute historical for root" + in let t = - { history - ; capacity - ; current_root - ; protocol_states_for_root_scan_state = - Full_frontier.protocol_states_for_root_scan_state frontier - } + { history; capacity; current_root; protocol_states_for_root_scan_state } in (t, t) @@ -55,7 +155,9 @@ module T = struct Full_frontier.Protocol_states_for_root_scan_state .protocol_states_for_next_root_scan_state t.protocol_states_for_root_scan_state - ~new_scan_state:(Root_data.Historical.scan_state new_oldest_root) + ~next_root_required_hashes: + ( Root_data.Historical.required_state_hashes new_oldest_root + |> State_hash.Set.to_list ) ~old_root_state: ( transition oldest_root |> Mina_block.Validated.forget |> With_hash.map ~f:(fun block -> @@ -77,18 +179,30 @@ module T = struct let should_produce_view = List.exists diffs_with_mutants ~f:(function (* TODO: send full diffs to extensions to avoid extra lookups in frontier *) - | E (Root_transitioned { new_root; _ }, _) -> ( + | E (Root_transitioned { new_root; _ }, _) -> let state_hash = (Root_data.Limited.Stable.Latest.hashes new_root).state_hash in - match Full_frontier.find frontier state_hash with - | Some breadcrumb -> - enqueue root_history (historical_of_breadcrumb breadcrumb) ; - true - | None -> - failwithf "root_history: new root %s not found in frontier" - (State_hash.to_base58_check state_hash) - () ) + let breadcrumb = + Full_frontier.find frontier state_hash + |> Option.value_exn + ~message: + (sprintf "root_history: new root %s not found in frontier" + (State_hash.to_base58_check state_hash) ) + in + let historical = + historical_of_breadcrumb + ~protocol_states_for_root_scan_state: + root_history.protocol_states_for_root_scan_state + ~history:root_history.history breadcrumb + |> Option.value_exn + ~message: + (sprintf + "root_history: can't compute historical for new root %s" + (State_hash.to_base58_check state_hash) ) + in + enqueue root_history historical ; + true | E _ -> false ) in @@ -96,79 +210,9 @@ module T = struct end include T -module Broadcasted = Functor.Make_broadcasted (T) -let lookup { history; _ } = Queue.lookup history - -let mem { history; _ } = Queue.mem history +module Broadcasted = Functor.Make_broadcasted (struct + type nonrec t = t -(** Looks up values by key using the lookup function and returns - obtained values in reverse order or None if any of the lookups fail *) -let lookup_all_reversed ~lookup = - List.fold_until ~init:[] ~finish:Option.some ~f:(fun acc key -> - match lookup key with - | Some value -> - Continue (value :: acc) - | None -> - Stop None ) - -let protocol_states_for_scan_state t state_hash = - let history = t.history in - let lookup_in_scan_states hash = - let%map.Option state_with_hash = - State_hash.Map.find t.protocol_states_for_root_scan_state hash - in - With_hash.data state_with_hash - in - let lookup_in_root_history hash = - Option.map ~f:Root_data.Historical.protocol_state - (Queue.lookup t.history hash) - in - let lookup hash = - match lookup_in_root_history hash with - | Some value -> - Some value - | None -> - lookup_in_scan_states hash - in - let open Option.Let_syntax in - let%bind data = Queue.lookup history state_hash in - let required_state_hashes = - Root_data.Historical.required_state_hashes data |> State_hash.Set.to_list - in - lookup_all_reversed ~lookup required_state_hashes - -let most_recent { history; _ } = - (* unfortunately, there is not function to inspect the last element in the queue, - * so we need to remove it and reinsert it instead *) - let open Option.Let_syntax in - let%map state_hash, breadcrumb = Queue.dequeue_back_with_key history in - (* should never return `Key_already_present since we just removed it *) - assert ( - [%equal: [ `Ok | `Key_already_present ]] `Ok - (Queue.enqueue_back history state_hash breadcrumb) ) ; - breadcrumb - -let oldest { history; _ } = Queue.first history - -let is_empty { history; _ } = Queue.is_empty history - -let to_list { history; _ } = Queue.to_list history - -let get_staged_ledger_aux_and_pending_coinbases_at_hash t state_hash : - Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Data - .Stable - .Latest - .t - option = - let%bind.Option root = lookup t state_hash in - let%map.Option scan_state_protocol_states = - protocol_states_for_scan_state t state_hash - in - Root_data.Historical. - ( scan_state root - , staged_ledger_target_ledger_hash root - , pending_coinbase root - , scan_state_protocol_states ) + include T +end) diff --git a/src/lib/transition_frontier/extensions/root_history.mli b/src/lib/transition_frontier/extensions/root_history.mli index ee7d1e63d58f..1fb3397b398c 100644 --- a/src/lib/transition_frontier/extensions/root_history.mli +++ b/src/lib/transition_frontier/extensions/root_history.mli @@ -21,14 +21,3 @@ val most_recent : t -> Root_data.Historical.t option val oldest : t -> Root_data.Historical.t option val to_list : t -> Root_data.Historical.t list - -val get_staged_ledger_aux_and_pending_coinbases_at_hash : - t - -> State_hash.t - -> Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Data - .Stable - .Latest - .t - option diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 0fda694704f5..1be092bdae82 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -44,28 +44,22 @@ end module Historical = struct type t = { transition : Mina_block.Validated.t - ; common : Common.t - ; staged_ledger_target_ledger_hash : Ledger_hash.t + ; staged_ledger_aux_and_pending_coinbases : + Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag + ; required_state_hashes : State_hash.Set.t } - - let transition t = t.transition - - let staged_ledger_target_ledger_hash t = t.staged_ledger_target_ledger_hash - - let scan_state t = Common.scan_state t.common - - let pending_coinbase t = Common.pending_coinbase t.common + [@@deriving fields] let protocol_state t = Mina_block.Validated.header t.transition |> Mina_block.Header.protocol_state - let required_state_hashes t = - Staged_ledger.Scan_state.required_state_hashes t.common.scan_state - - let create ~transition ~scan_state ~pending_coinbase - ~staged_ledger_target_ledger_hash = - let common = Common.create ~scan_state ~pending_coinbase in - { transition; common; staged_ledger_target_ledger_hash } + let create ~transition ~staged_ledger_aux_and_pending_coinbases + ~required_state_hashes = + { transition + ; staged_ledger_aux_and_pending_coinbases + ; required_state_hashes + } end module Limited = struct diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 3cc84ed6994b..4728c9505dd6 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -24,21 +24,22 @@ module Historical : sig val transition : t -> Mina_block.Validated.t - val scan_state : t -> Staged_ledger.Scan_state.t - - val pending_coinbase : t -> Pending_coinbase.t + val staged_ledger_aux_and_pending_coinbases : + t + -> Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag - val staged_ledger_target_ledger_hash : t -> Ledger_hash.t + val required_state_hashes : t -> State_hash.Set.t val protocol_state : t -> Mina_state.Protocol_state.Value.t - val required_state_hashes : t -> State_hash.Set.t - val create : transition:Mina_block.Validated.t - -> scan_state:Staged_ledger.Scan_state.t - -> pending_coinbase:Pending_coinbase.t - -> staged_ledger_target_ledger_hash:Ledger_hash.t + -> staged_ledger_aux_and_pending_coinbases: + Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .data_tag + -> required_state_hashes:State_hash.Set.t -> t end diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 57c0ee6aa021..5d3c1e23db7b 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -50,12 +50,8 @@ module Protocol_states_for_root_scan_state = struct type t = Protocol_state.value State_hash.With_state_hashes.t State_hash.Map.t let protocol_states_for_next_root_scan_state protocol_states_for_old_root - ~new_scan_state + ~next_root_required_hashes ~(old_root_state : Protocol_state.value State_hash.With_state_hashes.t) = - let required_state_hashes = - Staged_ledger.Scan_state.required_state_hashes new_scan_state - |> State_hash.Set.to_list - in let protocol_state_map = (*Note: Protocol states for the next root should all be in this map assuming roots transition to their successors and do not skip any node in @@ -64,7 +60,7 @@ module Protocol_states_for_root_scan_state = struct ~key:(State_hash.With_state_hashes.state_hash old_root_state) ~data:old_root_state in - List.map required_state_hashes + List.map next_root_required_hashes ~f:(State_hash.Map.find_exn protocol_state_map) end @@ -346,10 +342,14 @@ module Util = struct { transition; scan_state } ) in let new_scan_state = Staged_ledger.scan_state heir_staged_ledger in + let next_root_required_hashes = + Staged_ledger.Scan_state.required_state_hashes new_scan_state + |> State_hash.Set.to_list + in let protocol_states = Protocol_states_for_root_scan_state .protocol_states_for_next_root_scan_state - protocol_states_for_root_scan_state ~new_scan_state + protocol_states_for_root_scan_state ~next_root_required_hashes ~old_root_state:(Breadcrumb.protocol_state_with_hashes parent) in let heir_transition = diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index f011a7971237..0e6435557afc 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -29,7 +29,7 @@ module Protocol_states_for_root_scan_state : sig val protocol_states_for_next_root_scan_state : t - -> new_scan_state:Staged_ledger.Scan_state.t + -> next_root_required_hashes:State_hash.t list -> old_root_state:Protocol_state.value State_hash.With_state_hashes.t -> Protocol_state.value State_hash.With_state_hashes.t list end From 50b1ff685ea04ddb88444873531c0f4d1f9e5f2e Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 17:50:54 +0100 Subject: [PATCH 069/122] Small refactoring of boostrap controller --- .../bootstrap_controller.ml | 248 +++++++++--------- 1 file changed, 123 insertions(+), 125 deletions(-) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 96826376aca3..e745ca9685af 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -279,6 +279,121 @@ let download_snarked_ledger ~trust_system ~preferred_peers ~transition_graph Sync_ledger.Root.destroy root_sync_ledger ; data ) +let handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash + ~temp_snarked_ledger ~verifier ~constraint_constants ~signature_kind t + (scan_state, expected_merkle_root, pending_coinbases, protocol_states) = + let%map staged_ledger_construction_result = + O1trace.thread "construct_root_staged_ledger" (fun () -> + let open Deferred.Or_error.Let_syntax in + let received_staged_ledger_hash = + Staged_ledger_hash.of_aux_ledger_and_coinbase_hash + (Staged_ledger.Scan_state.Stable.Latest.hash scan_state) + expected_merkle_root pending_coinbases + in + [%log debug] + ~metadata: + [ ( "expected_staged_ledger_hash" + , Staged_ledger_hash.to_yojson expected_staged_ledger_hash ) + ; ( "received_staged_ledger_hash" + , Staged_ledger_hash.to_yojson received_staged_ledger_hash ) + ] + "Comparing $expected_staged_ledger_hash to \ + $received_staged_ledger_hash" ; + let%bind new_root = + t.current_root + |> Mina_block.Validation.skip_frontier_dependencies_validation + `This_block_belongs_to_a_detached_subtree + |> Mina_block.Validation.validate_staged_ledger_hash + (`Staged_ledger_already_materialized received_staged_ledger_hash) + |> Result.map_error ~f:(fun _ -> + Error.of_string "received faulty scan state from peer" ) + |> Deferred.return + in + let protocol_states = + List.map protocol_states + ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) + in + let%bind protocol_states = + Staged_ledger.Scan_state.check_required_protocol_states scan_state + ~protocol_states + |> Deferred.return + in + let protocol_states_map = + protocol_states + |> List.map ~f:(fun ps -> + (State_hash.With_state_hashes.state_hash ps, ps) ) + |> State_hash.Map.of_alist_exn + in + let get_state hash = + match Map.find protocol_states_map hash with + | None -> + let new_state_hash = + State_hash.With_state_hashes.state_hash (fst new_root) + in + [%log error] + ~metadata: + [ ("new_root", State_hash.to_yojson new_state_hash) + ; ("state_hash", State_hash.to_yojson hash) + ] + "Protocol state (for scan state transactions) for $state_hash \ + not found when bootstrapping to the new root $new_root" ; + Or_error.errorf + !"Protocol state (for scan state transactions) for \ + %{sexp:State_hash.t} not found when bootstrapping to the new \ + root %{sexp:State_hash.t}" + hash new_state_hash + | Some protocol_state -> + Ok (With_hash.data protocol_state) + in + (* step 3. Construct staged ledger from snarked ledger, scan state + and pending coinbases. *) + (* Construct the staged ledger before constructing the transition + * frontier in order to verify the scan state we received. + * TODO: reorganize the code to avoid doing this twice (#3480) *) + let open Deferred.Let_syntax in + let%map staged_ledger_construction_time, construction_result = + 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 + ~snarked_local_state: + Mina_block.( + t.current_root |> Validation.block |> header + |> Header.protocol_state |> Protocol_state.blockchain_state + |> Blockchain_state.snarked_local_state) + ~verifier ~constraint_constants ~scan_state + ~snarked_ledger:temp_mask ~expected_merkle_root + ~pending_coinbases ~get_state ~signature_kind + in + ignore + ( Ledger.Maskable.unregister_mask_exn ~loc:__LOC__ temp_mask + : Ledger.unattached_mask ) ; + Result.map result + ~f: + (const + (scan_state, pending_coinbases, new_root, protocol_states) )) + in + Ok (staged_ledger_construction_time, construction_result) ) + in + match staged_ledger_construction_result with + | Error err -> + (None, Error err) + | Ok (staged_ledger_construction_time, result) -> + (Some staged_ledger_construction_time, result) + (** Run one bootstrap cycle *) let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network ~consensus_local_state ~network_transition_pipe ~preferred_peers @@ -332,8 +447,7 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier (Float.of_int t.num_of_root_snarked_ledger_retargeted)) ; (* step 2. Download scan state and pending coinbases. *) let%bind ( staged_ledger_data_download_time - , staged_ledger_construction_time - , staged_ledger_aux_result ) = + , (staged_ledger_construction_time, staged_ledger_aux_result) ) = let%bind ( staged_ledger_data_download_time , staged_ledger_data_download_result ) = time_deferred @@ -342,130 +456,14 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier in match staged_ledger_data_download_result with | Error err -> - Deferred.return (staged_ledger_data_download_time, None, Error err) - | Ok (scan_state, expected_merkle_root, pending_coinbases, protocol_states) - -> ( - let%map staged_ledger_construction_result = - O1trace.thread "construct_root_staged_ledger" (fun () -> - let open Deferred.Or_error.Let_syntax in - let received_staged_ledger_hash = - Staged_ledger_hash.of_aux_ledger_and_coinbase_hash - (Staged_ledger.Scan_state.Stable.Latest.hash scan_state) - expected_merkle_root pending_coinbases - in - [%log debug] - ~metadata: - [ ( "expected_staged_ledger_hash" - , Staged_ledger_hash.to_yojson expected_staged_ledger_hash - ) - ; ( "received_staged_ledger_hash" - , Staged_ledger_hash.to_yojson received_staged_ledger_hash - ) - ] - "Comparing $expected_staged_ledger_hash to \ - $received_staged_ledger_hash" ; - let%bind new_root = - t.current_root - |> Mina_block.Validation.skip_frontier_dependencies_validation - `This_block_belongs_to_a_detached_subtree - |> Mina_block.Validation.validate_staged_ledger_hash - (`Staged_ledger_already_materialized - received_staged_ledger_hash ) - |> Result.map_error ~f:(fun _ -> - Error.of_string "received faulty scan state from peer" ) - |> Deferred.return - in - let protocol_states = - List.map protocol_states - ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) - in - let%bind protocol_states = - Staged_ledger.Scan_state.check_required_protocol_states - scan_state ~protocol_states - |> Deferred.return - in - let protocol_states_map = - protocol_states - |> List.map ~f:(fun ps -> - (State_hash.With_state_hashes.state_hash ps, ps) ) - |> State_hash.Map.of_alist_exn - in - let get_state hash = - match Map.find protocol_states_map hash with - | None -> - let new_state_hash = - State_hash.With_state_hashes.state_hash (fst new_root) - in - [%log error] - ~metadata: - [ ("new_root", State_hash.to_yojson new_state_hash) - ; ("state_hash", State_hash.to_yojson hash) - ] - "Protocol state (for scan state transactions) for \ - $state_hash not found when bootstrapping to the new \ - root $new_root" ; - Or_error.errorf - !"Protocol state (for scan state transactions) for \ - %{sexp:State_hash.t} not found when bootstrapping to \ - the new root %{sexp:State_hash.t}" - hash new_state_hash - | Some protocol_state -> - Ok (With_hash.data protocol_state) - in - (* step 3. Construct staged ledger from snarked ledger, scan state - and pending coinbases. *) - (* Construct the staged ledger before constructing the transition - * frontier in order to verify the scan state we received. - * TODO: reorganize the code to avoid doing this twice (#3480) *) - let open Deferred.Let_syntax in - let%map staged_ledger_construction_time, construction_result = - 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 - ~snarked_local_state: - Mina_block.( - t.current_root |> Validation.block |> header - |> Header.protocol_state - |> Protocol_state.blockchain_state - |> Blockchain_state.snarked_local_state) - ~verifier ~constraint_constants ~scan_state - ~snarked_ledger:temp_mask ~expected_merkle_root - ~pending_coinbases ~get_state ~signature_kind - in - ignore - ( Ledger.Maskable.unregister_mask_exn ~loc:__LOC__ temp_mask - : Ledger.unattached_mask ) ; - Result.map result - ~f: - (const - ( scan_state - , pending_coinbases - , new_root - , protocol_states ) )) - in - Ok (staged_ledger_construction_time, construction_result) ) + Deferred.return (staged_ledger_data_download_time, (None, Error err)) + | Ok result -> + let%map res = + handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash + ~temp_snarked_ledger ~verifier ~constraint_constants ~signature_kind + t result in - match staged_ledger_construction_result with - | Error err -> - (staged_ledger_data_download_time, None, Error err) - | Ok (staged_ledger_construction_time, result) -> - ( staged_ledger_data_download_time - , Some staged_ledger_construction_time - , result ) ) + (staged_ledger_data_download_time, res) in Transition_frontier.Persistent_root.Instance.close temp_persistent_root_instance ; From ec3efd56e1161bf1d514ae17ff52a42a1405d73f Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 17:56:56 +0100 Subject: [PATCH 070/122] Change type of RPC --- .../bootstrap_controller.ml | 24 ++++++++- .../transition_frontier_components_intf.ml | 9 ++-- src/lib/mina_networking/mina_networking.mli | 14 +++-- src/lib/mina_networking/rpcs.ml | 16 +++--- src/lib/sync_handler/sync_handler.ml | 52 ++++++------------- 5 files changed, 57 insertions(+), 58 deletions(-) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index e745ca9685af..302262933150 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -457,7 +457,29 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier match staged_ledger_data_download_result with | Error err -> Deferred.return (staged_ledger_data_download_time, (None, Error err)) - | Ok result -> + | Ok (Data result) -> + let%map res = + handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash + ~temp_snarked_ledger ~verifier ~constraint_constants ~signature_kind + t result + in + (staged_ledger_data_download_time, res) + | Ok (Tag tag) -> + (* This is an unexpected case, deserialization should always return [Data x] *) + [%log warn] + "Unexpected Tag returned from \ + get_staged_ledger_aux_and_pending_coinbases_at_hash" ; + let result = + State_hash.File_storage.read + ( module Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Data + .Stable + .Latest ) + tag + |> Or_error.tag ~tag:"failed to read unexpected Tag" + |> Or_error.ok_exn + in let%map res = handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash ~temp_snarked_ledger ~verifier ~constraint_constants ~signature_kind diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index 7ad7814e3f08..c8a135a1494a 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -240,11 +240,10 @@ module type Sync_handler_intf = sig logger:Logger.t -> frontier:transition_frontier -> State_hash.t - -> ( Staged_ledger.Scan_state.t - * Ledger_hash.t - * Pending_coinbase.t - * Mina_state.Protocol_state.value list ) - Option.t + -> Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .t + option val get_transition_chain : frontier:transition_frontier diff --git a/src/lib/mina_networking/mina_networking.mli b/src/lib/mina_networking/mina_networking.mli index 29bb6c71058a..dcdb208b1b10 100644 --- a/src/lib/mina_networking/mina_networking.mli +++ b/src/lib/mina_networking/mina_networking.mli @@ -53,10 +53,9 @@ module Rpcs : sig type query = State_hash.t type response = - ( Staged_ledger.Scan_state.Stable.Latest.t - * Ledger_hash.t - * Pending_coinbase.t - * Mina_state.Protocol_state.value list ) + Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .t option end @@ -229,10 +228,9 @@ val get_staged_ledger_aux_and_pending_coinbases_at_hash : t -> Peer.Id.t -> State_hash.t - -> ( Staged_ledger.Scan_state.Stable.Latest.t - * Ledger_hash.t - * Pending_coinbase.t - * Mina_state.Protocol_state.value list ) + -> Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .t Deferred.Or_error.t val get_completed_checked_snarks : diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 117666c3a262..2c0bb365d4a5 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -213,10 +213,9 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct type query = State_hash.t type response = - ( Staged_ledger.Scan_state.Stable.Latest.t - * Ledger_hash.t - * Pending_coinbase.t - * Mina_state.Protocol_state.value list ) + Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .t option end @@ -255,10 +254,11 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct type query = State_hash.Stable.V1.t type response = - ( Staged_ledger.Scan_state.Stable.V3.t - * Ledger_hash.Stable.V1.t - * Pending_coinbase.Stable.V2.t - * Mina_state.Protocol_state.Value.Stable.V2.t list ) + Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Stable + .V1 + .t option let query_of_caller_model = Fn.id diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 6e59a26b69eb..af0b21ba39bd 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -108,36 +108,12 @@ module Make (Inputs : Inputs_intf) : Sync_ledger.Any_ledger.Responder.answer_query responder query let get_staged_ledger_aux_and_pending_coinbases_at_hash ~logger ~frontier - state_hash : - Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Data - .Stable - .Latest - .t - option = + state_hash = + (* TODO: CAUTION we don't convert the scan state to serialized format *) match Transition_frontier.staged_ledger_aux_and_pending_coinbases_at_hash frontier state_hash with - | Some (res, staged_ledger_hash) -> - [%log debug] - ~metadata: - [ ( "staged_ledger_hash" - , Staged_ledger_hash.to_yojson staged_ledger_hash ) - ; ("state_hash", State_hash.to_yojson state_hash) - ] - "sending scan state and pending coinbase generated from frontier" ; - (* TODO: CAUTION we don't convert the scan state to serialized format *) - (* TODO: don't deserialize it here, return a tag *) - Option.some @@ Or_error.ok_exn - @@ State_hash.File_storage.read - ( module Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Data - .Stable - .Latest ) - res | None -> let open Transition_frontier.Extensions in let root_history = @@ -146,16 +122,20 @@ module Make (Inputs : Inputs_intf) : let%map.Option historical = Root_history.lookup root_history state_hash in - (* TODO: don't deserialize it here, return a tag *) - Or_error.ok_exn - @@ State_hash.File_storage.read - ( module Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Data - .Stable - .Latest ) - @@ Root_data.Historical.staged_ledger_aux_and_pending_coinbases - historical + Frontier_base.Network_types + .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Tag + (Root_data.Historical.staged_ledger_aux_and_pending_coinbases + historical ) + | Some (res, staged_ledger_hash) -> + [%log debug] + ~metadata: + [ ( "staged_ledger_hash" + , Staged_ledger_hash.to_yojson staged_ledger_hash ) + ; ("state_hash", State_hash.to_yojson state_hash) + ] + "sending scan state and pending coinbase generated from frontier" ; + Some (Tag res) let get_transition_chain ~frontier hashes = let open Option.Let_syntax in From 226a45196dc544855eec06982bf48f963bb4e516 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 17:58:39 +0100 Subject: [PATCH 071/122] Rename some types and funs --- .../bootstrap_controller.ml | 2 +- .../transition_frontier_components_intf.ml | 4 +-- src/lib/mina_networking/mina_networking.mli | 8 ++---- src/lib/mina_networking/rpcs.ml | 7 ++--- src/lib/sync_handler/sync_handler.ml | 8 ++---- .../extensions/root_history.ml | 7 ++--- .../frontier_base/breadcrumb.ml | 28 +++++++------------ .../frontier_base/breadcrumb.mli | 13 +++------ .../frontier_base/network_types.ml | 2 +- .../frontier_base/root_data.ml | 3 +- .../frontier_base/root_data.mli | 8 ++---- .../transition_frontier.ml | 4 +-- .../transition_frontier.mli | 5 ++-- 13 files changed, 33 insertions(+), 66 deletions(-) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 302262933150..c6054f9e19d8 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -472,7 +472,7 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier let result = State_hash.File_storage.read ( module Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + .Staged_ledger_aux_and_pending_coinbases .Data .Stable .Latest ) diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index c8a135a1494a..85ef93cc51fa 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -240,9 +240,7 @@ module type Sync_handler_intf = sig logger:Logger.t -> frontier:transition_frontier -> State_hash.t - -> Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .t + -> Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.t option val get_transition_chain : diff --git a/src/lib/mina_networking/mina_networking.mli b/src/lib/mina_networking/mina_networking.mli index dcdb208b1b10..692864ade08a 100644 --- a/src/lib/mina_networking/mina_networking.mli +++ b/src/lib/mina_networking/mina_networking.mli @@ -53,9 +53,7 @@ module Rpcs : sig type query = State_hash.t type response = - Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .t + Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.t option end @@ -228,9 +226,7 @@ val get_staged_ledger_aux_and_pending_coinbases_at_hash : t -> Peer.Id.t -> State_hash.t - -> Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .t + -> Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.t Deferred.Or_error.t val get_completed_checked_snarks : diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 2c0bb365d4a5..892ba4885204 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -213,9 +213,7 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct type query = State_hash.t type response = - Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .t + Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.t option end @@ -254,8 +252,7 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct type query = State_hash.Stable.V1.t type response = - Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result + Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases .Stable .V1 .t diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index af0b21ba39bd..a81d049fc90c 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -111,8 +111,8 @@ module Make (Inputs : Inputs_intf) : state_hash = (* TODO: CAUTION we don't convert the scan state to serialized format *) match - Transition_frontier.staged_ledger_aux_and_pending_coinbases_at_hash - frontier state_hash + Transition_frontier.staged_ledger_aux_and_pending_coinbases frontier + state_hash with | None -> let open Transition_frontier.Extensions in @@ -122,9 +122,7 @@ module Make (Inputs : Inputs_intf) : let%map.Option historical = Root_history.lookup root_history state_hash in - Frontier_base.Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Tag + Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.Tag (Root_data.Historical.staged_ledger_aux_and_pending_coinbases historical ) | Some (res, staged_ledger_hash) -> diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index 8ce3e9571839..e834f03a2b9e 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -88,10 +88,7 @@ let staged_ledger_aux_and_pending_coinbases_of_breadcrumb , scan_state_protocol_states ) in let module Data = - Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Data - .Stable - .Latest + Network_types.Staged_ledger_aux_and_pending_coinbases.Data.Stable.Latest in (* Cache in frontier and return tag *) State_hash.File_storage.append_values_exn (Breadcrumb.state_hash breadcrumb) @@ -101,7 +98,7 @@ let staged_ledger_aux_and_pending_coinbases_of_breadcrumb let historical_of_breadcrumb ~protocol_states_for_root_scan_state ~history breadcrumb = let cached_opt = - Breadcrumb.staged_ledger_aux_and_pending_coinbases_at_hash_cached breadcrumb + Breadcrumb.staged_ledger_aux_and_pending_coinbases_cached breadcrumb in let transition = Breadcrumb.validated_transition breadcrumb in let%map.Option staged_ledger_aux_and_pending_coinbases = diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index e2c80047f4bc..4aea879262b7 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -16,10 +16,8 @@ module T = struct ; staged_ledger_hash : Staged_ledger_hash.t ; accounts_created : Account_id.t list ; block_tag : Mina_block.Stable.Latest.t State_hash.File_storage.tag - ; mutable staged_ledger_aux_and_pending_coinbases_at_hash_cached : - Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag - option + ; mutable staged_ledger_aux_and_pending_coinbases_cached : + Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option } [@@deriving fields] @@ -59,7 +57,7 @@ module T = struct ; staged_ledger_hash ; accounts_created ; block_tag - ; staged_ledger_aux_and_pending_coinbases_at_hash_cached = None + ; staged_ledger_aux_and_pending_coinbases_cached = None } let to_yojson @@ -70,7 +68,7 @@ module T = struct ; staged_ledger_hash = _ ; accounts_created = _ ; block_tag = _ - ; staged_ledger_aux_and_pending_coinbases_at_hash_cached = _ + ; staged_ledger_aux_and_pending_coinbases_cached = _ } = `Assoc [ ( "validated_transition" @@ -94,7 +92,7 @@ T. , staged_ledger_hash , accounts_created , block_tag - , staged_ledger_aux_and_pending_coinbases_at_hash_cached )] + , staged_ledger_aux_and_pending_coinbases_cached )] let command_hashes t = T.validated_transition t |> Mina_block.Validated.body @@ -331,10 +329,7 @@ let staged_ledger_aux_and_pending_coinbases_at_hash_compute Staged_ledger.pending_coinbase_collection staged_ledger in let module Data = - Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .Data - .Stable - .Latest + Network_types.Staged_ledger_aux_and_pending_coinbases.Data.Stable.Latest in (* Cache in frontier and return tag *) State_hash.File_storage.append_values_exn (state_hash breadcrumb) @@ -343,12 +338,10 @@ let staged_ledger_aux_and_pending_coinbases_at_hash_compute (module Data) (scan_state, merkle_root, pending_coinbase, protocol_states) ) -let staged_ledger_aux_and_pending_coinbases_at_hash ~scan_state_protocol_states +let staged_ledger_aux_and_pending_coinbases ~scan_state_protocol_states breadcrumb : - Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag - option = - match staged_ledger_aux_and_pending_coinbases_at_hash_cached breadcrumb with + Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option = + match staged_ledger_aux_and_pending_coinbases_cached breadcrumb with | Some res -> Some res | None -> @@ -357,8 +350,7 @@ let staged_ledger_aux_and_pending_coinbases_at_hash ~scan_state_protocol_states ~scan_state_protocol_states breadcrumb in Option.iter res ~f:(fun tag -> - breadcrumb.staged_ledger_aux_and_pending_coinbases_at_hash_cached <- - Some tag ) ; + breadcrumb.staged_ledger_aux_and_pending_coinbases_cached <- Some tag ) ; res module For_tests = struct diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index cda25d283653..f846d57f47e9 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -104,20 +104,15 @@ val staged_ledger_hash : t -> Staged_ledger_hash.t For convenience of implementation, it's by definition an empty list for the root *) val accounts_created : t -> Account_id.t list -val staged_ledger_aux_and_pending_coinbases_at_hash_cached : - t - -> Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag - option +val staged_ledger_aux_and_pending_coinbases_cached : + t -> Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option -val staged_ledger_aux_and_pending_coinbases_at_hash : +val staged_ledger_aux_and_pending_coinbases : scan_state_protocol_states: ( Staged_ledger.Scan_state.t -> Mina_state.Protocol_state.Value.t list option ) -> t - -> Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag - option + -> Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option module For_tests : sig val gen : diff --git a/src/lib/transition_frontier/frontier_base/network_types.ml b/src/lib/transition_frontier/frontier_base/network_types.ml index e39b205f6041..efa89f293497 100644 --- a/src/lib/transition_frontier/frontier_base/network_types.ml +++ b/src/lib/transition_frontier/frontier_base/network_types.ml @@ -1,7 +1,7 @@ open Core_kernel open Mina_base -module Get_staged_ledger_aux_and_pending_coinbases_at_hash_result = struct +module Staged_ledger_aux_and_pending_coinbases = struct module Data = struct [%%versioned module Stable = struct diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 1be092bdae82..f7819dee3e0f 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -45,8 +45,7 @@ module Historical = struct type t = { transition : Mina_block.Validated.t ; staged_ledger_aux_and_pending_coinbases : - Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag + Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag ; required_state_hashes : State_hash.Set.t } [@@deriving fields] diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 4728c9505dd6..72a8037cea39 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -25,9 +25,7 @@ module Historical : sig val transition : t -> Mina_block.Validated.t val staged_ledger_aux_and_pending_coinbases : - t - -> Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag + t -> Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag val required_state_hashes : t -> State_hash.Set.t @@ -36,9 +34,7 @@ module Historical : sig val create : transition:Mina_block.Validated.t -> staged_ledger_aux_and_pending_coinbases: - Network_types - .Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag + Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag -> required_state_hashes:State_hash.Set.t -> t end diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index f73fb6f775e0..e4921dc80506 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -576,11 +576,11 @@ let protocol_states_of_scan_state ~frontier scan_state = Continue (Some acc') ) ~finish:Fn.id -let staged_ledger_aux_and_pending_coinbases_at_hash frontier state_hash = +let staged_ledger_aux_and_pending_coinbases frontier state_hash = let%bind.Option breadcrumb = find frontier state_hash in let scan_state_protocol_states = protocol_states_of_scan_state ~frontier in let%map.Option res = - Breadcrumb.staged_ledger_aux_and_pending_coinbases_at_hash + Breadcrumb.staged_ledger_aux_and_pending_coinbases ~scan_state_protocol_states breadcrumb in let staged_ledger_hash = Breadcrumb.staged_ledger_hash breadcrumb in diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 745befa70ecf..2edf541ee734 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -118,11 +118,10 @@ val rejected_blocks : val validated_blocks : (State_hash.t * Network_peer.Envelope.Sender.t * Block_time.t) Core.Queue.t -val staged_ledger_aux_and_pending_coinbases_at_hash : +val staged_ledger_aux_and_pending_coinbases : t -> State_hash.t - -> ( Network_types.Get_staged_ledger_aux_and_pending_coinbases_at_hash_result - .data_tag + -> ( Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag * Staged_ledger_hash.t ) option From 6eb3a157cdf9546d4db9917a2808ad2360701859 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 18:48:53 +0100 Subject: [PATCH 072/122] Introduce Root_data.Historical.protocol_state_with_hashes --- src/lib/transition_chain_prover/transition_chain_prover.ml | 7 +------ src/lib/transition_frontier/extensions/root_history.ml | 6 +----- src/lib/transition_frontier/frontier_base/root_data.ml | 5 +++++ src/lib/transition_frontier/frontier_base/root_data.mli | 3 +++ 4 files changed, 10 insertions(+), 11 deletions(-) diff --git a/src/lib/transition_chain_prover/transition_chain_prover.ml b/src/lib/transition_chain_prover/transition_chain_prover.ml index 7b8b46f14059..991b52df901d 100644 --- a/src/lib/transition_chain_prover/transition_chain_prover.ml +++ b/src/lib/transition_chain_prover/transition_chain_prover.ml @@ -18,12 +18,7 @@ module Make (Inputs : Inputs_intf) : get_extension (Transition_frontier.extensions frontier) Root_history in let%map root_data = Root_history.lookup root_history state_hash in - let validated_block = - Frontier_base.Root_data.Historical.transition root_data - in - Mina_block.Validated.forget validated_block - |> With_hash.map - ~f:(Fn.compose Mina_block.Header.protocol_state Mina_block.header) + Frontier_base.Root_data.Historical.protocol_state_with_hashes root_data module Merkle_list = Merkle_list_prover.Make_ident (struct type value = diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index e834f03a2b9e..e4d1b1d22bd8 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -155,11 +155,7 @@ module T = struct ~next_root_required_hashes: ( Root_data.Historical.required_state_hashes new_oldest_root |> State_hash.Set.to_list ) - ~old_root_state: - ( transition oldest_root |> Mina_block.Validated.forget - |> With_hash.map ~f:(fun block -> - block |> Mina_block.header - |> Mina_block.Header.protocol_state ) ) + ~old_root_state:(protocol_state_with_hashes oldest_root) |> List.map ~f:(fun s -> State_hash.With_state_hashes.(state_hash s, s)) |> State_hash.Map.of_alist_exn in diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index f7819dee3e0f..064977c13018 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -53,6 +53,11 @@ module Historical = struct let protocol_state t = Mina_block.Validated.header t.transition |> Mina_block.Header.protocol_state + let protocol_state_with_hashes t = + Mina_block.Validated.forget t.transition + |> With_hash.map + ~f:(Fn.compose Mina_block.Header.protocol_state Mina_block.header) + let create ~transition ~staged_ledger_aux_and_pending_coinbases ~required_state_hashes = { transition diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 72a8037cea39..45b8791dbaf4 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -31,6 +31,9 @@ module Historical : sig val protocol_state : t -> Mina_state.Protocol_state.Value.t + val protocol_state_with_hashes : + t -> Mina_state.Protocol_state.Value.t State_hash.With_state_hashes.t + val create : transition:Mina_block.Validated.t -> staged_ledger_aux_and_pending_coinbases: From 41f47ad89f8eabf012c4da592c46255fb770136a Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 19:03:26 +0100 Subject: [PATCH 073/122] Remove redundant check of protocol versions --- src/lib/mina_networking/rpcs.ml | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 892ba4885204..dd4abf807d09 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -567,13 +567,7 @@ module Get_transition_chain = struct in match result with | Some blocks -> - let%map valid_versions = - validate_protocol_versions ~logger ~trust_system - ~rpc_name:"Get_transition_chain" - ~sender:(Envelope.Incoming.sender request) - (List.map blocks ~f:Mina_block.header) - in - Option.some_if valid_versions + Deferred.return @@ Option.some @@ List.map ~f:Mina_block.read_all_proofs_from_disk blocks | None -> let%map () = From 2950886eec00632519d1be413b232de43f8f08ce Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 19:30:37 +0100 Subject: [PATCH 074/122] Add materializing tag type for block --- .../frontier_base/network_types.ml | 79 ++++++++++++------- 1 file changed, 49 insertions(+), 30 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/network_types.ml b/src/lib/transition_frontier/frontier_base/network_types.ml index efa89f293497..2bd41adec81e 100644 --- a/src/lib/transition_frontier/frontier_base/network_types.ml +++ b/src/lib/transition_frontier/frontier_base/network_types.ml @@ -1,6 +1,32 @@ open Core_kernel open Mina_base +module Make (Data : Binable.S) = struct + type t = Tag of Data.t State_hash.File_storage.tag | Data of Data.t + + type data_tag = Data.t State_hash.File_storage.tag + + let to_latest = Fn.id + + module Arg = struct + type nonrec t = t + + let to_binable = function + | Tag x -> + (* TODO This code deserializes the data stored in the file + and serializes it back. This is a bad thing to do. + But in future we will have a special communication + protocol between libp2p helper and daemon to push file reading + to the helper, and then we won't have deserialization anymore. + *) + State_hash.File_storage.read (module Data) x |> Or_error.ok_exn + | Data x -> + x + + let of_binable x = Data x + end +end + module Staged_ledger_aux_and_pending_coinbases = struct module Data = struct [%%versioned @@ -20,42 +46,35 @@ module Staged_ledger_aux_and_pending_coinbases = struct end] end - type data_tag = Data.Stable.Latest.t State_hash.File_storage.tag + module M = Make (Data.Stable.V1) + + type data_tag = M.data_tag [%%versioned_binable module Stable = struct module V1 = struct - module T = struct - type t = - | Tag of Data.Stable.Latest.t State_hash.File_storage.tag - | Data of Data.Stable.Latest.t + type t = M.t - let to_latest = Fn.id - end + let to_latest = M.to_latest + + include Binable.Of_binable_without_uuid (Data.Stable.V1) (M.Arg) + end + end] +end + +module Block = struct + module M = Make (Mina_block.Stable.V2) + + type data_tag = M.data_tag + + [%%versioned_binable + module Stable = struct + module V1 = struct + type t = M.t + + let to_latest = M.to_latest - include T - - include - Binable.Of_binable_without_uuid - (Data.Stable.V1) - (struct - type t = T.t - - let to_binable = function - | Tag x -> - (* TODO This code deserializes the data stored in the file - and serializes it back. This is a bad thing to do. - But in future we will have a special communication - protocol between libp2p helper and daemon to push file reading - to the helper, and then we won't have deserialization anymore. - *) - State_hash.File_storage.read (module Data.Stable.Latest) x - |> Or_error.ok_exn - | Data x -> - x - - let of_binable x = Data x - end) + include Binable.Of_binable_without_uuid (Mina_block.Stable.V2) (M.Arg) end end] end From 510f584ab85c1c9fed1073111160586f10da7f80 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 19:37:47 +0100 Subject: [PATCH 075/122] Don't store transitions in Root_data.Historical.t Store block tag instead. --- .../bootstrap_controller.ml | 24 +------------------ .../transition_frontier_components_intf.ml | 2 +- src/lib/mina_networking/mina_networking.ml | 16 +++++++++---- src/lib/mina_networking/mina_networking.mli | 7 ++++-- src/lib/mina_networking/rpcs.ml | 7 +++--- src/lib/sync_handler/sync_handler.ml | 16 +++++-------- .../extensions/root_history.ml | 9 ++++--- .../frontier_base/network_types.ml | 10 ++++++++ .../frontier_base/root_data.ml | 19 +++++++-------- .../frontier_base/root_data.mli | 8 ++++--- 10 files changed, 57 insertions(+), 61 deletions(-) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index c6054f9e19d8..e745ca9685af 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -457,29 +457,7 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier match staged_ledger_data_download_result with | Error err -> Deferred.return (staged_ledger_data_download_time, (None, Error err)) - | Ok (Data result) -> - let%map res = - handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash - ~temp_snarked_ledger ~verifier ~constraint_constants ~signature_kind - t result - in - (staged_ledger_data_download_time, res) - | Ok (Tag tag) -> - (* This is an unexpected case, deserialization should always return [Data x] *) - [%log warn] - "Unexpected Tag returned from \ - get_staged_ledger_aux_and_pending_coinbases_at_hash" ; - let result = - State_hash.File_storage.read - ( module Frontier_base.Network_types - .Staged_ledger_aux_and_pending_coinbases - .Data - .Stable - .Latest ) - tag - |> Or_error.tag ~tag:"failed to read unexpected Tag" - |> Or_error.ok_exn - in + | Ok result -> let%map res = handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash ~temp_snarked_ledger ~verifier ~constraint_constants ~signature_kind diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index 85ef93cc51fa..5c93a6a3a753 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -246,7 +246,7 @@ module type Sync_handler_intf = sig val get_transition_chain : frontier:transition_frontier -> State_hash.t list - -> Mina_block.t list option + -> Frontier_base.Network_types.Block.t list option val best_tip_path : frontier:transition_frontier -> State_hash.t list diff --git a/src/lib/mina_networking/mina_networking.ml b/src/lib/mina_networking/mina_networking.ml index cfe26fbe5ce5..5febfeba9758 100644 --- a/src/lib/mina_networking/mina_networking.ml +++ b/src/lib/mina_networking/mina_networking.ml @@ -257,13 +257,18 @@ let make_rpc_request ?heartbeat_timeout ?timeout ~rpc ~label t peer input = | Failed_to_connect e -> Error (Error.tag e ~tag:"failed-to-connect") -let get_transition_chain_proof ?heartbeat_timeout ?timeout t = +let get_transition_chain_proof ?heartbeat_timeout ?timeout t peer = make_rpc_request ?heartbeat_timeout ?timeout - ~rpc:Rpcs.Get_transition_chain_proof ~label:"transition chain proof" t + ~rpc:Rpcs.Get_transition_chain_proof ~label:"transition chain proof" t peer -let get_transition_chain ?heartbeat_timeout ?timeout t = +let get_transition_chain ?heartbeat_timeout ?timeout t peer req = + let extract = + Fn.compose Or_error.all + @@ List.map ~f:Frontier_base.Network_types.Block.extract + in make_rpc_request ?heartbeat_timeout ?timeout ~rpc:Rpcs.Get_transition_chain - ~label:"chain of transitions" t + ~label:"chain of transitions" t peer req + >>=? Fn.compose Deferred.return extract let get_best_tip ?heartbeat_timeout ?timeout t peer = make_rpc_request ?heartbeat_timeout ?timeout ~rpc:Rpcs.Get_best_tip @@ -367,6 +372,9 @@ let get_staged_ledger_aux_and_pending_coinbases_at_hash t inet_addr input = rpc_peer_then_random t inet_addr input ~rpc:Rpcs.Get_staged_ledger_aux_and_pending_coinbases_at_hash >>|? Envelope.Incoming.data + >>=? Fn.compose Deferred.return + Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases + .extract let get_ancestry t inet_addr input = rpc_peer_then_random t inet_addr input ~rpc:Rpcs.Get_ancestry diff --git a/src/lib/mina_networking/mina_networking.mli b/src/lib/mina_networking/mina_networking.mli index 692864ade08a..d5b9be7616f5 100644 --- a/src/lib/mina_networking/mina_networking.mli +++ b/src/lib/mina_networking/mina_networking.mli @@ -69,7 +69,7 @@ module Rpcs : sig module Get_transition_chain : sig type query = State_hash.t list - type response = Mina_block.Stable.Latest.t list option + type response = Frontier_base.Network_types.Block.t list option end module Get_transition_chain_proof : sig @@ -226,7 +226,10 @@ val get_staged_ledger_aux_and_pending_coinbases_at_hash : t -> Peer.Id.t -> State_hash.t - -> Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.t + -> Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.Data + .Stable + .Latest + .t Deferred.Or_error.t val get_completed_checked_snarks : diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index dd4abf807d09..1621569a6fee 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -495,7 +495,7 @@ module Get_transition_chain = struct module T = struct type query = State_hash.t list [@@deriving sexp, to_yojson] - type response = Mina_block.Stable.Latest.t list option + type response = Frontier_base.Network_types.Block.t list option end module Caller = T @@ -526,7 +526,7 @@ module Get_transition_chain = struct module T = struct type query = State_hash.Stable.V1.t list [@@deriving sexp] - type response = Mina_block.Stable.V2.t list option + type response = Frontier_base.Network_types.Block.Stable.V1.t list option let query_of_caller_model = Fn.id @@ -567,8 +567,7 @@ module Get_transition_chain = struct in match result with | Some blocks -> - Deferred.return @@ Option.some - @@ List.map ~f:Mina_block.read_all_proofs_from_disk blocks + Deferred.return @@ Option.some blocks | None -> let%map () = Trust_system.( diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index a81d049fc90c..1519da155ea2 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -122,7 +122,8 @@ module Make (Inputs : Inputs_intf) : let%map.Option historical = Root_history.lookup root_history state_hash in - Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.Tag + Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.M + .Tag (Root_data.Historical.staged_ledger_aux_and_pending_coinbases historical ) | Some (res, staged_ledger_hash) -> @@ -148,15 +149,10 @@ module Make (Inputs : Inputs_intf) : None ) in let get hash = - let%map validated_transition = - Option.merge - Transition_frontier.( - find frontier hash >>| Breadcrumb.validated_transition) - ( find_in_root_history frontier hash - >>| Root_data.Historical.transition ) - ~f:Fn.const - in - With_hash.data @@ Mina_block.Validated.forget validated_transition + Option.first_some + Transition_frontier.(find frontier hash >>| Breadcrumb.block_tag) + (find_in_root_history frontier hash >>| Root_data.Historical.block_tag) + |> Option.map ~f:(fun x -> Frontier_base.Network_types.Block.M.Tag x) in match Transition_frontier.catchup_state frontier with | Full _ -> diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index e4d1b1d22bd8..a267d64063d6 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -100,7 +100,6 @@ let historical_of_breadcrumb ~protocol_states_for_root_scan_state ~history let cached_opt = Breadcrumb.staged_ledger_aux_and_pending_coinbases_cached breadcrumb in - let transition = Breadcrumb.validated_transition breadcrumb in let%map.Option staged_ledger_aux_and_pending_coinbases = match cached_opt with | Some value -> @@ -115,8 +114,11 @@ let historical_of_breadcrumb ~protocol_states_for_root_scan_state ~history let required_state_hashes = Staged_ledger.Scan_state.required_state_hashes scan_state in - Root_data.Historical.create ~transition + Root_data.Historical.create + ~block_tag:(Breadcrumb.block_tag breadcrumb) ~staged_ledger_aux_and_pending_coinbases ~required_state_hashes + ~protocol_state_with_hashes: + (Breadcrumb.protocol_state_with_hashes breadcrumb) module T = struct type view = t @@ -163,7 +165,8 @@ module T = struct assert ( [%equal: [ `Ok | `Key_already_present ]] `Ok (Queue.enqueue_back t.history - (Mina_block.Validated.state_hash @@ transition t.current_root) + ( State_hash.With_state_hashes.state_hash + @@ protocol_state_with_hashes t.current_root ) t.current_root ) ) ; t.current_root <- new_root diff --git a/src/lib/transition_frontier/frontier_base/network_types.ml b/src/lib/transition_frontier/frontier_base/network_types.ml index 2bd41adec81e..baf76e87dbc3 100644 --- a/src/lib/transition_frontier/frontier_base/network_types.ml +++ b/src/lib/transition_frontier/frontier_base/network_types.ml @@ -6,6 +6,12 @@ module Make (Data : Binable.S) = struct type data_tag = Data.t State_hash.File_storage.tag + let extract = function + | Tag x -> + State_hash.File_storage.read (module Data) x + | Data x -> + Or_error.return x + let to_latest = Fn.id module Arg = struct @@ -50,6 +56,8 @@ module Staged_ledger_aux_and_pending_coinbases = struct type data_tag = M.data_tag + let extract = M.extract + [%%versioned_binable module Stable = struct module V1 = struct @@ -67,6 +75,8 @@ module Block = struct type data_tag = M.data_tag + let extract = M.extract + [%%versioned_binable module Stable = struct module V1 = struct diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 064977c13018..9eddecf2656f 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -43,26 +43,23 @@ end module Historical = struct type t = - { transition : Mina_block.Validated.t + { block_tag : Network_types.Block.data_tag ; staged_ledger_aux_and_pending_coinbases : Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag ; required_state_hashes : State_hash.Set.t + ; protocol_state_with_hashes : + Mina_state.Protocol_state.Value.t State_hash.With_state_hashes.t } [@@deriving fields] - let protocol_state t = - Mina_block.Validated.header t.transition |> Mina_block.Header.protocol_state - - let protocol_state_with_hashes t = - Mina_block.Validated.forget t.transition - |> With_hash.map - ~f:(Fn.compose Mina_block.Header.protocol_state Mina_block.header) + let protocol_state t = With_hash.data t.protocol_state_with_hashes - let create ~transition ~staged_ledger_aux_and_pending_coinbases - ~required_state_hashes = - { transition + let create ~block_tag ~staged_ledger_aux_and_pending_coinbases + ~required_state_hashes ~protocol_state_with_hashes = + { block_tag ; staged_ledger_aux_and_pending_coinbases ; required_state_hashes + ; protocol_state_with_hashes } end diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 45b8791dbaf4..d21b2a0e9ef6 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -22,8 +22,6 @@ end module Historical : sig type t - val transition : t -> Mina_block.Validated.t - val staged_ledger_aux_and_pending_coinbases : t -> Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag @@ -34,11 +32,15 @@ module Historical : sig val protocol_state_with_hashes : t -> Mina_state.Protocol_state.Value.t State_hash.With_state_hashes.t + val block_tag : t -> Network_types.Block.data_tag + val create : - transition:Mina_block.Validated.t + block_tag:Network_types.Block.data_tag -> staged_ledger_aux_and_pending_coinbases: Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag -> required_state_hashes:State_hash.Set.t + -> protocol_state_with_hashes: + Mina_state.Protocol_state.Value.t State_hash.With_state_hashes.t -> t end From 453c37a345bb2521e630bf3707dd69573ef08e43 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 20:19:43 +0100 Subject: [PATCH 076/122] Remove redundant checks of protocol versions --- src/lib/mina_networking/rpcs.ml | 40 ++++++++++----------------------- 1 file changed, 12 insertions(+), 28 deletions(-) diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 1621569a6fee..a0637c1b4a0e 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -978,17 +978,12 @@ module Get_ancestry = struct | Some { proof = chain, base_block; data = block } -> let block = Frontier_base.Breadcrumb.block block in let base_block = Frontier_base.Breadcrumb.block base_block in - let%map valid_versions = - validate_protocol_versions ~logger ~trust_system - ~rpc_name:"Get_ancestry" - ~sender:(Envelope.Incoming.sender request) - [ Mina_block.header base_block ] - in - Option.some_if valid_versions - { Proof_carrying_data.proof = - (chain, Mina_block.read_all_proofs_from_disk base_block) - ; data = Mina_block.read_all_proofs_from_disk block - } + Deferred.return + @@ Some + { Proof_carrying_data.proof = + (chain, Mina_block.read_all_proofs_from_disk base_block) + ; data = Mina_block.read_all_proofs_from_disk block + } let rate_limit_budget = (5, `Per Time.Span.minute) @@ -1179,23 +1174,12 @@ module Get_best_tip = struct | Some { data = data_block; proof = chain, proof_block } -> let data_block = Frontier_base.Breadcrumb.block data_block in let proof_block = Frontier_base.Breadcrumb.block proof_block in - let%map data_valid_versions = - validate_protocol_versions ~logger ~trust_system - ~rpc_name:"Get_best_tip (data)" - ~sender:(Envelope.Incoming.sender request) - [ Mina_block.header data_block ] - and proof_valid_versions = - validate_protocol_versions ~logger ~trust_system - ~rpc_name:"Get_best_tip (proof)" - ~sender:(Envelope.Incoming.sender request) - [ Mina_block.header proof_block ] - in - Option.some_if - (data_valid_versions && proof_valid_versions) - { Proof_carrying_data.data = - Mina_block.read_all_proofs_from_disk data_block - ; proof = (chain, Mina_block.read_all_proofs_from_disk proof_block) - } + Deferred.return + @@ Some + { Proof_carrying_data.data = + Mina_block.read_all_proofs_from_disk data_block + ; proof = (chain, Mina_block.read_all_proofs_from_disk proof_block) + } let rate_limit_budget = (3, `Per Time.Span.minute) From 49e42192b266106c76d5d85f42d3fadd6c68fd77 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 20:37:19 +0100 Subject: [PATCH 077/122] Use block tags in all RPCs --- src/lib/mina_networking/mina_networking.ml | 14 +++++++ src/lib/mina_networking/mina_networking.mli | 8 ++-- src/lib/mina_networking/rpcs.ml | 46 +++++++++++---------- 3 files changed, 42 insertions(+), 26 deletions(-) diff --git a/src/lib/mina_networking/mina_networking.ml b/src/lib/mina_networking/mina_networking.ml index 5febfeba9758..2724f870ed87 100644 --- a/src/lib/mina_networking/mina_networking.ml +++ b/src/lib/mina_networking/mina_networking.ml @@ -270,9 +270,18 @@ let get_transition_chain ?heartbeat_timeout ?timeout t peer req = ~label:"chain of transitions" t peer req >>=? Fn.compose Deferred.return extract +let extract_block_proof { Proof_carrying_data.data; proof = chain, proof_block } + = + let%bind.Or_error proof_block = + Frontier_base.Network_types.Block.extract proof_block + in + let%map.Or_error data = Frontier_base.Network_types.Block.extract data in + { Proof_carrying_data.data; proof = (chain, proof_block) } + let get_best_tip ?heartbeat_timeout ?timeout t peer = make_rpc_request ?heartbeat_timeout ?timeout ~rpc:Rpcs.Get_best_tip ~label:"best tip" t peer () + >>=? Fn.compose Deferred.return extract_block_proof let get_completed_checked_snarks t peer = make_rpc_request ~rpc:Rpcs.Get_completed_snarks @@ -377,7 +386,12 @@ let get_staged_ledger_aux_and_pending_coinbases_at_hash t inet_addr input = .extract let get_ancestry t inet_addr input = + let extract_block_proof' env = + let%map.Or_error data' = extract_block_proof (Envelope.Incoming.data env) in + Envelope.Incoming.map env ~f:(const data') + in rpc_peer_then_random t inet_addr input ~rpc:Rpcs.Get_ancestry + >>=? Fn.compose Deferred.return extract_block_proof' module Sl_downloader = struct module Key = struct diff --git a/src/lib/mina_networking/mina_networking.mli b/src/lib/mina_networking/mina_networking.mli index d5b9be7616f5..f4c462c3cc3d 100644 --- a/src/lib/mina_networking/mina_networking.mli +++ b/src/lib/mina_networking/mina_networking.mli @@ -89,8 +89,8 @@ module Rpcs : sig (Consensus.Data.Consensus_state.Value.t, State_hash.t) With_hash.t type response = - ( Mina_block.Stable.Latest.t - , State_body_hash.t list * Mina_block.Stable.Latest.t ) + ( Frontier_base.Network_types.Block.t + , State_body_hash.t list * Frontier_base.Network_types.Block.t ) Proof_carrying_data.t option end @@ -106,8 +106,8 @@ module Rpcs : sig type query = unit type response = - ( Mina_block.Stable.Latest.t - , State_body_hash.t list * Mina_block.Stable.Latest.t ) + ( Frontier_base.Network_types.Block.t + , State_body_hash.t list * Frontier_base.Network_types.Block.t ) Proof_carrying_data.t option end diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index a0637c1b4a0e..7ed3bb9957a4 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -879,8 +879,8 @@ module Get_ancestry = struct [@@deriving sexp, to_yojson] type response = - ( Mina_block.Stable.Latest.t - , State_body_hash.t list * Mina_block.Stable.Latest.t ) + ( Frontier_base.Network_types.Block.t + , State_body_hash.t list * Frontier_base.Network_types.Block.t ) Proof_carrying_data.t option end @@ -918,8 +918,9 @@ module Get_ancestry = struct [@@deriving sexp] type response = - ( Mina_block.Stable.V2.t - , State_body_hash.Stable.V1.t list * Mina_block.Stable.V2.t ) + ( Frontier_base.Network_types.Block.Stable.V1.t + , State_body_hash.Stable.V1.t list + * Frontier_base.Network_types.Block.Stable.V1.t ) Proof_carrying_data.Stable.V1.t option @@ -976,14 +977,14 @@ module Get_ancestry = struct in None | Some { proof = chain, base_block; data = block } -> - let block = Frontier_base.Breadcrumb.block block in - let base_block = Frontier_base.Breadcrumb.block base_block in + let block = Frontier_base.Breadcrumb.block_tag block in + let base_block = Frontier_base.Breadcrumb.block_tag base_block in Deferred.return - @@ Some - { Proof_carrying_data.proof = - (chain, Mina_block.read_all_proofs_from_disk base_block) - ; data = Mina_block.read_all_proofs_from_disk block - } + @@ ( Some + { Proof_carrying_data.proof = (chain, Tag base_block) + ; data = Tag block + } + : response ) let rate_limit_budget = (5, `Per Time.Span.minute) @@ -1085,8 +1086,8 @@ module Get_best_tip = struct type query = unit [@@deriving sexp, to_yojson] type response = - ( Mina_block.Stable.Latest.t - , State_body_hash.t list * Mina_block.Stable.Latest.t ) + ( Frontier_base.Network_types.Block.t + , State_body_hash.t list * Frontier_base.Network_types.Block.t ) Proof_carrying_data.t option end @@ -1120,8 +1121,9 @@ module Get_best_tip = struct type query = unit [@@deriving sexp] type response = - ( Mina_block.Stable.V2.t - , State_body_hash.Stable.V1.t list * Mina_block.Stable.V2.t ) + ( Frontier_base.Network_types.Block.Stable.V1.t + , State_body_hash.Stable.V1.t list + * Frontier_base.Network_types.Block.Stable.V1.t ) Proof_carrying_data.Stable.V1.t option @@ -1172,14 +1174,14 @@ module Get_best_tip = struct in None | Some { data = data_block; proof = chain, proof_block } -> - let data_block = Frontier_base.Breadcrumb.block data_block in - let proof_block = Frontier_base.Breadcrumb.block proof_block in + let data_block = Frontier_base.Breadcrumb.block_tag data_block in + let proof_block = Frontier_base.Breadcrumb.block_tag proof_block in Deferred.return - @@ Some - { Proof_carrying_data.data = - Mina_block.read_all_proofs_from_disk data_block - ; proof = (chain, Mina_block.read_all_proofs_from_disk proof_block) - } + @@ ( Some + { Proof_carrying_data.data = Tag data_block + ; proof = (chain, Tag proof_block) + } + : response ) let rate_limit_budget = (3, `Per Time.Span.minute) From d001696482530ed08cbd28530bdff8f28fa05c4a Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 21:14:04 +0100 Subject: [PATCH 078/122] Implement passthru serialization for tags in RPCs --- src/lib/multi-key-file-storage/intf.mli | 6 ++ .../multi_key_file_storage.ml | 32 ++++--- src/lib/sync_handler/sync_handler.ml | 5 +- .../frontier_base/network_types.ml | 90 ++++++++++--------- 4 files changed, 79 insertions(+), 54 deletions(-) diff --git a/src/lib/multi-key-file-storage/intf.mli b/src/lib/multi-key-file-storage/intf.mli index 975f34e61fb8..a04bb47f203c 100644 --- a/src/lib/multi-key-file-storage/intf.mli +++ b/src/lib/multi-key-file-storage/intf.mli @@ -94,4 +94,10 @@ module type S = sig (module Bin_prot.Binable.S with type t = 'a) -> 'a tag list -> 'a list Core_kernel.Or_error.t + + (** Read the bytes stored at the given tag *) + val read_bytes : 'a tag -> Bytes.t Core_kernel.Or_error.t + + (** Get the size of the value stored at the given tag *) + val size : 'a tag -> int end diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.ml b/src/lib/multi-key-file-storage/multi_key_file_storage.ml index e36c64789fdf..f8d7e1bda2a1 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.ml @@ -140,11 +140,12 @@ end) : in Out_channel.with_file filename ~binary:true ~append:true ~f:do_appending - (** Read a value from the database using a tag *) - let read : - type a. - (module Bin_prot.Binable.S with type t = a) -> a tag -> a Or_error.t = - fun (module B : Bin_prot.Binable.S with type t = a) tag -> + (** Get the size of the value stored at the given tag *) + let size (tag : _ tag) = tag.size + + (** Read the bytes stored at the given tag *) + let read_bytes : _ tag -> Bytes.t Or_error.t = + fun tag -> let do_reading ic = (* Seek to the specified offset *) In_channel.seek ic tag.offset ; @@ -152,7 +153,22 @@ end) : (* Read the exact number of bytes *) let buffer = Bytes.create tag.size in In_channel.really_input_exn ic ~buf:buffer ~pos:0 ~len:tag.size ; + buffer + in + Or_error.tag ~tag:(Inputs.filename tag.filename_key) + @@ Or_error.try_with ~backtrace:true + @@ fun () -> + In_channel.with_file + (Inputs.filename tag.filename_key) + ~binary:true ~f:do_reading + (** Read a value from the database using a tag *) + let read : + type a. + (module Bin_prot.Binable.S with type t = a) -> a tag -> a Or_error.t = + fun (module B : Bin_prot.Binable.S with type t = a) tag -> + let%bind.Or_error buffer = read_bytes tag in + let do_parsing () = (* Deserialize using bin_prot *) let bigstring = Bigstring.of_bytes buffer in let pos_ref = ref 0 in @@ -167,11 +183,7 @@ end) : else Ok value in Or_error.tag ~tag:(Inputs.filename tag.filename_key) - @@ Or_error.try_with_join ~backtrace:true - @@ fun () -> - In_channel.with_file - (Inputs.filename tag.filename_key) - ~binary:true ~f:do_reading + @@ Or_error.try_with_join ~backtrace:true do_parsing let read_many (type a) (module B : Bin_prot.Binable.S with type t = a) tags = let%map.Or_error reversed = diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 1519da155ea2..d415f646713e 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -122,8 +122,7 @@ module Make (Inputs : Inputs_intf) : let%map.Option historical = Root_history.lookup root_history state_hash in - Frontier_base.Network_types.Staged_ledger_aux_and_pending_coinbases.M - .Tag + Frontier_base.Network_types.Tag_or_data.Tag (Root_data.Historical.staged_ledger_aux_and_pending_coinbases historical ) | Some (res, staged_ledger_hash) -> @@ -152,7 +151,7 @@ module Make (Inputs : Inputs_intf) : Option.first_some Transition_frontier.(find frontier hash >>| Breadcrumb.block_tag) (find_in_root_history frontier hash >>| Root_data.Historical.block_tag) - |> Option.map ~f:(fun x -> Frontier_base.Network_types.Block.M.Tag x) + |> Option.map ~f:(fun x -> Frontier_base.Network_types.Tag_or_data.Tag x) in match Transition_frontier.catchup_state frontier with | Full _ -> diff --git a/src/lib/transition_frontier/frontier_base/network_types.ml b/src/lib/transition_frontier/frontier_base/network_types.ml index baf76e87dbc3..1d47a2963974 100644 --- a/src/lib/transition_frontier/frontier_base/network_types.ml +++ b/src/lib/transition_frontier/frontier_base/network_types.ml @@ -1,36 +1,48 @@ open Core_kernel open Mina_base -module Make (Data : Binable.S) = struct - type t = Tag of Data.t State_hash.File_storage.tag | Data of Data.t +module Tag_or_data = struct + type 'a t = Tag of 'a State_hash.File_storage.tag | Data of 'a +end - type data_tag = Data.t State_hash.File_storage.tag +module Make' (Data : Binable.S) = struct + include Bin_prot.Utils.Of_minimal (struct + type t = Data.t Tag_or_data.t - let extract = function - | Tag x -> - State_hash.File_storage.read (module Data) x - | Data x -> - Or_error.return x + let bin_shape_t = Data.bin_shape_t - let to_latest = Fn.id + let __bin_read_t__ buf ~pos_ref vint = + Tag_or_data.Data (Data.__bin_read_t__ buf ~pos_ref vint) - module Arg = struct - type nonrec t = t + let bin_read_t buf ~pos_ref = + Tag_or_data.Data (Data.bin_read_t buf ~pos_ref) - let to_binable = function - | Tag x -> - (* TODO This code deserializes the data stored in the file - and serializes it back. This is a bad thing to do. - But in future we will have a special communication - protocol between libp2p helper and daemon to push file reading - to the helper, and then we won't have deserialization anymore. - *) - State_hash.File_storage.read (module Data) x |> Or_error.ok_exn + let bin_size_t = function + | Tag_or_data.Tag tag -> + State_hash.File_storage.size tag | Data x -> - x + Data.bin_size_t x + + let bin_write_t buf ~pos = function + | Tag_or_data.Tag tag -> + let data = + State_hash.File_storage.read_bytes tag |> Or_error.ok_exn + in + let bs = Bigstring.of_bytes data in + let len = Bigstring.length bs in + Bigstring.blit ~src:bs ~src_pos:0 ~dst:buf ~dst_pos:pos ~len ; + pos + len + | Data x -> + Data.bin_write_t buf ~pos x + end) - let of_binable x = Data x - end + let extract = function + | Tag_or_data.Tag x -> + State_hash.File_storage.read (module Data) x + | Data x -> + Or_error.return x + + type data_tag = Data.t State_hash.File_storage.tag end module Staged_ledger_aux_and_pending_coinbases = struct @@ -52,39 +64,35 @@ module Staged_ledger_aux_and_pending_coinbases = struct end] end - module M = Make (Data.Stable.V1) - - type data_tag = M.data_tag - - let extract = M.extract - [%%versioned_binable module Stable = struct module V1 = struct - type t = M.t + type t = Data.Stable.V1.t Tag_or_data.t - let to_latest = M.to_latest + let to_latest = Fn.id - include Binable.Of_binable_without_uuid (Data.Stable.V1) (M.Arg) + include Make' (Data.Stable.V1) end end] -end -module Block = struct - module M = Make (Mina_block.Stable.V2) - - type data_tag = M.data_tag + let extract = Stable.Latest.extract - let extract = M.extract + type data_tag = Stable.Latest.data_tag +end +module Block = struct [%%versioned_binable module Stable = struct module V1 = struct - type t = M.t + type t = Mina_block.Stable.V2.t Tag_or_data.t - let to_latest = M.to_latest + let to_latest = Fn.id - include Binable.Of_binable_without_uuid (Mina_block.Stable.V2) (M.Arg) + include Make' (Mina_block.Stable.V2) end end] + + let extract = Stable.Latest.extract + + type data_tag = Stable.Latest.data_tag end From e0b478dea56d4ac82f67e9c802aacaa2410addb8 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 22:34:07 +0100 Subject: [PATCH 079/122] Reduce usage of validated_transition --- src/lib/mina_lib/mina_lib.ml | 14 +++------ .../frontier_base/breadcrumb.ml | 4 +++ .../frontier_base/breadcrumb.mli | 4 +++ .../frontier_base/command_stats.ml | 14 +++++++++ .../full_frontier/full_frontier.ml | 30 ++++--------------- src/lib/transition_handler/processor.ml | 6 ++-- 6 files changed, 34 insertions(+), 38 deletions(-) create mode 100644 src/lib/transition_frontier/frontier_base/command_stats.ml diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 5b743dc51b2a..aec36da6597d 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1665,8 +1665,8 @@ let fetch_completed_snarks (module Context : CONTEXT) snark_pool network | Some frontier -> let tip = Transition_frontier.best_tip frontier in let top_block = - Transition_frontier.Breadcrumb.validated_transition tip - |> Mina_block.Validated.header |> Mina_block.Header.blockchain_length + Transition_frontier.Breadcrumb.header tip + |> Mina_block.Header.blockchain_length in let delta = Unsigned.UInt32.(Infix.(received_block - top_block) |> to_int) @@ -2676,14 +2676,8 @@ let best_chain_block_by_height (t : t) height = let%bind transition_frontier = get_transition_frontier t in Transition_frontier.best_tip_path transition_frontier |> List.find ~f:(fun bc -> - let validated_transition = - Transition_frontier.Breadcrumb.validated_transition bc - in - let block_height = - Mina_block.( - blockchain_length @@ With_hash.data - @@ Validated.forget validated_transition) - in + let header = Transition_frontier.Breadcrumb.header bc in + let block_height = Mina_block.Header.blockchain_length header in Unsigned.UInt32.equal block_height height ) |> Result.of_option ~error: diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 4aea879262b7..9347d2860887 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -94,6 +94,8 @@ T. , block_tag , staged_ledger_aux_and_pending_coinbases_cached )] +let header t = T.validated_transition t |> Mina_block.Validated.header + let command_hashes t = T.validated_transition t |> Mina_block.Validated.body |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes @@ -259,6 +261,8 @@ let block_with_hash = let block = Fn.compose With_hash.data block_with_hash +let command_stats t = Command_stats.of_body @@ Mina_block.body @@ block t + let state_hash = Fn.compose Mina_block.Validated.state_hash validated_transition let protocol_state b = diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index f846d57f47e9..51b574dfd07c 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -62,6 +62,10 @@ val valid_commands_hashed : val contains_transaction_by_hash : t -> Mina_transaction.Transaction_hash.t -> bool +val header : t -> Mina_block.Header.t + +val command_stats : t -> Command_stats.t + val validated_transition : t -> Mina_block.Validated.t val block_tag : t -> Mina_block.Stable.Latest.t State_hash.File_storage.tag diff --git a/src/lib/transition_frontier/frontier_base/command_stats.ml b/src/lib/transition_frontier/frontier_base/command_stats.ml new file mode 100644 index 000000000000..576995f35387 --- /dev/null +++ b/src/lib/transition_frontier/frontier_base/command_stats.ml @@ -0,0 +1,14 @@ +open Core_kernel +open Mina_base + +type t = { total : int; zkapp_commands : int } + +let of_body (body : Mina_block.Body.t) = + Staged_ledger_diff.Body.staged_ledger_diff body + |> Staged_ledger_diff.commands + |> List.fold ~init:{ total = 0; zkapp_commands = 0 } + ~f:(fun { total; zkapp_commands } -> function + | { With_status.data = User_command.Signed_command _; _ } -> + { total = total + 1; zkapp_commands } + | { data = Zkapp_command _; _ } -> + { total = total + 1; zkapp_commands = zkapp_commands + 1 } ) diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 5d3c1e23db7b..ddb10e0d2997 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -706,12 +706,7 @@ module Metrics = struct let empty_blocks_at_best_tip t = let rec go acc b = - if - not - (List.is_empty - ( Breadcrumb.validated_transition b - |> Mina_block.Validated.valid_commands ) ) - then acc + if (Breadcrumb.command_stats b).total <> 0 then acc else match parent t b with None -> acc | Some b -> go (acc + 1) b in go 0 (best_tip t) @@ -798,10 +793,7 @@ let update_metrics_with_diff (type mutant) Int.to_float (1 + List.length garbage_breadcrumbs) in let num_finalized_staged_txns = - Int.to_float - (List.length - ( Breadcrumb.validated_transition new_root_breadcrumb - |> Mina_block.Validated.valid_commands ) ) + Int.to_float (Breadcrumb.command_stats new_root_breadcrumb).total in Gauge.dec Transition_frontier.active_breadcrumbs num_breadcrumbs_removed ; Gauge.set Transition_frontier.recently_finalized_staged_txns @@ -842,24 +834,14 @@ let update_metrics_with_diff (type mutant) in Block_time.Span.( <= ) (Block_time.diff now slot_time) two_slots in - let valid_commands = - Breadcrumb.validated_transition best_tip - |> Mina_block.Validated.valid_commands + let { Command_stats.total; zkapp_commands } = + Breadcrumb.command_stats best_tip in Mina_metrics.( - Gauge.set Transition_frontier.best_tip_user_txns - (Int.to_float (List.length valid_commands)) ; + Gauge.set Transition_frontier.best_tip_user_txns (Int.to_float total) ; Mina_metrics.( Gauge.set Transition_frontier.best_tip_zkapp_txns - (Int.to_float - (List.fold ~init:0 - ~f:(fun c cmd -> - match cmd.data with - | Mina_base.User_command.Poly.Zkapp_command _ -> - c + 1 - | _ -> - c ) - valid_commands ) )) ; + (Int.to_float zkapp_commands)) ; if is_recent_block then Gauge.set Transition_frontier.best_tip_coinbase (if has_coinbase best_tip then 1. else 0.) ; diff --git a/src/lib/transition_handler/processor.ml b/src/lib/transition_handler/processor.ml index 655cd6842254..4293ac01fd09 100644 --- a/src/lib/transition_handler/processor.ml +++ b/src/lib/transition_handler/processor.ml @@ -429,17 +429,15 @@ let run ~context:(module Context : CONTEXT) ~verifier ~trust_system () ) | `Local_breadcrumb breadcrumb -> let state_hash = - Transition_frontier.Breadcrumb.validated_transition + Transition_frontier.Breadcrumb.state_hash (Cached.peek breadcrumb) - |> Mina_block.Validated.state_hash in Internal_tracing.with_state_hash state_hash @@ fun () -> [%log internal] "Begin_local_block_processing" ; let transition_time = - Transition_frontier.Breadcrumb.validated_transition + Transition_frontier.Breadcrumb.header (Cached.peek breadcrumb) - |> Mina_block.Validated.header |> Mina_block.Header.protocol_state |> Protocol_state.blockchain_state |> Blockchain_state.timestamp |> Block_time.to_time_exn From b0149ff2cdf0a31b8e278c298d1ae11a40ff5507 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 22:51:29 +0100 Subject: [PATCH 080/122] Simplify garbage representation in diff.ml --- src/lib/transition_frontier/frontier_base/diff.ml | 8 ++------ src/lib/transition_frontier/frontier_base/diff.mli | 4 +--- .../transition_frontier/full_frontier/full_frontier.ml | 6 +++--- 3 files changed, 6 insertions(+), 12 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/diff.ml b/src/lib/transition_frontier/frontier_base/diff.ml index 91805639aad6..1895a4db0eda 100644 --- a/src/lib/transition_frontier/frontier_base/diff.ml +++ b/src/lib/transition_frontier/frontier_base/diff.ml @@ -13,9 +13,7 @@ end module Node_list = struct type full_node = - { transition : Mina_block.Validated.t - ; scan_state : Staged_ledger.Scan_state.t - } + { state_hash : State_hash.t; scan_state : Staged_ledger.Scan_state.t } type lite_node = State_hash.t @@ -25,9 +23,7 @@ module Node_list = struct type 'repr node_list = 'repr t - let to_lite = - List.map ~f:(fun { transition; _ } -> - Mina_block.Validated.state_hash transition ) + let to_lite = List.map ~f:(fun { state_hash; _ } -> state_hash) module Lite = struct module Binable_arg = struct diff --git a/src/lib/transition_frontier/frontier_base/diff.mli b/src/lib/transition_frontier/frontier_base/diff.mli index ee7489b41fbe..0eeebd7f28a1 100644 --- a/src/lib/transition_frontier/frontier_base/diff.mli +++ b/src/lib/transition_frontier/frontier_base/diff.mli @@ -28,9 +28,7 @@ end module Node_list : sig type full_node = - { transition : Mina_block.Validated.t - ; scan_state : Staged_ledger.Scan_state.t - } + { state_hash : State_hash.t; scan_state : Staged_ledger.Scan_state.t } type lite_node = State_hash.Stable.V1.t diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index ddb10e0d2997..74d717eb3b9c 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -335,11 +335,11 @@ module Util = struct let garbage_nodes = List.map garbage_breadcrumbs ~f:(fun breadcrumb -> let open Diff.Node_list in - let transition = Breadcrumb.validated_transition breadcrumb in + let state_hash = Breadcrumb.state_hash breadcrumb in let scan_state = Staged_ledger.scan_state (Breadcrumb.staged_ledger breadcrumb) in - { transition; scan_state } ) + { state_hash; scan_state } ) in let new_scan_state = Staged_ledger.scan_state heir_staged_ledger in let next_root_required_hashes = @@ -444,7 +444,7 @@ let move_root ({ context = (module Context); _ } as t) ~new_root_hash (* STEP 1 *) List.iter garbage ~f:(fun node -> let open Diff.Node_list in - let hash = Mina_block.Validated.state_hash node.transition in + let hash = node.state_hash in let breadcrumb = find_exn ~message:"garbage" t hash in let mask = Breadcrumb.mask breadcrumb in (* this should get garbage collected and should not require additional destruction *) From e760f2d51b01efc48ca60c8c144f106206dd54b5 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 23:25:19 +0100 Subject: [PATCH 081/122] Limit usage of Breadcrumb.block --- src/lib/block_producer/block_producer.ml | 4 +-- .../bootstrap_controller.ml | 4 +-- src/lib/ledger_catchup/super_catchup.ml | 2 +- src/lib/mina_graphql/mina_graphql.ml | 4 +-- src/lib/mina_lib/mina_lib.ml | 21 +++++------ src/lib/mina_lmdb_storage/block.ml | 1 + .../frontier_base/command_stats.ml | 35 ++++++++++++++----- .../full_frontier/full_frontier.ml | 16 ++------- 8 files changed, 46 insertions(+), 41 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index ec87124ce5b6..65f58dea57fb 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -1042,8 +1042,8 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover ~metadata: [ ( "blockchain_length" , Mina_numbers.Length.to_yojson - @@ Mina_block.blockchain_length - @@ Breadcrumb.block breadcrumb ) + @@ Mina_block.Header.blockchain_length + @@ Breadcrumb.header breadcrumb ) ; ("transactions", `List txs) ] ; [%str_log info] diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index e745ca9685af..1238e7b89a2d 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -905,9 +905,7 @@ let%test_module "Bootstrap_controller tests" = let assert_transitions_increasingly_sorted ~root (incoming_transitions : Transition_cache.element list) = - let root = - Transition_frontier.Breadcrumb.block root |> Mina_block.header - in + let root = Transition_frontier.Breadcrumb.header root in ignore ( List.fold_result ~init:root incoming_transitions ~f:(fun max_acc incoming_transition -> diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index 1ef7faec74f6..ea7236ad2b15 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -692,7 +692,7 @@ let create_node ~logger ~downloader t x = match x with | `Root root -> let blockchain_length = - Breadcrumb.block root |> Mina_block.blockchain_length + Breadcrumb.header root |> Mina_block.Header.blockchain_length in Internal_tracing.with_state_hash (Breadcrumb.state_hash root) @@ fun () -> diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index 2c86506c14f1..bcd3089ffecd 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -2210,8 +2210,8 @@ module Queries = struct |> Staged_ledger_diff.commands in let block_number = - bc |> Transition_frontier.Breadcrumb.block - |> Mina_block.header |> Mina_block.Header.blockchain_length + bc |> Transition_frontier.Breadcrumb.header + |> Mina_block.Header.blockchain_length in let transaction_seq = ref 0 in let action_list_list = diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index aec36da6597d..43b193860f4f 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -763,8 +763,7 @@ let get_snarked_ledger_full t state_hash_opt = else return () ) in let snarked_ledger_hash = - Transition_frontier.Breadcrumb.block b - |> Mina_block.header |> Header.protocol_state + Transition_frontier.Breadcrumb.protocol_state b |> Mina_state.Protocol_state.blockchain_state |> Mina_state.Blockchain_state.snarked_ledger_hash in @@ -2884,11 +2883,10 @@ module Hardfork_config = struct hard fork genesis slot delta in the runtime config, if those have been set and the [breadcrum_spec] was [`Stop_slot]. Otherwise, it will be the global slot since genesis of the hard fork block. *) - let hard_fork_global_slot ~breadcrumb_spec ~block mina : + let hard_fork_global_slot ~breadcrumb_spec ~consensus_state mina : Mina_numbers.Global_slot_since_hard_fork.t = let block_global_slot = - Mina_block.consensus_state block - |> Consensus.Data.Consensus_state.curr_global_slot + Consensus.Data.Consensus_state.curr_global_slot consensus_state in let configured_slot = match breadcrumb_spec with @@ -2939,15 +2937,18 @@ module Hardfork_config = struct let prepare_inputs ~breadcrumb_spec mina = let open Deferred.Result.Let_syntax in let%bind breadcrumb = breadcrumb ~breadcrumb_spec mina in - let block = Transition_frontier.Breadcrumb.block breadcrumb in - let blockchain_length = Mina_block.blockchain_length block in + let consensus_state = + Transition_frontier.Breadcrumb.consensus_state breadcrumb + in + let blockchain_length = + Consensus.Data.Consensus_state.blockchain_length consensus_state + in let global_slot_since_hard_fork = - hard_fork_global_slot ~breadcrumb_spec ~block mina + hard_fork_global_slot ~breadcrumb_spec ~consensus_state mina in let global_slot_since_genesis = move_hard_fork_consensus_to_scheduled_genesis - ~hard_fork_consensus_data:(Mina_block.consensus_state block) - global_slot_since_hard_fork + ~hard_fork_consensus_data:consensus_state global_slot_since_hard_fork in let genesis_state_timestamp = genesis_timestamp_str diff --git a/src/lib/mina_lmdb_storage/block.ml b/src/lib/mina_lmdb_storage/block.ml index ce35ed427e92..60fd98b83316 100644 --- a/src/lib/mina_lmdb_storage/block.ml +++ b/src/lib/mina_lmdb_storage/block.ml @@ -149,6 +149,7 @@ let%test_module "Block storage tests" = f conf_dir helper ) let send_and_receive ~helper ~reader ~db breadcrumb = + (* TODO use block tag *) let body = Breadcrumb.block breadcrumb |> Mina_block.body |> Mina_block.Body.read_all_proofs_from_disk diff --git a/src/lib/transition_frontier/frontier_base/command_stats.ml b/src/lib/transition_frontier/frontier_base/command_stats.ml index 576995f35387..362bb2a88e26 100644 --- a/src/lib/transition_frontier/frontier_base/command_stats.ml +++ b/src/lib/transition_frontier/frontier_base/command_stats.ml @@ -1,14 +1,31 @@ open Core_kernel open Mina_base -type t = { total : int; zkapp_commands : int } +type t = { total : int; zkapp_commands : int; has_coinbase : bool } + +let has_coinbase (staged_ledger_diff : Staged_ledger_diff.t) = + let d1, d2 = staged_ledger_diff.diff in + match (d1.coinbase, d2) with + | Zero, None | Zero, Some { coinbase = Zero; _ } -> + false + | Zero, Some { coinbase = One _; _ } | One _, _ | Two _, _ -> + true let of_body (body : Mina_block.Body.t) = - Staged_ledger_diff.Body.staged_ledger_diff body - |> Staged_ledger_diff.commands - |> List.fold ~init:{ total = 0; zkapp_commands = 0 } - ~f:(fun { total; zkapp_commands } -> function - | { With_status.data = User_command.Signed_command _; _ } -> - { total = total + 1; zkapp_commands } - | { data = Zkapp_command _; _ } -> - { total = total + 1; zkapp_commands = zkapp_commands + 1 } ) + let staged_ledger_diff = Staged_ledger_diff.Body.staged_ledger_diff body in + Staged_ledger_diff.commands staged_ledger_diff + |> List.fold + ~init: + { total = 0 + ; zkapp_commands = 0 + ; has_coinbase = has_coinbase staged_ledger_diff + } + ~f: + (fun v -> function + | { With_status.data = User_command.Signed_command _; _ } -> + { v with total = v.total + 1 } + | { data = Zkapp_command _; _ } -> + { v with + total = v.total + 1 + ; zkapp_commands = v.zkapp_commands + 1 + } ) diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 74d717eb3b9c..a71d81d59a53 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -726,18 +726,6 @@ module Metrics = struct in r -. Mina_metrics.time_offset_sec - let has_coinbase b = - let d1, d2 = - ( Breadcrumb.block b |> Mina_block.body - |> Mina_block.Body.staged_ledger_diff ) - .diff - in - match (d1.coinbase, d2) with - | Zero, None | Zero, Some { coinbase = Zero; _ } -> - false - | Zero, Some { coinbase = One _; _ } | One _, _ | Two _, _ -> - true - let intprop f b = Unsigned.UInt32.to_int (f (Breadcrumb.consensus_state b)) (* Rate of slots filled on the main chain in the k slots preceeding the best tip. *) @@ -834,7 +822,7 @@ let update_metrics_with_diff (type mutant) in Block_time.Span.( <= ) (Block_time.diff now slot_time) two_slots in - let { Command_stats.total; zkapp_commands } = + let { Command_stats.total; zkapp_commands; has_coinbase } = Breadcrumb.command_stats best_tip in Mina_metrics.( @@ -844,7 +832,7 @@ let update_metrics_with_diff (type mutant) (Int.to_float zkapp_commands)) ; if is_recent_block then Gauge.set Transition_frontier.best_tip_coinbase - (if has_coinbase best_tip then 1. else 0.) ; + (if has_coinbase then 1. else 0.) ; Gauge.set Transition_frontier.slot_fill_rate (slot_fill_rate t) ; Gauge.set Transition_frontier.min_window_density (Int.to_float (intprop min_window_density best_tip)) ; From 4508165b8c8d14db2d96558e5cd64850f21e43e1 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 23:32:30 +0100 Subject: [PATCH 082/122] Don't use Breadcrumb_block in uptime_service --- src/lib/uptime_service/uptime_service.ml | 31 ++++++++++++------------ 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/src/lib/uptime_service/uptime_service.ml b/src/lib/uptime_service/uptime_service.ml index 62b1861385c6..d8c02a290076 100644 --- a/src/lib/uptime_service/uptime_service.ml +++ b/src/lib/uptime_service/uptime_service.ml @@ -152,8 +152,10 @@ let send_uptime_data ~logger ~interruptor ~(submitter_keypair : Keypair.t) ~url let block_base64_of_breadcrumb breadcrumb = let external_transition = - breadcrumb |> Transition_frontier.Breadcrumb.block - |> Mina_block.read_all_proofs_from_disk + breadcrumb |> Transition_frontier.Breadcrumb.block_tag + |> State_hash.File_storage.read (module Mina_block.Stable.Latest) + |> Or_error.tag ~tag:"uptime_service" + |> Or_error.ok_exn in let block_string = Binable.to_string (module Mina_block.Stable.Latest) external_transition @@ -200,10 +202,9 @@ let read_all_proofs_for_work_single_spec = ~f_proof:Ledger_proof.Cached.read_proof_from_disk ~f_witness:Transaction_witness.read_all_proofs_from_disk -let send_block_and_transaction_snark ~logger ~constraint_constants ~interruptor - ~url ~snark_worker ~transition_frontier ~peer_id - ~(submitter_keypair : Keypair.t) ~snark_work_fee ~graphql_control_port - ~built_with_commit_sha = +let send_block_and_transaction_snark ~logger ~interruptor ~url ~snark_worker + ~transition_frontier ~peer_id ~(submitter_keypair : Keypair.t) + ~snark_work_fee ~graphql_control_port ~built_with_commit_sha = match Broadcast_pipe.Reader.peek transition_frontier with | None -> (* expected during daemon boot, so not logging as error *) @@ -220,11 +221,10 @@ let send_block_and_transaction_snark ~logger ~constraint_constants ~interruptor ~prover:(Public_key.compress submitter_keypair.public_key) in let best_tip = Transition_frontier.best_tip tf in - let best_tip_block = Transition_frontier.Breadcrumb.block best_tip in - if - List.is_empty - (Mina_block.transactions ~constraint_constants best_tip_block) - then ( + let best_tip_stats = + Transition_frontier.Breadcrumb.command_stats best_tip + in + if (not best_tip_stats.has_coinbase) && best_tip_stats.total = 0 then ( [%log info] "No transactions in block, sending block without SNARK work to \ uptime service" ; @@ -287,8 +287,7 @@ let send_block_and_transaction_snark ~logger ~constraint_constants ~interruptor ~f:Staged_ledger.Scan_state.Available_job.is_transition in let staged_ledger_hash = - Mina_block.header best_tip_block - |> Mina_block.Header.protocol_state + Transition_frontier.Breadcrumb.protocol_state best_tip |> Mina_state.Protocol_state.blockchain_state |> Mina_state.Blockchain_state.staged_ledger_hash in @@ -469,9 +468,9 @@ let start ~logger ~uptime_url ~snark_worker_opt ~constraint_constants "Uptime service will attempt to send a block and SNARK work" ; let snark_work_fee = get_snark_work_fee () in send_block_and_transaction_snark ~logger ~interruptor ~url - ~constraint_constants ~snark_worker ~transition_frontier - ~peer_id ~submitter_keypair ~snark_work_fee - ~graphql_control_port ~built_with_commit_sha + ~snark_worker ~transition_frontier ~peer_id + ~submitter_keypair ~snark_work_fee ~graphql_control_port + ~built_with_commit_sha in match get_next_producer_time_opt () with | None -> From ae924b7551d69afb4dc2fb63b65449e95fc348e2 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 23:45:02 +0100 Subject: [PATCH 083/122] Reduce usages of Breadcrumb.block_with_hash --- src/lib/block_producer/block_producer.ml | 33 ++++++++++-------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 65f58dea57fb..c2f66c018cf6 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -840,15 +840,15 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover ) ] "Producing new block with parent $parent_hash%!" ; - let previous_transition = Breadcrumb.block_with_hash crumb in - let previous_protocol_state = - Header.protocol_state - @@ Mina_block.header (With_hash.data previous_transition) + let previous_header = Breadcrumb.header crumb in + let previous_consensus_state_with_hashes = + Breadcrumb.consensus_state_with_hashes crumb in + let previous_protocol_state = Breadcrumb.protocol_state crumb in let%bind previous_protocol_state_proof = if Consensus.Data.Consensus_state.is_genesis_state - (Protocol_state.consensus_state previous_protocol_state) + (With_hash.data previous_consensus_state_with_hashes) && Option.is_none precomputed_values.proof_data then ( match%bind Interruptible.uninterruptible (genesis_breadcrumb ()) with @@ -860,10 +860,7 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover "Aborting block production: cannot generate a genesis proof" ~metadata:[ ("error", Error_json.error_to_yojson err) ] ; Interruptible.lift (Deferred.never ()) (Deferred.return ()) ) - else - return - ( Header.protocol_state_proof - @@ Mina_block.header (With_hash.data previous_transition) ) + else return (Header.protocol_state_proof previous_header) in [%log internal] "Get_transactions_from_pool" ; let transactions = @@ -910,9 +907,7 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover phys_equal (Consensus.Hooks.select ~context:(module Context) - ~existing: - (With_hash.map ~f:Mina_block.consensus_state - previous_transition ) + ~existing:previous_consensus_state_with_hashes ~candidate:consensus_state_with_hashes ) `Take || failwith @@ -1504,18 +1499,15 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system [%log trace] ~metadata:[ ("breadcrumb", Breadcrumb.to_yojson crumb) ] "Emitting precomputed block with parent $breadcrumb%!" ; - let previous_transition = Breadcrumb.block_with_hash crumb in - let previous_protocol_state = - Header.protocol_state - @@ Mina_block.header (With_hash.data previous_transition) + let previous_consensus_state_with_hashes = + Breadcrumb.consensus_state_with_hashes crumb in + let previous_protocol_state = Breadcrumb.protocol_state crumb in assert ( phys_equal (Consensus.Hooks.select ~context:(module Context) - ~existing: - (With_hash.map ~f:Mina_block.consensus_state - previous_transition ) + ~existing:previous_consensus_state_with_hashes ~candidate:consensus_state_with_hashes ) `Take || failwith @@ -1538,7 +1530,8 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system let emit_breadcrumb () = let open Deferred.Result.Let_syntax in let previous_protocol_state_hash = - State_hash.With_state_hashes.state_hash previous_transition + State_hash.With_state_hashes.state_hash + previous_consensus_state_with_hashes in let header = Header.create ~protocol_state ~protocol_state_proof From 9b1915132869e613e2d4a77b2c261dfe12a26cdc Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 26 Nov 2025 23:49:14 +0100 Subject: [PATCH 084/122] Retrieve command hashes before adding to frontier --- src/lib/transition_frontier/transition_frontier.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index e4921dc80506..271be603d54a 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -450,6 +450,7 @@ let add_breadcrumb_exn t breadcrumb = ; ("n", `Int (Full_frontier.size t.full_frontier)) ] "PRE: ($state_hash, $n)" ; + let user_cmd_hashes = Breadcrumb.command_hashes breadcrumb in [%str_log' trace t.logger] (Applying_diffs { diffs = List.map ~f:Diff.Full.E.to_yojson diffs }) ; [%log internal] "Apply_catchup_state_diffs" ; @@ -475,7 +476,6 @@ let add_breadcrumb_exn t breadcrumb = ; ("n", `Int (Full_frontier.size t.full_frontier)) ] "POST: ($state_hash, $n)" ; - let user_cmd_hashes = Breadcrumb.command_hashes breadcrumb in [%str_log' trace t.logger] Added_breadcrumb_user_commands ~metadata: [ ( "user_commands" From da9a95281b8fbfc386891902478d02a4c2cb158e Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 10:31:10 +0100 Subject: [PATCH 085/122] Store transaction hash set in breadcrumb --- .../frontier_base/breadcrumb.ml | 16 +++++++++++----- .../frontier_base/root_data.ml | 1 + .../transition_frontier/transition_frontier.ml | 1 + 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 9347d2860887..55fbe7382ea7 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -5,6 +5,10 @@ open Mina_state open Mina_block open Network_peer +let command_hashes_of_transition validated_transition = + Mina_block.Validated.body validated_transition + |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes + module T = struct let id = "breadcrumb" @@ -18,6 +22,7 @@ module T = struct ; block_tag : Mina_block.Stable.Latest.t State_hash.File_storage.tag ; mutable staged_ledger_aux_and_pending_coinbases_cached : Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option + ; transaction_hashes : Mina_transaction.Transaction_hash.Set.t } [@@deriving fields] @@ -58,6 +63,9 @@ module T = struct ; accounts_created ; block_tag ; staged_ledger_aux_and_pending_coinbases_cached = None + ; transaction_hashes = + command_hashes_of_transition validated_transition + |> Mina_transaction.Transaction_hash.Set.of_list } let to_yojson @@ -69,6 +77,7 @@ module T = struct ; accounts_created = _ ; block_tag = _ ; staged_ledger_aux_and_pending_coinbases_cached = _ + ; transaction_hashes = _ } = `Assoc [ ( "validated_transition" @@ -96,9 +105,7 @@ T. let header t = T.validated_transition t |> Mina_block.Validated.header -let command_hashes t = - T.validated_transition t |> Mina_block.Validated.body - |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes +let command_hashes t = command_hashes_of_transition t.T.validated_transition let valid_commands_hashed (t : T.t) = List.map2_exn (Mina_block.Validated.valid_commands t.validated_transition) @@ -114,8 +121,7 @@ let valid_commands_hashed (t : T.t) = then in transaction_status it will be necessary to only traverse all of the tips instead of all of the breadcrumbs. *) let contains_transaction_by_hash t hash = - List.exists (command_hashes t) - ~f:(Mina_transaction.Transaction_hash.equal hash) + Mina_transaction.Transaction_hash.Set.mem t.T.transaction_hashes hash include Allocation_functor.Make.Basic (T) diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 9eddecf2656f..bc468b10e8de 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -68,6 +68,7 @@ module Limited = struct module Stable = struct [@@@no_toplevel_latest_type] + (* TODO replace block with block tag *) module V4 = struct type t = { transition : Mina_block.Validated.Stable.V2.t diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 271be603d54a..6b759496a421 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -506,6 +506,7 @@ let add_breadcrumb_exn t breadcrumb = Extensions.notify t.extensions ~logger ~frontier:t.full_frontier ~diffs_with_mutants in + (* TODO: Drop validated transition from the block *) [%log internal] "Notify_frontier_extensions_done" ; [%log internal] "Add_breadcrumb_to_frontier_done" From b34f379f09164cd5d5c25d7dc7a3a36ab6b8aa52 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 10:31:40 +0100 Subject: [PATCH 086/122] Update Breadcrumb.to_yojson (used in logging only) --- .../transition_frontier/frontier_base/breadcrumb.ml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 55fbe7382ea7..ca66539bf664 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -77,17 +77,21 @@ module T = struct ; accounts_created = _ ; block_tag = _ ; staged_ledger_aux_and_pending_coinbases_cached = _ - ; transaction_hashes = _ + ; transaction_hashes } = `Assoc - [ ( "validated_transition" - , Mina_block.Validated.to_yojson validated_transition ) - ; ("staged_ledger", `String "") + [ ( "state_hash" + , State_hash.to_yojson + @@ Mina_block.Validated.state_hash validated_transition ) ; ("just_emitted_a_proof", `Bool just_emitted_a_proof) ; ( "transition_receipt_time" , `String (Option.value_map transition_receipt_time ~default:"" ~f:(Time.to_string_iso8601_basic ~zone:Time.Zone.utc) ) ) + ; ( "transaction_hashes_unordered" + , `List + ( Mina_transaction.Transaction_hash.Set.to_list transaction_hashes + |> List.map ~f:Mina_transaction.Transaction_hash.to_yojson ) ) ] end From 8a258bf55f4925c536b7ef20e8f9b0a2e97f09d8 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 11:46:02 +0100 Subject: [PATCH 087/122] Use block tags in all root-related types --- .../cli/src/init/fix_persistent_frontier.ml | 9 +- .../bootstrap_controller.ml | 30 ++++- src/lib/mina_block/validated_block.ml | 2 + src/lib/mina_block/validated_block.mli | 2 + .../transition_frontier/catchup_hash_tree.ml | 2 +- .../extensions/root_history.ml | 2 +- .../transition_frontier/frontier_base/diff.ml | 2 +- .../frontier_base/root_data.ml | 106 +++++++++++------- .../frontier_base/root_data.mli | 42 +++---- .../transition_frontier/full_catchup_tree.ml | 2 +- .../full_frontier/full_frontier.ml | 61 +++++++--- .../persistent_frontier/database.ml | 23 ++-- .../persistent_frontier.ml | 17 ++- .../persistent_frontier/worker.ml | 3 +- .../transition_frontier.ml | 12 +- 15 files changed, 184 insertions(+), 131 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index 8510a7bec469..e64ba0b4c198 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -62,17 +62,10 @@ let apply_root_transitions ~logger ~db diffs = | Diff.Lite.E.E (Diff.Root_transitioned { new_root; garbage = Lite garbage; _ } ) -> - let parent_hash = - Root_data.Limited.Stable.Latest.transition new_root - |> Mina_block.Validated.Stable.Latest.header - |> Mina_block.Header.protocol_state - |> Mina_state.Protocol_state.previous_state_hash - in - assert (State_hash.equal parent_hash old_root_hash) ; Transition_frontier.Persistent_frontier.Database.move_root ~old_root_hash ~new_root ~garbage batch ; (* Return new root hash for next iteration *) - (Root_data.Limited.Stable.Latest.hashes new_root).state_hash + Root_data.Limited.Stable.Latest.state_hash new_root | _ -> failwith "Expected Root_transitioned diff" ) : State_hash.t ) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 1238e7b89a2d..a339e0f0e7dd 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -560,11 +560,31 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier in Deferred.return (`Repeat (this_cycle :: previous_cycles)) | Ok () -> + let root_block_with_hash = + Mina_block.Validation.block_with_hash new_root + in + let new_root_state_hash = + State_hash.With_state_hashes.state_hash root_block_with_hash + in (* step 5. Close the old frontier and reload a new one from disk. *) let new_root_data : Transition_frontier.Root_data.Limited.t = - Transition_frontier.Root_data.Limited.create - ~transition:(Mina_block.Validated.lift new_root) - ~scan_state ~pending_coinbase ~protocol_states + let block = + With_hash.data root_block_with_hash + |> Mina_block.read_all_proofs_from_disk + in + (* We're initializing frontier, so there shouldn't be any data preserved at the + state hash's multi-key file storage, and root block won't be validated, so there won't + be an overwrite *) + let block_tag = + State_hash.File_storage.write_values_exn new_root_state_hash + ~f:(fun writer -> + State_hash.File_storage.write_value writer + (module Mina_block.Stable.Latest) + block ) + in + Transition_frontier.Root_data.Limited.create ~block_tag + ~state_hash:new_root_state_hash ~scan_state ~pending_coinbase + ~protocol_states in let%bind () = Transition_frontier.Persistent_frontier.reset_database_exn @@ -575,9 +595,7 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier in (* TODO: lazy load db in persistent root to avoid unnecessary opens like this *) Transition_frontier.Persistent_root.( - set_root_state_hash persistent_root - @@ Mina_block.Validated.state_hash - @@ Mina_block.Validated.lift new_root) ; + set_root_state_hash persistent_root new_root_state_hash) ; let%map new_frontier = let fail msg = failwith diff --git a/src/lib/mina_block/validated_block.ml b/src/lib/mina_block/validated_block.ml index 28bd56ff08a5..009958c7e03d 100644 --- a/src/lib/mina_block/validated_block.ml +++ b/src/lib/mina_block/validated_block.ml @@ -16,6 +16,8 @@ module Stable = struct let hashes (t, _) = With_hash.hash t let header (t, _) = With_hash.data t |> Block.Stable.V2.header + + let block (t, _) = With_hash.data t end end] diff --git a/src/lib/mina_block/validated_block.mli b/src/lib/mina_block/validated_block.mli index 2e7665f606d2..326e490ab9f0 100644 --- a/src/lib/mina_block/validated_block.mli +++ b/src/lib/mina_block/validated_block.mli @@ -10,6 +10,8 @@ module Stable : sig val hashes : t -> State_hash.State_hashes.Stable.V1.t val header : t -> Header.Stable.V2.t + + val block : t -> Block.Stable.V2.t end end] diff --git a/src/lib/transition_frontier/catchup_hash_tree.ml b/src/lib/transition_frontier/catchup_hash_tree.ml index fd8f575938b2..99da52f82961 100644 --- a/src/lib/transition_frontier/catchup_hash_tree.ml +++ b/src/lib/transition_frontier/catchup_hash_tree.ml @@ -213,7 +213,7 @@ let apply_diffs t (ds : Diff.Full.E.t list) = breadcrumb_added t b | E (Root_transitioned { new_root; garbage = Full hs; _ }) -> List.iter (Diff.Node_list.to_lite hs) ~f:(remove_node t) ; - let h = (Root_data.Limited.Stable.Latest.hashes new_root).state_hash in + let h = Root_data.Limited.Stable.Latest.state_hash new_root in Hashtbl.change t.nodes h ~f:(function | None -> [%log' debug t.logger] diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index a267d64063d6..20c5f389c850 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -177,7 +177,7 @@ module T = struct (* TODO: send full diffs to extensions to avoid extra lookups in frontier *) | E (Root_transitioned { new_root; _ }, _) -> let state_hash = - (Root_data.Limited.Stable.Latest.hashes new_root).state_hash + Root_data.Limited.Stable.Latest.state_hash new_root in let breadcrumb = Full_frontier.find frontier state_hash diff --git a/src/lib/transition_frontier/frontier_base/diff.ml b/src/lib/transition_frontier/frontier_base/diff.ml index 1895a4db0eda..9d515b71310c 100644 --- a/src/lib/transition_frontier/frontier_base/diff.ml +++ b/src/lib/transition_frontier/frontier_base/diff.ml @@ -194,7 +194,7 @@ let to_yojson (type repr mutant) (key : (repr, mutant) t) = `Assoc [ ( "new_root" , State_hash.to_yojson - (Root_data.Limited.Stable.Latest.hashes new_root).state_hash ) + (Root_data.Limited.Stable.Latest.state_hash new_root) ) ; ("garbage", `List (List.map ~f:State_hash.to_yojson garbage_hashes)) ; ("just_emitted_a_proof", `Bool just_emitted_a_proof) ] diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index bc468b10e8de..d016d9d94cb5 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -71,7 +71,11 @@ module Limited = struct (* TODO replace block with block tag *) module V4 = struct type t = - { transition : Mina_block.Validated.Stable.V2.t + { block_tag : + ( State_hash.Stable.V1.t + , Mina_block.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t + ; state_hash : State_hash.Stable.V1.t ; protocol_states : Mina_state.Protocol_state.Value.Stable.V2.t Mina_base.State_hash.With_state_hashes.Stable.V1.t @@ -81,12 +85,6 @@ module Limited = struct [@@deriving fields] let to_latest = Fn.id - - let hashes t = Mina_block.Validated.Stable.Latest.hashes t.transition - - let create ~transition ~scan_state ~pending_coinbase ~protocol_states = - let common = { Common.Stable.V3.scan_state; pending_coinbase } in - { transition; common; protocol_states } end module V3 = struct @@ -101,15 +99,28 @@ module Limited = struct [@@deriving fields] let to_latest { transition; protocol_states; common } = - { V4.transition + let state_hash = + (Mina_block.Validated.Stable.Latest.hashes transition).state_hash + in + (* We use append out of caution here, in case part of the system already + migrated to the new format and the file exists *) + let block_tag = + State_hash.File_storage.append_values_exn state_hash ~f:(fun writer -> + State_hash.File_storage.write_value writer + (module Mina_block.Stable.Latest) + (Mina_block.Validated.Stable.Latest.block transition) ) + in + { V4.block_tag + ; state_hash ; protocol_states ; common = Common.Stable.V2.to_latest common } end end] - type t = - { transition : Mina_block.Validated.t + type t = Stable.Latest.t = + { block_tag : Mina_block.Stable.Latest.t State_hash.File_storage.tag + ; state_hash : State_hash.Stable.V1.t ; protocol_states : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t @@ -118,29 +129,20 @@ module Limited = struct } [@@deriving fields] - let to_yojson { transition; protocol_states = _; common } = + let to_yojson { state_hash; common; _ } = `Assoc - [ ("transition", Mina_block.Validated.to_yojson transition) - ; ("protocol_states", `String "") + [ ("state_hash", State_hash.to_yojson state_hash) ; ("common", Common.to_yojson common) ] - let create ~transition ~scan_state ~pending_coinbase ~protocol_states = + let create ~block_tag ~state_hash ~scan_state ~pending_coinbase + ~protocol_states = let common = { Common.scan_state; pending_coinbase } in - { transition; common; protocol_states } - - let hashes t = With_hash.hash @@ Mina_block.Validated.forget t.transition + { block_tag; state_hash; protocol_states; common } let scan_state t = Common.scan_state t.common let pending_coinbase t = Common.pending_coinbase t.common - - let read_all_proofs_from_disk t = - { Stable.Latest.transition = - Mina_block.Validated.read_all_proofs_from_disk t.transition - ; protocol_states = t.protocol_states - ; common = t.common - } end module Minimal = struct @@ -149,10 +151,11 @@ module Minimal = struct [@@@no_toplevel_latest_type] module V3 = struct - type t = { hash : State_hash.Stable.V1.t; common : Common.Stable.V3.t } + type t = + { state_hash : State_hash.Stable.V1.t; common : Common.Stable.V3.t } [@@deriving fields] - let of_limited ~common hash = { hash; common } + let of_limited ~common state_hash = { state_hash; common } let to_latest = Fn.id @@ -164,19 +167,19 @@ module Minimal = struct end module V2 = struct - type t = { hash : State_hash.Stable.V1.t; common : Common.Stable.V2.t } + type t = + { state_hash : State_hash.Stable.V1.t; common : Common.Stable.V2.t } - let to_latest { hash; common } = - { V3.hash; common = Common.Stable.V2.to_latest common } + let to_latest { state_hash; common } = + { V3.state_hash; common = Common.Stable.V2.to_latest common } end end] - type t = { hash : State_hash.t; common : Common.t } [@@deriving fields] + type t = { state_hash : State_hash.t; common : Common.t } [@@deriving fields] - let of_limited ~common hash = { hash; common } + let of_limited ~common state_hash = { state_hash; common } - let upgrade t ~transition ~protocol_states = - assert (State_hash.equal (Mina_block.Validated.state_hash transition) t.hash) ; + let upgrade t ~block_tag ~protocol_states = let protocol_states = List.map protocol_states ~f:(fun (state_hash, s) -> { With_hash.data = s @@ -191,11 +194,15 @@ module Minimal = struct t.common.scan_state ~protocol_states |> Or_error.ok_exn : Mina_state.Protocol_state.value State_hash.With_state_hashes.t list ) ; - { Limited.transition; protocol_states; common = t.common } + { Limited.block_tag + ; state_hash = t.state_hash + ; protocol_states + ; common = t.common + } - let create ~hash ~scan_state ~pending_coinbase = + let create ~state_hash ~scan_state ~pending_coinbase = let common = { Common.scan_state; pending_coinbase } in - { hash; common } + { state_hash; common } let scan_state t = Common.scan_state t.common @@ -203,26 +210,39 @@ module Minimal = struct end type t = - { transition : Mina_block.Validated.t + { block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag + ; state_hash : State_hash.t ; staged_ledger : Staged_ledger.t ; protocol_states : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list - ; block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag + ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t } -let minimize { transition; staged_ledger; protocol_states = _; block_tag = _ } = +let minimize + { staged_ledger + ; protocol_states = _ + ; block_tag = _ + ; state_hash + ; delta_block_chain_proof = _ + } = let scan_state = Staged_ledger.scan_state staged_ledger in let pending_coinbase = Staged_ledger.pending_coinbase_collection staged_ledger in let common = Common.create ~scan_state ~pending_coinbase in - { Minimal.hash = Mina_block.Validated.state_hash transition; common } - -let limit { transition; staged_ledger; protocol_states; block_tag = _ } = + { Minimal.state_hash; common } + +let limit + { staged_ledger + ; protocol_states + ; block_tag + ; state_hash + ; delta_block_chain_proof = _ + } = let scan_state = Staged_ledger.scan_state staged_ledger in let pending_coinbase = Staged_ledger.pending_coinbase_collection staged_ledger in let common = Common.create ~scan_state ~pending_coinbase in - { Limited.transition; common; protocol_states } + { Limited.block_tag; common; protocol_states; state_hash } diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index d21b2a0e9ef6..f61d1f633602 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -54,7 +54,7 @@ module Limited : sig module V4 : sig type t - val hashes : t -> State_hash.State_hashes.Stable.V1.t + val state_hash : t -> State_hash.Stable.V1.t val common : t -> Common.Stable.V3.t @@ -64,17 +64,11 @@ module Limited : sig Mina_base.State_hash.With_state_hashes.Stable.V1.t list - val create : - transition:Mina_block.Validated.Stable.V2.t - -> scan_state:Staged_ledger.Scan_state.Stable.V3.t - -> pending_coinbase:Pending_coinbase.Stable.V2.t - -> protocol_states: - Mina_state.Protocol_state.value - State_hash.With_state_hashes.Stable.V1.t - list - -> t - - val transition : t -> Mina_block.Validated.Stable.V2.t + val block_tag : + t + -> ( State_hash.Stable.V1.t + , Mina_block.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t end module V3 : sig @@ -84,11 +78,11 @@ module Limited : sig end end] - type t [@@deriving to_yojson] + type t = Stable.Latest.t [@@deriving to_yojson] - val transition : t -> Mina_block.Validated.t + val block_tag : t -> Mina_block.Stable.Latest.t State_hash.File_storage.tag - val hashes : t -> State_hash.State_hashes.t + val state_hash : t -> State_hash.t val scan_state : t -> Staged_ledger.Scan_state.t @@ -98,7 +92,8 @@ module Limited : sig t -> Mina_state.Protocol_state.value State_hash.With_state_hashes.t list val create : - transition:Mina_block.Validated.t + block_tag:Mina_block.Stable.Latest.t State_hash.File_storage.tag + -> state_hash:State_hash.t -> scan_state:Staged_ledger.Scan_state.t -> pending_coinbase:Pending_coinbase.t -> protocol_states: @@ -106,8 +101,6 @@ module Limited : sig -> t val common : t -> Common.t - - val read_all_proofs_from_disk : t -> Stable.Latest.t end (* Minimal root data contains the smallest amount of information about a root. @@ -123,7 +116,7 @@ module Minimal : sig module V3 : sig type t - val hash : t -> State_hash.t + val state_hash : t -> State_hash.t val of_limited : common:Common.Stable.V3.t -> State_hash.Stable.V1.t -> t @@ -143,7 +136,7 @@ module Minimal : sig type t - val hash : t -> State_hash.t + val state_hash : t -> State_hash.t val scan_state : t -> Staged_ledger.Scan_state.t @@ -153,25 +146,26 @@ module Minimal : sig val upgrade : t - -> transition:Mina_block.Validated.t + -> block_tag:Mina_block.Stable.Latest.t State_hash.File_storage.tag -> protocol_states: (Mina_base.State_hash.t * Mina_state.Protocol_state.Value.t) list -> Limited.t val create : - hash:State_hash.t + state_hash:State_hash.t -> scan_state:Staged_ledger.Scan_state.t -> pending_coinbase:Pending_coinbase.t -> t end type t = - { transition : Mina_block.Validated.t + { block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag + ; state_hash : State_hash.t ; staged_ledger : Staged_ledger.t ; protocol_states : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list - ; block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag + ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t } val minimize : t -> Minimal.t diff --git a/src/lib/transition_frontier/full_catchup_tree.ml b/src/lib/transition_frontier/full_catchup_tree.ml index 1363c0f1aae2..75d3fa20013e 100644 --- a/src/lib/transition_frontier/full_catchup_tree.ml +++ b/src/lib/transition_frontier/full_catchup_tree.ml @@ -368,7 +368,7 @@ let apply_diffs (t : t) (ds : Diff.Full.E.t list) = breadcrumb_added t b | E (Root_transitioned { new_root; garbage = Full hs; _ }) -> List.iter (Diff.Node_list.to_lite hs) ~f:(remove_node t) ; - let h = (Root_data.Limited.Stable.Latest.hashes new_root).state_hash in + let h = Root_data.Limited.Stable.Latest.state_hash new_root in if Hashtbl.mem t.nodes h then prune t ~root_hash:h else ( [%log' debug t.logger] diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index a71d81d59a53..2b21d31bd019 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -139,17 +139,44 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger let open Context in let open Root_data in let transition_receipt_time = None in - let validated_transition = root_data.transition in - let root_hash = Mina_block.Validated.state_hash validated_transition in + let root_block_stable = + root_data.block_tag + |> State_hash.File_storage.read (module Mina_block.Stable.Latest) + |> Or_error.tag ~tag:"Full_frontier.create" + |> Or_error.ok_exn + in + let root_block = + (* It's ok to use identity DB because root is a short-lived + object: when frontier moves, it will be utilized, + and it's just one block in memory, so no concern + about excessive RAM usage *) + Mina_block.write_all_proofs_to_disk root_block_stable + ~signature_kind:Mina_signature_kind.t_DEPRECATED + ~proof_cache_db:(Proof_cache_tag.create_identity_db ()) + in + let root_hash = root_data.state_hash in + let root_block_with_hashes = + { With_hash.data = root_block + ; hash = + State_hash.State_hashes. + { state_hash = root_hash; state_body_hash = None } + } + in + let validated_transition = + Mina_block.Validated.unsafe_of_trusted_block + ~delta_block_chain_proof:root_data.delta_block_chain_proof + (`This_block_is_trusted_to_be_safe root_block_with_hashes) + in let protocol_states_for_root_scan_state = root_data.protocol_states |> List.map ~f:(fun s -> (State_hash.With_state_hashes.state_hash s, s)) |> State_hash.Map.of_alist_exn in let root_protocol_state = - validated_transition |> Mina_block.Validated.forget |> With_hash.data - |> Mina_block.header |> Mina_block.Header.protocol_state + Mina_block.Stable.Latest.header root_block_stable + |> Mina_block.Header.protocol_state in + let root_blockchain_state = Protocol_state.blockchain_state root_protocol_state in @@ -189,10 +216,13 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger let root_data t = let open Root_data in let root = root t in - { transition = Breadcrumb.validated_transition root + { state_hash = Breadcrumb.state_hash root ; staged_ledger = Breadcrumb.staged_ledger root ; protocol_states = State_hash.Map.data t.protocol_states_for_root_scan_state ; block_tag = Breadcrumb.block_tag root + ; delta_block_chain_proof = + Breadcrumb.validated_transition root + |> Mina_block.Validated.delta_block_chain_proof } let max_length { max_length; _ } = max_length @@ -352,13 +382,10 @@ module Util = struct protocol_states_for_root_scan_state ~next_root_required_hashes ~old_root_state:(Breadcrumb.protocol_state_with_hashes parent) in - let heir_transition = - Breadcrumb.validated_transition heir - |> Mina_block.Validated.read_all_proofs_from_disk - in let new_root_data = - Root_data.Limited.Stable.Latest.create ~transition:heir_transition - ~scan_state:new_scan_state + Root_data.Limited.create + ~block_tag:(Breadcrumb.block_tag heir) + ~state_hash:heir_hash ~scan_state:new_scan_state ~pending_coinbase: (Staged_ledger.pending_coinbase_collection heir_staged_ledger) ~protocol_states @@ -663,9 +690,7 @@ let apply_diff (type mutant) t (diff : (Diff.full, mutant) Diff.t) t.best_tip <- new_best_tip ; (old_best_tip, None) | Root_transitioned { new_root; garbage = Full garbage; _ } -> - let new_root_hash = - (Root_data.Limited.Stable.Latest.hashes new_root).state_hash - in + let new_root_hash = Root_data.Limited.Stable.Latest.state_hash new_root in let old_root_hash = t.root in let new_root_protocol_states = Root_data.Limited.Stable.Latest.protocol_states new_root @@ -991,7 +1016,13 @@ module For_tests = struct let root_data = let open Root_data in let transition, block_tag = Mina_block.genesis ~precomputed_values in - { transition; staged_ledger; protocol_states = []; block_tag } + { state_hash = Mina_block.Validated.state_hash transition + ; delta_block_chain_proof = + Mina_block.Validated.delta_block_chain_proof transition + ; staged_ledger + ; protocol_states = [] + ; block_tag + } in let persistent_root = Persistent_root.create ~logger ~backing_type:Stable_db diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index d68414ff189f..a62610e04319 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -283,7 +283,7 @@ let get_root t = | Ok root -> (* automatically split Root into (Root_hash, Root_common) *) Batch.with_batch t.db ~f:(fun batch -> - let hash = Root_data.Minimal.Stable.Latest.hash root in + let hash = Root_data.Minimal.Stable.Latest.state_hash root in let common = Root_data.Minimal.Stable.Latest.common root in Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:hash ; @@ -298,7 +298,7 @@ let get_root_hash t = | Ok hash -> Ok hash | Error _ -> - Result.map ~f:Root_data.Minimal.Stable.Latest.hash (get_root t) + Result.map ~f:Root_data.Minimal.Stable.Latest.state_hash (get_root t) (* TODO: check that best tip is connected to root *) (* TODO: check for garbage *) @@ -370,20 +370,19 @@ let check t ~genesis_state_hash = |> Result.join let initialize t ~root_data = - let root_state_hash, root_transition = - let t = - Mina_block.Validated.forget (Root_data.Limited.transition root_data) - in - ( State_hash.With_state_hashes.state_hash t - , State_hash.With_state_hashes.data t ) + let root_state_hash = Root_data.Limited.state_hash root_data in + let root_block = + (* TODO preserve block tags in frontier *) + Root_data.Limited.block_tag root_data + |> State_hash.File_storage.read (module Mina_block.Stable.Latest) + |> Or_error.ok_exn in - let root_transition = Mina_block.read_all_proofs_from_disk root_transition in [%log' trace t.logger] ~metadata:[ ("root_data", Root_data.Limited.to_yojson root_data) ] "Initializing persistent frontier database with $root_data" ; Batch.with_batch t.db ~f:(fun batch -> Batch.set batch ~key:Db_version ~data:version ; - Batch.set batch ~key:(Transition root_state_hash) ~data:root_transition ; + Batch.set batch ~key:(Transition root_state_hash) ~data:root_block ; Batch.set batch ~key:(Arcs root_state_hash) ~data:[] ; Batch.set batch ~key:Root_hash ~data:root_state_hash ; Batch.set batch ~key:Root_common @@ -436,9 +435,7 @@ let add ~arcs_cache ~transition = Batch.set batch ~key:(Arcs parent_hash) ~data:(hash :: parent_arcs) let move_root ~old_root_hash ~new_root ~garbage = - let new_root_hash = - (Root_data.Limited.Stable.Latest.hashes new_root).state_hash - in + let new_root_hash = Root_data.Limited.Stable.Latest.state_hash new_root in fun batch -> Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:new_root_hash ; diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 7bebaaf5a4ca..158f053cd15f 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -271,7 +271,7 @@ module Instance = struct let%bind root, root_transition, best_tip, protocol_states, root_hash = (let open Result.Let_syntax in let%bind root = Database.get_root t.db in - let root_hash = Root_data.Minimal.Stable.Latest.hash root in + let root_hash = Root_data.Minimal.Stable.Latest.state_hash root in let%bind root_transition = Database.get_transition t.db ~signature_kind ~proof_cache_db root_hash in @@ -302,6 +302,7 @@ module Instance = struct | Ok staged_ledger -> Ok staged_ledger in + let root_state_hash = Root_data.Minimal.Stable.Latest.state_hash root in (* TODO remove the hack *) let root_block_tag = State_hash.File_storage.write_values_exn (Lazy.force temp_state_hash) @@ -317,12 +318,14 @@ module Instance = struct ~context:(module Context) ~time_controller:t.factory.time_controller ~root_data: - { transition = root_transition + { state_hash = root_state_hash ; staged_ledger = root_staged_ledger ; protocol_states = List.map protocol_states ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) ; block_tag = root_block_tag + ; delta_block_chain_proof = + Mina_block.Validated.delta_block_chain_proof root_transition } ~root_ledger:(Root_ledger.as_unmasked root_ledger) ~consensus_local_state ~max_length ~persistent_root_instance @@ -400,15 +403,9 @@ let with_instance_exn t ~f = x let reset_database_exn t ~root_data ~genesis_state_hash = - let open Root_data.Limited in - let open Deferred.Let_syntax in - let root_transition = transition root_data in + let root_state_hash = Root_data.Limited.state_hash root_data in [%log' info t.logger] - ~metadata: - [ ( "state_hash" - , State_hash.to_yojson - @@ Mina_block.Validated.state_hash root_transition ) - ] + ~metadata:[ ("state_hash", State_hash.to_yojson root_state_hash) ] "Resetting transition frontier database to new root" ; let%bind () = destroy_database_exn t in with_instance_exn t ~f:(fun instance -> diff --git a/src/lib/transition_frontier/persistent_frontier/worker.ml b/src/lib/transition_frontier/persistent_frontier/worker.ml index cd54885e956b..46d65839ff89 100644 --- a/src/lib/transition_frontier/persistent_frontier/worker.ml +++ b/src/lib/transition_frontier/persistent_frontier/worker.ml @@ -67,8 +67,7 @@ module Worker = struct List.drop_last root_transition_diffs |> Option.value ~default:[] |> List.bind ~f:(fun { new_root; garbage = Lite garbage; _ } -> - (Root_data.Limited.Stable.Latest.hashes new_root).state_hash - :: garbage ) + Root_data.Limited.Stable.Latest.state_hash new_root :: garbage ) in let total_root_transition_diff = Option.map final_root_transition_diff diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 6b759496a421..5eb314f9ef62 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -82,7 +82,8 @@ type Structured_log_events.t += Persisted_frontier_dropped [@@deriving register_event { msg = "Persistent frontier dropped" }] let genesis_root_data ~precomputed_values = - let transition, _ = Mina_block.genesis ~precomputed_values in + let transition, block_tag = Mina_block.genesis ~precomputed_values in + let state_hash = Mina_block.Validated.state_hash transition in let constraint_constants = precomputed_values.constraint_constants in let scan_state = Staged_ledger.Scan_state.empty ~constraint_constants () in (*if scan state is empty the protocol states required is also empty*) @@ -92,7 +93,7 @@ let genesis_root_data ~precomputed_values = (Pending_coinbase.create ~depth:constraint_constants.pending_coinbase_depth () ) in - Root_data.Limited.create ~transition ~scan_state ~pending_coinbase + Root_data.Limited.create ~block_tag ~state_hash ~scan_state ~pending_coinbase ~protocol_states let load_from_persistence_and_start ~context:(module Context : CONTEXT) @@ -755,7 +756,8 @@ module For_tests = struct in let root_data = Root_data.Limited.create - ~transition:(Breadcrumb.validated_transition root) + ~block_tag:(Breadcrumb.block_tag root) + ~state_hash:(Breadcrumb.state_hash root) ~scan_state:(Breadcrumb.staged_ledger root |> Staged_ledger.scan_state) ~pending_coinbase: ( Breadcrumb.staged_ledger root @@ -772,9 +774,7 @@ module For_tests = struct precomputed_values.protocol_state_with_hashes ) ) ; Async.Thread_safe.block_on_async_exn (fun () -> Persistent_root.reset_factory_root_exn persistent_root ~create_root - ~root_state_hash: - ( Root_data.Limited.transition root_data - |> Mina_block.Validated.state_hash ) ) ; + ~root_state_hash:(Root_data.Limited.state_hash root_data) ) ; let frontier_result = Async.Thread_safe.block_on_async_exn (fun () -> load_with_max_length ~max_length ~retry_with_fresh_db:false From a47fc777715d1e64e7d7076219bd57b3b6644cc8 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 12:04:59 +0100 Subject: [PATCH 088/122] Remove redundant stable types --- src/app/archive/lib/diff.ml | 3 - src/app/archive/lib/processor.ml | 65 +++++++------- .../cli/src/init/fix_persistent_frontier.ml | 6 +- .../transition_frontier/catchup_hash_tree.ml | 2 +- .../extensions/root_history.ml | 4 +- .../transition_frontier/frontier_base/diff.ml | 88 +------------------ .../frontier_base/diff.mli | 9 +- .../frontier_base/root_data.ml | 71 +++------------ .../frontier_base/root_data.mli | 33 +------ .../transition_frontier/full_catchup_tree.ml | 2 +- .../full_frontier/full_frontier.ml | 4 +- .../persistent_frontier/database.ml | 7 +- .../persistent_frontier/database.mli | 2 +- .../persistent_frontier/worker.ml | 2 +- 14 files changed, 61 insertions(+), 237 deletions(-) diff --git a/src/app/archive/lib/diff.ml b/src/app/archive/lib/diff.ml index 1935c7dd36e8..5daeba1c6080 100644 --- a/src/app/archive/lib/diff.ml +++ b/src/app/archive/lib/diff.ml @@ -26,9 +26,6 @@ module Transition_frontier = struct (Account_id.Stable.Latest.t * Receipt.Chain_hash.Stable.Latest.t) list } - | Root_transitioned of - Transition_frontier.Diff.Root_transition.Lite.Stable.Latest.t - | Bootstrap of { lost_blocks : State_hash.Stable.Latest.t list } [@@deriving bin_io_unversioned] end diff --git a/src/app/archive/lib/processor.ml b/src/app/archive/lib/processor.ml index ea54cbf78b4a..5c155e646570 100644 --- a/src/app/archive/lib/processor.ml +++ b/src/app/archive/lib/processor.ml @@ -4590,39 +4590,38 @@ let add_block_aux_extensional ~proof_cache_db ~logger ~signature_kind ?retries let run pool reader ~proof_cache_db ~genesis_constants ~constraint_constants ~logger ~delete_older_than : unit Deferred.t = Strict_pipe.Reader.iter reader ~f:(function - | Diff.Transition_frontier - (Breadcrumb_added - { block; accounts_accessed; accounts_created; tokens_used; _ } ) -> ( - let add_block = - Block.add_if_doesn't_exist ~logger ~constraint_constants - ~accounts_accessed ~accounts_created - in - let hash = State_hash.With_state_hashes.state_hash in - let signature_kind = Mina_signature_kind.t_DEPRECATED in - let block = - With_hash.map - ~f: - (Mina_block.write_all_proofs_to_disk ~signature_kind - ~proof_cache_db ) - block - in - match%bind - add_block_aux ~logger ~genesis_constants ~pool ~delete_older_than - ~hash ~add_block ~tokens_used block - with - | Error e -> - let state_hash = hash block in - [%log warn] - ~metadata: - [ ("state_hash", State_hash.to_yojson state_hash) - ; ("error", `String (Caqti_error.show e)) - ] - "Failed to archive block with state hash $state_hash, see $error" ; - Deferred.unit - | Ok () -> - Deferred.unit ) - | Transition_frontier _ -> - Deferred.unit ) + | Diff.Transition_frontier + (Breadcrumb_added + { block; accounts_accessed; accounts_created; tokens_used; _ } ) + -> + (let add_block = + Block.add_if_doesn't_exist ~logger ~constraint_constants + ~accounts_accessed ~accounts_created + in + let hash = State_hash.With_state_hashes.state_hash in + let signature_kind = Mina_signature_kind.t_DEPRECATED in + let block = + With_hash.map + ~f: + (Mina_block.write_all_proofs_to_disk ~signature_kind + ~proof_cache_db ) + block + in + match%bind + add_block_aux ~logger ~genesis_constants ~pool ~delete_older_than ~hash + ~add_block ~tokens_used block + with + | Error e -> + let state_hash = hash block in + [%log warn] + ~metadata: + [ ("state_hash", State_hash.to_yojson state_hash) + ; ("error", `String (Caqti_error.show e)) + ] + "Failed to archive block with state hash $state_hash, see $error" ; + Deferred.unit + | Ok () -> + Deferred.unit ) ) (* [add_genesis_accounts] is called when starting the archive process *) let add_genesis_accounts ~logger ~(runtime_config_opt : Runtime_config.t option) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index e64ba0b4c198..495c705c83ff 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -65,7 +65,7 @@ let apply_root_transitions ~logger ~db diffs = Transition_frontier.Persistent_frontier.Database.move_root ~old_root_hash ~new_root ~garbage batch ; (* Return new root hash for next iteration *) - Root_data.Limited.Stable.Latest.state_hash new_root + Root_data.Limited.state_hash new_root | _ -> failwith "Expected Root_transitioned diff" ) : State_hash.t ) @@ -256,8 +256,8 @@ let fix_persistent_frontier_root_do ~logger ~config_directory in ( ( breadcrumb , Transition_frontier.Util.to_protocol_states_map_exn - @@ Root_data.Limited.Stable.Latest.protocol_states - @@ root_transition.new_root ) + @@ Root_data.Limited.protocol_states @@ root_transition.new_root + ) , res ) ) in [%log info] "Generated $count transition diffs" diff --git a/src/lib/transition_frontier/catchup_hash_tree.ml b/src/lib/transition_frontier/catchup_hash_tree.ml index 99da52f82961..1419308dd213 100644 --- a/src/lib/transition_frontier/catchup_hash_tree.ml +++ b/src/lib/transition_frontier/catchup_hash_tree.ml @@ -213,7 +213,7 @@ let apply_diffs t (ds : Diff.Full.E.t list) = breadcrumb_added t b | E (Root_transitioned { new_root; garbage = Full hs; _ }) -> List.iter (Diff.Node_list.to_lite hs) ~f:(remove_node t) ; - let h = Root_data.Limited.Stable.Latest.state_hash new_root in + let h = Root_data.Limited.state_hash new_root in Hashtbl.change t.nodes h ~f:(function | None -> [%log' debug t.logger] diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index 20c5f389c850..44b59f582d3e 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -176,9 +176,7 @@ module T = struct List.exists diffs_with_mutants ~f:(function (* TODO: send full diffs to extensions to avoid extra lookups in frontier *) | E (Root_transitioned { new_root; _ }, _) -> - let state_hash = - Root_data.Limited.Stable.Latest.state_hash new_root - in + let state_hash = Root_data.Limited.state_hash new_root in let breadcrumb = Full_frontier.find frontier state_hash |> Option.value_exn diff --git a/src/lib/transition_frontier/frontier_base/diff.ml b/src/lib/transition_frontier/frontier_base/diff.ml index 9d515b71310c..398c99872660 100644 --- a/src/lib/transition_frontier/frontier_base/diff.ml +++ b/src/lib/transition_frontier/frontier_base/diff.ml @@ -66,7 +66,7 @@ module Root_transition = struct | Full : Staged_ledger.Scan_state.t -> full root_transition_scan_state type 'repr t = - { new_root : Root_data.Limited.Stable.Latest.t + { new_root : Root_data.Limited.t ; garbage : 'repr Node_list.t ; old_root_scan_state : 'repr root_transition_scan_state ; just_emitted_a_proof : bool @@ -74,89 +74,8 @@ module Root_transition = struct type 'repr root_transition = 'repr t - module Lite_binable = struct - [%%versioned - module Stable = struct - [@@@no_toplevel_latest_type] - - module V5 = struct - type t = - { new_root : Root_data.Limited.Stable.V4.t - ; garbage : Node_list.Lite.Stable.V1.t - ; just_emitted_a_proof : bool - } - - let to_latest = Fn.id - end - - module V4 = struct - type t = - { new_root : Root_data.Limited.Stable.V3.t - ; garbage : Node_list.Lite.Stable.V1.t - ; just_emitted_a_proof : bool - } - - let to_latest t = - { V5.new_root = Root_data.Limited.Stable.V3.to_latest t.new_root - ; garbage = t.garbage - ; just_emitted_a_proof = t.just_emitted_a_proof - } - end - end] - end - module Lite = struct - module Binable_arg = struct - [%%versioned - module Stable = struct - [@@@no_toplevel_latest_type] - - module V5 = struct - type t = Lite_binable.Stable.V5.t - - let to_latest = Fn.id - end - - module V4 = struct - type t = Lite_binable.Stable.V4.t - - let to_latest = Lite_binable.Stable.V4.to_latest - end - end] - end - - [%%versioned_binable - module Stable = struct - module V4 = struct - type t = lite root_transition - - module T_nonbinable = struct - type nonrec t = t - - let to_binable - ({ new_root - ; garbage - ; just_emitted_a_proof - ; old_root_scan_state = Lite - } : - t ) : Binable_arg.Stable.V5.t = - { new_root; garbage; just_emitted_a_proof } - - let of_binable - ({ new_root; garbage; just_emitted_a_proof } : - Binable_arg.Stable.V5.t ) : t = - { new_root - ; garbage - ; old_root_scan_state = Lite - ; just_emitted_a_proof - } - end - - include Binable.Of_binable (Binable_arg.Stable.V5) (T_nonbinable) - - let to_latest = Fn.id - end - end] + type t = lite root_transition end end @@ -193,8 +112,7 @@ let to_yojson (type repr mutant) (key : (repr, mutant) t) = in `Assoc [ ( "new_root" - , State_hash.to_yojson - (Root_data.Limited.Stable.Latest.state_hash new_root) ) + , State_hash.to_yojson (Root_data.Limited.state_hash new_root) ) ; ("garbage", `List (List.map ~f:State_hash.to_yojson garbage_hashes)) ; ("just_emitted_a_proof", `Bool just_emitted_a_proof) ] diff --git a/src/lib/transition_frontier/frontier_base/diff.mli b/src/lib/transition_frontier/frontier_base/diff.mli index 0eeebd7f28a1..df71a367c6a0 100644 --- a/src/lib/transition_frontier/frontier_base/diff.mli +++ b/src/lib/transition_frontier/frontier_base/diff.mli @@ -60,7 +60,7 @@ module Root_transition : sig | Full : Staged_ledger.Scan_state.t -> full root_transition_scan_state type 'repr t = - { new_root : Root_data.Limited.Stable.Latest.t + { new_root : Root_data.Limited.t ; garbage : 'repr Node_list.t ; old_root_scan_state : 'repr root_transition_scan_state ; just_emitted_a_proof : bool @@ -69,12 +69,7 @@ module Root_transition : sig type 'repr root_transition = 'repr t module Lite : sig - [%%versioned: - module Stable : sig - module V4 : sig - type t = lite root_transition - end - end] + type t = lite root_transition end end diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index d016d9d94cb5..39b5fd39752f 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -64,70 +64,19 @@ module Historical = struct end module Limited = struct - [%%versioned - module Stable = struct - [@@@no_toplevel_latest_type] - - (* TODO replace block with block tag *) - module V4 = struct - type t = - { block_tag : - ( State_hash.Stable.V1.t - , Mina_block.Stable.V2.t ) - Multi_key_file_storage.Tag.Stable.V1.t - ; state_hash : State_hash.Stable.V1.t - ; protocol_states : - Mina_state.Protocol_state.Value.Stable.V2.t - Mina_base.State_hash.With_state_hashes.Stable.V1.t - list - ; common : Common.Stable.V3.t - } - [@@deriving fields] - - let to_latest = Fn.id - end - - module V3 = struct - type t = - { transition : Mina_block.Validated.Stable.V2.t - ; protocol_states : - Mina_state.Protocol_state.Value.Stable.V2.t - Mina_base.State_hash.With_state_hashes.Stable.V1.t - list - ; common : Common.Stable.V2.t - } - [@@deriving fields] - - let to_latest { transition; protocol_states; common } = - let state_hash = - (Mina_block.Validated.Stable.Latest.hashes transition).state_hash - in - (* We use append out of caution here, in case part of the system already - migrated to the new format and the file exists *) - let block_tag = - State_hash.File_storage.append_values_exn state_hash ~f:(fun writer -> - State_hash.File_storage.write_value writer - (module Mina_block.Stable.Latest) - (Mina_block.Validated.Stable.Latest.block transition) ) - in - { V4.block_tag - ; state_hash - ; protocol_states - ; common = Common.Stable.V2.to_latest common - } - end - end] - - type t = Stable.Latest.t = - { block_tag : Mina_block.Stable.Latest.t State_hash.File_storage.tag - ; state_hash : State_hash.Stable.V1.t + type t = + { block_tag : + ( State_hash.Stable.Latest.t + , Mina_block.Stable.Latest.t ) + Multi_key_file_storage.Tag.Stable.Latest.t + ; state_hash : State_hash.Stable.Latest.t ; protocol_states : - Mina_state.Protocol_state.Value.t - Mina_base.State_hash.With_state_hashes.t + Mina_state.Protocol_state.Value.Stable.Latest.t + Mina_base.State_hash.With_state_hashes.Stable.Latest.t list - ; common : Common.t + ; common : Common.Stable.Latest.t } - [@@deriving fields] + [@@deriving bin_io_unversioned, fields] let to_yojson { state_hash; common; _ } = `Assoc diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index f61d1f633602..a0b2c4b2533c 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -47,38 +47,7 @@ end (* Limited root data is similar to Minimal root data, except that it contains * the full validated transition at a root instead of just a pointer to one and protocol states for the root scan state *) module Limited : sig - [%%versioned: - module Stable : sig - [@@@no_toplevel_latest_type] - - module V4 : sig - type t - - val state_hash : t -> State_hash.Stable.V1.t - - val common : t -> Common.Stable.V3.t - - val protocol_states : - t - -> Mina_state.Protocol_state.Value.Stable.V2.t - Mina_base.State_hash.With_state_hashes.Stable.V1.t - list - - val block_tag : - t - -> ( State_hash.Stable.V1.t - , Mina_block.Stable.V2.t ) - Multi_key_file_storage.Tag.Stable.V1.t - end - - module V3 : sig - type t - - val to_latest : t -> V4.t - end - end] - - type t = Stable.Latest.t [@@deriving to_yojson] + type t [@@deriving to_yojson, bin_io] val block_tag : t -> Mina_block.Stable.Latest.t State_hash.File_storage.tag diff --git a/src/lib/transition_frontier/full_catchup_tree.ml b/src/lib/transition_frontier/full_catchup_tree.ml index 75d3fa20013e..d851d19235b2 100644 --- a/src/lib/transition_frontier/full_catchup_tree.ml +++ b/src/lib/transition_frontier/full_catchup_tree.ml @@ -368,7 +368,7 @@ let apply_diffs (t : t) (ds : Diff.Full.E.t list) = breadcrumb_added t b | E (Root_transitioned { new_root; garbage = Full hs; _ }) -> List.iter (Diff.Node_list.to_lite hs) ~f:(remove_node t) ; - let h = Root_data.Limited.Stable.Latest.state_hash new_root in + let h = Root_data.Limited.state_hash new_root in if Hashtbl.mem t.nodes h then prune t ~root_hash:h else ( [%log' debug t.logger] diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 2b21d31bd019..69c012d0c015 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -690,10 +690,10 @@ let apply_diff (type mutant) t (diff : (Diff.full, mutant) Diff.t) t.best_tip <- new_best_tip ; (old_best_tip, None) | Root_transitioned { new_root; garbage = Full garbage; _ } -> - let new_root_hash = Root_data.Limited.Stable.Latest.state_hash new_root in + let new_root_hash = Root_data.Limited.state_hash new_root in let old_root_hash = t.root in let new_root_protocol_states = - Root_data.Limited.Stable.Latest.protocol_states new_root + Root_data.Limited.protocol_states new_root in [%log' internal t.logger] "Move_frontier_root" ; move_root t ~new_root_hash ~new_root_protocol_states ~garbage diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index a62610e04319..8b14bbeb0743 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -435,16 +435,15 @@ let add ~arcs_cache ~transition = Batch.set batch ~key:(Arcs parent_hash) ~data:(hash :: parent_arcs) let move_root ~old_root_hash ~new_root ~garbage = - let new_root_hash = Root_data.Limited.Stable.Latest.state_hash new_root in + let new_root_hash = Root_data.Limited.state_hash new_root in fun batch -> Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:new_root_hash ; - Batch.set batch ~key:Root_common - ~data:(Root_data.Limited.Stable.Latest.common new_root) ; + Batch.set batch ~key:Root_common ~data:(Root_data.Limited.common new_root) ; Batch.set batch ~key:Protocol_states_for_root_scan_state ~data: (List.map ~f:With_hash.data - (Root_data.Limited.Stable.Latest.protocol_states new_root) ) ; + (Root_data.Limited.protocol_states new_root) ) ; List.iter (old_root_hash :: garbage) ~f:(fun node_hash -> (* because we are removing entire forks of the tree, there is * no need to have extra logic to any remove arcs to the node diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index 70a7affcc996..2779e85f59f1 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -87,7 +87,7 @@ val add : val move_root : old_root_hash:State_hash.t - -> new_root:Root_data.Limited.Stable.Latest.t + -> new_root:Root_data.Limited.t -> garbage:State_hash.t list -> batch_t -> unit diff --git a/src/lib/transition_frontier/persistent_frontier/worker.ml b/src/lib/transition_frontier/persistent_frontier/worker.ml index 46d65839ff89..dbd260969752 100644 --- a/src/lib/transition_frontier/persistent_frontier/worker.ml +++ b/src/lib/transition_frontier/persistent_frontier/worker.ml @@ -67,7 +67,7 @@ module Worker = struct List.drop_last root_transition_diffs |> Option.value ~default:[] |> List.bind ~f:(fun { new_root; garbage = Lite garbage; _ } -> - Root_data.Limited.Stable.Latest.state_hash new_root :: garbage ) + Root_data.Limited.state_hash new_root :: garbage ) in let total_root_transition_diff = Option.map final_root_transition_diff From a9f0bc36396e67b9d31bbeaae19790b1598f218b Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 17:33:34 +0100 Subject: [PATCH 089/122] Extend Root_data.Minimal.t --- .../cli/src/init/fix_persistent_frontier.ml | 4 +- .../bootstrap_controller.ml | 8 +- .../frontier_base/root_data.ml | 116 +++++++++++++----- .../frontier_base/root_data.mli | 51 ++++---- .../full_frontier/full_frontier.ml | 18 ++- .../persistent_frontier/database.ml | 12 +- .../persistent_frontier.ml | 85 ++++++++----- .../transition_frontier.ml | 11 +- 8 files changed, 200 insertions(+), 105 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index 495c705c83ff..70081396cb0e 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -256,8 +256,8 @@ let fix_persistent_frontier_root_do ~logger ~config_directory in ( ( breadcrumb , Transition_frontier.Util.to_protocol_states_map_exn - @@ Root_data.Limited.protocol_states @@ root_transition.new_root - ) + @@ Root_data.Limited.protocol_states_for_scan_state + root_transition.new_root ) , res ) ) in [%log info] "Generated $count transition diffs" diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index a339e0f0e7dd..669db1009790 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -498,7 +498,8 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier } in `Repeat (this_cycle :: previous_cycles) - | Ok (scan_state, pending_coinbase, new_root, protocol_states) -> ( + | Ok (scan_state, pending_coinbase, new_root, protocol_states_for_scan_state) + -> ( let%bind () = Trust_system.( record t.trust_system logger sender @@ -584,7 +585,10 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier in Transition_frontier.Root_data.Limited.create ~block_tag ~state_hash:new_root_state_hash ~scan_state ~pending_coinbase - ~protocol_states + ~protocol_states_for_scan_state + ~protocol_state: + ( Mina_block.Stable.Latest.header block + |> Mina_block.Header.protocol_state ) in let%bind () = Transition_frontier.Persistent_frontier.reset_database_exn diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 39b5fd39752f..39092c2b048e 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -70,11 +70,12 @@ module Limited = struct , Mina_block.Stable.Latest.t ) Multi_key_file_storage.Tag.Stable.Latest.t ; state_hash : State_hash.Stable.Latest.t - ; protocol_states : + ; protocol_states_for_scan_state : Mina_state.Protocol_state.Value.Stable.Latest.t Mina_base.State_hash.With_state_hashes.Stable.Latest.t list ; common : Common.Stable.Latest.t + ; protocol_state : Mina_state.Protocol_state.Value.Stable.Latest.t } [@@deriving bin_io_unversioned, fields] @@ -85,9 +86,14 @@ module Limited = struct ] let create ~block_tag ~state_hash ~scan_state ~pending_coinbase - ~protocol_states = + ~protocol_states_for_scan_state ~protocol_state = let common = { Common.scan_state; pending_coinbase } in - { block_tag; state_hash; protocol_states; common } + { block_tag + ; state_hash + ; protocol_states_for_scan_state + ; common + ; protocol_state + } let scan_state t = Common.scan_state t.common @@ -95,24 +101,46 @@ module Limited = struct end module Minimal = struct + module Block_data = struct + [%%versioned + module Stable = struct + [@@@no_toplevel_latest_type] + + module V1 = struct + type t = + { protocol_state : Mina_state.Protocol_state.Value.Stable.V2.t + ; block_tag : + ( State_hash.Stable.V1.t + , Mina_block.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t + ; delta_block_chain_proof : + State_hash.Stable.V1.t Mina_stdlib.Nonempty_list.Stable.V1.t + } + + let to_latest = Fn.id + end + end] + + type t = Stable.Latest.t = + { protocol_state : Mina_state.Protocol_state.value + ; block_tag : + Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag + ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t + } + end + [%%versioned module Stable = struct [@@@no_toplevel_latest_type] module V3 = struct type t = - { state_hash : State_hash.Stable.V1.t; common : Common.Stable.V3.t } - [@@deriving fields] - - let of_limited ~common state_hash = { state_hash; common } + { state_hash : State_hash.Stable.V1.t + ; common : Common.Stable.V3.t + ; block_data_opt : Block_data.Stable.V1.t option + } let to_latest = Fn.id - - let common t = t.common - - let scan_state t = t.common.Common.Stable.Latest.scan_state - - let pending_coinbase t = t.common.Common.Stable.Latest.pending_coinbase end module V2 = struct @@ -120,17 +148,25 @@ module Minimal = struct { state_hash : State_hash.Stable.V1.t; common : Common.Stable.V2.t } let to_latest { state_hash; common } = - { V3.state_hash; common = Common.Stable.V2.to_latest common } + { V3.state_hash + ; common = Common.Stable.V2.to_latest common + ; block_data_opt = None + } end end] - type t = { state_hash : State_hash.t; common : Common.t } [@@deriving fields] + type t = Stable.Latest.t = + { state_hash : State_hash.t + ; common : Common.t + ; block_data_opt : Block_data.Stable.Latest.t option + } + [@@deriving fields] - let of_limited ~common state_hash = { state_hash; common } + let common t = t.common - let upgrade t ~block_tag ~protocol_states = - let protocol_states = - List.map protocol_states ~f:(fun (state_hash, s) -> + let upgrade t ~protocol_states_for_scan_state ~protocol_state ~block_tag = + let protocol_states_for_scan_state = + List.map protocol_states_for_scan_state ~f:(fun (state_hash, s) -> { With_hash.data = s ; hash = { Mina_base.State_hash.State_hashes.state_hash @@ -140,18 +176,27 @@ module Minimal = struct in ignore ( Staged_ledger.Scan_state.check_required_protocol_states - t.common.scan_state ~protocol_states + t.common.scan_state ~protocol_states:protocol_states_for_scan_state |> Or_error.ok_exn : Mina_state.Protocol_state.value State_hash.With_state_hashes.t list ) ; { Limited.block_tag ; state_hash = t.state_hash - ; protocol_states ; common = t.common + ; protocol_states_for_scan_state + ; protocol_state } - let create ~state_hash ~scan_state ~pending_coinbase = + let create ~state_hash ~scan_state ~pending_coinbase ~block_tag + ~protocol_state ~delta_block_chain_proof = let common = { Common.scan_state; pending_coinbase } in - { state_hash; common } + { state_hash + ; common + ; block_data_opt = + Some { block_tag; protocol_state; delta_block_chain_proof } + } + + let of_legacy_minimal ~state_hash common = + { state_hash; common; block_data_opt = None } let scan_state t = Common.scan_state t.common @@ -161,8 +206,9 @@ end type t = { block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag ; state_hash : State_hash.t + ; protocol_state : Mina_state.Protocol_state.Value.t ; staged_ledger : Staged_ledger.t - ; protocol_states : + ; protocol_states_for_scan_state : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t @@ -170,28 +216,38 @@ type t = let minimize { staged_ledger - ; protocol_states = _ - ; block_tag = _ + ; protocol_states_for_scan_state = _ + ; block_tag ; state_hash - ; delta_block_chain_proof = _ + ; delta_block_chain_proof + ; protocol_state } = let scan_state = Staged_ledger.scan_state staged_ledger in let pending_coinbase = Staged_ledger.pending_coinbase_collection staged_ledger in let common = Common.create ~scan_state ~pending_coinbase in - { Minimal.state_hash; common } + { Minimal.state_hash + ; common + ; block_data_opt = Some { block_tag; protocol_state; delta_block_chain_proof } + } let limit { staged_ledger - ; protocol_states + ; protocol_states_for_scan_state ; block_tag ; state_hash ; delta_block_chain_proof = _ + ; protocol_state } = let scan_state = Staged_ledger.scan_state staged_ledger in let pending_coinbase = Staged_ledger.pending_coinbase_collection staged_ledger in let common = Common.create ~scan_state ~pending_coinbase in - { Limited.block_tag; common; protocol_states; state_hash } + { Limited.block_tag + ; common + ; protocol_states_for_scan_state + ; state_hash + ; protocol_state + } diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index a0b2c4b2533c..e1786207c8a4 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -57,16 +57,19 @@ module Limited : sig val pending_coinbase : t -> Pending_coinbase.t - val protocol_states : + val protocol_states_for_scan_state : t -> Mina_state.Protocol_state.value State_hash.With_state_hashes.t list + val protocol_state : t -> Mina_state.Protocol_state.value + val create : block_tag:Mina_block.Stable.Latest.t State_hash.File_storage.tag -> state_hash:State_hash.t -> scan_state:Staged_ledger.Scan_state.t -> pending_coinbase:Pending_coinbase.t - -> protocol_states: + -> protocol_states_for_scan_state: Mina_state.Protocol_state.value State_hash.With_state_hashes.t list + -> protocol_state:Mina_state.Protocol_state.value -> t val common : t -> Common.t @@ -78,32 +81,23 @@ end * pending_coinbase). *) module Minimal : sig + module Block_data : sig + type t = + { protocol_state : Mina_state.Protocol_state.value + ; block_tag : + Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag + ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t + } + end + [%%versioned: module Stable : sig - [@@@no_toplevel_latest_type] - module V3 : sig type t - - val state_hash : t -> State_hash.t - - val of_limited : common:Common.Stable.V3.t -> State_hash.Stable.V1.t -> t - - val common : t -> Common.Stable.V3.t - - val scan_state : t -> Staged_ledger.Scan_state.Stable.V3.t - - val pending_coinbase : t -> Pending_coinbase.Stable.V2.t - end - - module V2 : sig - type t - - val to_latest : t -> V3.t end end] - type t + val common : t -> Common.t val state_hash : t -> State_hash.t @@ -111,27 +105,34 @@ module Minimal : sig val pending_coinbase : t -> Pending_coinbase.t - val of_limited : common:Common.t -> State_hash.t -> t + val of_legacy_minimal : state_hash:State_hash.t -> Common.t -> t + + val block_data_opt : t -> Block_data.t option val upgrade : t + -> protocol_states_for_scan_state: + (State_hash.t * Mina_state.Protocol_state.value) list + -> protocol_state:Mina_state.Protocol_state.Value.t -> block_tag:Mina_block.Stable.Latest.t State_hash.File_storage.tag - -> protocol_states: - (Mina_base.State_hash.t * Mina_state.Protocol_state.Value.t) list -> Limited.t val create : state_hash:State_hash.t -> scan_state:Staged_ledger.Scan_state.t -> pending_coinbase:Pending_coinbase.t + -> block_tag:Mina_block.Stable.Latest.t State_hash.File_storage.tag + -> protocol_state:Mina_state.Protocol_state.Value.t + -> delta_block_chain_proof:State_hash.t Mina_stdlib.Nonempty_list.t -> t end type t = { block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag ; state_hash : State_hash.t + ; protocol_state : Mina_state.Protocol_state.Value.t ; staged_ledger : Staged_ledger.t - ; protocol_states : + ; protocol_states_for_scan_state : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 69c012d0c015..98e31be05e51 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -168,7 +168,7 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger (`This_block_is_trusted_to_be_safe root_block_with_hashes) in let protocol_states_for_root_scan_state = - root_data.protocol_states + root_data.protocol_states_for_scan_state |> List.map ~f:(fun s -> (State_hash.With_state_hashes.state_hash s, s)) |> State_hash.Map.of_alist_exn in @@ -218,11 +218,13 @@ let root_data t = let root = root t in { state_hash = Breadcrumb.state_hash root ; staged_ledger = Breadcrumb.staged_ledger root - ; protocol_states = State_hash.Map.data t.protocol_states_for_root_scan_state + ; protocol_states_for_scan_state = + State_hash.Map.data t.protocol_states_for_root_scan_state ; block_tag = Breadcrumb.block_tag root ; delta_block_chain_proof = Breadcrumb.validated_transition root |> Mina_block.Validated.delta_block_chain_proof + ; protocol_state = Breadcrumb.protocol_state root } let max_length { max_length; _ } = max_length @@ -376,7 +378,7 @@ module Util = struct Staged_ledger.Scan_state.required_state_hashes new_scan_state |> State_hash.Set.to_list in - let protocol_states = + let protocol_states_for_scan_state = Protocol_states_for_root_scan_state .protocol_states_for_next_root_scan_state protocol_states_for_root_scan_state ~next_root_required_hashes @@ -388,7 +390,8 @@ module Util = struct ~state_hash:heir_hash ~scan_state:new_scan_state ~pending_coinbase: (Staged_ledger.pending_coinbase_collection heir_staged_ledger) - ~protocol_states + ~protocol_states_for_scan_state + ~protocol_state:(Breadcrumb.protocol_state heir) in let just_emitted_a_proof = Breadcrumb.just_emitted_a_proof heir in { Diff.Root_transition.new_root = new_root_data @@ -693,7 +696,7 @@ let apply_diff (type mutant) t (diff : (Diff.full, mutant) Diff.t) let new_root_hash = Root_data.Limited.state_hash new_root in let old_root_hash = t.root in let new_root_protocol_states = - Root_data.Limited.protocol_states new_root + Root_data.Limited.protocol_states_for_scan_state new_root in [%log' internal t.logger] "Move_frontier_root" ; move_root t ~new_root_hash ~new_root_protocol_states ~garbage @@ -1020,8 +1023,11 @@ module For_tests = struct ; delta_block_chain_proof = Mina_block.Validated.delta_block_chain_proof transition ; staged_ledger - ; protocol_states = [] + ; protocol_states_for_scan_state = [] ; block_tag + ; protocol_state = + Mina_block.Validated.header transition + |> Mina_block.Header.protocol_state } in let persistent_root = diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 8b14bbeb0743..effaea4a30fa 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -277,14 +277,14 @@ let get_root t = | [ Some (Some_key_value (Root_hash, hash)) ; Some (Some_key_value (Root_common, common)) ] -> - Ok (Root_data.Minimal.Stable.Latest.of_limited ~common hash) + Ok (Root_data.Minimal.of_legacy_minimal common ~state_hash:hash) | _ -> ( match get t.db ~key:Root ~error:(`Not_found `Root) with | Ok root -> (* automatically split Root into (Root_hash, Root_common) *) Batch.with_batch t.db ~f:(fun batch -> - let hash = Root_data.Minimal.Stable.Latest.state_hash root in - let common = Root_data.Minimal.Stable.Latest.common root in + let hash = Root_data.Minimal.state_hash root in + let common = Root_data.Minimal.common root in Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:hash ; Batch.set batch ~key:Root_common ~data:common ) ; @@ -298,7 +298,7 @@ let get_root_hash t = | Ok hash -> Ok hash | Error _ -> - Result.map ~f:Root_data.Minimal.Stable.Latest.state_hash (get_root t) + Result.map ~f:Root_data.Minimal.state_hash (get_root t) (* TODO: check that best tip is connected to root *) (* TODO: check for garbage *) @@ -390,7 +390,7 @@ let initialize t ~root_data = Batch.set batch ~key:Best_tip ~data:root_state_hash ; Batch.set batch ~key:Protocol_states_for_root_scan_state ~data: - ( Root_data.Limited.protocol_states root_data + ( Root_data.Limited.protocol_states_for_scan_state root_data |> List.map ~f:With_hash.data ) ) let find_arcs_and_root t ~(arcs_cache : State_hash.t list State_hash.Table.t) @@ -443,7 +443,7 @@ let move_root ~old_root_hash ~new_root ~garbage = Batch.set batch ~key:Protocol_states_for_root_scan_state ~data: (List.map ~f:With_hash.data - (Root_data.Limited.protocol_states new_root) ) ; + (Root_data.Limited.protocol_states_for_scan_state new_root) ) ; List.iter (old_root_hash :: garbage) ~f:(fun node_hash -> (* because we are removing entire forks of the tree, there is * no need to have extra logic to any remove arcs to the node diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 158f053cd15f..19e0006facee 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -35,15 +35,12 @@ end exception Invalid_genesis_state_hash of Mina_block.Validated.t let construct_staged_ledger_at_root ~(precomputed_values : Precomputed_values.t) - ~root_ledger ~root_transition ~(root : Root_data.Minimal.Stable.Latest.t) - ~protocol_states ~logger ~signature_kind = - let blockchain_state = - root_transition |> Mina_block.Validated.forget |> With_hash.data - |> Mina_block.header |> Mina_block.Header.protocol_state - |> Protocol_state.blockchain_state - in + ~root_ledger ~root_protocol_state + ~(root : Root_data.Minimal.Stable.Latest.t) ~protocol_states ~logger + ~signature_kind = + let blockchain_state = Protocol_state.blockchain_state root_protocol_state in let pending_coinbases, scan_state = - Root_data.Minimal.Stable.Latest.(pending_coinbase root, scan_state root) + Root_data.Minimal.(pending_coinbase root, scan_state root) in let protocol_states_map = List.fold protocol_states ~init:State_hash.Map.empty @@ -268,33 +265,70 @@ module Instance = struct let open Deferred.Result.Let_syntax in let%bind () = Deferred.return (assert_no_sync t) in (* read basic information from the database *) - let%bind root, root_transition, best_tip, protocol_states, root_hash = + let%bind ( root + , best_tip + , protocol_states + , root_hash + , { block_tag = root_block_tag + ; protocol_state = root_protocol_state + ; delta_block_chain_proof = root_delta_block_chain_proof + } ) = (let open Result.Let_syntax in let%bind root = Database.get_root t.db in - let root_hash = Root_data.Minimal.Stable.Latest.state_hash root in - let%bind root_transition = - Database.get_transition t.db ~signature_kind ~proof_cache_db root_hash + let root_hash = Root_data.Minimal.state_hash root in + let%bind root_block_data = + match Root_data.Minimal.block_data_opt root with + | Some block_data -> + Result.return block_data + | None -> + let%map root_transition = + Database.get_transition t.db ~signature_kind ~proof_cache_db + root_hash + in + let block = + Mina_block.Validated.forget root_transition + |> With_hash.data |> Mina_block.read_all_proofs_from_disk + in + (* We're initializing frontier, so there shouldn't be any data preserved at the + state hash's multi-key file storage, and root block won't be validated, so there won't + be an overwrite *) + let block_tag = + State_hash.File_storage.write_values_exn root_hash + ~f:(fun writer -> + State_hash.File_storage.write_value writer + (module Mina_block.Stable.Latest) + block ) + in + let protocol_state = + Mina_block.Validated.header root_transition + |> Mina_block.Header.protocol_state + in + let delta_block_chain_proof = + Mina_block.Validated.delta_block_chain_proof root_transition + in + { Root_data.Minimal.Block_data.block_tag + ; protocol_state + ; delta_block_chain_proof + } in let%bind best_tip = Database.get_best_tip t.db in let%map protocol_states = Database.get_protocol_states_for_root_scan_state t.db in - (root, root_transition, best_tip, protocol_states, root_hash)) + (root, best_tip, protocol_states, root_hash, root_block_data)) |> Result.map_error ~f:(fun err -> `Failure (Database.Error.not_found_message err) ) |> Deferred.return in let root_genesis_state_hash = - root_transition |> Mina_block.Validated.forget |> With_hash.data - |> Mina_block.header |> Mina_block.Header.protocol_state - |> Protocol_state.genesis_state_hash + Protocol_state.genesis_state_hash root_protocol_state in (* construct the root staged ledger in memory *) let%bind root_staged_ledger = let open Deferred.Let_syntax in match%map construct_staged_ledger_at_root ~precomputed_values ~root_ledger - ~root_transition ~root ~protocol_states + ~root_protocol_state ~root ~protocol_states ~signature_kind:t.factory.signature_kind ~logger:t.factory.logger with | Error err -> @@ -302,16 +336,7 @@ module Instance = struct | Ok staged_ledger -> Ok staged_ledger in - let root_state_hash = Root_data.Minimal.Stable.Latest.state_hash root in - (* TODO remove the hack *) - let root_block_tag = - State_hash.File_storage.write_values_exn (Lazy.force temp_state_hash) - ~f:(fun writer -> - State_hash.File_storage.write_value writer - (module Mina_block.Stable.Latest) - @@ Mina_block.read_all_proofs_from_disk @@ With_hash.data - @@ Mina_block.Validated.forget root_transition ) - in + let root_state_hash = Root_data.Minimal.state_hash root in (* initialize the new in memory frontier and extensions *) let frontier = Full_frontier.create @@ -320,12 +345,12 @@ module Instance = struct ~root_data: { state_hash = root_state_hash ; staged_ledger = root_staged_ledger - ; protocol_states = + ; protocol_states_for_scan_state = List.map protocol_states ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) ; block_tag = root_block_tag - ; delta_block_chain_proof = - Mina_block.Validated.delta_block_chain_proof root_transition + ; delta_block_chain_proof = root_delta_block_chain_proof + ; protocol_state = root_protocol_state } ~root_ledger:(Root_ledger.as_unmasked root_ledger) ~consensus_local_state ~max_length ~persistent_root_instance diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 5eb314f9ef62..e30f7d0b113c 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -84,17 +84,19 @@ type Structured_log_events.t += Persisted_frontier_dropped let genesis_root_data ~precomputed_values = let transition, block_tag = Mina_block.genesis ~precomputed_values in let state_hash = Mina_block.Validated.state_hash transition in + let protocol_state = + Mina_block.Validated.header transition |> Mina_block.Header.protocol_state + in let constraint_constants = precomputed_values.constraint_constants in let scan_state = Staged_ledger.Scan_state.empty ~constraint_constants () in (*if scan state is empty the protocol states required is also empty*) - let protocol_states = [] in let pending_coinbase = Or_error.ok_exn (Pending_coinbase.create ~depth:constraint_constants.pending_coinbase_depth () ) in Root_data.Limited.create ~block_tag ~state_hash ~scan_state ~pending_coinbase - ~protocol_states + ~protocol_states_for_scan_state:[] ~protocol_state let load_from_persistence_and_start ~context:(module Context : CONTEXT) ~verifier ~consensus_local_state ~max_length ~persistent_root @@ -742,7 +744,7 @@ module For_tests = struct in let create_root, root_ledger_accounts = create_root_and_accounts in (* TODO: ensure that rose_tree cannot be longer than k *) - let%bind root, branches, protocol_states = + let%bind root, branches, protocol_states_for_scan_state = let%bind root, protocol_states = gen_root_breadcrumb in let%map (Mina_stdlib.Rose_tree.T (root, branches)) = Quickcheck.Generator.with_size ~size @@ -762,7 +764,8 @@ module For_tests = struct ~pending_coinbase: ( Breadcrumb.staged_ledger root |> Staged_ledger.pending_coinbase_collection ) - ~protocol_states + ~protocol_states_for_scan_state + ~protocol_state:(Breadcrumb.protocol_state root) in let%map persistent_root, persistent_frontier = gen_persistence ~logger ~precomputed_values ~verifier () From 63e5af9d7b4f57c3338c1332f023dd9bf42bdf90 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 18:32:27 +0100 Subject: [PATCH 090/122] Remove staged ledger from Root_data.t --- .../frontier_base/root_data.ml | 17 ++++++----------- .../frontier_base/root_data.mli | 3 ++- .../full_frontier/full_frontier.ml | 16 ++++++++++------ .../full_frontier/full_frontier.mli | 1 + .../persistent_frontier/persistent_frontier.ml | 5 ++++- 5 files changed, 23 insertions(+), 19 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index 39092c2b048e..ce5f12dd2d2c 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -207,7 +207,8 @@ type t = { block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag ; state_hash : State_hash.t ; protocol_state : Mina_state.Protocol_state.Value.t - ; staged_ledger : Staged_ledger.t + ; scan_state : Staged_ledger.Scan_state.t + ; pending_coinbase : Pending_coinbase.t ; protocol_states_for_scan_state : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list @@ -215,17 +216,14 @@ type t = } let minimize - { staged_ledger + { scan_state + ; pending_coinbase ; protocol_states_for_scan_state = _ ; block_tag ; state_hash ; delta_block_chain_proof ; protocol_state } = - let scan_state = Staged_ledger.scan_state staged_ledger in - let pending_coinbase = - Staged_ledger.pending_coinbase_collection staged_ledger - in let common = Common.create ~scan_state ~pending_coinbase in { Minimal.state_hash ; common @@ -233,17 +231,14 @@ let minimize } let limit - { staged_ledger + { scan_state + ; pending_coinbase ; protocol_states_for_scan_state ; block_tag ; state_hash ; delta_block_chain_proof = _ ; protocol_state } = - let scan_state = Staged_ledger.scan_state staged_ledger in - let pending_coinbase = - Staged_ledger.pending_coinbase_collection staged_ledger - in let common = Common.create ~scan_state ~pending_coinbase in { Limited.block_tag ; common diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index e1786207c8a4..e1bbd2c79fb6 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -131,7 +131,8 @@ type t = { block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag ; state_hash : State_hash.t ; protocol_state : Mina_state.Protocol_state.Value.t - ; staged_ledger : Staged_ledger.t + ; scan_state : Staged_ledger.Scan_state.t + ; pending_coinbase : Pending_coinbase.t ; protocol_states_for_scan_state : Mina_state.Protocol_state.Value.t Mina_base.State_hash.With_state_hashes.t list diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 98e31be05e51..d7f23b4cff8b 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -135,7 +135,7 @@ let close ~loc t = let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger ~consensus_local_state ~max_length ~persistent_root_instance - ~time_controller = + ~time_controller ~staged_ledger = let open Context in let open Root_data in let transition_receipt_time = None in @@ -189,8 +189,8 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger (Ledger.Any_ledger.M.merkle_root root_ledger) ) root_blockchain_state_ledger_hash ) ; let root_breadcrumb = - Breadcrumb.create ~validated_transition - ~staged_ledger:root_data.staged_ledger ~just_emitted_a_proof:false + Breadcrumb.create ~validated_transition ~staged_ledger + ~just_emitted_a_proof:false ~transition_receipt_time (* accounts created shouldn't be used for the root *) ~accounts_created:[] ~block_tag:root_data.block_tag @@ -217,7 +217,9 @@ let root_data t = let open Root_data in let root = root t in { state_hash = Breadcrumb.state_hash root - ; staged_ledger = Breadcrumb.staged_ledger root + ; scan_state = Breadcrumb.staged_ledger root |> Staged_ledger.scan_state + ; pending_coinbase = + Breadcrumb.staged_ledger root |> Staged_ledger.pending_coinbase_collection ; protocol_states_for_scan_state = State_hash.Map.data t.protocol_states_for_root_scan_state ; block_tag = Breadcrumb.block_tag root @@ -1022,7 +1024,9 @@ module For_tests = struct { state_hash = Mina_block.Validated.state_hash transition ; delta_block_chain_proof = Mina_block.Validated.delta_block_chain_proof transition - ; staged_ledger + ; scan_state = Staged_ledger.scan_state staged_ledger + ; pending_coinbase = + Staged_ledger.pending_coinbase_collection staged_ledger ; protocol_states_for_scan_state = [] ; block_tag ; protocol_state = @@ -1050,7 +1054,7 @@ module For_tests = struct root_ledger ) ~consensus_local_state ~max_length ~time_controller:(Block_time.Controller.basic ~logger) - ~persistent_root_instance + ~persistent_root_instance ~staged_ledger let clean_up_persistent_root ~frontier = let persistent_root_instance = persistent_root_instance frontier in diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index 0e6435557afc..4665292e4316 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -46,6 +46,7 @@ val create : -> max_length:int -> persistent_root_instance:Persistent_root.Instance.t -> time_controller:Block_time.Controller.t + -> staged_ledger:Staged_ledger.t -> t val persistent_root_instance : t -> Persistent_root.Instance.t diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 19e0006facee..b68841d7a6d9 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -342,9 +342,12 @@ module Instance = struct Full_frontier.create ~context:(module Context) ~time_controller:t.factory.time_controller + ~staged_ledger:root_staged_ledger ~root_data: { state_hash = root_state_hash - ; staged_ledger = root_staged_ledger + ; scan_state = Staged_ledger.scan_state root_staged_ledger + ; pending_coinbase = + Staged_ledger.pending_coinbase_collection root_staged_ledger ; protocol_states_for_scan_state = List.map protocol_states ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) From c3ed1cfb56a72bd8b81f0a7c68118b067eddc8ed Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 18:46:13 +0100 Subject: [PATCH 091/122] Include block data into Root_data.Common --- .../cli/src/init/fix_persistent_frontier.ml | 5 +- .../bootstrap_controller.ml | 19 ++- .../transition_frontier/catchup_hash_tree.ml | 2 +- .../extensions/root_history.ml | 3 +- .../frontier_base/block_data.ml | 27 ++++ .../transition_frontier/frontier_base/diff.ml | 5 +- .../frontier_base/diff.mli | 2 +- .../frontier_base/root_data.ml | 147 ++++++++---------- .../frontier_base/root_data.mli | 21 ++- .../transition_frontier/full_catchup_tree.ml | 2 +- .../full_frontier/full_frontier.ml | 32 ++-- .../persistent_frontier/database.ml | 22 ++- .../persistent_frontier/database.mli | 4 +- .../persistent_frontier.ml | 7 +- .../persistent_frontier/worker.ml | 2 +- .../transition_frontier.ml | 34 ++-- 16 files changed, 175 insertions(+), 159 deletions(-) create mode 100644 src/lib/transition_frontier/frontier_base/block_data.ml diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index 70081396cb0e..b522060eafa7 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -65,7 +65,7 @@ let apply_root_transitions ~logger ~db diffs = Transition_frontier.Persistent_frontier.Database.move_root ~old_root_hash ~new_root ~garbage batch ; (* Return new root hash for next iteration *) - Root_data.Limited.state_hash new_root + new_root.state_hash | _ -> failwith "Expected Root_transitioned diff" ) : State_hash.t ) @@ -256,8 +256,7 @@ let fix_persistent_frontier_root_do ~logger ~config_directory in ( ( breadcrumb , Transition_frontier.Util.to_protocol_states_map_exn - @@ Root_data.Limited.protocol_states_for_scan_state - root_transition.new_root ) + root_transition.new_root.protocol_states_for_scan_state ) , res ) ) in [%log info] "Generated $count transition diffs" diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 669db1009790..f2281d27aba6 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -568,7 +568,7 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier State_hash.With_state_hashes.state_hash root_block_with_hash in (* step 5. Close the old frontier and reload a new one from disk. *) - let new_root_data : Transition_frontier.Root_data.Limited.t = + let new_root_data : Transition_frontier.Root_data.t = let block = With_hash.data root_block_with_hash |> Mina_block.read_all_proofs_from_disk @@ -583,12 +583,17 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier (module Mina_block.Stable.Latest) block ) in - Transition_frontier.Root_data.Limited.create ~block_tag - ~state_hash:new_root_state_hash ~scan_state ~pending_coinbase - ~protocol_states_for_scan_state - ~protocol_state: - ( Mina_block.Stable.Latest.header block - |> Mina_block.Header.protocol_state ) + { block_tag + ; state_hash = new_root_state_hash + ; scan_state + ; pending_coinbase + ; protocol_states_for_scan_state + ; protocol_state = + Mina_block.Stable.Latest.header block + |> Mina_block.Header.protocol_state + ; delta_block_chain_proof = + Mina_block.Validated.(delta_block_chain_proof @@ lift new_root) + } in let%bind () = Transition_frontier.Persistent_frontier.reset_database_exn diff --git a/src/lib/transition_frontier/catchup_hash_tree.ml b/src/lib/transition_frontier/catchup_hash_tree.ml index 1419308dd213..d3ac4c46473f 100644 --- a/src/lib/transition_frontier/catchup_hash_tree.ml +++ b/src/lib/transition_frontier/catchup_hash_tree.ml @@ -213,7 +213,7 @@ let apply_diffs t (ds : Diff.Full.E.t list) = breadcrumb_added t b | E (Root_transitioned { new_root; garbage = Full hs; _ }) -> List.iter (Diff.Node_list.to_lite hs) ~f:(remove_node t) ; - let h = Root_data.Limited.state_hash new_root in + let h = new_root.state_hash in Hashtbl.change t.nodes h ~f:(function | None -> [%log' debug t.logger] diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index 44b59f582d3e..b5fdd1240178 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -175,8 +175,7 @@ module T = struct let should_produce_view = List.exists diffs_with_mutants ~f:(function (* TODO: send full diffs to extensions to avoid extra lookups in frontier *) - | E (Root_transitioned { new_root; _ }, _) -> - let state_hash = Root_data.Limited.state_hash new_root in + | E (Root_transitioned { new_root = { state_hash; _ }; _ }, _) -> let breadcrumb = Full_frontier.find frontier state_hash |> Option.value_exn diff --git a/src/lib/transition_frontier/frontier_base/block_data.ml b/src/lib/transition_frontier/frontier_base/block_data.ml new file mode 100644 index 000000000000..f930fba90207 --- /dev/null +++ b/src/lib/transition_frontier/frontier_base/block_data.ml @@ -0,0 +1,27 @@ +open Core_kernel +open Mina_base + +[%%versioned +module Stable = struct + [@@@no_toplevel_latest_type] + + module V1 = struct + type t = + { protocol_state : Mina_state.Protocol_state.Value.Stable.V2.t + ; block_tag : + ( State_hash.Stable.V1.t + , Mina_block.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t + ; delta_block_chain_proof : + State_hash.Stable.V1.t Mina_stdlib.Nonempty_list.Stable.V1.t + } + + let to_latest = Fn.id + end +end] + +type t = Stable.Latest.t = + { protocol_state : Mina_state.Protocol_state.value + ; block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag + ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t + } diff --git a/src/lib/transition_frontier/frontier_base/diff.ml b/src/lib/transition_frontier/frontier_base/diff.ml index 398c99872660..8a52bee02ab0 100644 --- a/src/lib/transition_frontier/frontier_base/diff.ml +++ b/src/lib/transition_frontier/frontier_base/diff.ml @@ -66,7 +66,7 @@ module Root_transition = struct | Full : Staged_ledger.Scan_state.t -> full root_transition_scan_state type 'repr t = - { new_root : Root_data.Limited.t + { new_root : Root_data.t ; garbage : 'repr Node_list.t ; old_root_scan_state : 'repr root_transition_scan_state ; just_emitted_a_proof : bool @@ -111,8 +111,7 @@ let to_yojson (type repr mutant) (key : (repr, mutant) t) = hashes in `Assoc - [ ( "new_root" - , State_hash.to_yojson (Root_data.Limited.state_hash new_root) ) + [ ("new_root", State_hash.to_yojson new_root.state_hash) ; ("garbage", `List (List.map ~f:State_hash.to_yojson garbage_hashes)) ; ("just_emitted_a_proof", `Bool just_emitted_a_proof) ] diff --git a/src/lib/transition_frontier/frontier_base/diff.mli b/src/lib/transition_frontier/frontier_base/diff.mli index df71a367c6a0..93323e56a868 100644 --- a/src/lib/transition_frontier/frontier_base/diff.mli +++ b/src/lib/transition_frontier/frontier_base/diff.mli @@ -60,7 +60,7 @@ module Root_transition : sig | Full : Staged_ledger.Scan_state.t -> full root_transition_scan_state type 'repr t = - { new_root : Root_data.Limited.t + { new_root : Root_data.t ; garbage : 'repr Node_list.t ; old_root_scan_state : 'repr root_transition_scan_state ; just_emitted_a_proof : bool diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index ce5f12dd2d2c..b762d0a7522f 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -8,6 +8,7 @@ module Common = struct type t = { scan_state : Staged_ledger.Scan_state.Stable.V3.t ; pending_coinbase : Pending_coinbase.Stable.V2.t + ; block_data_opt : Block_data.Stable.V1.t option } let to_latest = Fn.id @@ -23,18 +24,13 @@ module Common = struct { V3.scan_state = Staged_ledger.Scan_state.Stable.V2.to_latest scan_state ; pending_coinbase + ; block_data_opt = None } end end] - let to_yojson { scan_state = _; pending_coinbase } = - `Assoc - [ ("scan_state", `String "") - ; ( "pending_coinbase" - , Pending_coinbase.Stable.V2.to_yojson pending_coinbase ) - ] - - let create ~scan_state ~pending_coinbase = { scan_state; pending_coinbase } + let create ~scan_state ~pending_coinbase ~block_data_opt = + { scan_state; pending_coinbase; block_data_opt } let scan_state t = t.scan_state @@ -65,80 +61,51 @@ end module Limited = struct type t = - { block_tag : - ( State_hash.Stable.Latest.t - , Mina_block.Stable.Latest.t ) - Multi_key_file_storage.Tag.Stable.Latest.t - ; state_hash : State_hash.Stable.Latest.t + { state_hash : State_hash.Stable.Latest.t ; protocol_states_for_scan_state : Mina_state.Protocol_state.Value.Stable.Latest.t Mina_base.State_hash.With_state_hashes.Stable.Latest.t list - ; common : Common.Stable.Latest.t + ; scan_state : Staged_ledger.Scan_state.Stable.Latest.t + ; pending_coinbase : Pending_coinbase.Stable.Latest.t ; protocol_state : Mina_state.Protocol_state.Value.Stable.Latest.t + ; block_tag : + ( State_hash.Stable.Latest.t + , Mina_block.Stable.Latest.t ) + Multi_key_file_storage.Tag.Stable.Latest.t } [@@deriving bin_io_unversioned, fields] - let to_yojson { state_hash; common; _ } = - `Assoc - [ ("state_hash", State_hash.to_yojson state_hash) - ; ("common", Common.to_yojson common) - ] + let to_yojson { state_hash; _ } = + `Assoc [ ("state_hash", State_hash.to_yojson state_hash) ] let create ~block_tag ~state_hash ~scan_state ~pending_coinbase ~protocol_states_for_scan_state ~protocol_state = - let common = { Common.scan_state; pending_coinbase } in - { block_tag - ; state_hash + { state_hash ; protocol_states_for_scan_state - ; common + ; scan_state + ; pending_coinbase ; protocol_state + ; block_tag } - let scan_state t = Common.scan_state t.common + let scan_state t = t.scan_state - let pending_coinbase t = Common.pending_coinbase t.common + let pending_coinbase t = t.pending_coinbase + + let block_tag t = t.block_tag + + let protocol_state t = t.protocol_state end module Minimal = struct - module Block_data = struct - [%%versioned - module Stable = struct - [@@@no_toplevel_latest_type] - - module V1 = struct - type t = - { protocol_state : Mina_state.Protocol_state.Value.Stable.V2.t - ; block_tag : - ( State_hash.Stable.V1.t - , Mina_block.Stable.V2.t ) - Multi_key_file_storage.Tag.Stable.V1.t - ; delta_block_chain_proof : - State_hash.Stable.V1.t Mina_stdlib.Nonempty_list.Stable.V1.t - } - - let to_latest = Fn.id - end - end] - - type t = Stable.Latest.t = - { protocol_state : Mina_state.Protocol_state.value - ; block_tag : - Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag - ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t - } - end - [%%versioned module Stable = struct [@@@no_toplevel_latest_type] module V3 = struct type t = - { state_hash : State_hash.Stable.V1.t - ; common : Common.Stable.V3.t - ; block_data_opt : Block_data.Stable.V1.t option - } + { state_hash : State_hash.Stable.V1.t; common : Common.Stable.V3.t } let to_latest = Fn.id end @@ -148,23 +115,19 @@ module Minimal = struct { state_hash : State_hash.Stable.V1.t; common : Common.Stable.V2.t } let to_latest { state_hash; common } = - { V3.state_hash - ; common = Common.Stable.V2.to_latest common - ; block_data_opt = None - } + { V3.state_hash; common = Common.Stable.V2.to_latest common } end end] - type t = Stable.Latest.t = - { state_hash : State_hash.t - ; common : Common.t - ; block_data_opt : Block_data.Stable.Latest.t option - } + type t = Stable.Latest.t = { state_hash : State_hash.t; common : Common.t } [@@deriving fields] let common t = t.common + let block_data_opt t = t.common.block_data_opt + let upgrade t ~protocol_states_for_scan_state ~protocol_state ~block_tag = + (* TODO: make common always contain block_data and then remove three last parameters of this function *) let protocol_states_for_scan_state = List.map protocol_states_for_scan_state ~f:(fun (state_hash, s) -> { With_hash.data = s @@ -179,24 +142,26 @@ module Minimal = struct t.common.scan_state ~protocol_states:protocol_states_for_scan_state |> Or_error.ok_exn : Mina_state.Protocol_state.value State_hash.With_state_hashes.t list ) ; - { Limited.block_tag - ; state_hash = t.state_hash - ; common = t.common + { Limited.state_hash = t.state_hash ; protocol_states_for_scan_state + ; scan_state = t.common.scan_state + ; pending_coinbase = t.common.pending_coinbase + ; block_tag ; protocol_state } let create ~state_hash ~scan_state ~pending_coinbase ~block_tag ~protocol_state ~delta_block_chain_proof = - let common = { Common.scan_state; pending_coinbase } in - { state_hash - ; common - ; block_data_opt = - Some { block_tag; protocol_state; delta_block_chain_proof } - } + let common = + { Common.scan_state + ; pending_coinbase + ; block_data_opt = + Some { block_tag; protocol_state; delta_block_chain_proof } + } + in + { state_hash; common } - let of_legacy_minimal ~state_hash common = - { state_hash; common; block_data_opt = None } + let of_common ~state_hash common = { state_hash; common } let scan_state t = Common.scan_state t.common @@ -224,11 +189,12 @@ let minimize ; delta_block_chain_proof ; protocol_state } = - let common = Common.create ~scan_state ~pending_coinbase in - { Minimal.state_hash - ; common - ; block_data_opt = Some { block_tag; protocol_state; delta_block_chain_proof } - } + let common = + Common.create ~scan_state ~pending_coinbase + ~block_data_opt: + (Some { block_tag; protocol_state; delta_block_chain_proof }) + in + { Minimal.state_hash; common } let limit { scan_state @@ -239,10 +205,21 @@ let limit ; delta_block_chain_proof = _ ; protocol_state } = - let common = Common.create ~scan_state ~pending_coinbase in { Limited.block_tag - ; common + ; protocol_state ; protocol_states_for_scan_state ; state_hash - ; protocol_state + ; scan_state + ; pending_coinbase } + +let to_common + { scan_state + ; pending_coinbase + ; block_tag + ; protocol_state + ; delta_block_chain_proof + ; _ + } = + Common.create ~scan_state ~pending_coinbase + ~block_data_opt:(Some { block_tag; protocol_state; delta_block_chain_proof }) diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index e1bbd2c79fb6..d7489fcd41d0 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -13,6 +13,12 @@ module Common : sig val to_latest : t -> V3.t end end] + + val create : + scan_state:Staged_ledger.Scan_state.t + -> pending_coinbase:Pending_coinbase.t + -> block_data_opt:Block_data.t option + -> t end (* Historical root data is similar to Limited root data, except that it also @@ -71,8 +77,6 @@ module Limited : sig Mina_state.Protocol_state.value State_hash.With_state_hashes.t list -> protocol_state:Mina_state.Protocol_state.value -> t - - val common : t -> Common.t end (* Minimal root data contains the smallest amount of information about a root. @@ -81,15 +85,6 @@ end * pending_coinbase). *) module Minimal : sig - module Block_data : sig - type t = - { protocol_state : Mina_state.Protocol_state.value - ; block_tag : - Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag - ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t - } - end - [%%versioned: module Stable : sig module V3 : sig @@ -105,7 +100,7 @@ module Minimal : sig val pending_coinbase : t -> Pending_coinbase.t - val of_legacy_minimal : state_hash:State_hash.t -> Common.t -> t + val of_common : state_hash:State_hash.t -> Common.t -> t val block_data_opt : t -> Block_data.t option @@ -142,3 +137,5 @@ type t = val minimize : t -> Minimal.t val limit : t -> Limited.t + +val to_common : t -> Common.t diff --git a/src/lib/transition_frontier/full_catchup_tree.ml b/src/lib/transition_frontier/full_catchup_tree.ml index d851d19235b2..bd2d8ee28176 100644 --- a/src/lib/transition_frontier/full_catchup_tree.ml +++ b/src/lib/transition_frontier/full_catchup_tree.ml @@ -368,7 +368,7 @@ let apply_diffs (t : t) (ds : Diff.Full.E.t list) = breadcrumb_added t b | E (Root_transitioned { new_root; garbage = Full hs; _ }) -> List.iter (Diff.Node_list.to_lite hs) ~f:(remove_node t) ; - let h = Root_data.Limited.state_hash new_root in + let h = new_root.state_hash in if Hashtbl.mem t.nodes h then prune t ~root_hash:h else ( [%log' debug t.logger] diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index d7f23b4cff8b..3f6848c7c185 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -387,13 +387,17 @@ module Util = struct ~old_root_state:(Breadcrumb.protocol_state_with_hashes parent) in let new_root_data = - Root_data.Limited.create - ~block_tag:(Breadcrumb.block_tag heir) - ~state_hash:heir_hash ~scan_state:new_scan_state - ~pending_coinbase: - (Staged_ledger.pending_coinbase_collection heir_staged_ledger) - ~protocol_states_for_scan_state - ~protocol_state:(Breadcrumb.protocol_state heir) + { Root_data.block_tag = Breadcrumb.block_tag heir + ; state_hash = heir_hash + ; scan_state = new_scan_state + ; pending_coinbase = + Staged_ledger.pending_coinbase_collection heir_staged_ledger + ; protocol_states_for_scan_state + ; protocol_state = Breadcrumb.protocol_state heir + ; delta_block_chain_proof = + Breadcrumb.validated_transition heir + |> Mina_block.Validated.delta_block_chain_proof + } in let just_emitted_a_proof = Breadcrumb.just_emitted_a_proof heir in { Diff.Root_transition.new_root = new_root_data @@ -694,12 +698,16 @@ let apply_diff (type mutant) t (diff : (Diff.full, mutant) Diff.t) let old_best_tip = t.best_tip in t.best_tip <- new_best_tip ; (old_best_tip, None) - | Root_transitioned { new_root; garbage = Full garbage; _ } -> - let new_root_hash = Root_data.Limited.state_hash new_root in + | Root_transitioned + { new_root = + { state_hash = new_root_hash + ; protocol_states_for_scan_state = new_root_protocol_states + ; _ + } + ; garbage = Full garbage + ; _ + } -> let old_root_hash = t.root in - let new_root_protocol_states = - Root_data.Limited.protocol_states_for_scan_state new_root - in [%log' internal t.logger] "Move_frontier_root" ; move_root t ~new_root_hash ~new_root_protocol_states ~garbage ~enable_epoch_ledger_sync ; diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index effaea4a30fa..95e28553d1c6 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -277,7 +277,7 @@ let get_root t = | [ Some (Some_key_value (Root_hash, hash)) ; Some (Some_key_value (Root_common, common)) ] -> - Ok (Root_data.Minimal.of_legacy_minimal common ~state_hash:hash) + Ok (Root_data.Minimal.of_common common ~state_hash:hash) | _ -> ( match get t.db ~key:Root ~error:(`Not_found `Root) with | Ok root -> @@ -370,27 +370,27 @@ let check t ~genesis_state_hash = |> Result.join let initialize t ~root_data = - let root_state_hash = Root_data.Limited.state_hash root_data in + let root_state_hash = root_data.Root_data.state_hash in let root_block = (* TODO preserve block tags in frontier *) - Root_data.Limited.block_tag root_data + root_data.block_tag |> State_hash.File_storage.read (module Mina_block.Stable.Latest) |> Or_error.ok_exn in + let root_common = Root_data.to_common root_data in [%log' trace t.logger] - ~metadata:[ ("root_data", Root_data.Limited.to_yojson root_data) ] + ~metadata:[ ("root_data", State_hash.to_yojson root_state_hash) ] "Initializing persistent frontier database with $root_data" ; Batch.with_batch t.db ~f:(fun batch -> Batch.set batch ~key:Db_version ~data:version ; Batch.set batch ~key:(Transition root_state_hash) ~data:root_block ; Batch.set batch ~key:(Arcs root_state_hash) ~data:[] ; Batch.set batch ~key:Root_hash ~data:root_state_hash ; - Batch.set batch ~key:Root_common - ~data:(Root_data.Limited.common root_data) ; + Batch.set batch ~key:Root_common ~data:root_common ; Batch.set batch ~key:Best_tip ~data:root_state_hash ; Batch.set batch ~key:Protocol_states_for_root_scan_state ~data: - ( Root_data.Limited.protocol_states_for_scan_state root_data + ( root_data.protocol_states_for_scan_state |> List.map ~f:With_hash.data ) ) let find_arcs_and_root t ~(arcs_cache : State_hash.t list State_hash.Table.t) @@ -435,15 +435,13 @@ let add ~arcs_cache ~transition = Batch.set batch ~key:(Arcs parent_hash) ~data:(hash :: parent_arcs) let move_root ~old_root_hash ~new_root ~garbage = - let new_root_hash = Root_data.Limited.state_hash new_root in + let new_root_hash = new_root.Root_data.state_hash in fun batch -> Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:new_root_hash ; - Batch.set batch ~key:Root_common ~data:(Root_data.Limited.common new_root) ; + Batch.set batch ~key:Root_common ~data:(Root_data.to_common new_root) ; Batch.set batch ~key:Protocol_states_for_root_scan_state - ~data: - (List.map ~f:With_hash.data - (Root_data.Limited.protocol_states_for_scan_state new_root) ) ; + ~data:(List.map ~f:With_hash.data new_root.protocol_states_for_scan_state) ; List.iter (old_root_hash :: garbage) ~f:(fun node_hash -> (* because we are removing entire forks of the tree, there is * no need to have extra logic to any remove arcs to the node diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index 2779e85f59f1..a7863eb79a3c 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -69,7 +69,7 @@ val check : | `Raised of Core_kernel.Error.t ] ] ) Result.t -val initialize : t -> root_data:Root_data.Limited.t -> unit +val initialize : t -> root_data:Root_data.t -> unit val find_arcs_and_root : t @@ -87,7 +87,7 @@ val add : val move_root : old_root_hash:State_hash.t - -> new_root:Root_data.Limited.t + -> new_root:Root_data.t -> garbage:State_hash.t list -> batch_t -> unit diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index b68841d7a6d9..1b543909dbf3 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -306,10 +306,7 @@ module Instance = struct let delta_block_chain_proof = Mina_block.Validated.delta_block_chain_proof root_transition in - { Root_data.Minimal.Block_data.block_tag - ; protocol_state - ; delta_block_chain_proof - } + { Block_data.block_tag; protocol_state; delta_block_chain_proof } in let%bind best_tip = Database.get_best_tip t.db in let%map protocol_states = @@ -431,7 +428,7 @@ let with_instance_exn t ~f = x let reset_database_exn t ~root_data ~genesis_state_hash = - let root_state_hash = Root_data.Limited.state_hash root_data in + let root_state_hash = root_data.Root_data.state_hash in [%log' info t.logger] ~metadata:[ ("state_hash", State_hash.to_yojson root_state_hash) ] "Resetting transition frontier database to new root" ; diff --git a/src/lib/transition_frontier/persistent_frontier/worker.ml b/src/lib/transition_frontier/persistent_frontier/worker.ml index dbd260969752..c462d0bc4997 100644 --- a/src/lib/transition_frontier/persistent_frontier/worker.ml +++ b/src/lib/transition_frontier/persistent_frontier/worker.ml @@ -67,7 +67,7 @@ module Worker = struct List.drop_last root_transition_diffs |> Option.value ~default:[] |> List.bind ~f:(fun { new_root; garbage = Lite garbage; _ } -> - Root_data.Limited.state_hash new_root :: garbage ) + new_root.state_hash :: garbage ) in let total_root_transition_diff = Option.map final_root_transition_diff diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index e30f7d0b113c..e310bb5ddc1d 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -95,8 +95,15 @@ let genesis_root_data ~precomputed_values = (Pending_coinbase.create ~depth:constraint_constants.pending_coinbase_depth () ) in - Root_data.Limited.create ~block_tag ~state_hash ~scan_state ~pending_coinbase - ~protocol_states_for_scan_state:[] ~protocol_state + { Root_data.block_tag + ; state_hash + ; scan_state + ; pending_coinbase + ; protocol_states_for_scan_state = [] + ; protocol_state + ; delta_block_chain_proof = + Mina_block.Validated.delta_block_chain_proof transition + } let load_from_persistence_and_start ~context:(module Context : CONTEXT) ~verifier ~consensus_local_state ~max_length ~persistent_root @@ -757,15 +764,18 @@ module For_tests = struct (root, branches, protocol_states) in let root_data = - Root_data.Limited.create - ~block_tag:(Breadcrumb.block_tag root) - ~state_hash:(Breadcrumb.state_hash root) - ~scan_state:(Breadcrumb.staged_ledger root |> Staged_ledger.scan_state) - ~pending_coinbase: - ( Breadcrumb.staged_ledger root - |> Staged_ledger.pending_coinbase_collection ) - ~protocol_states_for_scan_state - ~protocol_state:(Breadcrumb.protocol_state root) + { Root_data.block_tag = Breadcrumb.block_tag root + ; state_hash = Breadcrumb.state_hash root + ; scan_state = Breadcrumb.staged_ledger root |> Staged_ledger.scan_state + ; pending_coinbase = + Breadcrumb.staged_ledger root + |> Staged_ledger.pending_coinbase_collection + ; protocol_states_for_scan_state + ; protocol_state = Breadcrumb.protocol_state root + ; delta_block_chain_proof = + Mina_block.Validated.delta_block_chain_proof + (Breadcrumb.validated_transition root) + } in let%map persistent_root, persistent_frontier = gen_persistence ~logger ~precomputed_values ~verifier () @@ -777,7 +787,7 @@ module For_tests = struct precomputed_values.protocol_state_with_hashes ) ) ; Async.Thread_safe.block_on_async_exn (fun () -> Persistent_root.reset_factory_root_exn persistent_root ~create_root - ~root_state_hash:(Root_data.Limited.state_hash root_data) ) ; + ~root_state_hash:root_data.state_hash ) ; let frontier_result = Async.Thread_safe.block_on_async_exn (fun () -> load_with_max_length ~max_length ~retry_with_fresh_db:false From 1d01cbd346a0fcfd238721b7a6b9bd50a5031b68 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 19:09:28 +0100 Subject: [PATCH 092/122] Don't rely on Transition entry for root --- .../persistent_frontier/database.ml | 7 ---- .../persistent_frontier.ml | 32 +++++++++++++++++-- 2 files changed, 29 insertions(+), 10 deletions(-) diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 95e28553d1c6..7cebda6c3f74 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -371,19 +371,12 @@ let check t ~genesis_state_hash = let initialize t ~root_data = let root_state_hash = root_data.Root_data.state_hash in - let root_block = - (* TODO preserve block tags in frontier *) - root_data.block_tag - |> State_hash.File_storage.read (module Mina_block.Stable.Latest) - |> Or_error.ok_exn - in let root_common = Root_data.to_common root_data in [%log' trace t.logger] ~metadata:[ ("root_data", State_hash.to_yojson root_state_hash) ] "Initializing persistent frontier database with $root_data" ; Batch.with_batch t.db ~f:(fun batch -> Batch.set batch ~key:Db_version ~data:version ; - Batch.set batch ~key:(Transition root_state_hash) ~data:root_block ; Batch.set batch ~key:(Arcs root_state_hash) ~data:[] ; Batch.set batch ~key:Root_hash ~data:root_state_hash ; Batch.set batch ~key:Root_common ~data:root_common ; diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 1b543909dbf3..b4c0dfa44802 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -161,9 +161,35 @@ module Instance = struct let get_root_transition ~signature_kind ~proof_cache_db t = let open Result.Let_syntax in - Database.get_root_hash t.db - >>= Database.get_transition t.db ~signature_kind ~proof_cache_db - |> Result.map_error ~f:Database.Error.message + let%bind root = + Database.get_root t.db |> Result.map_error ~f:Database.Error.message + in + let root_hash = Root_data.Minimal.state_hash root in + match Root_data.Minimal.block_data_opt root with + | None -> + Database.get_transition t.db ~signature_kind ~proof_cache_db root_hash + |> Result.map_error ~f:Database.Error.message + | Some { block_tag; delta_block_chain_proof; _ } -> + let%map block_stable = + State_hash.File_storage.read + (module Mina_block.Stable.Latest) + block_tag + (* TODO consider using a more specific error *) + |> Result.map_error ~f:(fun e -> + Error.(tag ~tag:"get_root_transition" e |> to_string_mach) ) + in + let block = + Mina_block.write_all_proofs_to_disk ~signature_kind ~proof_cache_db + block_stable + in + Mina_block.Validated.unsafe_of_trusted_block ~delta_block_chain_proof + (`This_block_is_trusted_to_be_safe + { With_hash.data = block + ; hash = + { State_hash.State_hashes.state_hash = root_hash + ; state_body_hash = None + } + } ) let fast_forward t target_root : (unit, [> `Failure of string | `Bootstrap_required ]) Result.t = From 69c56846796b8e98ff5158d0b3133353378b4821 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 21:04:30 +0100 Subject: [PATCH 093/122] Use new format for transition storage --- src/lib/block_producer/block_producer.ml | 11 +- src/lib/mina_block/block.mli | 6 +- src/lib/mina_block/validation.ml | 23 +++- src/lib/mina_block/validation.mli | 2 + src/lib/mina_ledger/ledger.mli | 28 +++-- .../scan_state_application_data.ml | 28 +++++ src/lib/staged_ledger/staged_ledger.ml | 49 +++++---- src/lib/staged_ledger/staged_ledger.mli | 40 ++----- .../transaction_snark_scan_state.mli | 16 ++- .../frontier_base/block_data.ml | 73 +++++++++++++ .../frontier_base/breadcrumb.ml | 74 +++++++++++-- .../frontier_base/breadcrumb.mli | 7 ++ .../transition_frontier/frontier_base/diff.ml | 10 +- .../frontier_base/diff.mli | 2 +- .../frontier_base/network_types.ml | 14 ++- .../full_frontier/full_frontier.ml | 3 +- .../persistent_frontier/database.ml | 102 +++++++++++------- .../persistent_frontier/database.mli | 3 +- .../persistent_frontier.ml | 5 +- .../persistent_frontier/worker.ml | 12 +-- 20 files changed, 370 insertions(+), 138 deletions(-) create mode 100644 src/lib/staged_ledger/scan_state_application_data.ml diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index c2f66c018cf6..fc16b3366db1 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -337,6 +337,14 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants in (witnesses', works') ) in + let scan_state_application_data = + { Staged_ledger.Scan_state.Application_data.is_new_stack + ; stack_update + ; first_pass_ledger_end + ; tagged_works + ; tagged_witnesses + } + in (* TODO consider skipping verification (i.e. ~skip_verification:true) *) let%map.Deferred.Result new_staged_ledger, ledger_proof_opt = Staged_ledger.apply_to_scan_state ~logger ~skip_verification:false @@ -344,8 +352,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants ~previous_pending_coinbase_collection: (Staged_ledger.pending_coinbase_collection staged_ledger) ~previous_scan_state:(Staged_ledger.scan_state staged_ledger) - ~constraint_constants ~is_new_stack ~stack_update - ~first_pass_ledger_end tagged_works tagged_witnesses + ~constraint_constants scan_state_application_data in (new_staged_ledger, ledger_proof_opt, is_new_stack, pcu_action) in diff --git a/src/lib/mina_block/block.mli b/src/lib/mina_block/block.mli index 1f17f6c44fe8..abef2ba874d4 100644 --- a/src/lib/mina_block/block.mli +++ b/src/lib/mina_block/block.mli @@ -6,7 +6,11 @@ module Stable : sig [@@@no_toplevel_latest_type] module V2 : sig - type t [@@deriving sexp, equal] + type t = + { header : Header.Stable.V2.t + ; body : Staged_ledger_diff.Body.Stable.V1.t + } + [@@deriving sexp, equal] val header : t -> Header.Stable.V2.t diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index c3157db8db4c..e886b37662aa 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -508,7 +508,8 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger let%bind.Deferred.Result ( transitioned_staged_ledger , proof_opt , accounts_created - , tagged_block ) = + , tagged_block + , scan_state_application_data ) = Deferred.Result.map_error ~f:(fun e -> `Staged_ledger_application_failed e) @@ let%bind.Deferred.Result ( `Ledger new_ledger , `Accounts_created accounts_created @@ -550,6 +551,14 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger in (witnesses', works', block') ) in + let scan_state_application_data = + { Staged_ledger.Scan_state.Application_data.is_new_stack + ; stack_update + ; first_pass_ledger_end + ; tagged_works + ; tagged_witnesses + } + in let%map.Deferred.Result new_staged_ledger, res_opt = let skip_verification = [%equal: [ `All | `Proofs ] option] skip_staged_ledger_verification @@ -560,8 +569,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger ~previous_pending_coinbase_collection: (Staged_ledger.pending_coinbase_collection parent_staged_ledger) ~previous_scan_state:(Staged_ledger.scan_state parent_staged_ledger) - ~constraint_constants ~is_new_stack ~stack_update - ~first_pass_ledger_end tagged_works tagged_witnesses + ~constraint_constants scan_state_application_data in Or_error.iter_error ( Staged_ledger.update_scan_state_metrics @@ -570,7 +578,11 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] !"Error updating metrics after applying scan state: $error" ) ; - (new_staged_ledger, res_opt, accounts_created, tagged_block) + ( new_staged_ledger + , res_opt + , accounts_created + , tagged_block + , scan_state_application_data ) in [%log internal] "Diff_applied" ; let staged_ledger_hash_opt = @@ -629,7 +641,8 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger (t, Unsafe.set_valid_staged_ledger_diff validation) , `Staged_ledger transitioned_staged_ledger , `Accounts_created accounts_created - , `Block_serialized tagged_block ) + , `Block_serialized tagged_block + , `Scan_state_application_data scan_state_application_data ) | 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 a1e50634c394..be890f6a5b01 100644 --- a/src/lib/mina_block/validation.mli +++ b/src/lib/mina_block/validation.mli @@ -381,6 +381,8 @@ val validate_staged_ledger_diff : * [ `Staged_ledger of Staged_ledger.t ] * [ `Accounts_created of Account_id.t list ] * [ `Block_serialized of Block.Stable.V2.t State_hash.File_storage.tag ] + * [ `Scan_state_application_data of + Staged_ledger.Scan_state.Application_data.t ] , [> `Staged_ledger_application_failed of Staged_ledger.Staged_ledger_error.t | `Invalid_body_reference diff --git a/src/lib/mina_ledger/ledger.mli b/src/lib/mina_ledger/ledger.mli index f157adca8f71..384993660cfd 100644 --- a/src/lib/mina_ledger/ledger.mli +++ b/src/lib/mina_ledger/ledger.mli @@ -4,17 +4,23 @@ open Mina_base module Location : Merkle_ledger.Location_intf.S -module Mask_maps : - Merkle_mask.Mask_maps_intf.S - with type account := Account.t - and type account_id := Account_id.t - and type 'a account_id_map := 'a Account_id.Map.t - and type account_id_set := Account_id.Set.t - and type 'a address_map := 'a Location.Addr.Map.t - and type hash := Ledger_hash.t - and type location := Location.t - and type 'a location_map := 'a Location.Map.t - and type 'a token_id_map := 'a Token_id.Map.t +module Mask_maps : sig + include + Merkle_mask.Mask_maps_intf.S + with type account := Account.t + and type account_id := Account_id.t + and type 'a account_id_map := 'a Account_id.Map.t + and type account_id_set := Account_id.Set.t + and type 'a address_map := 'a Location.Addr.Map.t + and type hash := Ledger_hash.t + and type location := Location.t + and type 'a location_map := 'a Location.Map.t + and type 'a token_id_map := 'a Token_id.Map.t + + val to_stable : ledger_depth:int -> t -> Mask_maps.Stable.Latest.t + + val of_stable : ledger_depth:int -> Mask_maps.Stable.Latest.t -> t +end module Db : Merkle_ledger.Intf.Ledger.DATABASE diff --git a/src/lib/staged_ledger/scan_state_application_data.ml b/src/lib/staged_ledger/scan_state_application_data.ml new file mode 100644 index 000000000000..b60b9779a73b --- /dev/null +++ b/src/lib/staged_ledger/scan_state_application_data.ml @@ -0,0 +1,28 @@ +open Core_kernel +open Mina_base + +[%%versioned +module Stable = struct + module V1 = struct + (* Data for loading the staged ledger *) + type t = + { is_new_stack : bool + ; stack_update : + Pending_coinbase.Stack_versioned.Stable.V1.t One_or_two.Stable.V1.t + option + ; first_pass_ledger_end : Frozen_ledger_hash.Stable.V1.t + ; tagged_works : + Transaction_snark_scan_state.Ledger_proof_with_sok_message.Tagged + .Stable + .V1 + .t + list + ; tagged_witnesses : + Transaction_snark_scan_state.Transaction_with_witness.Tagged.Stable.V1 + .t + list + } + + let to_latest = Fn.id + end +end] diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 2dad34fd4b79..558623cb8c59 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -36,7 +36,11 @@ module Pre_statement = struct end module T = struct - module Scan_state = Transaction_snark_scan_state + module Scan_state = struct + include Transaction_snark_scan_state + module Application_data = Scan_state_application_data + end + module Pre_diff_info = Pre_diff_info module Staged_ledger_error = struct @@ -836,7 +840,7 @@ module T = struct ( is_new_stack , data , Pending_coinbase.Update.Action.Update_one - , `Update_one updated_stack + , Some (`One updated_stack) , `First_pass_ledger_end first_pass_ledger_end ) ) else (*Two partition: @@ -869,24 +873,24 @@ module T = struct match (coinbase_in_first_partition, second_has_data) with | true, true -> ( Pending_coinbase.Update.Action.Update_two_coinbase_in_first - , `Update_two (updated_stack1, updated_stack2) ) + , Some (`Two (updated_stack1, updated_stack2)) ) (* updated_stack2 does not have coinbase and but has the state from the previous stack *) | true, false -> (* updated_stack1 has some new coinbase but parition 2 has no data and so we have only one stack to update *) - (Update_one, `Update_one updated_stack1) + (Update_one, Some (`One updated_stack1)) | false, true -> (* updated_stack1 just has the new state. [updated stack2] might have coinbase, definitely has some data and therefore will have a non-dummy state. *) ( Update_two_coinbase_in_second - , `Update_two (updated_stack1, updated_stack2) ) + , Some (`Two (updated_stack1, updated_stack2)) ) | false, false -> (* a diff consists of only non-coinbase transactions. This is currently not possible because a diff will have a coinbase at the very least, so don't update anything? *) - (Update_none, `Update_none) + (Update_none, None) in [%log internal] "Update_coinbase_stack_done" ~metadata: @@ -922,7 +926,7 @@ module T = struct ( false , [] , Pending_coinbase.Update.Action.Update_none - , `Update_none + , None , `First_pass_ledger_end (Ledger.merkle_root ledger) ) ) ) (* Update the pending_coinbase tree with the updated/new stack and delete the @@ -959,13 +963,13 @@ module T = struct in (* Updating the latest stack and/or adding a new one *) match stack_update with - | `Update_none -> + | None -> Ok pending_coinbase_collection_updated1 - | `Update_one stack1 -> + | Some (`One stack1) -> Pending_coinbase.update_coinbase_stack ~depth pending_coinbase_collection_updated1 stack1 ~is_new_stack |> to_staged_ledger_or_error - | `Update_two (stack1, stack2) -> + | Some (`Two (stack1, stack2)) -> (* The case when some of the transactions go into the old tree and remaining on to the new tree *) let%bind update1 = @@ -1011,8 +1015,13 @@ module T = struct let apply_to_scan_state ~logger ~skip_verification ~log_prefix ~ledger ~previous_pending_coinbase_collection ~previous_scan_state - ~constraint_constants ~is_new_stack ~stack_update ~first_pass_ledger_end - tagged_works tagged_witnesses = + ~constraint_constants + { Scan_state.Application_data.is_new_stack + ; stack_update + ; first_pass_ledger_end + ; tagged_works + ; tagged_witnesses + } = let open Deferred.Result.Let_syntax in [%log internal] "Fill_work_and_enqueue_transactions" ; let%bind res_opt, scan_state = @@ -2372,7 +2381,7 @@ let%test_module "staged ledger tests" = ~state_and_body_hash ~coinbase_receiver ~supercharge_coinbase ~zkapp_cmd_limit_hardcap ~signature_kind = let%bind.Deferred.Result ( `Ledger new_ledger - , `Accounts_created accounts_created + , `Accounts_created _ , `Stack_update stack_update , `First_pass_ledger_end first_pass_ledger_end , `Witnesses witnesses @@ -2397,16 +2406,22 @@ let%test_module "staged ledger tests" = in (witnesses', works') ) in + let data = + { Scan_state.Application_data.is_new_stack + ; stack_update + ; first_pass_ledger_end + ; tagged_works + ; tagged_witnesses + } + in let%map.Deferred.Result new_staged_ledger, res_opt = apply_to_scan_state ~logger ~skip_verification:false ~log_prefix:"apply_diff" ~ledger:new_ledger ~previous_pending_coinbase_collection:t.pending_coinbase_collection - ~previous_scan_state:t.scan_state ~constraint_constants ~is_new_stack - ~stack_update ~first_pass_ledger_end tagged_works tagged_witnesses + ~previous_scan_state:t.scan_state ~constraint_constants data in ( `Ledger_proof res_opt , `Staged_ledger new_staged_ledger - , `Accounts_created accounts_created , `Pending_coinbase_update (is_new_stack, pending_coinbase_update_action) ) @@ -2442,7 +2457,6 @@ 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 apply_diff_full ~constraint_constants ~global_slot !sl diff' ~logger @@ -3432,7 +3446,6 @@ 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 ca91d26f6d27..d76ea4fdf913 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -8,6 +8,8 @@ module Ledger = Mina_ledger.Ledger type t module Scan_state : sig + module Application_data = Scan_state_application_data + module Available_job : sig type t @@ -40,9 +42,8 @@ module Scan_state : sig end module Ledger_proof_with_sok_message : sig - module Tagged : sig - type t - end + module Tagged = + Transaction_snark_scan_state.Ledger_proof_with_sok_message.Tagged val persist_many : Transaction_snark_work.t list @@ -53,9 +54,7 @@ module Scan_state : sig module Transaction_with_witness : sig type t - module Tagged : sig - type t - end + module Tagged = Transaction_snark_scan_state.Transaction_with_witness.Tagged val persist_many : t list -> State_hash.File_storage.writer_t -> Tagged.t list @@ -252,11 +251,7 @@ val apply_diff : -> ( [ `Ledger of Ledger.t ] * [ `Accounts_created of Account_id.t list ] * [ `Stack_update of - [ `Update_none - | `Update_one of Pending_coinbase.Stack_versioned.t - | `Update_two of - Pending_coinbase.Stack_versioned.t - * Pending_coinbase.Stack_versioned.t ] ] + Pending_coinbase.Stack_versioned.t One_or_two.t option ] * [ `First_pass_ledger_end of Frozen_ledger_hash.t ] * [ `Witnesses of Scan_state.Transaction_with_witness.t list ] * [ `Works of Transaction_snark_work.t list ] @@ -279,11 +274,7 @@ val apply_diff_unchecked : -> ( [ `Ledger of Ledger.t ] * [ `Accounts_created of Account_id.t list ] * [ `Stack_update of - [ `Update_none - | `Update_one of Pending_coinbase.Stack_versioned.t - | `Update_two of - Pending_coinbase.Stack_versioned.t - * Pending_coinbase.Stack_versioned.t ] ] + Pending_coinbase.Stack_versioned.t One_or_two.t option ] * [ `First_pass_ledger_end of Frozen_ledger_hash.t ] * [ `Witnesses of Scan_state.Transaction_with_witness.t list ] * [ `Works of Transaction_snark_work.t list ] @@ -299,16 +290,7 @@ val apply_to_scan_state : -> previous_pending_coinbase_collection:Pending_coinbase.t -> previous_scan_state:Scan_state.t -> constraint_constants:Genesis_constants.Constraint_constants.t - -> is_new_stack:bool - -> stack_update: - [< `Update_none - | `Update_one of Pending_coinbase.Stack_versioned.t - | `Update_two of - Pending_coinbase.Stack_versioned.t * Pending_coinbase.Stack_versioned.t - ] - -> first_pass_ledger_end:Frozen_ledger_hash.t - -> Scan_state.Ledger_proof_with_sok_message.Tagged.t list - -> Scan_state.Transaction_with_witness.Tagged.t list + -> Scan_state.Application_data.t -> (t * Ledger_proof.Tagged.t option, Staged_ledger_error.t) Deferred.Result.t (* This should memoize the snark verifications *) @@ -413,11 +395,7 @@ module Test_helpers : sig * Account_id.t list ) list * Pending_coinbase.Update.Action.t - * [> `Update_none - | `Update_one of Pending_coinbase.Stack_versioned.t - | `Update_two of - Pending_coinbase.Stack_versioned.t - * Pending_coinbase.Stack_versioned.t ] + * Pending_coinbase.Stack_versioned.t One_or_two.t option * [> `First_pass_ledger_end of Frozen_ledger_hash.t ] , Staged_ledger_error.t ) Deferred.Result.t 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 711550281124..3a67dc482219 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 @@ -46,6 +46,15 @@ module Transaction_with_witness : sig val create : tag:Tag.t -> Stable.Latest.t -> t + [%%versioned: + module Stable : sig + [@@@no_toplevel_latest_type] + + module V1 : sig + type nonrec t = t + end + end] + val statement : t -> Transaction_snark.Statement.t end @@ -77,7 +86,12 @@ module Ledger_proof_with_sok_message : sig type t = Ledger_proof.t * Sok_message.t module Tagged : sig - type t + [%%versioned: + module Stable : sig + module V1 : sig + type t + end + end] val create : tag:Proof.t State_hash.Tag.t diff --git a/src/lib/transition_frontier/frontier_base/block_data.ml b/src/lib/transition_frontier/frontier_base/block_data.ml index f930fba90207..2746b9c1bce7 100644 --- a/src/lib/transition_frontier/frontier_base/block_data.ml +++ b/src/lib/transition_frontier/frontier_base/block_data.ml @@ -25,3 +25,76 @@ type t = Stable.Latest.t = ; block_tag : Mina_block.Stable.Latest.t Mina_base.State_hash.File_storage.tag ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t } + +let validated_of_stable ~signature_kind ~proof_cache_db ~state_hash transition = + let block = + { With_hash.data = transition + ; hash = { State_hash.State_hashes.state_hash; state_body_hash = None } + } + in + let parent_hash = + block |> With_hash.data |> Mina_block.Stable.Latest.header + |> Mina_block.Header.protocol_state + |> Mina_state.Protocol_state.previous_state_hash + in + let cached_block = + With_hash.map + ~f:(Mina_block.write_all_proofs_to_disk ~signature_kind ~proof_cache_db) + block + in + (* TODO: the delta transition chain proof is incorrect (same behavior the daemon used to have, but we should probably fix this?) *) + Mina_block.Validated.unsafe_of_trusted_block + ~delta_block_chain_proof:(Mina_stdlib.Nonempty_list.singleton parent_hash) + (`This_block_is_trusted_to_be_safe cached_block) + +module Staged_ledger_data = struct + type t = + Mina_ledger.Mask_maps.Stable.Latest.t + * Staged_ledger.Scan_state.Application_data.t +end + +module Full = struct + [%%versioned + module Stable = struct + [@@@no_toplevel_latest_type] + + module V1 = struct + type t = + { header : Mina_block.Header.Stable.V2.t + ; block_tag : + ( State_hash.Stable.V1.t + , Mina_block.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t + ; delta_block_chain_proof : + State_hash.Stable.V1.t Mina_stdlib.Nonempty_list.Stable.V1.t + ; staged_ledger_data : + Mina_ledger.Mask_maps.Stable.V1.t + * Staged_ledger.Scan_state.Application_data.Stable.V1.t + ; staged_ledger_hash : Staged_ledger_hash.Stable.V1.t + ; accounts_created : Account_id.Stable.V2.t list + ; staged_ledger_aux_and_pending_coinbases_cached : + ( State_hash.Stable.V1.t + , Network_types.Staged_ledger_aux_and_pending_coinbases.Data.Stable + .V1 + .t ) + Multi_key_file_storage.Tag.Stable.V1.t + option + ; transaction_hashes_unordered : + Mina_transaction.Transaction_hash.Stable.V1.t list + } + + let to_latest = Fn.id + end + end] + + type t = Stable.Latest.t + + let read_block { Stable.Latest.block_tag; _ } = + State_hash.File_storage.read (module Mina_block.Stable.Latest) block_tag + + let to_validated_block ~signature_kind ~proof_cache_db ~state_hash + transition_data = + read_block transition_data + |> Or_error.map + ~f:(validated_of_stable ~signature_kind ~proof_cache_db ~state_hash) +end diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index ca66539bf664..69219c0d3b4f 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -23,6 +23,8 @@ module T = struct ; mutable staged_ledger_aux_and_pending_coinbases_cached : Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option ; transaction_hashes : Mina_transaction.Transaction_hash.Set.t + (* Should be some for non-root *) + ; application_data : Staged_ledger.Scan_state.Application_data.t option } [@@deriving fields] @@ -66,6 +68,7 @@ module T = struct ; transaction_hashes = command_hashes_of_transition validated_transition |> Mina_transaction.Transaction_hash.Set.of_list + ; application_data = None } let to_yojson @@ -78,6 +81,7 @@ module T = struct ; block_tag = _ ; staged_ledger_aux_and_pending_coinbases_cached = _ ; transaction_hashes + ; application_data = _ } = `Assoc [ ( "state_hash" @@ -182,14 +186,30 @@ let build ?skip_staged_ledger_verification ?transaction_pool_proxy ~logger , `Block_with_validation fully_valid_block , `Staged_ledger transitioned_staged_ledger , `Accounts_created accounts_created - , `Block_serialized block_tag ) -> + , `Block_serialized block_tag + , `Scan_state_application_data application_data ) -> [%log internal] "Create_breadcrumb" ; + let validated_transition = + Mina_block.Validated.lift fully_valid_block + in Deferred.Result.return - (create - ~validated_transition: - (Mina_block.Validated.lift fully_valid_block) - ~staged_ledger:transitioned_staged_ledger ~accounts_created - ~just_emitted_a_proof ~transition_receipt_time ~block_tag ) + { T.validated_transition + ; staged_ledger = transitioned_staged_ledger + ; accounts_created + ; just_emitted_a_proof + ; transition_receipt_time + ; block_tag + ; application_data = Some application_data + ; staged_ledger_hash = + Mina_block.Validated.header validated_transition + |> Mina_block.Header.protocol_state + |> Protocol_state.blockchain_state + |> Blockchain_state.staged_ledger_hash + ; staged_ledger_aux_and_pending_coinbases_cached = None + ; transaction_hashes = + command_hashes_of_transition validated_transition + |> Mina_transaction.Transaction_hash.Set.of_list + } | Error `Invalid_body_reference -> let message = "invalid body reference" in let%map () = @@ -367,6 +387,37 @@ let staged_ledger_aux_and_pending_coinbases ~scan_state_protocol_states breadcrumb.staged_ledger_aux_and_pending_coinbases_cached <- Some tag ) ; res +let to_maps (staged_ledger : Staged_ledger.t) = + let ledger = Staged_ledger.ledger staged_ledger in + Mina_ledger.Ledger.get_maps ledger + |> Mina_ledger.Ledger.Mask_maps.to_stable + ~ledger_depth:(Mina_ledger.Ledger.depth ledger) + +let to_block_data_exn (breadcrumb : T.t) : Block_data.Full.t = + let application_data = + match breadcrumb.application_data with + | Some application_data -> + application_data + | None -> + failwithf "application_data is not set for breadcrumb %s" + (State_hash.to_base58_check @@ state_hash breadcrumb) + () + in + { Block_data.Full.Stable.Latest.header = header breadcrumb + ; block_tag = breadcrumb.block_tag + ; delta_block_chain_proof = + Mina_block.Validated.delta_block_chain_proof + breadcrumb.validated_transition + ; staged_ledger_data = (to_maps breadcrumb.staged_ledger, application_data) + ; staged_ledger_hash = breadcrumb.staged_ledger_hash + ; accounts_created = breadcrumb.accounts_created + ; staged_ledger_aux_and_pending_coinbases_cached = + breadcrumb.staged_ledger_aux_and_pending_coinbases_cached + ; transaction_hashes_unordered = + Mina_transaction.Transaction_hash.Set.to_list + breadcrumb.transaction_hashes + } + module For_tests = struct open Currency open Signature_lib @@ -539,14 +590,21 @@ module For_tests = struct in (witnesses', works') ) in + let scan_state_application_data = + { Staged_ledger.Scan_state.Application_data.is_new_stack + ; stack_update + ; first_pass_ledger_end + ; tagged_works + ; tagged_witnesses + } + in Staged_ledger.apply_to_scan_state ~logger ~skip_verification:false ~log_prefix:"apply_diff" ~ledger:new_ledger ~previous_pending_coinbase_collection: (Staged_ledger.pending_coinbase_collection parent_staged_ledger) ~previous_scan_state:(Staged_ledger.scan_state parent_staged_ledger) ~constraint_constants:precomputed_values.constraint_constants - ~is_new_stack ~stack_update ~first_pass_ledger_end tagged_works - tagged_witnesses + scan_state_application_data in let%bind transitioned_staged_ledger, ledger_proof_opt = match%bind ledger_and_proof with diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index 51b574dfd07c..b845972f345d 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -118,6 +118,13 @@ val staged_ledger_aux_and_pending_coinbases : -> t -> Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option +(** Convert a breadcrumb to a block data + + Will return an exception if called on transition frontier root or + a transition that was saved to frontier. +*) +val to_block_data_exn : t -> Block_data.Full.t + module For_tests : sig val gen : ?logger:Logger.t diff --git a/src/lib/transition_frontier/frontier_base/diff.ml b/src/lib/transition_frontier/frontier_base/diff.ml index 8a52bee02ab0..5fde60450dda 100644 --- a/src/lib/transition_frontier/frontier_base/diff.ml +++ b/src/lib/transition_frontier/frontier_base/diff.ml @@ -8,7 +8,7 @@ type lite = Lite module Node = struct type 'a t = | Full : Breadcrumb.t -> full t - | Lite : Mina_block.Validated.t -> lite t + | Lite : State_hash.t * Block_data.Full.t -> lite t end module Node_list = struct @@ -99,8 +99,8 @@ let to_yojson (type repr mutant) (key : (repr, mutant) t) = match key with | New_node (Full breadcrumb) -> State_hash.to_yojson (Breadcrumb.state_hash breadcrumb) - | New_node (Lite transition) -> - State_hash.to_yojson (Mina_block.Validated.state_hash transition) + | New_node (Lite (state_hash, _)) -> + State_hash.to_yojson state_hash | Root_transitioned { new_root; garbage; just_emitted_a_proof; old_root_scan_state = _ } -> let garbage_hashes = @@ -123,8 +123,8 @@ let to_yojson (type repr mutant) (key : (repr, mutant) t) = let to_lite (type mutant) (diff : (full, mutant) t) : (lite, mutant) t = match diff with | New_node (Full breadcrumb) -> - let external_transition = Breadcrumb.validated_transition breadcrumb in - New_node (Lite external_transition) + let external_transition = Breadcrumb.to_block_data_exn breadcrumb in + New_node (Lite (Breadcrumb.state_hash breadcrumb, external_transition)) | Root_transitioned { new_root ; garbage = Full garbage_nodes diff --git a/src/lib/transition_frontier/frontier_base/diff.mli b/src/lib/transition_frontier/frontier_base/diff.mli index 93323e56a868..dd5b41c6c245 100644 --- a/src/lib/transition_frontier/frontier_base/diff.mli +++ b/src/lib/transition_frontier/frontier_base/diff.mli @@ -23,7 +23,7 @@ type lite = Lite module Node : sig type 'a t = | Full : Breadcrumb.t -> full t - | Lite : Mina_block.Validated.t -> lite t + | Lite : State_hash.t * Block_data.Full.t -> lite t end module Node_list : sig diff --git a/src/lib/transition_frontier/frontier_base/network_types.ml b/src/lib/transition_frontier/frontier_base/network_types.ml index 1d47a2963974..b5756410b76d 100644 --- a/src/lib/transition_frontier/frontier_base/network_types.ml +++ b/src/lib/transition_frontier/frontier_base/network_types.ml @@ -2,7 +2,17 @@ open Core_kernel open Mina_base module Tag_or_data = struct - type 'a t = Tag of 'a State_hash.File_storage.tag | Data of 'a + [%%versioned + module Stable = struct + module V1 = struct + type 'a t = + | Tag of + (State_hash.Stable.V1.t, 'a) Multi_key_file_storage.Tag.Stable.V1.t + | Data of 'a + + let to_latest = Fn.id + end + end] end module Make' (Data : Binable.S) = struct @@ -67,7 +77,7 @@ module Staged_ledger_aux_and_pending_coinbases = struct [%%versioned_binable module Stable = struct module V1 = struct - type t = Data.Stable.V1.t Tag_or_data.t + type t = Data.Stable.Latest.t Tag_or_data.t let to_latest = Fn.id diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 3f6848c7c185..eb4a629e9bb1 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -138,7 +138,6 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger ~time_controller ~staged_ledger = let open Context in let open Root_data in - let transition_receipt_time = None in let root_block_stable = root_data.block_tag |> State_hash.File_storage.read (module Mina_block.Stable.Latest) @@ -191,7 +190,7 @@ let create ~context:(module Context : CONTEXT) ~root_data ~root_ledger let root_breadcrumb = Breadcrumb.create ~validated_transition ~staged_ledger ~just_emitted_a_proof:false - ~transition_receipt_time + ~transition_receipt_time:None (* accounts created shouldn't be used for the root *) ~accounts_created:[] ~block_tag:root_data.block_tag in diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 7cebda6c3f74..08fc47b598ac 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -48,9 +48,49 @@ module Schema = struct [@@@warning "-22"] + module Transition = struct + [%%versioned + module Stable = struct + [@@@no_toplevel_latest_type] + + module V3 = struct + type t = + | Old_format of Mina_block.Stable.V2.t + | New_format of Block_data.Full.Stable.V1.t + + let to_latest = Fn.id + end + + module V2 = struct + type t = Mina_block.Stable.V2.t = + { header : Header.Stable.V2.t + ; body : Staged_ledger_diff.Body.Stable.V1.t + } + + let to_latest : t -> V3.t = fun block -> Old_format block + end + end] + + let header = function + | Stable.Latest.Old_format block -> + Mina_block.Stable.V2.header block + | New_format { header; _ } -> + header + + let to_validated_block ~signature_kind ~proof_cache_db ~state_hash = + function + | Stable.Latest.Old_format transition -> + Result.return + @@ Block_data.validated_of_stable ~signature_kind ~proof_cache_db + ~state_hash transition + | New_format transition -> + Block_data.Full.to_validated_block ~signature_kind ~proof_cache_db + ~state_hash transition + end + type _ t = | Db_version : int t - | Transition : State_hash.Stable.V1.t -> Mina_block.Stable.V2.t t + | Transition : State_hash.Stable.V1.t -> Transition.Stable.V3.t t | Arcs : State_hash.Stable.V1.t -> State_hash.Stable.V1.t list t (* TODO: In hard forks, `Root` should be replaced by `(Root_hash, Root_common)`; @@ -93,7 +133,7 @@ module Schema = struct | Db_version -> [%bin_type_class: int] | Transition _ -> - [%bin_type_class: Mina_block.Stable.Latest.t] + [%bin_type_class: Transition.Stable.Latest.t] | Arcs _ -> [%bin_type_class: State_hash.Stable.Latest.t list] | Root -> @@ -351,8 +391,7 @@ let check t ~genesis_state_hash = let%bind () = check_version () in let%bind root_hash, root_block = check_base () in let root_protocol_state = - root_block |> Mina_block.Stable.Latest.header - |> Mina_block.Header.protocol_state + Transition.header root_block |> Mina_block.Header.protocol_state in let%bind () = let persisted_genesis_state_hash = @@ -363,7 +402,8 @@ let check t ~genesis_state_hash = else Error (`Genesis_state_mismatch persisted_genesis_state_hash) in let%map () = check_arcs root_hash in - root_block |> Mina_block.Stable.Latest.header |> Header.protocol_state + Transition.header root_block + |> Mina_block.Header.protocol_state |> Mina_state.Protocol_state.blockchain_state |> Mina_state.Blockchain_state.snarked_ledger_hash ) |> Result.map_error ~f:(fun err -> `Corrupt (`Raised err)) @@ -409,23 +449,20 @@ let find_arcs_and_root t ~(arcs_cache : State_hash.t list State_hash.Table.t) | _ -> Error (`Not_found `Old_root_transition) -let add ~arcs_cache ~transition = - let transition = Mina_block.Validated.forget transition in - let hash = State_hash.With_state_hashes.state_hash transition in +let add ~arcs_cache ~state_hash ~transition_data = let parent_hash = - With_hash.data transition |> Mina_block.header |> Header.protocol_state - |> Mina_state.Protocol_state.previous_state_hash + transition_data.Block_data.Full.Stable.Latest.header + |> Header.protocol_state |> Mina_state.Protocol_state.previous_state_hash in let parent_arcs = State_hash.Table.find_exn arcs_cache parent_hash in - State_hash.Table.set arcs_cache ~key:parent_hash ~data:(hash :: parent_arcs) ; - State_hash.Table.set arcs_cache ~key:hash ~data:[] ; - let transition_unwrapped = - With_hash.data transition |> Mina_block.read_all_proofs_from_disk - in + State_hash.Table.set arcs_cache ~key:parent_hash + ~data:(state_hash :: parent_arcs) ; + State_hash.Table.set arcs_cache ~key:state_hash ~data:[] ; fun batch -> - Batch.set batch ~key:(Transition hash) ~data:transition_unwrapped ; - Batch.set batch ~key:(Arcs hash) ~data:[] ; - Batch.set batch ~key:(Arcs parent_hash) ~data:(hash :: parent_arcs) + Batch.set batch ~key:(Transition state_hash) + ~data:(New_format transition_data) ; + Batch.set batch ~key:(Arcs state_hash) ~data:[] ; + Batch.set batch ~key:(Arcs parent_hash) ~data:(state_hash :: parent_arcs) let move_root ~old_root_hash ~new_root ~garbage = let new_root_hash = new_root.Root_data.state_hash in @@ -445,29 +482,12 @@ let move_root ~old_root_hash ~new_root ~garbage = Batch.remove batch ~key:(Arcs node_hash) ) let get_transition ~signature_kind ~proof_cache_db t hash = - let%map transition = - get t.db ~key:(Transition hash) ~error:(`Not_found (`Transition hash)) - in - let block = - { With_hash.data = transition - ; hash = - { State_hash.State_hashes.state_hash = hash; state_body_hash = None } - } - in - let parent_hash = - block |> With_hash.data |> Mina_block.Stable.Latest.header - |> Mina_block.Header.protocol_state - |> Mina_state.Protocol_state.previous_state_hash - in - let cached_block = - With_hash.map - ~f:(Mina_block.write_all_proofs_to_disk ~signature_kind ~proof_cache_db) - block - in - (* TODO: the delta transition chain proof is incorrect (same behavior the daemon used to have, but we should probably fix this?) *) - Mina_block.Validated.unsafe_of_trusted_block - ~delta_block_chain_proof:(Mina_stdlib.Nonempty_list.singleton parent_hash) - (`This_block_is_trusted_to_be_safe cached_block) + (* TODO: consider using a more specific error *) + let error = `Not_found (`Transition hash) in + let%bind.Result transition_data = get t.db ~key:(Transition hash) ~error in + Transition.to_validated_block ~signature_kind ~proof_cache_db ~state_hash:hash + transition_data + |> Result.map_error ~f:(fun _ -> error) let get_arcs t hash = get t.db ~key:(Arcs hash) ~error:(`Not_found (`Arcs hash)) diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index a7863eb79a3c..902db5003fe8 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -81,7 +81,8 @@ val find_arcs_and_root : val add : arcs_cache:State_hash.t list State_hash.Table.t - -> transition:Mina_block.Validated.t + -> state_hash:State_hash.t + -> transition_data:Block_data.Full.t -> batch_t -> unit diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index b4c0dfa44802..4ff448fcea78 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -272,12 +272,11 @@ module Instance = struct (* we're loading transitions from persistent storage, don't assign a timestamp *) - let transition_receipt_time = None in Breadcrumb.build ~skip_staged_ledger_verification:`All ~logger:t.factory.logger ~precomputed_values ~verifier:t.factory.verifier ~trust_system:(Trust_system.null ()) ~parent ~transition - ~get_completed_work:(Fn.const None) ~sender:None ~transition_receipt_time - () + ~get_completed_work:(Fn.const None) ~sender:None + ~transition_receipt_time:None () let set_best_tip ~logger ~frontier ~extensions ~ignore_consensus_local_state ~root_ledger best_tip_hash = diff --git a/src/lib/transition_frontier/persistent_frontier/worker.ml b/src/lib/transition_frontier/persistent_frontier/worker.ml index c462d0bc4997..3c19aaf1a63f 100644 --- a/src/lib/transition_frontier/persistent_frontier/worker.ml +++ b/src/lib/transition_frontier/persistent_frontier/worker.ml @@ -37,8 +37,8 @@ module Worker = struct let apply_diff (type mutant) ~old_root_hash ~arcs_cache (diff : mutant Diff.Lite.t) : Database.batch_t -> unit = match diff with - | New_node (Lite transition) -> - Database.add ~arcs_cache ~transition + | New_node (Lite (state_hash, transition_data)) -> + Database.add ~arcs_cache ~state_hash ~transition_data | Root_transitioned { new_root; garbage = Lite garbage; _ } -> Database.move_root ~old_root_hash ~new_root ~garbage | Best_tip_changed best_tip_hash -> @@ -86,17 +86,17 @@ module Worker = struct let apply_funcs = let state_hashes = List.filter_map input ~f:(function - | E (New_node (Lite transition)) -> - Mina_block.Validated.state_hash transition |> Option.some + | E (New_node (Lite (state_hash, _))) -> + Option.some state_hash | _ -> None ) |> State_hash.Set.of_list in let parent_hashes = List.filter_map input ~f:(function - | E (New_node (Lite transition)) -> + | E (New_node (Lite (_, transition))) -> let parent_hash = - Mina_block.Validated.header transition + transition.Block_data.Full.Stable.Latest.header |> Header.protocol_state |> Mina_state.Protocol_state.previous_state_hash in From 5d575566fbdb31c73b8d1d184cf41b4db6cd968b Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 22:32:40 +0100 Subject: [PATCH 094/122] Store breadcrumb in lightweight way --- .../frontier_base/breadcrumb.ml | 162 +++++++++++++----- .../frontier_base/breadcrumb.mli | 65 +++++-- .../full_frontier/full_frontier.ml | 14 +- .../full_frontier/full_frontier.mli | 2 + .../persistent_frontier.ml | 1 + .../transition_frontier.ml | 5 +- 6 files changed, 185 insertions(+), 64 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 69219c0d3b4f..d4056d389a6b 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -9,11 +9,26 @@ let command_hashes_of_transition validated_transition = Mina_block.Validated.body validated_transition |> Body.staged_ledger_diff |> Staged_ledger_diff.command_hashes +type stored_transition = + | Full of Mina_block.Validated.t + | Lite of + { header : Mina_block.Header.t + ; hashes : State_hash.State_hashes.t + ; delta_block_chain_proof : State_hash.t Mina_stdlib.Nonempty_list.t + ; command_stats : Command_stats.t + } + +let state_hash_of_stored_transition = function + | Full validated_transition -> + Mina_block.Validated.state_hash validated_transition + | Lite { hashes; _ } -> + hashes.state_hash + module T = struct let id = "breadcrumb" type t = - { validated_transition : Mina_block.Validated.t + { validated_transition : stored_transition ; staged_ledger : Staged_ledger.t ; just_emitted_a_proof : bool ; transition_receipt_time : Time.t option @@ -57,7 +72,7 @@ module T = struct |> Mina_block.Header.protocol_state |> Protocol_state.blockchain_state |> Blockchain_state.staged_ledger_hash in - { validated_transition + { validated_transition = Full validated_transition ; staged_ledger ; just_emitted_a_proof ; transition_receipt_time @@ -86,7 +101,7 @@ module T = struct `Assoc [ ( "state_hash" , State_hash.to_yojson - @@ Mina_block.Validated.state_hash validated_transition ) + @@ state_hash_of_stored_transition validated_transition ) ; ("just_emitted_a_proof", `Bool just_emitted_a_proof) ; ( "transition_receipt_time" , `String @@ -101,8 +116,7 @@ end [%%define_locally T. - ( validated_transition - , staged_ledger + ( staged_ledger , just_emitted_a_proof , transition_receipt_time , to_yojson @@ -111,18 +125,12 @@ T. , block_tag , staged_ledger_aux_and_pending_coinbases_cached )] -let header t = T.validated_transition t |> Mina_block.Validated.header - -let command_hashes t = command_hashes_of_transition t.T.validated_transition - -let valid_commands_hashed (t : T.t) = - List.map2_exn (Mina_block.Validated.valid_commands t.validated_transition) - (command_hashes t) ~f:(fun command hash -> - With_status.map command - ~f: - (Fn.flip - Mina_transaction.Transaction_hash.User_command_with_valid_signature - .make hash ) ) +let header t = + match T.validated_transition t with + | Full validated_transition -> + Mina_block.Validated.header validated_transition + | Lite { header; _ } -> + header (* TODO: for better efficiency, add set of tx hashes to `maps_t` and use existing mechanism of mask handling to get accumulated lookups, @@ -177,8 +185,7 @@ let build ?skip_staged_ledger_verification ?transaction_pool_proxy ~logger ~get_completed_work ~logger ~precomputed_values ~verifier ~parent_staged_ledger:(staged_ledger parent) ~parent_protocol_state: - ( parent.validated_transition |> Mina_block.Validated.header - |> Mina_block.Header.protocol_state ) + (header parent |> Mina_block.Header.protocol_state) ?transaction_pool_proxy transition_with_validation with | Ok @@ -193,7 +200,7 @@ let build ?skip_staged_ledger_verification ?transaction_pool_proxy ~logger Mina_block.Validated.lift fully_valid_block in Deferred.Result.return - { T.validated_transition + { T.validated_transition = Full validated_transition ; staged_ledger = transitioned_staged_ledger ; accounts_created ; just_emitted_a_proof @@ -286,29 +293,40 @@ let build ?skip_staged_ledger_verification ?transaction_pool_proxy ~logger (Staged_ledger.Staged_ledger_error.to_error staged_ledger_error) ) ) -let block_with_hash = - Fn.compose Mina_block.Validated.forget validated_transition - -let block = Fn.compose With_hash.data block_with_hash +let command_stats t = + match t.T.validated_transition with + | Full validated_transition -> + Command_stats.of_body @@ Mina_block.Validated.body @@ validated_transition + | Lite { command_stats; _ } -> + command_stats -let command_stats t = Command_stats.of_body @@ Mina_block.body @@ block t +let state_hash t = state_hash_of_stored_transition t.T.validated_transition -let state_hash = Fn.compose Mina_block.Validated.state_hash validated_transition - -let protocol_state b = - b |> block |> Mina_block.header |> Mina_block.Header.protocol_state +let protocol_state b = Mina_block.Header.protocol_state (header b) let protocol_state_with_hashes breadcrumb = - breadcrumb |> validated_transition |> Mina_block.Validated.forget - |> With_hash.map ~f:(Fn.compose Header.protocol_state Mina_block.header) + match breadcrumb.T.validated_transition with + | Full validated_transition -> + Mina_block.Validated.forget validated_transition + |> With_hash.map + ~f:(Fn.compose Mina_block.Header.protocol_state Mina_block.header) + | Lite { hashes; header; _ } -> + { With_hash.hash = hashes + ; data = Mina_block.Header.protocol_state header + } + +let delta_block_chain_proof breadcrumb = + match breadcrumb.T.validated_transition with + | Full validated_transition -> + Mina_block.Validated.delta_block_chain_proof validated_transition + | Lite { delta_block_chain_proof; _ } -> + delta_block_chain_proof let consensus_state = Fn.compose Protocol_state.consensus_state protocol_state let consensus_state_with_hashes breadcrumb = - breadcrumb |> block_with_hash - |> With_hash.map ~f:(fun block -> - block |> Mina_block.header |> Mina_block.Header.protocol_state - |> Protocol_state.consensus_state ) + protocol_state_with_hashes breadcrumb + |> With_hash.map ~f:Protocol_state.consensus_state let parent_hash b = b |> protocol_state |> Protocol_state.previous_state_hash @@ -335,9 +353,7 @@ type display = [@@deriving yojson] let display t = - let protocol_state = - t |> block |> Mina_block.header |> Mina_block.Header.protocol_state - in + let protocol_state = t |> header |> Mina_block.Header.protocol_state in let blockchain_state = Blockchain_state.display (Protocol_state.blockchain_state protocol_state) in @@ -405,9 +421,7 @@ let to_block_data_exn (breadcrumb : T.t) : Block_data.Full.t = in { Block_data.Full.Stable.Latest.header = header breadcrumb ; block_tag = breadcrumb.block_tag - ; delta_block_chain_proof = - Mina_block.Validated.delta_block_chain_proof - breadcrumb.validated_transition + ; delta_block_chain_proof = delta_block_chain_proof breadcrumb ; staged_ledger_data = (to_maps breadcrumb.staged_ledger, application_data) ; staged_ledger_hash = breadcrumb.staged_ledger_hash ; accounts_created = breadcrumb.accounts_created @@ -418,6 +432,72 @@ let to_block_data_exn (breadcrumb : T.t) : Block_data.Full.t = breadcrumb.transaction_hashes } +let lighten (breadcrumb : T.t) : T.t = + match breadcrumb.T.validated_transition with + | Full validated_transition -> + { breadcrumb with + validated_transition = + Lite + { header = header breadcrumb + ; hashes = + Mina_block.Validated.forget validated_transition + |> With_hash.hash + ; delta_block_chain_proof = delta_block_chain_proof breadcrumb + ; command_stats = command_stats breadcrumb + } + ; application_data = None + } + | Lite _ -> + breadcrumb + +(* Methods below are expensive if called on Lite transition *) +(* TODO consider strengthening usage of these on a type level + to avoid calling them on Lite transitions without explicit conversion to Full *) + +let validated_transition t = + match t.T.validated_transition with + | Full validated_transition -> + validated_transition + | Lite { hashes; delta_block_chain_proof; _ } -> + let proof_cache_db = + (* TODO: replace with actual DB *) + Proof_cache_tag.create_identity_db () + in + let block_stable = + State_hash.File_storage.read + (module Mina_block.Stable.Latest) + t.T.block_tag + (* TODO consider using a more specific error *) + |> Or_error.tag ~tag:"get_root_transition" + |> Or_error.ok_exn + in + let block = + Mina_block.write_all_proofs_to_disk + ~signature_kind:Mina_signature_kind.t_DEPRECATED ~proof_cache_db + block_stable + in + Mina_block.Validated.unsafe_of_trusted_block ~delta_block_chain_proof + (`This_block_is_trusted_to_be_safe + { With_hash.data = block; hash = hashes } ) + +let block_with_hash = + Fn.compose Mina_block.Validated.forget validated_transition + +let block = Fn.compose With_hash.data block_with_hash + +let command_hashes t = command_hashes_of_transition (validated_transition t) + +let valid_commands_hashed (t : T.t) = + List.map2_exn + (Mina_block.Validated.valid_commands @@ validated_transition t) + (command_hashes t) + ~f:(fun command hash -> + With_status.map command + ~f: + (Fn.flip + Mina_transaction.Transaction_hash.User_command_with_valid_signature + .make hash ) ) + module For_tests = struct open Currency open Signature_lib diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index b845972f345d..148295dfdc66 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -51,14 +51,6 @@ val build : Result.t Deferred.t -val command_hashes : t -> Mina_transaction.Transaction_hash.t list - -val valid_commands_hashed : - t - -> Mina_transaction.Transaction_hash.User_command_with_valid_signature.t - With_status.t - list - val contains_transaction_by_hash : t -> Mina_transaction.Transaction_hash.t -> bool @@ -66,14 +58,8 @@ val header : t -> Mina_block.Header.t val command_stats : t -> Command_stats.t -val validated_transition : t -> Mina_block.Validated.t - val block_tag : t -> Mina_block.Stable.Latest.t State_hash.File_storage.tag -val block_with_hash : t -> Mina_block.with_hash - -val block : t -> Mina_block.t - val staged_ledger : t -> Staged_ledger.t val just_emitted_a_proof : t -> bool @@ -108,6 +94,8 @@ val staged_ledger_hash : t -> Staged_ledger_hash.t For convenience of implementation, it's by definition an empty list for the root *) val accounts_created : t -> Account_id.t list +val delta_block_chain_proof : t -> State_hash.t Mina_stdlib.Nonempty_list.t + val staged_ledger_aux_and_pending_coinbases_cached : t -> Network_types.Staged_ledger_aux_and_pending_coinbases.data_tag option @@ -125,6 +113,55 @@ val staged_ledger_aux_and_pending_coinbases : *) val to_block_data_exn : t -> Block_data.Full.t +(** Convert a full breadcrumb to a lite breadcrumb *) +val lighten : t -> t + +(** Get the validated transition from a breadcrumb. + + Caution: operation is expensive if called on a lite + breadcrumb (and can throw an exception on reading from + multi-key file storage for block). +*) +val validated_transition : t -> Mina_block.Validated.t + +(** Get the block with hash from a breadcrumb. + + Caution: operation is expensive if called on a lite + breadcrumb (and can throw an exception on reading from + multi-key file storage for block). +*) +val block_with_hash : t -> Mina_block.with_hash + +(** Get the block from a breadcrumb. + + Caution: operation is expensive if called on a lite + breadcrumb (and can throw an exception on reading from + multi-key file storage for block). +*) +val block : t -> Mina_block.t + +(** Get the command hashes from a breadcrumb + (in order of transaction appearance in block). + + Caution: operation is expensive if called on a lite + breadcrumb (and can throw an exception on reading from + multi-key file storage for block). +*) +val command_hashes : t -> Mina_transaction.Transaction_hash.t list + +(** Get the valid commands from a breadcrumb along with their hashes + (in order of transaction appearance in block). + + Caution: operation is expensive if called on a lite + breadcrumb (and can throw an exception on reading from + multi-key file storage for block). +*) +val valid_commands_hashed : + t + -> Mina_transaction.Transaction_hash.User_command_with_valid_signature.t + With_status.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 eb4a629e9bb1..ec4ebbbde720 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -222,9 +222,7 @@ let root_data t = ; protocol_states_for_scan_state = State_hash.Map.data t.protocol_states_for_root_scan_state ; block_tag = Breadcrumb.block_tag root - ; delta_block_chain_proof = - Breadcrumb.validated_transition root - |> Mina_block.Validated.delta_block_chain_proof + ; delta_block_chain_proof = Breadcrumb.delta_block_chain_proof root ; protocol_state = Breadcrumb.protocol_state root } @@ -393,9 +391,7 @@ module Util = struct Staged_ledger.pending_coinbase_collection heir_staged_ledger ; protocol_states_for_scan_state ; protocol_state = Breadcrumb.protocol_state heir - ; delta_block_chain_proof = - Breadcrumb.validated_transition heir - |> Mina_block.Validated.delta_block_chain_proof + ; delta_block_chain_proof = Breadcrumb.delta_block_chain_proof heir } in let just_emitted_a_proof = Breadcrumb.just_emitted_a_proof heir in @@ -882,6 +878,12 @@ let update_metrics_with_diff (type mutant) Gauge.set Transition_frontier.empty_blocks_at_best_tip (Int.to_float (empty_blocks_at_best_tip t))) +let lighten t state_hash = + let f node = + { node with Node.breadcrumb = Breadcrumb.lighten node.Node.breadcrumb } + in + Hashtbl.change t.table state_hash ~f:(Option.map ~f) + let apply_diffs ({ context = (module Context); _ } as t) diffs ~enable_epoch_ledger_sync ~has_long_catchup_job = let open Context in diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index 4665292e4316..b420186ecfd3 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -75,6 +75,8 @@ val common_ancestor : , [ `Parent_not_found of State_hash.t * [ `Parent of State_hash.t ] ] ) Result.t +val lighten : t -> State_hash.t -> unit + module Util : sig (** given an heir, calculate the diff that will transition the root to that heir (assuming parent is the root) *) diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 4ff448fcea78..6f5739d08434 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -394,6 +394,7 @@ module Instance = struct apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state ~root_ledger (E (New_node (Full breadcrumb))) in + Full_frontier.lighten frontier state_hash ; [%log internal] "Breadcrumb_integrated" ; breadcrumb in diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index e310bb5ddc1d..b4dd38bbf2d2 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -518,6 +518,7 @@ let add_breadcrumb_exn t breadcrumb = in (* TODO: Drop validated transition from the block *) [%log internal] "Notify_frontier_extensions_done" ; + Full_frontier.lighten t.full_frontier state_hash ; [%log internal] "Add_breadcrumb_to_frontier_done" (* proxy full frontier functions *) @@ -772,9 +773,7 @@ module For_tests = struct |> Staged_ledger.pending_coinbase_collection ; protocol_states_for_scan_state ; protocol_state = Breadcrumb.protocol_state root - ; delta_block_chain_proof = - Mina_block.Validated.delta_block_chain_proof - (Breadcrumb.validated_transition root) + ; delta_block_chain_proof = Breadcrumb.delta_block_chain_proof root } in let%map persistent_root, persistent_frontier = From 573130bdc125fc8a0a720b4cf3b2ae000414a3c8 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 23:34:31 +0100 Subject: [PATCH 095/122] Don't read block bytes when loading frontier --- .../frontier_base/block_data.ml | 3 +- .../frontier_base/breadcrumb.ml | 52 +++++++++++++- .../frontier_base/breadcrumb.mli | 10 ++- .../frontier_base/command_stats.ml | 9 ++- .../persistent_frontier/database.ml | 15 +++- .../persistent_frontier/database.mli | 6 +- .../persistent_frontier.ml | 70 ++++++++++++++----- 7 files changed, 142 insertions(+), 23 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/block_data.ml b/src/lib/transition_frontier/frontier_base/block_data.ml index 2746b9c1bce7..9b5c72dd6504 100644 --- a/src/lib/transition_frontier/frontier_base/block_data.ml +++ b/src/lib/transition_frontier/frontier_base/block_data.ml @@ -70,7 +70,7 @@ module Full = struct ; staged_ledger_data : Mina_ledger.Mask_maps.Stable.V1.t * Staged_ledger.Scan_state.Application_data.Stable.V1.t - ; staged_ledger_hash : Staged_ledger_hash.Stable.V1.t + (* TODO consider removing the field, it's not used on lite breadcrumb *) ; accounts_created : Account_id.Stable.V2.t list ; staged_ledger_aux_and_pending_coinbases_cached : ( State_hash.Stable.V1.t @@ -81,6 +81,7 @@ module Full = struct option ; transaction_hashes_unordered : Mina_transaction.Transaction_hash.Stable.V1.t list + ; command_stats : Command_stats.Stable.V1.t } let to_latest = Fn.id diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index d4056d389a6b..8a0c39521853 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -423,13 +423,13 @@ let to_block_data_exn (breadcrumb : T.t) : Block_data.Full.t = ; block_tag = breadcrumb.block_tag ; delta_block_chain_proof = delta_block_chain_proof breadcrumb ; staged_ledger_data = (to_maps breadcrumb.staged_ledger, application_data) - ; staged_ledger_hash = breadcrumb.staged_ledger_hash ; accounts_created = breadcrumb.accounts_created ; staged_ledger_aux_and_pending_coinbases_cached = breadcrumb.staged_ledger_aux_and_pending_coinbases_cached ; transaction_hashes_unordered = Mina_transaction.Transaction_hash.Set.to_list breadcrumb.transaction_hashes + ; command_stats = command_stats breadcrumb } let lighten (breadcrumb : T.t) : T.t = @@ -498,6 +498,56 @@ let valid_commands_hashed (t : T.t) = Mina_transaction.Transaction_hash.User_command_with_valid_signature .make hash ) ) +let stored_transition_of_block_data ~state_hash (block_data : Block_data.Full.t) + : stored_transition = + Lite + { hashes = { State_hash.State_hashes.state_hash; state_body_hash = None } + ; delta_block_chain_proof = block_data.delta_block_chain_proof + ; command_stats = block_data.command_stats + ; header = block_data.header + } + +let of_block_data ~logger ~constraint_constants ~parent_staged_ledger + ~state_hash (block_data : Block_data.Full.t) : (t, _) Deferred.Result.t = + let maps_stable, application_data = block_data.staged_ledger_data in + let parent_ledger = Staged_ledger.ledger parent_staged_ledger in + let maps = + Mina_ledger.Ledger.Mask_maps.of_stable + ~ledger_depth:(Mina_ledger.Ledger.depth parent_ledger) + maps_stable + in + let new_mask = + Mina_ledger.Ledger.Mask.create + ~depth:(Mina_ledger.Ledger.depth parent_ledger) + () + in + let new_ledger = Mina_ledger.Ledger.register_mask parent_ledger new_mask in + Mina_ledger.Ledger.append_maps new_ledger maps ; + let%map.Deferred.Result staged_ledger, res_opt = + Staged_ledger.apply_to_scan_state ~logger ~skip_verification:true + ~log_prefix:"of_block_data" ~ledger:new_ledger + ~previous_pending_coinbase_collection: + (Staged_ledger.pending_coinbase_collection parent_staged_ledger) + ~previous_scan_state:(Staged_ledger.scan_state parent_staged_ledger) + ~constraint_constants application_data + in + { T.validated_transition = + stored_transition_of_block_data ~state_hash block_data + ; staged_ledger + ; accounts_created = block_data.accounts_created + ; just_emitted_a_proof = Option.is_some res_opt + ; transition_receipt_time = None + ; block_tag = block_data.block_tag + ; application_data = None + ; staged_ledger_hash = + Mina_block.Header.protocol_state block_data.header + |> Protocol_state.blockchain_state |> Blockchain_state.staged_ledger_hash + ; staged_ledger_aux_and_pending_coinbases_cached = None + ; transaction_hashes = + Mina_transaction.Transaction_hash.Set.of_list + block_data.transaction_hashes_unordered + } + module For_tests = struct open Currency open Signature_lib diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index 148295dfdc66..fe86edd3491b 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -109,7 +109,7 @@ val staged_ledger_aux_and_pending_coinbases : (** Convert a breadcrumb to a block data Will return an exception if called on transition frontier root or - a transition that was saved to frontier. + a lite breadcrumb (i.e. one that was added to frontier). *) val to_block_data_exn : t -> Block_data.Full.t @@ -162,6 +162,14 @@ val valid_commands_hashed : With_status.t list +val of_block_data : + logger:Logger.t + -> constraint_constants:Genesis_constants.Constraint_constants.t + -> parent_staged_ledger:Staged_ledger.t + -> state_hash:Frozen_ledger_hash.t + -> Block_data.Full.t + -> (t, Staged_ledger.Staged_ledger_error.t) Deferred.Result.t + module For_tests : sig val gen : ?logger:Logger.t diff --git a/src/lib/transition_frontier/frontier_base/command_stats.ml b/src/lib/transition_frontier/frontier_base/command_stats.ml index 362bb2a88e26..8cfa48c7a16f 100644 --- a/src/lib/transition_frontier/frontier_base/command_stats.ml +++ b/src/lib/transition_frontier/frontier_base/command_stats.ml @@ -1,7 +1,14 @@ open Core_kernel open Mina_base -type t = { total : int; zkapp_commands : int; has_coinbase : bool } +[%%versioned +module Stable = struct + module V1 = struct + type t = { total : int; zkapp_commands : int; has_coinbase : bool } + + let to_latest = Fn.id + end +end] let has_coinbase (staged_ledger_diff : Staged_ledger_diff.t) = let d1, d2 = staged_ledger_diff.diff in diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 08fc47b598ac..5fd4105ea1d8 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -481,6 +481,16 @@ let move_root ~old_root_hash ~new_root ~garbage = Batch.remove batch ~key:(Transition node_hash) ; Batch.remove batch ~key:(Arcs node_hash) ) +let get_transition_data ~signature_kind ~proof_cache_db t hash = + let error = `Not_found (`Transition hash) in + match%map.Result get t.db ~key:(Transition hash) ~error with + | Old_format block -> + Either.First + (Block_data.validated_of_stable ~signature_kind ~proof_cache_db + ~state_hash:hash block ) + | New_format transition -> + Either.Second transition + let get_transition ~signature_kind ~proof_cache_db t hash = (* TODO: consider using a more specific error *) let error = `Not_found (`Transition hash) in @@ -512,10 +522,11 @@ let rec crawl_successors ?max_depth ~signature_kind ~proof_cache_db ~init ~f t deferred_list_result_iter successors ~f:(fun succ_hash -> let%bind transition = Deferred.return - (get_transition ~signature_kind ~proof_cache_db t succ_hash) + (get_transition_data ~signature_kind ~proof_cache_db t succ_hash) in let%bind init' = - Deferred.map (f init transition) + Deferred.map + (f ~state_hash:succ_hash init transition) ~f:(Result.map_error ~f:(fun err -> `Crawl_error err)) in crawl_successors ~signature_kind ~proof_cache_db diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index 902db5003fe8..c22c5ff708d5 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -129,7 +129,11 @@ val crawl_successors : -> signature_kind:Mina_signature_kind.t -> proof_cache_db:Proof_cache_tag.cache_db -> init:'a - -> f:('a -> Mina_block.Validated.t -> ('a, 'b) Deferred.Result.t) + -> f: + ( state_hash:State_hash.t + -> 'a + -> (Mina_block.Validated.t, Block_data.Full.t) Either.t + -> ('a, 'b) Deferred.Result.t ) -> t -> State_hash.t -> ( unit diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 6f5739d08434..99b960d715eb 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -221,7 +221,7 @@ module Instance = struct let downgrade_transition transition genesis_state_hash : ( Mina_block.almost_valid_block - , [ `Invalid_genesis_protocol_state ] ) + , [> `Invalid_genesis_protocol_state ] ) Result.t = (* we explicitly re-validate the genesis protocol state here to prevent X-version bugs *) transition |> Mina_block.Validated.remember @@ -246,15 +246,11 @@ module Instance = struct [%log internal] "Notify_frontier_extensions_done" ; Result.return result - let load_transition ~root_genesis_state_hash ~logger ~precomputed_values t - ~parent transition = + let load_transition_old_format ~root_genesis_state_hash ~logger + ~precomputed_values ~verifier ~parent (transition : Mina_block.Validated.t) + = let%bind.Deferred.Result transition = - match downgrade_transition transition root_genesis_state_hash with - | Ok t -> - Deferred.Result.return t - | Error `Invalid_genesis_protocol_state -> - Error (`Fatal_error (Invalid_genesis_state_hash transition)) - |> Deferred.return + downgrade_transition transition root_genesis_state_hash |> Deferred.return in let state_hash = (With_hash.hash @@ Mina_block.Validation.block_with_hash transition) @@ -272,12 +268,50 @@ module Instance = struct (* we're loading transitions from persistent storage, don't assign a timestamp *) - Breadcrumb.build ~skip_staged_ledger_verification:`All - ~logger:t.factory.logger ~precomputed_values ~verifier:t.factory.verifier - ~trust_system:(Trust_system.null ()) ~parent ~transition - ~get_completed_work:(Fn.const None) ~sender:None + Breadcrumb.build ~skip_staged_ledger_verification:`All ~logger + ~precomputed_values ~verifier ~trust_system:(Trust_system.null ()) ~parent + ~transition ~get_completed_work:(Fn.const None) ~sender:None ~transition_receipt_time:None () + let load_transition_new_format ~state_hash ~root_genesis_state_hash ~logger + ~precomputed_values ~parent (block_data : Block_data.Full.t) = + let hashes = + { State_hash.State_hashes.state_hash; state_body_hash = None } + in + let%bind.Deferred.Result _ = + Validation.wrap_header + { With_hash.hash = hashes; data = block_data.header } + |> Validation.validate_genesis_protocol_state + ~genesis_state_hash:root_genesis_state_hash + |> Deferred.return + in + Internal_tracing.with_state_hash state_hash + @@ fun () -> + [%log internal] "@block_metadata" + ~metadata: + [ ( "blockchain_length" + , Mina_numbers.Length.to_yojson + @@ Mina_block.Header.blockchain_length block_data.header ) + ] ; + [%log internal] "Loaded_transition_from_storage" ; + Breadcrumb.of_block_data ~logger + ~constraint_constants: + precomputed_values.Precomputed_values.constraint_constants + ~parent_staged_ledger:(Breadcrumb.staged_ledger parent) + ~state_hash block_data + |> Deferred.Result.map_error ~f:(fun e -> + `Invalid_staged_ledger_diff + (Staged_ledger.Staged_ledger_error.to_error e) ) + + let load_transition ~root_genesis_state_hash ~logger ~precomputed_values + ~verifier ~parent ~state_hash = function + | Either.First old -> + load_transition_old_format ~root_genesis_state_hash ~logger + ~precomputed_values ~parent ~verifier old + | Second new_ -> + load_transition_new_format ~state_hash ~root_genesis_state_hash ~logger + ~precomputed_values ~parent new_ + let set_best_tip ~logger ~frontier ~extensions ~ignore_consensus_local_state ~root_ledger best_tip_hash = apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state @@ -385,10 +419,11 @@ module Instance = struct (Extensions.create ~logger:t.factory.logger frontier) ~f:Result.return in - let visit parent transition = + let visit ~state_hash parent transition = let%bind breadcrumb = - load_transition ~root_genesis_state_hash ~logger ~precomputed_values t - ~parent transition + load_transition ~state_hash ~root_genesis_state_hash + ~logger:t.factory.logger ~precomputed_values ~parent + ~verifier:t.factory.verifier transition in let%map () = apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state @@ -412,6 +447,9 @@ module Instance = struct match err with | `Fatal_error exn -> "fatal error -- " ^ Exn.to_string exn + | `Invalid_genesis_protocol_state -> + "loaded block doesn't correspond to the genesis protocol \ + state" | `Invalid_staged_ledger_diff err | `Invalid_staged_ledger_hash err -> "staged ledger diff application failed -- " From 919c0dd21e965cbbec1e674815ed27c9ed8a62e9 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 23:42:53 +0100 Subject: [PATCH 096/122] Add --migrate-frontier flag to fix-persistent-frontier --- .../cli/src/init/fix_persistent_frontier.ml | 48 +++++++++++++++++-- .../frontier_base/breadcrumb.ml | 6 ++- .../frontier_base/breadcrumb.mli | 2 +- .../full_frontier/full_frontier.ml | 7 ++- .../full_frontier/full_frontier.mli | 2 +- .../persistent_frontier/database.ml | 6 ++- .../persistent_frontier/database.mli | 6 +++ .../persistent_frontier.ml | 5 +- .../transition_frontier.ml | 24 ++++++---- .../transition_frontier.mli | 4 ++ 10 files changed, 88 insertions(+), 22 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index b522060eafa7..bb29784c3bf2 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -78,8 +78,20 @@ let apply_root_transitions ~logger ~db diffs = ~metadata:[ ("error", `String (Exn.to_string exn)) ] ; Error ("Failed to apply root transitions: " ^ Exn.to_string exn) +let persist_all_transitions ~logger ~db breadcrumbs = + [%log info] "Re-persisting %d transitions" (List.length breadcrumbs) ; + Transition_frontier.Persistent_frontier.Database.with_batch db + ~f:(fun batch -> + List.iter breadcrumbs ~f:(fun breadcrumb -> + Transition_frontier.Persistent_frontier.Database.set_transition + ~state_hash:(Breadcrumb.state_hash breadcrumb) + ~transition_data:(Breadcrumb.to_block_data_exn breadcrumb) + batch ) ) ; + [%log info] "Re-persisted %d transitions" (List.length breadcrumbs) + let fix_persistent_frontier_root_do ~logger ~config_directory - ~chain_state_locations ~max_frontier_depth runtime_config = + ~chain_state_locations ~max_frontier_depth ~migrate_frontier runtime_config + = let signature_kind = Mina_signature_kind.t_DEPRECATED in (* Get compile-time constants *) let genesis_constants = Genesis_constants.Compiled.genesis_constants in @@ -171,7 +183,10 @@ let fix_persistent_frontier_root_do ~logger ~config_directory ~context:(module Context) ~retry_with_fresh_db:false ~max_frontier_depth ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier - ~catchup_mode:`Super ~set_best_tip:false () + ~catchup_mode:`Super + ~set_best_tip:false + (* application data is used in frontier migration, so we need to retain it *) + ~retain_application_data:migrate_frontier () with | Error err -> let err_str = @@ -198,7 +213,25 @@ let fix_persistent_frontier_root_do ~logger ~config_directory let with_persistent_frontier_instance f = Persistent_frontier.with_instance_exn persistent_frontier ~f in + let migrate_frontier_do (instance : Persistent_frontier.Instance.t) = + if migrate_frontier then + let root_hash = + Transition_frontier.root frontier |> Breadcrumb.state_hash + in + let breadcrumbs = + (* Excluding root, because for it application data is not preserved, + and transition record isn't used. *) + Transition_frontier.all_breadcrumbs frontier + |> List.filter ~f:(fun breadcrumb -> + not @@ State_hash.equal root_hash + @@ Breadcrumb.state_hash breadcrumb ) + in + persist_all_transitions ~logger ~db:instance.db breadcrumbs + else () + in let clean_frontier () = + Transition_frontier.with_persistent_frontier_instance_exn frontier + ~f:migrate_frontier_do ; let%bind () = Transition_frontier.close ~loc:__LOC__ frontier in Mina_stdlib_unix.File_system.remove_dir tmp_root_location in @@ -270,7 +303,7 @@ let fix_persistent_frontier_root_do ~logger ~config_directory [%log info] "Successfully moved frontier root to match persistent root" let fix_persistent_frontier_root ~config_directory ~config_file - ~max_frontier_depth = + ~max_frontier_depth ~migrate_frontier = Logger.Consumer_registry.register ~commit_id:"" ~id:Logger.Logger_id.mina ~processor:Internal_tracing.For_logger.processor ~transport: @@ -314,7 +347,8 @@ let fix_persistent_frontier_root ~config_directory ~config_file Deferred.Result.return () | `Both_exist -> fix_persistent_frontier_root_do ~logger ~config_directory - ~chain_state_locations ~max_frontier_depth runtime_config + ~chain_state_locations ~max_frontier_depth ~migrate_frontier + runtime_config let command = Command.async @@ -329,6 +363,11 @@ let command = and max_frontier_depth = flag "--max-frontier-depth" ~doc:"INT maximum frontier depth (default: 10)" (optional int) + and migrate_frontier = + flag "--migrate-frontier" + ~doc: + "BOOL whether to migrate frontier to the new format (default: false)" + no_arg in Cli_lib.Exceptions.handle_nicely @@ fun () -> @@ -344,6 +383,7 @@ let command = match%bind fix_persistent_frontier_root ~config_directory:conf_dir ~config_file ~max_frontier_depth:(Option.value max_frontier_depth ~default:10) + ~migrate_frontier with | Ok () -> printf "Persistent frontier root fix completed successfully.\n" ; diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 8a0c39521853..908bbe005c94 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -432,7 +432,7 @@ let to_block_data_exn (breadcrumb : T.t) : Block_data.Full.t = ; command_stats = command_stats breadcrumb } -let lighten (breadcrumb : T.t) : T.t = +let lighten ?(retain_application_data = false) (breadcrumb : T.t) : T.t = match breadcrumb.T.validated_transition with | Full validated_transition -> { breadcrumb with @@ -445,7 +445,9 @@ let lighten (breadcrumb : T.t) : T.t = ; delta_block_chain_proof = delta_block_chain_proof breadcrumb ; command_stats = command_stats breadcrumb } - ; application_data = None + ; application_data = + (let%bind.Option () = Option.some_if retain_application_data () in + breadcrumb.application_data ) } | Lite _ -> breadcrumb diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.mli b/src/lib/transition_frontier/frontier_base/breadcrumb.mli index fe86edd3491b..1322521cf4cd 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.mli +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.mli @@ -114,7 +114,7 @@ val staged_ledger_aux_and_pending_coinbases : val to_block_data_exn : t -> Block_data.Full.t (** Convert a full breadcrumb to a lite breadcrumb *) -val lighten : t -> t +val lighten : ?retain_application_data:bool -> t -> t (** Get the validated transition from a breadcrumb. diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index ec4ebbbde720..96265c43ada3 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -878,9 +878,12 @@ let update_metrics_with_diff (type mutant) Gauge.set Transition_frontier.empty_blocks_at_best_tip (Int.to_float (empty_blocks_at_best_tip t))) -let lighten t state_hash = +let lighten ?retain_application_data t state_hash = let f node = - { node with Node.breadcrumb = Breadcrumb.lighten node.Node.breadcrumb } + { node with + Node.breadcrumb = + Breadcrumb.lighten ?retain_application_data node.Node.breadcrumb + } in Hashtbl.change t.table state_hash ~f:(Option.map ~f) diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index b420186ecfd3..7da30a5e863a 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -75,7 +75,7 @@ val common_ancestor : , [ `Parent_not_found of State_hash.t * [ `Parent of State_hash.t ] ] ) Result.t -val lighten : t -> State_hash.t -> unit +val lighten : ?retain_application_data:bool -> t -> State_hash.t -> unit module Util : sig (** given an heir, calculate the diff that will transition diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 5fd4105ea1d8..178c0e440e2f 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -449,6 +449,9 @@ let find_arcs_and_root t ~(arcs_cache : State_hash.t list State_hash.Table.t) | _ -> Error (`Not_found `Old_root_transition) +let set_transition ~state_hash ~transition_data = + Batch.set ~key:(Transition state_hash) ~data:(New_format transition_data) + let add ~arcs_cache ~state_hash ~transition_data = let parent_hash = transition_data.Block_data.Full.Stable.Latest.header @@ -459,8 +462,7 @@ let add ~arcs_cache ~state_hash ~transition_data = ~data:(state_hash :: parent_arcs) ; State_hash.Table.set arcs_cache ~key:state_hash ~data:[] ; fun batch -> - Batch.set batch ~key:(Transition state_hash) - ~data:(New_format transition_data) ; + set_transition batch ~state_hash ~transition_data ; Batch.set batch ~key:(Arcs state_hash) ~data:[] ; Batch.set batch ~key:(Arcs parent_hash) ~data:(state_hash :: parent_arcs) diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index c22c5ff708d5..571be4e92837 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -102,6 +102,12 @@ val get_transition : , [> `Not_found of [> `Transition of State_hash.t ] ] ) Result.t +val set_transition : + state_hash:State_hash.t + -> transition_data:Block_data.Full.t + -> batch_t + -> unit + val get_arcs : t -> State_hash.t diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 99b960d715eb..90aff395ac29 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -319,7 +319,8 @@ module Instance = struct let load_full_frontier t ~context:(module Context : CONTEXT) ~root_ledger ~consensus_local_state ~max_length ~ignore_consensus_local_state - ~persistent_root_instance ?max_frontier_depth () = + ~persistent_root_instance ?max_frontier_depth ?retain_application_data () + = let open Context in let open Deferred.Result.Let_syntax in let%bind () = Deferred.return (assert_no_sync t) in @@ -429,7 +430,7 @@ module Instance = struct apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state ~root_ledger (E (New_node (Full breadcrumb))) in - Full_frontier.lighten frontier state_hash ; + Full_frontier.lighten ?retain_application_data frontier state_hash ; [%log internal] "Breadcrumb_integrated" ; breadcrumb in diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index b4dd38bbf2d2..5888fe6f340c 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -109,7 +109,7 @@ let load_from_persistence_and_start ~context:(module Context : CONTEXT) ~verifier ~consensus_local_state ~max_length ~persistent_root ~persistent_root_instance ~persistent_frontier ~persistent_frontier_instance ~catchup_mode ?max_frontier_depth ?(set_best_tip = true) - ignore_consensus_local_state = + ?retain_application_data ignore_consensus_local_state = let open Context in let open Deferred.Result.Let_syntax in let root_identifier = @@ -151,7 +151,8 @@ let load_from_persistence_and_start ~context:(module Context : CONTEXT) ~root_ledger: (Persistent_root.Instance.snarked_ledger persistent_root_instance) ~consensus_local_state ~ignore_consensus_local_state - ~persistent_root_instance ?max_frontier_depth () + ~persistent_root_instance ?max_frontier_depth ?retain_application_data + () with | Error `Sync_cannot_be_running -> Error (`Failure "sync job is already running on persistent frontier") @@ -215,6 +216,7 @@ let rec load_with_max_length : -> persistent_frontier:Persistent_frontier.t -> catchup_mode:[ `Super ] -> ?set_best_tip:bool + -> ?retain_application_data:bool -> unit -> ( t , [> `Bootstrap_required @@ -225,7 +227,7 @@ let rec load_with_max_length : fun ~context:(module Context : CONTEXT) ~max_length ?(retry_with_fresh_db = true) ?max_frontier_depth ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier ~catchup_mode - ?set_best_tip () -> + ?set_best_tip ?retain_application_data () -> let open Context in let open Deferred.Let_syntax in (* TODO: #3053 *) @@ -257,7 +259,7 @@ let rec load_with_max_length : ~verifier ~consensus_local_state ~max_length ~persistent_root ~persistent_root_instance ~catchup_mode ~persistent_frontier ~persistent_frontier_instance ?max_frontier_depth ?set_best_tip - ignore_consensus_local_state + ?retain_application_data ignore_consensus_local_state with | Ok _ as result -> [%str_log trace] Persisted_frontier_loaded ; @@ -362,7 +364,8 @@ let rec load_with_max_length : load_with_max_length ~context:(module Context) ~max_length ~verifier ~consensus_local_state ~persistent_root - ~persistent_frontier ~retry_with_fresh_db:false ~catchup_mode () + ~persistent_frontier ~retry_with_fresh_db:false ~catchup_mode + ?retain_application_data () >>| Result.map_error ~f:(function | `Persistent_frontier_malformed -> `Failure @@ -390,8 +393,9 @@ let rec load_with_max_length : return res ) let load ?(retry_with_fresh_db = true) ?max_frontier_depth ?set_best_tip - ~context:(module Context : CONTEXT) ~verifier ~consensus_local_state - ~persistent_root ~persistent_frontier ~catchup_mode () = + ?retain_application_data ~context:(module Context : CONTEXT) ~verifier + ~consensus_local_state ~persistent_root ~persistent_frontier ~catchup_mode + () = let open Context in O1trace.thread "transition_frontier_load" (fun () -> let max_length = @@ -402,7 +406,7 @@ let load ?(retry_with_fresh_db = true) ?max_frontier_depth ?set_best_tip ~context:(module Context) ~max_length ~retry_with_fresh_db ?max_frontier_depth ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier - ~catchup_mode ?set_best_tip () ) + ~catchup_mode ?set_best_tip () ?retain_application_data ) (* The persistent root and persistent frontier as safe to ignore here * because their lifecycle is longer than the transition frontier's *) @@ -429,6 +433,10 @@ let close ~loc Persistent_root.Instance.close persistent_root_instance ; Ivar.fill_if_empty closed () +let with_persistent_frontier_instance_exn t ~f = + if Option.is_none (Ivar.peek t.closed) then f t.persistent_frontier_instance + else failwith "Transition frontier is closed" + let closed t = Ivar.read t.closed let persistent_root { persistent_root; _ } = persistent_root diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 2edf541ee734..58c905831329 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -72,6 +72,7 @@ val load : ?retry_with_fresh_db:bool -> ?max_frontier_depth:int -> ?set_best_tip:bool + -> ?retain_application_data:bool -> context:(module CONTEXT) -> verifier:Verifier.t -> consensus_local_state:Consensus.Data.Local_state.t @@ -88,6 +89,9 @@ val load : val close : loc:string -> t -> unit Deferred.t +val with_persistent_frontier_instance_exn : + t -> f:(Persistent_frontier.Instance.t -> 'a) -> 'a + val closed : t -> unit Deferred.t val add_breadcrumb_exn : t -> Breadcrumb.t -> unit Deferred.t From cd722218ef96d23b0aef98b4fa44b3364f8469ab Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 27 Nov 2025 23:51:18 +0100 Subject: [PATCH 097/122] Print RAM used after frontier loading --- .../cli/src/init/fix_persistent_frontier.ml | 15 ++++++++++ src/lib/mina_metrics/prometheus_metrics/dune | 3 +- .../prometheus_metrics/mina_metrics.ml | 29 ++----------------- src/lib/mina_stdlib_unix/file_system.ml | 23 +++++++++++++++ 4 files changed, 43 insertions(+), 27 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index bb29784c3bf2..af2a3e42e9c0 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -175,6 +175,8 @@ let fix_persistent_frontier_root_do ~logger ~config_directory ~epoch_ledger_backing_type:Stable_db Signature_lib.Public_key.Compressed.Set.empty in + let rss_before = Mina_stdlib_unix.File_system.read_rss_kb None in + let start = Time.now () in (* TODO loading of frontier is redundant unless fixing is needed *) (* Load transition frontier using the standard API *) let%bind frontier = @@ -206,6 +208,19 @@ let fix_persistent_frontier_root_do ~logger ~config_directory | Ok f -> f in + let rss_after = Mina_stdlib_unix.File_system.read_rss_kb None in + let elapsed = Time.diff (Time.now ()) start in + [%log info] + "Loaded transition frontier of %d breadcrumbs in $elapsed seconds with RSS \ + $rss_after (started with $rss_before)" + (Transition_frontier.all_breadcrumbs frontier |> List.length) + ~metadata: + [ ("elapsed", `Float (Time.Span.to_sec elapsed)) + ; ( "rss_after" + , Option.value_map ~default:`Null rss_after ~f:(fun x -> `Float x) ) + ; ( "rss_before" + , Option.value_map ~default:`Null rss_before ~f:(fun x -> `Float x) ) + ] ; let frontier_root_hash = Transition_frontier.root frontier |> Breadcrumb.state_hash in diff --git a/src/lib/mina_metrics/prometheus_metrics/dune b/src/lib/mina_metrics/prometheus_metrics/dune index 3cd172f3a46b..831cd1737ee4 100644 --- a/src/lib/mina_metrics/prometheus_metrics/dune +++ b/src/lib/mina_metrics/prometheus_metrics/dune @@ -22,7 +22,8 @@ ;; local libraries logger o1trace - mina_node_config) + mina_node_config + mina_stdlib_unix) (instrumentation (backend bisect_ppx)) (preprocess diff --git a/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml b/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml index 6c41bbb9f676..2fc04e7f1a38 100644 --- a/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml +++ b/src/lib/mina_metrics/prometheus_metrics/mina_metrics.ml @@ -250,31 +250,6 @@ end module Process_memory = struct let subsystem = "Process_memory" - (* Read RSS (Resident Set Size) from /proc//status *) - let read_rss_kb pid_opt = - try - let proc_file = - match pid_opt with - | None -> - "/proc/self/status" - | Some pid -> - Printf.sprintf "/proc/%d/status" (Pid.to_int pid) - in - let ic = In_channel.create proc_file in - let rec find_vmrss () = - let%bind.Option line = In_channel.input_line ic in - match - Option.try_with (fun () -> Scanf.sscanf line "VmRSS: %f" Fn.id) - with - | None -> - find_vmrss () - | Some kb -> - Some kb - in - let result = find_vmrss () in - In_channel.close ic ; result - with _ -> None - (* Functor to create RSS gauge for a specific process type *) module Make_rss_gauge (Config : sig val process_name : string @@ -300,7 +275,9 @@ module Process_memory = struct let update () = if Config.is_daemon || Option.is_some !process_pid then - Option.iter (read_rss_kb !process_pid) ~f:(Gauge.set gauge) + Option.iter + (Mina_stdlib_unix.File_system.read_rss_kb !process_pid) + ~f:(Gauge.set gauge) end module Daemon = Make_rss_gauge (struct diff --git a/src/lib/mina_stdlib_unix/file_system.ml b/src/lib/mina_stdlib_unix/file_system.ml index 25c0212b7c90..92af38498e26 100644 --- a/src/lib/mina_stdlib_unix/file_system.ml +++ b/src/lib/mina_stdlib_unix/file_system.ml @@ -83,3 +83,26 @@ let create_dir ?(clear_if_exists = false) dir = if clear_if_exists then clear_dir dir else return () | _ -> return (Core.Unix.mkdir_p dir) + +(* Read RSS (Resident Set Size) from /proc//status *) +let read_rss_kb pid_opt = + try + let proc_file = + match pid_opt with + | None -> + "/proc/self/status" + | Some pid -> + Printf.sprintf "/proc/%d/status" (Pid.to_int pid) + in + let ic = In_channel.create proc_file in + let rec find_vmrss () = + let%bind.Option line = In_channel.input_line ic in + match Option.try_with (fun () -> Scanf.sscanf line "VmRSS: %f" Fn.id) with + | None -> + find_vmrss () + | Some kb -> + Some kb + in + let result = find_vmrss () in + In_channel.close ic ; result + with _ -> None From 54c090b30078e4806a6ac84e43ae46c9934a67d9 Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 28 Nov 2025 00:35:23 +0100 Subject: [PATCH 098/122] Fix compatibility of database --- .../persistent_frontier/database.ml | 79 ++++++++++++++----- 1 file changed, 61 insertions(+), 18 deletions(-) diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 178c0e440e2f..8fb2f881ce1b 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -90,7 +90,8 @@ module Schema = struct type _ t = | Db_version : int t - | Transition : State_hash.Stable.V1.t -> Transition.Stable.V3.t t + | Transition : State_hash.Stable.V1.t -> Mina_block.Stable.V2.t t + | Transition_new : State_hash.Stable.V1.t -> Block_data.Full.Stable.V1.t t | Arcs : State_hash.Stable.V1.t -> State_hash.Stable.V1.t list t (* TODO: In hard forks, `Root` should be replaced by `(Root_hash, Root_common)`; @@ -104,7 +105,8 @@ module Schema = struct *) | Root : Root_data.Minimal.Stable.V3.t t | Root_hash : State_hash.Stable.V1.t t - | Root_common : Root_data.Common.Stable.V3.t t + | Root_common : Root_data.Common.Stable.V2.t t + | Root_new : Root_data.Common.Stable.V3.t t | Best_tip : State_hash.Stable.V1.t t | Protocol_states_for_root_scan_state : Mina_state.Protocol_state.Value.Stable.V2.t list t @@ -116,6 +118,8 @@ module Schema = struct "Db_version" | Transition _ -> "Transition _" + | Transition_new _ -> + "Transition_new _" | Arcs _ -> "Arcs _" | Root -> @@ -124,6 +128,8 @@ module Schema = struct "Root_hash" | Root_common -> "Root_common" + | Root_new -> + "Root_new" | Best_tip -> "Best_tip" | Protocol_states_for_root_scan_state -> @@ -133,7 +139,9 @@ module Schema = struct | Db_version -> [%bin_type_class: int] | Transition _ -> - [%bin_type_class: Transition.Stable.Latest.t] + [%bin_type_class: Mina_block.Stable.Latest.t] + | Transition_new _ -> + [%bin_type_class: Block_data.Full.Stable.Latest.t] | Arcs _ -> [%bin_type_class: State_hash.Stable.Latest.t list] | Root -> @@ -141,6 +149,8 @@ module Schema = struct | Root_hash -> [%bin_type_class: State_hash.Stable.Latest.t] | Root_common -> + [%bin_type_class: Root_data.Common.Stable.V2.t] + | Root_new -> [%bin_type_class: Root_data.Common.Stable.Latest.t] | Best_tip -> [%bin_type_class: State_hash.Stable.Latest.t] @@ -186,6 +196,11 @@ module Schema = struct (module Keys.Prefixed_state_hash.Stable.Latest) ~to_gadt:(fun (_, hash) -> Transition hash) ~of_gadt:(fun (Transition hash) -> ("transition", hash)) + | Transition_new _ -> + gadt_input_type_class + (module Keys.Prefixed_state_hash.Stable.Latest) + ~to_gadt:(fun (_, hash) -> Transition_new hash) + ~of_gadt:(fun (Transition_new hash) -> ("transition_new", hash)) | Arcs _ -> gadt_input_type_class (module Keys.Prefixed_state_hash.Stable.Latest) @@ -201,6 +216,11 @@ module Schema = struct (module Keys.String) ~to_gadt:(fun _ -> Root_hash) ~of_gadt:(fun Root_hash -> "root_hash") + | Root_new -> + gadt_input_type_class + (module Keys.String) + ~to_gadt:(fun _ -> Root_new) + ~of_gadt:(fun Root_new -> "root_new") | Root_common -> gadt_input_type_class (module Keys.String) @@ -313,11 +333,23 @@ let get db ~key ~error = Don't use this when possible. It cost ~90s while get_root_hash cost seconds. *) let get_root t = - match get_batch t.db ~keys:[ Some_key Root_hash; Some_key Root_common ] with + match + get_batch t.db + ~keys:[ Some_key Root_hash; Some_key Root_new; Some_key Root_common ] + with | [ Some (Some_key_value (Root_hash, hash)) - ; Some (Some_key_value (Root_common, common)) + ; Some (Some_key_value (Root_new, common)) + ; _ ] -> Ok (Root_data.Minimal.of_common common ~state_hash:hash) + | [ Some (Some_key_value (Root_hash, hash)) + ; None + ; Some (Some_key_value (Root_common, common)) + ] -> + Ok + (Root_data.Minimal.of_common + (Root_data.Common.Stable.V2.to_latest common) + ~state_hash:hash ) | _ -> ( match get t.db ~key:Root ~error:(`Not_found `Root) with | Ok root -> @@ -327,7 +359,7 @@ let get_root t = let common = Root_data.Minimal.common root in Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:hash ; - Batch.set batch ~key:Root_common ~data:common ) ; + Batch.set batch ~key:Root_new ~data:common ) ; Ok root | Error _ as e -> @@ -340,6 +372,15 @@ let get_root_hash t = | Error _ -> Result.map ~f:Root_data.Minimal.state_hash (get_root t) +let get_transition_do t hash = + let error = `Not_found (`Transition hash) in + match get t.db ~key:(Transition_new hash) ~error with + | Ok transition -> + Ok (Transition.Stable.Latest.New_format transition) + | Error _ -> + get t.db ~key:(Transition hash) ~error + |> Result.map ~f:(fun x -> Transition.Stable.Latest.Old_format x) + (* TODO: check that best tip is connected to root *) (* TODO: check for garbage *) let check t ~genesis_state_hash = @@ -362,16 +403,18 @@ let check t ~genesis_state_hash = get t.db ~key:Best_tip ~error:(`Corrupt (`Not_found `Best_tip)) in let%bind root_transition = - get t.db ~key:(Transition root_hash) - ~error:(`Corrupt (`Not_found `Root_transition)) + get_transition_do t root_hash + |> Result.map_error + ~f:(const @@ `Corrupt (`Not_found `Root_transition)) in let%bind _ = get t.db ~key:Protocol_states_for_root_scan_state ~error:(`Corrupt (`Not_found `Protocol_states_for_root_scan_state)) in let%map _ = - get t.db ~key:(Transition best_tip) - ~error:(`Corrupt (`Not_found `Best_tip_transition)) + get_transition_do t best_tip + |> Result.map_error + ~f:(const @@ `Corrupt (`Not_found `Best_tip_transition)) in (root_hash, root_transition) in @@ -383,8 +426,8 @@ let check t ~genesis_state_hash = List.fold successors ~init:(Ok ()) ~f:(fun acc succ_hash -> let%bind () = acc in let%bind _ = - get t.db ~key:(Transition succ_hash) - ~error:(`Corrupt (`Not_found (`Transition succ_hash))) + get_transition_do t succ_hash + |> Result.map_error ~f:(fun e -> `Corrupt e) in check_arcs succ_hash ) in @@ -419,7 +462,7 @@ let initialize t ~root_data = Batch.set batch ~key:Db_version ~data:version ; Batch.set batch ~key:(Arcs root_state_hash) ~data:[] ; Batch.set batch ~key:Root_hash ~data:root_state_hash ; - Batch.set batch ~key:Root_common ~data:root_common ; + Batch.set batch ~key:Root_new ~data:root_common ; Batch.set batch ~key:Best_tip ~data:root_state_hash ; Batch.set batch ~key:Protocol_states_for_root_scan_state ~data: @@ -450,7 +493,7 @@ let find_arcs_and_root t ~(arcs_cache : State_hash.t list State_hash.Table.t) Error (`Not_found `Old_root_transition) let set_transition ~state_hash ~transition_data = - Batch.set ~key:(Transition state_hash) ~data:(New_format transition_data) + Batch.set ~key:(Transition_new state_hash) ~data:transition_data let add ~arcs_cache ~state_hash ~transition_data = let parent_hash = @@ -471,7 +514,7 @@ let move_root ~old_root_hash ~new_root ~garbage = fun batch -> Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:new_root_hash ; - Batch.set batch ~key:Root_common ~data:(Root_data.to_common new_root) ; + Batch.set batch ~key:Root_new ~data:(Root_data.to_common new_root) ; Batch.set batch ~key:Protocol_states_for_root_scan_state ~data:(List.map ~f:With_hash.data new_root.protocol_states_for_scan_state) ; List.iter (old_root_hash :: garbage) ~f:(fun node_hash -> @@ -480,12 +523,12 @@ let move_root ~old_root_hash ~new_root ~garbage = * we are deleting since there we are deleting all of a node's * parents as well *) + Batch.remove batch ~key:(Transition_new node_hash) ; Batch.remove batch ~key:(Transition node_hash) ; Batch.remove batch ~key:(Arcs node_hash) ) let get_transition_data ~signature_kind ~proof_cache_db t hash = - let error = `Not_found (`Transition hash) in - match%map.Result get t.db ~key:(Transition hash) ~error with + match%map.Result get_transition_do t hash with | Old_format block -> Either.First (Block_data.validated_of_stable ~signature_kind ~proof_cache_db @@ -496,7 +539,7 @@ let get_transition_data ~signature_kind ~proof_cache_db t hash = let get_transition ~signature_kind ~proof_cache_db t hash = (* TODO: consider using a more specific error *) let error = `Not_found (`Transition hash) in - let%bind.Result transition_data = get t.db ~key:(Transition hash) ~error in + let%bind.Result transition_data = get_transition_do t hash in Transition.to_validated_block ~signature_kind ~proof_cache_db ~state_hash:hash transition_data |> Result.map_error ~f:(fun _ -> error) From adc6945d00c1a8ce3707faaac68bb4d6af6940b1 Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 28 Nov 2025 09:09:22 +0100 Subject: [PATCH 099/122] Remove problematic fold_result usages, fix a bug --- .../multi_key_file_storage.ml | 9 +-- src/lib/parallel_scan/parallel_scan.ml | 8 +-- .../transaction_snark_scan_state.ml | 59 ++----------------- 3 files changed, 8 insertions(+), 68 deletions(-) diff --git a/src/lib/multi-key-file-storage/multi_key_file_storage.ml b/src/lib/multi-key-file-storage/multi_key_file_storage.ml index f8d7e1bda2a1..194c8065ee66 100644 --- a/src/lib/multi-key-file-storage/multi_key_file_storage.ml +++ b/src/lib/multi-key-file-storage/multi_key_file_storage.ml @@ -185,13 +185,8 @@ end) : Or_error.tag ~tag:(Inputs.filename tag.filename_key) @@ Or_error.try_with_join ~backtrace:true do_parsing - let read_many (type a) (module B : Bin_prot.Binable.S with type t = a) tags = - let%map.Or_error reversed = - List.fold_result tags ~init:[] ~f:(fun acc tag -> - let%map.Or_error value = read (module B) tag in - value :: acc ) - in - List.rev reversed + let read_many (type a) (module B : Bin_prot.Binable.S with type t = a) = + Mina_stdlib.Result.List.map ~f:(read (module B)) end include Make_custom (struct diff --git a/src/lib/parallel_scan/parallel_scan.ml b/src/lib/parallel_scan/parallel_scan.ml index d52ce8b4d94f..8f7527184e05 100644 --- a/src/lib/parallel_scan/parallel_scan.ml +++ b/src/lib/parallel_scan/parallel_scan.ml @@ -1013,12 +1013,8 @@ module State = struct Ok None | Some (m, bs) -> let%bind.Result m = f1 m in - let%map.Result bs = - List.fold_result bs ~init:[] ~f:(fun acc x -> - let%map.Result x' = f2 x in - x' :: acc ) - in - Some (m, List.rev bs) + let%map.Result bs = Mina_stdlib.Result.List.map ~f:f2 bs in + Some (m, bs) in { t with trees; acc } 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 bac71dc7791b..8300837b4a23 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 @@ -1012,12 +1012,8 @@ struct let check_invariants t ~verifier = let verify tagged_list = let%bind.Deferred.Or_error ps = - (* Reversed list, it's ok here *) - List.fold_result tagged_list ~init:[] ~f:(fun acc tagged -> - let%map.Or_error p = - Ledger_proof_with_sok_message.read_tag tagged - in - p :: acc ) + Mina_stdlib.Result.List.map ~f:Ledger_proof_with_sok_message.read_tag + tagged_list |> Deferred.return in Verifier.verify ~verifier ps @@ -1276,14 +1272,9 @@ let staged_transactions_untagged ~signature_kind ~proof_cache_db t = in let txns_with_witnesses_tagged = Parallel_scan.pending_data t.scan_state in let%bind.Or_error txns_with_witnesses = - List.fold_result ~init:[] - ~f:(fun acc lst -> - let%map.Or_error lst' = - read_tags_and_write_proofs ~signature_kind ~proof_cache_db lst - in - lst' :: acc ) + Mina_stdlib.Result.List.map + ~f:(read_tags_and_write_proofs ~signature_kind ~proof_cache_db) txns_with_witnesses_tagged - |> Or_error.map ~f:List.rev in let%map.Or_error previous_incomplete = read_tags_and_write_proofs ~signature_kind ~proof_cache_db @@ -1703,29 +1694,6 @@ let work_statements_for_new_diff t : Transaction_snark_work.Statement.t list = | Some stmt -> stmt ) ) ) -(* 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) : - Snark_work_lib.Spec.Single.t One_or_two.t list Or_error.t = - let all_jobs = all_jobs t in - List.fold_until all_jobs ~init:[] - ~finish:(fun lst -> Ok lst) - ~f:(fun acc jobs -> - let specs_list = - single_spec_one_or_twos_rev_of_job_list ~get_state jobs - in - match specs_list with - | Ok list -> - Continue (acc @ List.rev list) - | Error e -> - Stop (Error e) ) *) - let all_work_pairs t : Available_job.t One_or_two.t list = all_jobs t |> List.concat_map ~f:One_or_two.group_list @@ -1844,22 +1812,3 @@ let check_required_protocol_states t ~protocol_states = in let%map () = check_length protocol_states_assoc in protocol_states_assoc - -(* let read_all_proofs_from_disk - { scan_state = cached - ; previous_incomplete_zkapp_updates = tx_list, border_status - } = - let%bind.Result scan_state = - Parallel_scan.State.map_result ~f1:Ledger_proof_with_sok_message.read_tag - ~f2:Transaction_with_witness.read_tag cached - in - let%map.Result tx_list' = - List.fold_result tx_list ~init:[] ~f:(fun acc tx -> - let%map.Result tx' = Transaction_with_witness.read_tag tx in - tx' :: acc ) - |> Result.map ~f:List.rev - in - Stable.Latest. - { scan_state - ; previous_incomplete_zkapp_updates = (tx_list', border_status) - } *) From e334c4b24a9094df34db6c7018838a1bda10f7a5 Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 28 Nov 2025 09:25:12 +0100 Subject: [PATCH 100/122] Skip checking arcs in fix-persistent-frontier --- src/app/cli/src/init/fix_persistent_frontier.ml | 2 +- .../persistent_frontier/database.ml | 8 ++++---- .../persistent_frontier/database.mli | 3 ++- .../persistent_frontier/persistent_frontier.ml | 2 +- .../transition_frontier/transition_frontier.ml | 15 ++++++++------- .../transition_frontier/transition_frontier.mli | 1 + 6 files changed, 17 insertions(+), 14 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index af2a3e42e9c0..ccd3b947cfd0 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -188,7 +188,7 @@ let fix_persistent_frontier_root_do ~logger ~config_directory ~catchup_mode:`Super ~set_best_tip:false (* application data is used in frontier migration, so we need to retain it *) - ~retain_application_data:migrate_frontier () + ~retain_application_data:migrate_frontier ~check_arcs:false () with | Error err -> let err_str = diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 8fb2f881ce1b..2762700912a1 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -383,7 +383,7 @@ let get_transition_do t hash = (* TODO: check that best tip is connected to root *) (* TODO: check for garbage *) -let check t ~genesis_state_hash = +let check ?(check_arcs = true) t ~genesis_state_hash = Or_error.try_with (fun () -> let check_version () = match get_if_exists t.db ~key:Db_version ~default:0 with @@ -418,7 +418,7 @@ let check t ~genesis_state_hash = in (root_hash, root_transition) in - let rec check_arcs pred_hash = + let rec check_arcs_do pred_hash = let%bind successors = get t.db ~key:(Arcs pred_hash) ~error:(`Corrupt (`Not_found (`Arcs pred_hash))) @@ -429,7 +429,7 @@ let check t ~genesis_state_hash = get_transition_do t succ_hash |> Result.map_error ~f:(fun e -> `Corrupt e) in - check_arcs succ_hash ) + check_arcs_do succ_hash ) in let%bind () = check_version () in let%bind root_hash, root_block = check_base () in @@ -444,7 +444,7 @@ let check t ~genesis_state_hash = Ok () else Error (`Genesis_state_mismatch persisted_genesis_state_hash) in - let%map () = check_arcs root_hash in + let%map () = if check_arcs then check_arcs_do root_hash else Ok () in Transition.header root_block |> Mina_block.Header.protocol_state |> Mina_state.Protocol_state.blockchain_state diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index 571be4e92837..35bb4c0a90c9 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -50,7 +50,8 @@ val create : logger:Logger.t -> directory:string -> t val close : t -> unit val check : - t + ?check_arcs:bool + -> t -> genesis_state_hash:State_hash.t -> ( Frozen_ledger_hash.t , [> `Not_initialized diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 90aff395ac29..df9a390f5344 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -154,7 +154,7 @@ module Instance = struct let factory { factory; _ } = factory - let check_database t = Database.check t.db + let check_database ?check_arcs t = Database.check ?check_arcs t.db let get_root_hash t = Database.get_root_hash t.db |> Result.map_error ~f:Database.Error.message diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 5888fe6f340c..e649ea666c8b 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -217,6 +217,7 @@ let rec load_with_max_length : -> catchup_mode:[ `Super ] -> ?set_best_tip:bool -> ?retain_application_data:bool + -> ?check_arcs:bool -> unit -> ( t , [> `Bootstrap_required @@ -227,7 +228,7 @@ let rec load_with_max_length : fun ~context:(module Context : CONTEXT) ~max_length ?(retry_with_fresh_db = true) ?max_frontier_depth ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier ~catchup_mode - ?set_best_tip ?retain_application_data () -> + ?set_best_tip ?retain_application_data ?check_arcs () -> let open Context in let open Deferred.Let_syntax in (* TODO: #3053 *) @@ -320,7 +321,7 @@ let rec load_with_max_length : match time ~label:"Persistent_frontier.Instance.check_database" ~logger @@ fun () -> - Persistent_frontier.Instance.check_database + Persistent_frontier.Instance.check_database ?check_arcs ~genesis_state_hash: (State_hash.With_state_hashes.state_hash precomputed_values.protocol_state_with_hashes ) @@ -365,7 +366,7 @@ let rec load_with_max_length : ~context:(module Context) ~max_length ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier ~retry_with_fresh_db:false ~catchup_mode - ?retain_application_data () + ?retain_application_data ?check_arcs () >>| Result.map_error ~f:(function | `Persistent_frontier_malformed -> `Failure @@ -393,9 +394,9 @@ let rec load_with_max_length : return res ) let load ?(retry_with_fresh_db = true) ?max_frontier_depth ?set_best_tip - ?retain_application_data ~context:(module Context : CONTEXT) ~verifier - ~consensus_local_state ~persistent_root ~persistent_frontier ~catchup_mode - () = + ?retain_application_data ?check_arcs ~context:(module Context : CONTEXT) + ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier + ~catchup_mode () = let open Context in O1trace.thread "transition_frontier_load" (fun () -> let max_length = @@ -406,7 +407,7 @@ let load ?(retry_with_fresh_db = true) ?max_frontier_depth ?set_best_tip ~context:(module Context) ~max_length ~retry_with_fresh_db ?max_frontier_depth ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier - ~catchup_mode ?set_best_tip () ?retain_application_data ) + ~catchup_mode ?set_best_tip ?retain_application_data ?check_arcs () ) (* The persistent root and persistent frontier as safe to ignore here * because their lifecycle is longer than the transition frontier's *) diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 58c905831329..9a75b383faed 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -73,6 +73,7 @@ val load : -> ?max_frontier_depth:int -> ?set_best_tip:bool -> ?retain_application_data:bool + -> ?check_arcs:bool -> context:(module CONTEXT) -> verifier:Verifier.t -> consensus_local_state:Consensus.Data.Local_state.t From 6f6a183493b07fc2eb8949bb5d9c6e15f7e0356d Mon Sep 17 00:00:00 2001 From: georgeee Date: Sat, 29 Nov 2025 19:52:32 +0100 Subject: [PATCH 101/122] Revert faulty change introduced in 3e9d36f15 --- .../transaction_snark_scan_state.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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 8300837b4a23..123c09a63adc 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 @@ -1229,14 +1229,15 @@ let latest_recent_proof_txs_untagged ~signature_kind ~proof_cache_db t = |> Option.some let incomplete_txns_from_recent_proof_tree t = - let%bind.Option tagged, txns_with_witnesses = + let%map.Option tagged, txns_with_witnesses = Parallel_scan.last_emitted_value t.scan_state in (* First pass ledger is considered as the snarked ledger, so any account update whether completed in the same tree or not should be included in the next tree *) - let%map.Option res = + let res = Tagged_categorizer.second_pass_last_block txns_with_witnesses + |> Option.value ~default:([], `Border_block_continued_in_the_next_tree false) in (Ledger_proof_with_sok_message.Tagged.statement tagged, res) From 5e04b4f35d5e6bcb77cffb62b4a1411007ea4ad2 Mon Sep 17 00:00:00 2001 From: georgeee Date: Sun, 30 Nov 2025 00:33:49 +0100 Subject: [PATCH 102/122] Small refactoring of transaction_snark_scan_state.ml --- .../transaction_snark_scan_state.ml | 38 ++++++------------- 1 file changed, 12 insertions(+), 26 deletions(-) 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 123c09a63adc..7852d9f0346d 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 @@ -113,8 +113,6 @@ module Transaction_with_witness = struct Mina_state.Protocol_state.Body.Value.t option } - let source_first_pass_ledger t = t.statement.source.first_pass_ledger - let source_second_pass_ledger t = t.statement.source.second_pass_ledger let target_first_pass_ledger t = t.statement.target.first_pass_ledger @@ -161,9 +159,6 @@ module Transaction_with_witness = struct end end] - let source_first_pass_ledger t = - t.Stable.Latest.statement.source.first_pass_ledger - let source_second_pass_ledger t = t.Stable.Latest.statement.source.second_pass_ledger @@ -1067,8 +1062,6 @@ end module Make_transaction_categorizer (Tx : sig type t - val source_first_pass_ledger : t -> Ledger_hash.t - val source_second_pass_ledger : t -> Ledger_hash.t val target_first_pass_ledger : t -> Ledger_hash.t @@ -1082,16 +1075,6 @@ struct List.group txns_per_tree ~break:(fun t1 t2 -> not (Tx.of_same_block t1 t2)) |> List.filter_map ~f:Mina_stdlib.Nonempty_list.of_list_opt - let fold_tx (first_pass_txns, second_pass_txns, _old_root) txn = - let target_first_pass_ledger = Tx.target_first_pass_ledger txn in - match Tx.transaction_type txn with - | `Coinbase | `Fee_transfer | `Signed_command -> - (txn :: first_pass_txns, second_pass_txns, target_first_pass_ledger) - | `Zkapp_command -> - ( txn :: first_pass_txns - , txn :: second_pass_txns - , target_first_pass_ledger ) - (** Compoutes representation for the sequence of transactions extracted from scan state when it emitted a proof, split into: @@ -1108,14 +1091,17 @@ struct let categorize_transactions ~previous_incomplete txns_non_empty = let first_txn = Mina_stdlib.Nonempty_list.head txns_non_empty in let txns = Mina_stdlib.Nonempty_list.to_list txns_non_empty in - let init = ([], [], Tx.source_first_pass_ledger first_txn) in - let first_pass_txns, second_pass_txns, target_first_pass_ledger = - let first_pass_txns_rev, second_pass_txns_rev, target_first_pass_ledger = - List.fold ~init txns ~f:fold_tx - in - ( List.rev first_pass_txns_rev - , List.rev second_pass_txns_rev - , target_first_pass_ledger ) + let target_first_pass_ledger = + Tx.target_first_pass_ledger + (Mina_stdlib.Nonempty_list.last txns_non_empty) + in + let second_pass_txns = + List.filter txns ~f:(fun txn -> + match Tx.transaction_type txn with + | `Zkapp_command -> + true + | _ -> + false ) in (* determine whether second pass completed in the same tree *) let continued_in_the_next_tree = @@ -1133,7 +1119,7 @@ struct | _ -> [] in - { Transactions_categorized.Poly.first_pass = first_pass_txns + { Transactions_categorized.Poly.first_pass = txns ; second_pass = second_pass_txns ; previous_incomplete ; continued_in_the_next_tree From 7cd7c30874ccaeb9a21212c0775176099f36ad0c Mon Sep 17 00:00:00 2001 From: georgeee Date: Sun, 30 Nov 2025 00:56:35 +0100 Subject: [PATCH 103/122] Fix inconsistency between new and old implementations --- .../transaction_snark_scan_state.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) 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 7852d9f0346d..ce5ae47d758f 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 @@ -1492,7 +1492,9 @@ let apply_categorized_txns_stepwise ?(stop_at_first_pass = false) in let do_second_pass = (*if transactions completed in the same tree; do second pass now*) - (not txns_per_block.continued_in_the_next_tree) + (not + ( txns_per_block.continued_in_the_next_tree + || List.is_empty txns_per_block.second_pass ) ) || continue_previous_tree's_txns in if do_second_pass then From eaf70a5d51d3653c51746a4955f5ffa0df2d5ecf Mon Sep 17 00:00:00 2001 From: georgeee Date: Sun, 30 Nov 2025 01:08:44 +0100 Subject: [PATCH 104/122] Fix another inconsistency between new and old implementations --- .../transaction_snark_scan_state.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 ce5ae47d758f..5ffdf2e53b75 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 @@ -1172,7 +1172,7 @@ let latest_recent_proof_txs_impl ~process ~continued_in_next_tree (if continued_in_next_tree then previous_incomplete else []) txns_with_witnesses in - if List.is_empty previous_incomplete then txns + if List.is_empty previous_incomplete || continued_in_next_tree then txns else { Transactions_categorized.Poly.first_pass = [] ; second_pass = [] From b4916a85f78edcbe0562aa0082de443e909b3d12 Mon Sep 17 00:00:00 2001 From: georgeee Date: Sun, 30 Nov 2025 15:16:42 +0100 Subject: [PATCH 105/122] Update logging messages --- src/lib/mina_block/validation.ml | 2 +- src/lib/staged_ledger/staged_ledger.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index e886b37662aa..72223359a48f 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -600,7 +600,7 @@ let validate_staged_ledger_diff ?skip_staged_ledger_verification ~logger [ ( "time_elapsed" , `Float Core.Time.(Span.to_ms @@ diff (now ()) apply_start_time) ) ] - "Staged_ledger.apply_diff takes $time_elapsed" ; + "Staged ledger diff application (diffs + scan state) takes $time_elapsed" ; let snarked_ledger_hash = match proof_opt with | None -> diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 558623cb8c59..5be27abf4aa5 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1299,7 +1299,7 @@ module T = struct , `Float Core.Time.(Span.to_ms @@ diff (now ()) apply_diff_start_time) ) ] - "Staged_ledger.apply_diff take $time_elapsed" ; + "Staged_ledger.apply_diff takes $time_elapsed" ; res let apply_diff_unchecked ~constraint_constants ~global_slot ~logger From 8bb62821caa02bb2de2a13e9ddb9164b0bfa5290 Mon Sep 17 00:00:00 2001 From: georgeee Date: Sun, 30 Nov 2025 15:20:08 +0100 Subject: [PATCH 106/122] Skip command verification when loading from disk This is only useful for as long as we need to maintain the legacy flow of loading frontier from disk. But it's useful for testing before that is fully delivered. --- src/lib/staged_ledger/staged_ledger.ml | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 5be27abf4aa5..f712ad5522fa 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1267,13 +1267,28 @@ module T = struct check_completed_works ~get_completed_work ~logger ~verifier t.scan_state work ) in + let check_commands txs hashes = + match skip_verification with + | Some `All -> + let f { With_status.data = tx; _ } = + (* Skipping verification when [`All] is provided (this + is used only when loading an already verified + transition from disk). *) + let (`If_this_is_used_it_should_have_a_comment_justifying_it tx') = + User_command.to_valid_unsafe tx + in + tx' + in + let res = List.map ~f txs in + Deferred.Result.return (Ok res) + | _ -> + Check_commands.check_commands t.ledger ~verifier + ~transaction_pool_proxy txs hashes + in [%log internal] "Prediff" ; let%bind prediff = Pre_diff_info.get staged_ledger_diff ~constraint_constants - ~coinbase_receiver ~supercharge_coinbase - ~check: - (Check_commands.check_commands t.ledger ~verifier - ~transaction_pool_proxy ) + ~coinbase_receiver ~supercharge_coinbase ~check:check_commands |> Deferred.map ~f: (Result.map_error ~f:(fun error -> From 3ff71cc68f34b34949b9ff4925d6a0f38c52ebcb Mon Sep 17 00:00:00 2001 From: georgeee Date: Mon, 1 Dec 2025 10:25:35 +0100 Subject: [PATCH 107/122] TMP: disable extension updates, to see if it's the leak of RAM --- .../persistent_frontier/persistent_frontier.ml | 14 ++++++++------ src/lib/transition_frontier/transition_frontier.ml | 1 + 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index df9a390f5344..25b26d0fc3d0 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -229,10 +229,10 @@ module Instance = struct |> Validation.reset_genesis_protocol_state_validation |> validate genesis_state_hash - let apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state + let apply_diff ~logger ~frontier ~extensions:_ ~ignore_consensus_local_state ~root_ledger diff = [%log internal] "Apply_full_frontier_diffs" ; - let (`New_root_and_diffs_with_mutants (_, diffs_with_mutants)) = + let (`New_root_and_diffs_with_mutants (_, _diffs_with_mutants)) = Full_frontier.apply_diffs frontier [ diff ] ~has_long_catchup_job:false ~enable_epoch_ledger_sync: ( if ignore_consensus_local_state then `Disabled @@ -240,11 +240,12 @@ module Instance = struct in [%log internal] "Apply_full_frontier_diffs_done" ; [%log internal] "Notify_frontier_extensions" ; - let%map.Deferred result = - Extensions.notify extensions ~logger ~frontier ~diffs_with_mutants + let%map.Deferred () = + (* Extensions.notify extensions ~logger ~frontier ~diffs_with_mutants *) + Deferred.unit + (* TMP change *) in - [%log internal] "Notify_frontier_extensions_done" ; - Result.return result + [%log internal] "Notify_frontier_extensions_done" let load_transition_old_format ~root_genesis_state_hash ~logger ~precomputed_values ~verifier ~parent (transition : Mina_block.Validated.t) @@ -429,6 +430,7 @@ module Instance = struct let%map () = apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state ~root_ledger (E (New_node (Full breadcrumb))) + |> Deferred.map ~f:Result.return in Full_frontier.lighten ?retain_application_data frontier state_hash ; [%log internal] "Breadcrumb_integrated" ; diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index e649ea666c8b..a41643ae5482 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -165,6 +165,7 @@ let load_from_persistence_and_start ~context:(module Context : CONTEXT) if set_best_tip then Persistent_frontier.Instance.set_best_tip ~logger ~frontier:full_frontier ~extensions ~ignore_consensus_local_state ~root_ledger best_tip_hash + |> Deferred.map ~f:Result.return else return () in [%log info] "Loaded full frontier and extensions" ; From 141a70e32d1b4470bd5fd5e310d3b5cd3bf250f6 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 2 Dec 2025 11:53:26 +0100 Subject: [PATCH 108/122] Print RAM usage after explicit GC.compact --- src/app/cli/src/init/fix_persistent_frontier.ml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index ccd3b947cfd0..1238b731fb37 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -209,17 +209,19 @@ let fix_persistent_frontier_root_do ~logger ~config_directory f in let rss_after = Mina_stdlib_unix.File_system.read_rss_kb None in + Gc.compact () ; + let rss_after_gc = Mina_stdlib_unix.File_system.read_rss_kb None in let elapsed = Time.diff (Time.now ()) start in + let flot_opt_json = Option.value_map ~default:`Null ~f:(fun x -> `Float x) in [%log info] "Loaded transition frontier of %d breadcrumbs in $elapsed seconds with RSS \ - $rss_after (started with $rss_before)" + $rss_after_gc (started with $rss_before, before GC: $rss_after)" (Transition_frontier.all_breadcrumbs frontier |> List.length) ~metadata: [ ("elapsed", `Float (Time.Span.to_sec elapsed)) - ; ( "rss_after" - , Option.value_map ~default:`Null rss_after ~f:(fun x -> `Float x) ) - ; ( "rss_before" - , Option.value_map ~default:`Null rss_before ~f:(fun x -> `Float x) ) + ; ("rss_after", flot_opt_json rss_after) + ; ("rss_after_gc", flot_opt_json rss_after_gc) + ; ("rss_before", flot_opt_json rss_before) ] ; let frontier_root_hash = Transition_frontier.root frontier |> Breadcrumb.state_hash From 6b4036c29c6a64abd0949e8a32ca1dd1c08d03a3 Mon Sep 17 00:00:00 2001 From: georgeee Date: Tue, 2 Dec 2025 15:54:23 +0100 Subject: [PATCH 109/122] Print additional heap stats --- .../cli/src/init/fix_persistent_frontier.ml | 49 +++++++++++++++---- 1 file changed, 39 insertions(+), 10 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index 1238b731fb37..9d8b8b02409a 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -89,6 +89,43 @@ let persist_all_transitions ~logger ~db breadcrumbs = batch ) ) ; [%log info] "Re-persisted %d transitions" (List.length breadcrumbs) +let print_ram_usage ~logger frontier_length rss_before rss_after rss_after_gc + elapsed = + let gc_stats = Gc.stat () in + let float_opt_json = Option.value_map ~default:`Null ~f:(fun x -> `Float x) in + [%log info] + "Loaded transition frontier of %d breadcrumbs in $elapsed seconds with RSS \ + $rss_after_gc (started with $rss_before, before GC: $rss_after), see \ + $gc_stats (taken after GC)" + frontier_length + ~metadata: + [ ("elapsed", `Float (Time.Span.to_sec elapsed)) + ; ("rss_after", float_opt_json rss_after) + ; ("rss_after_gc", float_opt_json rss_after_gc) + ; ("rss_before", float_opt_json rss_before) + ; ( "gc_stats" + , `Assoc + [ ("heap_words", `Int gc_stats.heap_words) + ; ("major_words", `Float gc_stats.major_words) + ; ("minor_words", `Float gc_stats.minor_words) + ; ( "forced_major_collections" + , `Int gc_stats.forced_major_collections ) + ; ("major_collections", `Int gc_stats.major_collections) + ; ("minor_collections", `Int gc_stats.minor_collections) + ; ("compactions", `Int gc_stats.compactions) + ; ("promoted_words", `Float gc_stats.promoted_words) + ; ("heap_chunks", `Int gc_stats.heap_chunks) + ; ("live_words", `Int gc_stats.live_words) + ; ("free_words", `Int gc_stats.free_words) + ; ("largest_free", `Int gc_stats.largest_free) + ; ("fragments", `Int gc_stats.fragments) + ; ("live_blocks", `Int gc_stats.live_blocks) + ; ("free_blocks", `Int gc_stats.free_blocks) + ; ("top_heap_words", `Int gc_stats.top_heap_words) + ; ("stack_size", `Int gc_stats.stack_size) + ] ) + ] + let fix_persistent_frontier_root_do ~logger ~config_directory ~chain_state_locations ~max_frontier_depth ~migrate_frontier runtime_config = @@ -212,17 +249,9 @@ let fix_persistent_frontier_root_do ~logger ~config_directory Gc.compact () ; let rss_after_gc = Mina_stdlib_unix.File_system.read_rss_kb None in let elapsed = Time.diff (Time.now ()) start in - let flot_opt_json = Option.value_map ~default:`Null ~f:(fun x -> `Float x) in - [%log info] - "Loaded transition frontier of %d breadcrumbs in $elapsed seconds with RSS \ - $rss_after_gc (started with $rss_before, before GC: $rss_after)" + print_ram_usage ~logger (Transition_frontier.all_breadcrumbs frontier |> List.length) - ~metadata: - [ ("elapsed", `Float (Time.Span.to_sec elapsed)) - ; ("rss_after", flot_opt_json rss_after) - ; ("rss_after_gc", flot_opt_json rss_after_gc) - ; ("rss_before", flot_opt_json rss_before) - ] ; + rss_before rss_after rss_after_gc elapsed ; let frontier_root_hash = Transition_frontier.root frontier |> Breadcrumb.state_hash in From 414c3963aac5b2151e299ea4228b3ed513093ea9 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 3 Dec 2025 01:03:35 +0100 Subject: [PATCH 110/122] Experimental --- .../persistent_frontier/persistent_frontier.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 25b26d0fc3d0..4803045835b8 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -433,7 +433,9 @@ module Instance = struct |> Deferred.map ~f:Result.return in Full_frontier.lighten ?retain_application_data frontier state_hash ; + let breadcrumb = Breadcrumb.lighten breadcrumb in [%log internal] "Breadcrumb_integrated" ; + Gc.compact () ; breadcrumb in (* crawl through persistent frontier and load transitions into in memory frontier *) From 79bf6f5a84eefef6a020e6f13745695a4539b674 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 3 Dec 2025 11:15:34 +0100 Subject: [PATCH 111/122] Revert "TMP: disable extension updates, to see if it's the leak of RAM" This reverts commit c537af4a9d4f6c6f0a07636d8a41a7eb6283a8c4. --- .../persistent_frontier/persistent_frontier.ml | 14 ++++++-------- src/lib/transition_frontier/transition_frontier.ml | 1 - 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 4803045835b8..d965dbc49ec2 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -229,10 +229,10 @@ module Instance = struct |> Validation.reset_genesis_protocol_state_validation |> validate genesis_state_hash - let apply_diff ~logger ~frontier ~extensions:_ ~ignore_consensus_local_state + let apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state ~root_ledger diff = [%log internal] "Apply_full_frontier_diffs" ; - let (`New_root_and_diffs_with_mutants (_, _diffs_with_mutants)) = + let (`New_root_and_diffs_with_mutants (_, diffs_with_mutants)) = Full_frontier.apply_diffs frontier [ diff ] ~has_long_catchup_job:false ~enable_epoch_ledger_sync: ( if ignore_consensus_local_state then `Disabled @@ -240,12 +240,11 @@ module Instance = struct in [%log internal] "Apply_full_frontier_diffs_done" ; [%log internal] "Notify_frontier_extensions" ; - let%map.Deferred () = - (* Extensions.notify extensions ~logger ~frontier ~diffs_with_mutants *) - Deferred.unit - (* TMP change *) + let%map.Deferred result = + Extensions.notify extensions ~logger ~frontier ~diffs_with_mutants in - [%log internal] "Notify_frontier_extensions_done" + [%log internal] "Notify_frontier_extensions_done" ; + Result.return result let load_transition_old_format ~root_genesis_state_hash ~logger ~precomputed_values ~verifier ~parent (transition : Mina_block.Validated.t) @@ -430,7 +429,6 @@ module Instance = struct let%map () = apply_diff ~logger ~frontier ~extensions ~ignore_consensus_local_state ~root_ledger (E (New_node (Full breadcrumb))) - |> Deferred.map ~f:Result.return in Full_frontier.lighten ?retain_application_data frontier state_hash ; let breadcrumb = Breadcrumb.lighten breadcrumb in diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index a41643ae5482..e649ea666c8b 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -165,7 +165,6 @@ let load_from_persistence_and_start ~context:(module Context : CONTEXT) if set_best_tip then Persistent_frontier.Instance.set_best_tip ~logger ~frontier:full_frontier ~extensions ~ignore_consensus_local_state ~root_ledger best_tip_hash - |> Deferred.map ~f:Result.return else return () in [%log info] "Loaded full frontier and extensions" ; From 8bbaf8720c0ed3106aa093e02c167681d12d2554 Mon Sep 17 00:00:00 2001 From: georgeee Date: Wed, 3 Dec 2025 17:07:15 +0100 Subject: [PATCH 112/122] Revert "Experimental" This reverts commit 6213263675ad6ef0dda6aeb4ca18473cc4961659. --- .../persistent_frontier/persistent_frontier.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index d965dbc49ec2..df9a390f5344 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -431,9 +431,7 @@ module Instance = struct ~root_ledger (E (New_node (Full breadcrumb))) in Full_frontier.lighten ?retain_application_data frontier state_hash ; - let breadcrumb = Breadcrumb.lighten breadcrumb in [%log internal] "Breadcrumb_integrated" ; - Gc.compact () ; breadcrumb in (* crawl through persistent frontier and load transitions into in memory frontier *) From d3f3797e88d423db23af9eab2e621f8d08b9cbca Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 18:37:34 +0100 Subject: [PATCH 113/122] Remove temporary hack --- .../persistent_frontier/persistent_frontier.ml | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index df9a390f5344..09dc9adfc50e 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -7,17 +7,6 @@ open Frontier_base module Database = Database module Root_ledger = Mina_ledger.Root -(* TODO get rid of the hack, preserve block tag in database - instead of the full transition *) -let temp_state_hash = - lazy - (Quickcheck.random_value - ~seed: - (`Deterministic - Blake2.( - digest_string "temporary state hash for root" |> to_raw_string) ) - State_hash.gen ) - module type CONTEXT = sig val logger : Logger.t From d27da3d858c7c4aa43b238837f0fc50b19438f6a Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 20:17:29 +0100 Subject: [PATCH 114/122] Remove unused derivings --- .../transaction_snark_scan_state.ml | 2 -- 1 file changed, 2 deletions(-) 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 5ffdf2e53b75..a4424dec15b4 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 @@ -42,7 +42,6 @@ module Transaction_with_witness = struct ; previous_protocol_state_body_opt : Mina_state.Protocol_state.Body.Value.Stable.V2.t option } - [@@deriving sexp, to_yojson] let transaction_type t = Transaction_type.of_transaction @@ -71,7 +70,6 @@ module Transaction_with_witness = struct ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t } - [@@deriving sexp, to_yojson] let to_latest : t -> V3.t = fun { transaction_with_info From 01cee96ea98fcaaf7fd984f9d73b32f294321a03 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 21:44:44 +0100 Subject: [PATCH 115/122] Remove internal methods from interface of Transaction_with_witness --- .../transaction_snark_scan_state.mli | 8 -------- 1 file changed, 8 deletions(-) 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 3a67dc482219..a47689717be4 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 @@ -71,14 +71,6 @@ module Transaction_with_witness : sig Mina_state.Protocol_state.Body.Value.t option } - val write_all_proofs_to_disk : - signature_kind:Mina_signature_kind.t - -> proof_cache_db:Proof_cache_tag.cache_db - -> Stable.Latest.t - -> t - - val read_all_proofs_from_disk : t -> Stable.Latest.t - val persist_many : t list -> State_hash.File_storage.writer_t -> Tagged.t list end From 6ba04becf12e176643c678e3123f072e7e349946 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 22:26:23 +0100 Subject: [PATCH 116/122] Store transaction_applied_tag in latest stable tx witness --- .../disk_caching_stats/disk_caching_stats.ml | 46 ++++++++++++--- src/app/heap_usage/values.ml | 47 ++++++++++++++- src/lib/staged_ledger/staged_ledger.ml | 1 + .../transaction_snark_scan_state.ml | 58 ++++++++++++++----- .../transaction_snark_scan_state.mli | 7 ++- 5 files changed, 135 insertions(+), 24 deletions(-) diff --git a/src/app/disk_caching_stats/disk_caching_stats.ml b/src/app/disk_caching_stats/disk_caching_stats.ml index 129b6c8b9dd4..0ace529d5b81 100644 --- a/src/app/disk_caching_stats/disk_caching_stats.ml +++ b/src/app/disk_caching_stats/disk_caching_stats.ml @@ -364,7 +364,8 @@ module Values (S : Sample) = struct let base_work varying witness : Transaction_snark_scan_state.Transaction_with_witness.t = - { transaction_with_status = varying () + let transaction_with_status, tx_applied = varying () in + { transaction_with_status ; state_hash = (state_hash (), field ()) ; statement = (*Transaction_snark.Statement.Stable.V2.t*) @@ -392,24 +393,55 @@ module Values (S : Sample) = struct ; second_pass_ledger_witness = witness () ; block_global_slot = global_slot_since_genesis () (* TODO: add a value *) ; previous_protocol_state_body_opt = None + ; transaction_applied_or_tag = First tx_applied } let zkapp_command_base_work ~config () : Transaction_snark_scan_state.Transaction_with_witness.t = base_work (fun () -> - { Mina_base.With_status.status = Applied - ; data = Command (Zkapp_command (zkapp_command' ())) - } ) + let zkapp_command = zkapp_command' () in + ( { Mina_base.With_status.status = Applied + ; data = Command (Zkapp_command zkapp_command) + } + , { previous_hash = field () + ; varying = + Command + (Zkapp_command + { accounts = + List.init Params.max_accounts_modified_per_zkapp_command + ~f:(fun _ -> + let a = account () in + (Mina_base.Account.identifier a, Some a) ) + ; command = { status = Applied; data = zkapp_command } + ; new_accounts = [] + } ) + } ) ) (zkapp_command_witness ~config) let signed_command_base_work ~config () : Transaction_snark_scan_state.Transaction_with_witness.t = base_work (fun () -> - { Mina_base.With_status.status = Applied - ; data = Command (Signed_command (signed_command' ())) - } ) + let signed_command = signed_command' () in + ( { Mina_base.With_status.status = Applied + ; data = Command (Signed_command signed_command) + } + , { previous_hash = field () + ; varying = + Command + (Signed_command + { common = + { user_command = + { status = Applied; data = signed_command } + } + ; body = + Payment + { new_accounts = + [ Mina_base.Account.identifier (account ()) ] + } + } ) + } ) ) (signed_command_witness ~config) let sok_message () : Mina_base.Sok_message.t = diff --git a/src/app/heap_usage/values.ml b/src/app/heap_usage/values.ml index 51ddc9ba1b2a..02e275c3e857 100644 --- a/src/app/heap_usage/values.ml +++ b/src/app/heap_usage/values.ml @@ -69,6 +69,7 @@ let verification_key = let applied = Mina_base.Transaction_status.Applied let mk_scan_state_base_node (transaction : Mina_transaction.Transaction.t) + (varying_applied : Mina_transaction_logic.Transaction_applied.Varying.t) ~(constraint_constants : Genesis_constants.Constraint_constants.t) : Transaction_snark_scan_state.Transaction_with_witness.t Parallel_scan.Base.t = @@ -115,6 +116,7 @@ let mk_scan_state_base_node (transaction : Mina_transaction.Transaction.t) acct ) ) ; !ledger in + let previous_hash = get Mina_base.Ledger_hash.gen in let job : Transaction_snark_scan_state.Transaction_with_witness.t = { transaction_with_status = { status = applied; data = transaction } ; state_hash = (state_hash, state_body_hash) @@ -125,6 +127,8 @@ let mk_scan_state_base_node (transaction : Mina_transaction.Transaction.t) ; block_global_slot = Mina_numbers.Global_slot_since_genesis.zero (* TODO: add a value *) ; previous_protocol_state_body_opt = None + ; transaction_applied_or_tag = + First { previous_hash; varying = varying_applied } } in let record : _ Parallel_scan.Base.Record.t = @@ -140,7 +144,14 @@ let scan_state_base_node_coinbase = ~receiver:sample_pk_compressed ~fee_transfer:None |> Or_error.ok_exn in - mk_scan_state_base_node (Coinbase coinbase) + let applied = + Mina_transaction_logic.Transaction_applied.Varying.Coinbase + { coinbase = Mina_base.With_status.{ data = coinbase; status = Applied } + ; new_accounts = [] + ; burned_tokens = Currency.Amount.zero + } + in + mk_scan_state_base_node (Coinbase coinbase) applied let scan_state_base_node_payment = let payload : Mina_base.Signed_command_payload.t = @@ -165,9 +176,41 @@ let scan_state_base_node_payment = { payload; signer = sample_pk; signature = Mina_base.Signature.dummy } in mk_scan_state_base_node (Command (Signed_command user_command)) + (Command + (Signed_command + { common = + { user_command = { data = user_command; status = Applied } } + ; body = Payment { new_accounts = [] } + } ) ) let scan_state_base_node_zkapp ~zkapp_command = - mk_scan_state_base_node (Command (Zkapp_command zkapp_command)) + let varying : Mina_transaction_logic.Transaction_applied.Varying.t = + let zkapp_command_applied : + Mina_transaction_logic.Transaction_applied.Zkapp_command_applied.t = + let accounts = + (* fudge: the `accounts` calculation is more complex; see `apply_zkapp_command_unchecked_aux` + also, we're using the same account repeatedly + *) + let accessed = + Mina_base.Zkapp_command.account_access_statuses zkapp_command applied + |> List.filter_map ~f:(fun (acct_id, accessed) -> + match accessed with + | `Accessed -> + Some acct_id + | `Not_accessed -> + None ) + in + List.map accessed ~f:(fun acct_id -> (acct_id, Some account)) + in + let command = + Mina_base.With_status.{ data = zkapp_command; status = applied } + in + let new_accounts = [] in + { accounts; command; new_accounts } + in + Command (Zkapp_command zkapp_command_applied) + in + mk_scan_state_base_node (Command (Zkapp_command zkapp_command)) varying let scan_state_merge_node : Transaction_snark_scan_state.Ledger_proof_with_sok_message.t diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index f712ad5522fa..49502808bc1c 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -590,6 +590,7 @@ module T = struct ; statement ; block_global_slot = global_slot ; previous_protocol_state_body_opt = None + ; transaction_applied_or_tag = First applied_txn } , Mina_transaction_logic.Transaction_applied.new_accounts applied_txn ) 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 a4424dec15b4..ab868b003555 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 @@ -32,21 +32,30 @@ module Transaction_with_witness = struct ; state_hash : State_hash.Stable.V1.t * State_body_hash.Stable.V1.t ; statement : Transaction_snark.Statement.Stable.V2.t ; init_stack : Mina_base.Pending_coinbase.Stack_versioned.Stable.V1.t - ; first_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) - ; second_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.Stable.V2.t + ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.Stable.V2.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t (* TODO: in Mesa remove the option, just have the value *) ; previous_protocol_state_body_opt : Mina_state.Protocol_state.Body.Value.Stable.V2.t option + ; transaction_applied_tag : + ( State_hash.Stable.V1.t + , Mina_transaction_logic.Transaction_applied.Stable.V2.t ) + Multi_key_file_storage.Tag.Stable.V1.t } let transaction_type t = Transaction_type.of_transaction (With_status.data t.transaction_with_status) + let mk_transaction_applied_tag writer + (transaction_applied : + Mina_transaction_logic.Transaction_applied.Stable.V2.t ) = + State_hash.File_storage.write_value writer + (module Mina_transaction_logic.Transaction_applied.Stable.V2) + transaction_applied + let to_latest = Fn.id end @@ -63,16 +72,15 @@ module Transaction_with_witness = struct Transaction_snark.Pending_coinbase_stack_state.Init_stack.Stable .V1 .t - ; first_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) - ; second_pass_ledger_witness : - (Mina_ledger.Sparse_ledger.Stable.V2.t[@sexp.opaque]) + ; first_pass_ledger_witness : Mina_ledger.Sparse_ledger.Stable.V2.t + ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.Stable.V2.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t } - let to_latest : t -> V3.t = - fun { transaction_with_info + let to_latest : State_hash.File_storage.writer_t -> t -> V3.t = + fun writer + { transaction_with_info ; state_hash ; statement ; init_stack @@ -95,6 +103,10 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness ; block_global_slot ; previous_protocol_state_body_opt = None + ; transaction_applied_tag = + State_hash.File_storage.write_value writer + (module Mina_transaction_logic.Transaction_applied.Stable.V2) + transaction_with_info } end end] @@ -109,6 +121,11 @@ module Transaction_with_witness = struct ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t ; previous_protocol_state_body_opt : Mina_state.Protocol_state.Body.Value.t option + ; transaction_applied_or_tag : + ( Mina_transaction_logic.Transaction_applied.t + , Mina_transaction_logic.Transaction_applied.Stable.V2.t + State_hash.File_storage.tag ) + Either.t } let source_second_pass_ledger t = t.statement.source.second_pass_ledger @@ -201,6 +218,7 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness ; block_global_slot ; previous_protocol_state_body_opt + ; transaction_applied_tag } = { transaction_with_status = With_status.map @@ -215,9 +233,10 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness ; block_global_slot ; previous_protocol_state_body_opt + ; transaction_applied_or_tag = Either.Second transaction_applied_tag } - let read_all_proofs_from_disk + let read_all_proofs_from_disk writer { transaction_with_status ; state_hash ; statement @@ -226,6 +245,7 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness ; block_global_slot ; previous_protocol_state_body_opt + ; transaction_applied_or_tag } = { Stable.Latest.transaction_with_status = With_status.map ~f:Transaction.read_all_proofs_from_disk @@ -237,6 +257,14 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness ; block_global_slot ; previous_protocol_state_body_opt + ; transaction_applied_tag = + ( match transaction_applied_or_tag with + | First data -> + Stable.V3.mk_transaction_applied_tag writer + @@ Mina_transaction_logic.Transaction_applied + .read_all_proofs_from_disk data + | Second tag -> + tag ) } let persist_many witnesses writer = @@ -244,7 +272,7 @@ module Transaction_with_witness = struct let write_witness = FS.write_value writer (module Stable.Latest) in let write_witness' witness = (* TODO remove read_all_proofs_from_disk *) - let stable = read_all_proofs_from_disk witness in + let stable = read_all_proofs_from_disk writer witness in Tagged.create ~tag:(write_witness stable) stable in List.map ~f:write_witness' witnesses @@ -351,6 +379,7 @@ module Available_job = struct ; init_stack ; block_global_slot ; previous_protocol_state_body_opt + ; transaction_applied_tag = _ } = Transaction_with_witness.read_tag tagged_witness in @@ -553,7 +582,9 @@ module Stable = struct ~statement in let f2 witness = - let stable = Transaction_with_witness.Stable.V2.to_latest witness in + let stable = + Transaction_with_witness.Stable.V2.to_latest writer witness + in let tag = State_hash.File_storage.write_value writer (module Transaction_with_witness.Stable.V3) @@ -584,6 +615,7 @@ let create_expected_statement ~constraint_constants ; statement ; block_global_slot ; previous_protocol_state_body_opt + ; transaction_applied_or_tag = _ } = let open Or_error.Let_syntax in let source_first_pass_merkle_root = 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 a47689717be4..4c4942c56d40 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 @@ -32,8 +32,6 @@ module Transaction_with_witness : sig module V2 : sig type t - - val to_latest : t -> V3.t end end] @@ -69,6 +67,11 @@ module Transaction_with_witness : sig ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t ; previous_protocol_state_body_opt : Mina_state.Protocol_state.Body.Value.t option + ; transaction_applied_or_tag : + ( Mina_transaction_logic.Transaction_applied.t + , Mina_transaction_logic.Transaction_applied.Stable.V2.t + State_hash.File_storage.tag ) + Either.t } val persist_many : t list -> State_hash.File_storage.writer_t -> Tagged.t list From 021e1ee7ba5577fd05d03603e9b4a54896be216e Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 22:47:32 +0100 Subject: [PATCH 117/122] Implement scan state hash in backwards-compatible way --- .../transaction_snark_scan_state.ml | 66 ++++++++++++++++++- .../transaction_snark_scan_state.mli | 4 ++ 2 files changed, 68 insertions(+), 2 deletions(-) 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 ab868b003555..43d625487d62 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 @@ -78,6 +78,30 @@ module Transaction_with_witness = struct Mina_numbers.Global_slot_since_genesis.Stable.V1.t } + let of_latest_exn : V3.t -> t = + fun { state_hash + ; statement + ; init_stack + ; first_pass_ledger_witness + ; second_pass_ledger_witness + ; block_global_slot + ; transaction_applied_tag + ; _ + } -> + { transaction_with_info = + State_hash.File_storage.read + (module Mina_transaction_logic.Transaction_applied.Stable.V2) + transaction_applied_tag + |> Or_error.tag ~tag:"of_latest_exn" + |> Or_error.ok_exn + ; state_hash + ; statement + ; init_stack = Base init_stack + ; first_pass_ledger_witness + ; second_pass_ledger_witness + ; block_global_slot + } + let to_latest : State_hash.File_storage.writer_t -> t -> V3.t = fun writer { transaction_with_info @@ -562,6 +586,22 @@ module Stable = struct * [ `Border_block_continued_in_the_next_tree of bool ] } + let of_latest_exn : V3.t -> t = + let f1 = + Ledger_proof_with_sok_message.read_tag_exn ~error_tag:"v3 -> v2" + in + let f2 w = + Transaction_with_witness.read_tag_exn ~error_tag:"v3 -> v2" w + |> Transaction_with_witness.Stable.V2.of_latest_exn + in + fun { scan_state + ; previous_incomplete_zkapp_updates = updates, continue_in_next_tree + } -> + { scan_state = Parallel_scan.State.map scan_state ~f1 ~f2 + ; previous_incomplete_zkapp_updates = + (List.map updates ~f:f2, continue_in_next_tree) + } + let to_latest : t -> V3.t = fun { scan_state ; previous_incomplete_zkapp_updates = updates, continue_in_next_tree @@ -596,11 +636,33 @@ module Stable = struct ; previous_incomplete_zkapp_updates = (List.map updates ~f:f2, continue_in_next_tree) } ) + + let hash (t : t) = + hash_generic t.scan_state t.previous_incomplete_zkapp_updates + ~serialize_ledger_proof_with_sok_message: + (Binable.to_string (module Ledger_proof_with_sok_message.Stable.V2)) + ~serialize_transaction_with_witness: + (Binable.to_string (module Transaction_with_witness.Stable.V2)) + + let serialize_ledger_proof_with_sok_message_tagged = + Fn.compose + (Binable.to_string (module Ledger_proof_with_sok_message.Stable.V2)) + @@ Ledger_proof_with_sok_message.read_tag_exn + ~error_tag:"scan state hashing" + + let serialize_transaction_with_witness_tagged w = + Binable.to_string (module Transaction_with_witness.Stable.V2) + @@ Transaction_with_witness.Stable.V2.of_latest_exn + @@ Transaction_with_witness.read_tag_exn ~error_tag:"scan state hashing" w end end] -(* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) -let hash : t -> _ = Stable.Latest.hash +let hash t = + hash_generic t.scan_state t.previous_incomplete_zkapp_updates + ~serialize_ledger_proof_with_sok_message: + Stable.V2.serialize_ledger_proof_with_sok_message_tagged + ~serialize_transaction_with_witness: + Stable.V2.serialize_transaction_with_witness_tagged (**********Helpers*************) 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 4c4942c56d40..4aeb3a1c05ea 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 @@ -16,6 +16,10 @@ module Stable : sig type t val to_latest : t -> V3.t + + val hash : t -> Staged_ledger_hash.Aux_hash.t + + val of_latest_exn : V3.t -> t end end] From 995d6077f90bac8baa6ccb06a0c236882833a203 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 23:03:23 +0100 Subject: [PATCH 118/122] fixup! Fix compatibility of database --- .../transaction_snark_scan_state.ml | 6 ++++++ src/lib/transition_frontier/frontier_base/root_data.mli | 6 ++++++ .../transition_frontier/persistent_frontier/database.ml | 7 ++++--- 3 files changed, 16 insertions(+), 3 deletions(-) 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 43d625487d62..2245def122bc 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 @@ -606,6 +606,12 @@ module Stable = struct fun { scan_state ; previous_incomplete_zkapp_updates = updates, continue_in_next_tree } -> + (* TODO: Although this trick will work, it is not the best way to do it. + Conversion logic is dependent upon the fact that it's safe to write to + location associated with `State_hash.dummy`. + Instead of having V3 for the same module, let's create a different module + equivalent to V3 and have `to_latest` accept writer as an argument. + *) State_hash.File_storage.write_values_exn State_hash.dummy ~f:(fun writer -> let f1 diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index d7489fcd41d0..494766b759f7 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -90,6 +90,12 @@ module Minimal : sig module V3 : sig type t end + + module V2 : sig + type t + + val to_latest : t -> V3.t + end end] val common : t -> Common.t diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 2762700912a1..8078fc09f192 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -103,7 +103,7 @@ module Schema = struct Most of the time, we just need the hash, but whole `Root` is being read; This combos with `bin_prot` being slow results in 90s bottleneck. *) - | Root : Root_data.Minimal.Stable.V3.t t + | Root : Root_data.Minimal.Stable.V2.t t | Root_hash : State_hash.Stable.V1.t t | Root_common : Root_data.Common.Stable.V2.t t | Root_new : Root_data.Common.Stable.V3.t t @@ -145,7 +145,7 @@ module Schema = struct | Arcs _ -> [%bin_type_class: State_hash.Stable.Latest.t list] | Root -> - [%bin_type_class: Root_data.Minimal.Stable.Latest.t] + [%bin_type_class: Root_data.Minimal.Stable.V2.t] | Root_hash -> [%bin_type_class: State_hash.Stable.Latest.t] | Root_common -> @@ -352,7 +352,8 @@ let get_root t = ~state_hash:hash ) | _ -> ( match get t.db ~key:Root ~error:(`Not_found `Root) with - | Ok root -> + | Ok root_old -> + let root = Root_data.Minimal.Stable.V2.to_latest root_old in (* automatically split Root into (Root_hash, Root_common) *) Batch.with_batch t.db ~f:(fun batch -> let hash = Root_data.Minimal.state_hash root in From 34e0505f8a3889d2535cd900bf8a90a9242c1011 Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 23:09:12 +0100 Subject: [PATCH 119/122] Fix bootstrap's RPC: use old scan state representation --- .../bootstrap_controller.ml | 7 +++++-- src/lib/staged_ledger/staged_ledger.mli | 6 ++++-- .../transaction_snark_scan_state.ml | 20 +++---------------- .../transaction_snark_scan_state.mli | 2 -- .../extensions/root_history.ml | 2 +- .../frontier_base/breadcrumb.ml | 5 ++++- .../frontier_base/network_types.ml | 3 +-- 7 files changed, 18 insertions(+), 27 deletions(-) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index f2281d27aba6..6b283da36eee 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -281,13 +281,13 @@ let download_snarked_ledger ~trust_system ~preferred_peers ~transition_graph let handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash ~temp_snarked_ledger ~verifier ~constraint_constants ~signature_kind t - (scan_state, expected_merkle_root, pending_coinbases, protocol_states) = + (scan_state_v2, expected_merkle_root, pending_coinbases, protocol_states) = let%map staged_ledger_construction_result = O1trace.thread "construct_root_staged_ledger" (fun () -> let open Deferred.Or_error.Let_syntax in let received_staged_ledger_hash = Staged_ledger_hash.of_aux_ledger_and_coinbase_hash - (Staged_ledger.Scan_state.Stable.Latest.hash scan_state) + (Staged_ledger.Scan_state.Stable.V2.hash scan_state_v2) expected_merkle_root pending_coinbases in [%log debug] @@ -313,6 +313,9 @@ let handle_scan_state_and_aux ~logger ~expected_staged_ledger_hash List.map protocol_states ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes) in + let scan_state = + Staged_ledger.Scan_state.Stable.V2.to_latest scan_state_v2 + in let%bind protocol_states = Staged_ledger.Scan_state.check_required_protocol_states scan_state ~protocol_states diff --git a/src/lib/staged_ledger/staged_ledger.mli b/src/lib/staged_ledger/staged_ledger.mli index d76ea4fdf913..995af255a047 100644 --- a/src/lib/staged_ledger/staged_ledger.mli +++ b/src/lib/staged_ledger/staged_ledger.mli @@ -66,14 +66,16 @@ module Scan_state : sig module V3 : sig type t - - val hash : t -> Staged_ledger_hash.Aux_hash.t end module V2 : sig type t + val hash : t -> Staged_ledger_hash.Aux_hash.t + val to_latest : t -> V3.t + + val of_latest_exn : V3.t -> t end end] 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 2245def122bc..fa155e61bcdc 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 @@ -36,13 +36,15 @@ module Transaction_with_witness = struct ; second_pass_ledger_witness : Mina_ledger.Sparse_ledger.Stable.V2.t ; block_global_slot : Mina_numbers.Global_slot_since_genesis.Stable.V1.t - (* TODO: in Mesa remove the option, just have the value *) ; previous_protocol_state_body_opt : Mina_state.Protocol_state.Body.Value.Stable.V2.t option + (* TODO: in Mesa remove the option, just have the value *) ; transaction_applied_tag : ( State_hash.Stable.V1.t , Mina_transaction_logic.Transaction_applied.Stable.V2.t ) Multi_key_file_storage.Tag.Stable.V1.t + (* TODO: in Mesa remove the field, after modifying + network synchronization and hash computation *) } let transaction_type t = @@ -545,7 +547,6 @@ let hash_generic ~serialize_ledger_proof_with_sok_message the snarked ledger*) [%%versioned module Stable = struct - (* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) module V3 = struct type t = { scan_state : @@ -557,21 +558,6 @@ module Stable = struct * [ `Border_block_continued_in_the_next_tree of bool ] } - (* Caution !!!: Don't merge to `compatible`, this is incompatible with the Berkeley network *) - let hash (t : t) = - hash_generic t.scan_state t.previous_incomplete_zkapp_updates - ~serialize_ledger_proof_with_sok_message: - ( Fn.compose - (Binable.to_string - (module Ledger_proof_with_sok_message.Stable.V2) ) - @@ Ledger_proof_with_sok_message.read_tag_exn - ~error_tag:"scan state hashing" ) - ~serialize_transaction_with_witness: - ( Fn.compose - (Binable.to_string (module Transaction_with_witness.Stable.V3)) - @@ Transaction_with_witness.read_tag_exn - ~error_tag:"scan state hashing" ) - let to_latest = Fn.id end 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 4aeb3a1c05ea..1d53b3849ba8 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 @@ -8,8 +8,6 @@ module Ledger = Mina_ledger.Ledger module Stable : sig module V3 : sig type t - - val hash : t -> Staged_ledger_hash.Aux_hash.t end module V2 : sig diff --git a/src/lib/transition_frontier/extensions/root_history.ml b/src/lib/transition_frontier/extensions/root_history.ml index b5fdd1240178..bea3d3633c5a 100644 --- a/src/lib/transition_frontier/extensions/root_history.ml +++ b/src/lib/transition_frontier/extensions/root_history.ml @@ -82,7 +82,7 @@ let staged_ledger_aux_and_pending_coinbases_of_breadcrumb Breadcrumb.staged_ledger_hash breadcrumb |> Staged_ledger_hash.ledger_hash in let data = - ( scan_state + ( Staged_ledger.Scan_state.Stable.V2.of_latest_exn scan_state , staged_ledger_target_ledger_hash , pending_coinbase , scan_state_protocol_states ) diff --git a/src/lib/transition_frontier/frontier_base/breadcrumb.ml b/src/lib/transition_frontier/frontier_base/breadcrumb.ml index 908bbe005c94..66a67a8a653b 100644 --- a/src/lib/transition_frontier/frontier_base/breadcrumb.ml +++ b/src/lib/transition_frontier/frontier_base/breadcrumb.ml @@ -386,7 +386,10 @@ let staged_ledger_aux_and_pending_coinbases_at_hash_compute ~f:(fun writer -> State_hash.File_storage.write_value writer (module Data) - (scan_state, merkle_root, pending_coinbase, protocol_states) ) + ( Staged_ledger.Scan_state.Stable.V2.of_latest_exn scan_state + , merkle_root + , pending_coinbase + , protocol_states ) ) let staged_ledger_aux_and_pending_coinbases ~scan_state_protocol_states breadcrumb : diff --git a/src/lib/transition_frontier/frontier_base/network_types.ml b/src/lib/transition_frontier/frontier_base/network_types.ml index b5756410b76d..2a921d423011 100644 --- a/src/lib/transition_frontier/frontier_base/network_types.ml +++ b/src/lib/transition_frontier/frontier_base/network_types.ml @@ -63,8 +63,7 @@ module Staged_ledger_aux_and_pending_coinbases = struct module V1 = struct type t = - (* TODO replace with V2 to fix the incorrect serialization issue *) - Staged_ledger.Scan_state.Stable.V3.t + Staged_ledger.Scan_state.Stable.V2.t * Ledger_hash.Stable.V1.t * Pending_coinbase.Stable.V2.t * Mina_state.Protocol_state.Value.Stable.V2.t list From 66aec9b87f17c0f1bbe9ec63884aef142633532e Mon Sep 17 00:00:00 2001 From: georgeee Date: Thu, 4 Dec 2025 23:34:28 +0100 Subject: [PATCH 120/122] Introduce root_history_capacity parameter to database.ml --- src/app/cli/src/init/fix_persistent_frontier.ml | 4 ++++ .../persistent_frontier/database.ml | 13 +++++++++---- .../persistent_frontier/database.mli | 3 ++- .../persistent_frontier/persistent_frontier.ml | 6 +++++- src/lib/transition_frontier/transition_frontier.ml | 5 +++-- src/lib/transition_frontier/transition_frontier.mli | 7 ------- src/lib/transition_router/transition_router.ml | 4 ++++ 7 files changed, 27 insertions(+), 15 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index 9d8b8b02409a..6b34d7da2112 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -173,6 +173,10 @@ let fix_persistent_frontier_root_do ~logger ~config_directory ~directory:chain_state_locations.frontier ~time_controller:(Block_time.Controller.basic ~logger) ~signature_kind + ~root_history_capacity: + ( 2 + * Transition_frontier.global_max_length + precomputed_values.genesis_constants ) in let proof_cache_db = Proof_cache_tag.create_identity_db () in let%bind.Deferred.Result persistent_frontier_root_hash = diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 8078fc09f192..05fda959dcac 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -309,12 +309,17 @@ end module Rocks = Rocksdb.Serializable.GADT.Make (Schema) -type t = { directory : string; logger : Logger.t; db : Rocks.t } - -let create ~logger ~directory = +type t = + { directory : string + ; logger : Logger.t + ; db : Rocks.t + ; root_history_capacity : int + } + +let create ~logger ~directory ~root_history_capacity = if not (Result.is_ok (Unix.access directory [ `Exists ])) then Unix.mkdir ~perm:0o766 directory ; - { directory; logger; db = Rocks.create directory } + { directory; logger; db = Rocks.create directory; root_history_capacity } let close t = Rocks.close t.db diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index 35bb4c0a90c9..320ceba86a20 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -45,7 +45,8 @@ module Error : sig val message : t -> string end -val create : logger:Logger.t -> directory:string -> t +val create : + logger:Logger.t -> directory:string -> root_history_capacity:int -> t val close : t -> unit diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 09dc9adfc50e..7641aa8e0be0 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -77,6 +77,7 @@ and Factory_type : sig ; verifier : Verifier.t ; time_controller : Block_time.Controller.t ; signature_kind : Mina_signature_kind.t + ; root_history_capacity : int ; mutable instance : Instance_type.t option } end = @@ -91,6 +92,7 @@ module Instance = struct let create factory = let db = Database.create ~logger:factory.logger ~directory:factory.directory + ~root_history_capacity:factory.root_history_capacity in { db; sync = None; factory } @@ -456,12 +458,14 @@ end type t = Factory_type.t -let create ~logger ~verifier ~time_controller ~directory ~signature_kind = +let create ~logger ~verifier ~time_controller ~directory ~signature_kind + ~root_history_capacity = { logger ; verifier ; time_controller ; directory ; signature_kind + ; root_history_capacity ; instance = None } diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index e649ea666c8b..3c2311376122 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -658,7 +658,7 @@ module For_tests = struct ~block_tag:genesis_block_tag ) let gen_persistence ?(logger = Logger.null ()) ~verifier - ~(precomputed_values : Precomputed_values.t) () = + ~(precomputed_values : Precomputed_values.t) ~max_length () = let open Core in let root_dir = "/tmp/coda_unit_test" in Quickcheck.Generator.create (fun ~size:_ ~random:_ -> @@ -693,6 +693,7 @@ module For_tests = struct Persistent_frontier.create ~logger ~verifier ~time_controller:(Block_time.Controller.basic ~logger) ~directory:frontier_dir ~signature_kind:Testnet + ~root_history_capacity:(max_length * 2) in Gc.Expert.add_finalizer_exn persistent_root clean_temp_dirs ; Gc.Expert.add_finalizer_exn persistent_frontier (fun x -> @@ -786,7 +787,7 @@ module For_tests = struct } in let%map persistent_root, persistent_frontier = - gen_persistence ~logger ~precomputed_values ~verifier () + gen_persistence ~logger ~precomputed_values ~verifier ~max_length () in Async.Thread_safe.block_on_async_exn (fun () -> Persistent_frontier.reset_database_exn persistent_frontier ~root_data diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 9a75b383faed..917a2756265d 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -141,13 +141,6 @@ module For_tests : sig -> unit -> Breadcrumb.t Quickcheck.Generator.t - val gen_persistence : - ?logger:Logger.t - -> verifier:Verifier.t - -> precomputed_values:Precomputed_values.t - -> unit - -> (Persistent_root.t * Persistent_frontier.t) Quickcheck.Generator.t - val gen : ?logger:Logger.t -> verifier:Verifier.t diff --git a/src/lib/transition_router/transition_router.ml b/src/lib/transition_router/transition_router.ml index cd5ef37d0599..b11c4f0eda35 100644 --- a/src/lib/transition_router/transition_router.ml +++ b/src/lib/transition_router/transition_router.ml @@ -618,6 +618,10 @@ let run ?(sync_local_state = true) ?(cache_exceptions = false) Transition_frontier.Persistent_frontier.create ~logger ~verifier ~time_controller ~directory:persistent_frontier_location ~signature_kind + ~root_history_capacity: + ( 2 + * Transition_frontier.global_max_length + precomputed_values.genesis_constants ) in let persistent_root = Transition_frontier.Persistent_root.create ~logger From ca126bb320ac2bebb18bc074ac34707f274b1c35 Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 5 Dec 2025 00:20:02 +0100 Subject: [PATCH 121/122] Keep root history in DB, garbage-collect disk data It's safe to remove multi-key file storage files only once corresponding blocks may not be possible referred by the Daemon. For orphan blocks it's ok to remove them during root transition. For old roots it's not the case, because entries in scan states may still be referring old blocks. Assumption: root history capacity (2k, or 580 blocks) ensures that any entry in scan state from the root transition will be referincing a block there. Also for root history structure in Daemon there is a similar guarantee. --- .../cli/src/init/fix_persistent_frontier.ml | 21 ++++++-- src/lib/mina_base/state_hash.ml | 6 ++- .../persistent_frontier/database.ml | 53 +++++++++++++++---- .../persistent_frontier/database.mli | 6 +++ .../persistent_frontier/worker.ml | 12 +++-- 5 files changed, 78 insertions(+), 20 deletions(-) diff --git a/src/app/cli/src/init/fix_persistent_frontier.ml b/src/app/cli/src/init/fix_persistent_frontier.ml index 6b34d7da2112..3b462c8ed585 100644 --- a/src/app/cli/src/init/fix_persistent_frontier.ml +++ b/src/app/cli/src/init/fix_persistent_frontier.ml @@ -55,20 +55,33 @@ let apply_root_transitions ~logger ~db diffs = .message err ) ) ) |> Result.ok_exn in + let initial_root_history = + Transition_frontier.Persistent_frontier.Database.get_root_history db + in + let root_history_capacity = + Transition_frontier.Persistent_frontier.Database.root_history_capacity db + in Transition_frontier.Persistent_frontier.Database.with_batch db ~f:(fun batch -> - ( List.fold diffs ~init:initial_root_hash ~f:(fun old_root_hash diff -> + ( List.fold diffs ~init:(initial_root_hash, initial_root_history) + ~f:(fun (old_root_hash, old_root_history) diff -> match diff with | Diff.Lite.E.E (Diff.Root_transitioned { new_root; garbage = Lite garbage; _ } ) -> Transition_frontier.Persistent_frontier.Database.move_root - ~old_root_hash ~new_root ~garbage batch ; + ~old_root_hash ~new_root ~garbage ~old_root_history + ~root_history_capacity batch ; (* Return new root hash for next iteration *) - new_root.state_hash + let old_root_history' = + if List.length old_root_history = root_history_capacity then + List.drop_last_exn old_root_history + else old_root_history + in + (new_root.state_hash, old_root_hash :: old_root_history') | _ -> failwith "Expected Root_transitioned diff" ) - : State_hash.t ) + : State_hash.t * State_hash.t list ) |> ignore ) ; [%log' info logger] "Successfully applied $count diffs" ~metadata:[ ("count", `Int (List.length diffs)) ] ; diff --git a/src/lib/mina_base/state_hash.ml b/src/lib/mina_base/state_hash.ml index 4876a3a3cbe0..99caef2c148c 100644 --- a/src/lib/mina_base/state_hash.ml +++ b/src/lib/mina_base/state_hash.ml @@ -84,9 +84,11 @@ module Tag = struct [%%define_locally Stable.Latest.(compare, equal, sexp_of_t, t_of_sexp)] end -module File_storage = Multi_key_file_storage.Make_custom (struct +module File_storage_filename = struct type filename_key = t (* TODO replace with hex string, pass directory parameter *) let filename h = T.to_decimal_string h ^ ".dat" -end) +end + +module File_storage = Multi_key_file_storage.Make_custom (File_storage_filename) diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index 05fda959dcac..e7fd5f4566a5 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -110,6 +110,7 @@ module Schema = struct | Best_tip : State_hash.Stable.V1.t t | Protocol_states_for_root_scan_state : Mina_state.Protocol_state.Value.Stable.V2.t list t + | Root_history : State_hash.Stable.V1.t list t [@@@warning "+22"] @@ -134,6 +135,8 @@ module Schema = struct "Best_tip" | Protocol_states_for_root_scan_state -> "Protocol_states_for_root_scan_state" + | Root_history -> + "Root_history" let binable_data_type (type a) : a t -> a Bin_prot.Type_class.t = function | Db_version -> @@ -156,6 +159,8 @@ module Schema = struct [%bin_type_class: State_hash.Stable.Latest.t] | Protocol_states_for_root_scan_state -> [%bin_type_class: Mina_state.Protocol_state.Value.Stable.Latest.t list] + | Root_history -> + [%bin_type_class: State_hash.Stable.Latest.t list] (* HACK: a simple way to derive Bin_prot.Type_class.t for each case of a GADT *) let gadt_input_type_class (type data a) : @@ -237,6 +242,11 @@ module Schema = struct ~to_gadt:(fun _ -> Protocol_states_for_root_scan_state) ~of_gadt:(fun Protocol_states_for_root_scan_state -> "protocol_states_in_root_scan_state" ) + | Root_history -> + gadt_input_type_class + (module Keys.String) + ~to_gadt:(fun _ -> Root_history) + ~of_gadt:(fun Root_history -> "root_history") end module Error = struct @@ -290,6 +300,8 @@ module Error = struct ("arcs", Some hash) | `Protocol_states_for_root_scan_state -> ("protocol states in root scan state", None) + | `Root_history -> + ("root history", None) in let additional_context = Option.map member_id ~f:(fun id -> @@ -316,6 +328,8 @@ type t = ; root_history_capacity : int } +let root_history_capacity t = t.root_history_capacity + let create ~logger ~directory ~root_history_capacity = if not (Result.is_ok (Unix.access directory [ `Exists ])) then Unix.mkdir ~perm:0o766 directory ; @@ -378,6 +392,13 @@ let get_root_hash t = | Error _ -> Result.map ~f:Root_data.Minimal.state_hash (get_root t) +let get_root_history t = + match get t.db ~key:Root_history ~error:(`Not_found `Root_history) with + | Ok history -> + history + | Error _ -> + [] + let get_transition_do t hash = let error = `Not_found (`Transition hash) in match get t.db ~key:(Transition_new hash) ~error with @@ -515,23 +536,35 @@ let add ~arcs_cache ~state_hash ~transition_data = Batch.set batch ~key:(Arcs state_hash) ~data:[] ; Batch.set batch ~key:(Arcs parent_hash) ~data:(state_hash :: parent_arcs) -let move_root ~old_root_hash ~new_root ~garbage = +let move_root ~old_root_hash ~old_root_history ~root_history_capacity ~new_root + ~garbage = let new_root_hash = new_root.Root_data.state_hash in + let root_for_removal_opt, old_root_history' = + if List.length old_root_history = root_history_capacity then + (List.last old_root_history, List.drop_last_exn old_root_history) + else (None, old_root_history) + in fun batch -> Batch.remove batch ~key:Root ; Batch.set batch ~key:Root_hash ~data:new_root_hash ; Batch.set batch ~key:Root_new ~data:(Root_data.to_common new_root) ; Batch.set batch ~key:Protocol_states_for_root_scan_state ~data:(List.map ~f:With_hash.data new_root.protocol_states_for_scan_state) ; - List.iter (old_root_hash :: garbage) ~f:(fun node_hash -> - (* because we are removing entire forks of the tree, there is - * no need to have extra logic to any remove arcs to the node - * we are deleting since there we are deleting all of a node's - * parents as well - *) - Batch.remove batch ~key:(Transition_new node_hash) ; - Batch.remove batch ~key:(Transition node_hash) ; - Batch.remove batch ~key:(Arcs node_hash) ) + Batch.set batch ~key:Root_history ~data:(old_root_hash :: old_root_history') ; + let remove node_hash = + (* because we are removing entire forks of the tree, there is + * no need to have extra logic to any remove arcs to the node + * we are deleting since there we are deleting all of a node's + * parents as well + *) + Batch.remove batch ~key:(Transition_new node_hash) ; + Batch.remove batch ~key:(Transition node_hash) ; + Batch.remove batch ~key:(Arcs node_hash) ; + (* TODO shouldn't be within DB batch *) + Core.Sys.remove @@ State_hash.File_storage_filename.filename node_hash + in + List.iter garbage ~f:remove ; + Option.iter root_for_removal_opt ~f:remove let get_transition_data ~signature_kind ~proof_cache_db t hash = match%map.Result get_transition_do t hash with diff --git a/src/lib/transition_frontier/persistent_frontier/database.mli b/src/lib/transition_frontier/persistent_frontier/database.mli index 320ceba86a20..0ebf4a31c602 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.mli +++ b/src/lib/transition_frontier/persistent_frontier/database.mli @@ -48,6 +48,8 @@ end val create : logger:Logger.t -> directory:string -> root_history_capacity:int -> t +val root_history_capacity : t -> int + val close : t -> unit val check : @@ -90,6 +92,8 @@ val add : val move_root : old_root_hash:State_hash.t + -> old_root_history:State_hash.t list + -> root_history_capacity:int -> new_root:Root_data.t -> garbage:State_hash.t list -> batch_t @@ -104,6 +108,8 @@ val get_transition : , [> `Not_found of [> `Transition of State_hash.t ] ] ) Result.t +val get_root_history : t -> State_hash.t list + val set_transition : state_hash:State_hash.t -> transition_data:Block_data.Full.t diff --git a/src/lib/transition_frontier/persistent_frontier/worker.ml b/src/lib/transition_frontier/persistent_frontier/worker.ml index 3c19aaf1a63f..67e6b9ef1516 100644 --- a/src/lib/transition_frontier/persistent_frontier/worker.ml +++ b/src/lib/transition_frontier/persistent_frontier/worker.ml @@ -34,13 +34,14 @@ module Worker = struct (* nothing to close *) let close _ = Deferred.unit - let apply_diff (type mutant) ~old_root_hash ~arcs_cache - (diff : mutant Diff.Lite.t) : Database.batch_t -> unit = + let apply_diff (type mutant) ~old_root_hash ~arcs_cache ~root_history_capacity + ~old_root_history (diff : mutant Diff.Lite.t) : Database.batch_t -> unit = match diff with | New_node (Lite (state_hash, transition_data)) -> Database.add ~arcs_cache ~state_hash ~transition_data | Root_transitioned { new_root; garbage = Lite garbage; _ } -> - Database.move_root ~old_root_hash ~new_root ~garbage + Database.move_root ~old_root_hash ~old_root_history + ~root_history_capacity ~new_root ~garbage | Best_tip_changed best_tip_hash -> Database.set_best_tip best_tip_hash @@ -109,8 +110,11 @@ module Worker = struct let%map.Result old_root_hash = Database.find_arcs_and_root t.db ~arcs_cache ~parent_hashes in + let old_root_history = Database.get_root_history t.db in List.map diffs_to_apply ~f:(fun (Diff.Lite.E.E diff) -> - apply_diff ~old_root_hash ~arcs_cache diff ) + apply_diff + ~root_history_capacity:(Database.root_history_capacity t.db) + ~old_root_hash ~arcs_cache ~old_root_history diff ) in let handle_emitted_proof = function | { Diff.Root_transition.just_emitted_a_proof = true; _ } -> From a0dbef4d6095a6c007d43c45068c45c3de664a8a Mon Sep 17 00:00:00 2001 From: georgeee Date: Fri, 5 Dec 2025 23:33:48 +0100 Subject: [PATCH 122/122] Fix Database.check Do not assume `Transition` entry for the root (now root breadcrumb is built entirely from root data). --- .../frontier_base/root_data.ml | 4 ++ .../frontier_base/root_data.mli | 2 + .../persistent_frontier/database.ml | 43 ++++++++++++------- 3 files changed, 34 insertions(+), 15 deletions(-) diff --git a/src/lib/transition_frontier/frontier_base/root_data.ml b/src/lib/transition_frontier/frontier_base/root_data.ml index b762d0a7522f..e973c0b07129 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.ml +++ b/src/lib/transition_frontier/frontier_base/root_data.ml @@ -4,6 +4,7 @@ open Mina_base module Common = struct [%%versioned module Stable = struct + (* TODO: split out V3 as a new type, remove the "option" from [block_data_opt] *) module V3 = struct type t = { scan_state : Staged_ledger.Scan_state.Stable.V3.t @@ -35,6 +36,9 @@ module Common = struct let scan_state t = t.scan_state let pending_coinbase t = t.pending_coinbase + + let protocol_state t = + Option.map t.block_data_opt ~f:(fun t -> t.protocol_state) end module Historical = struct diff --git a/src/lib/transition_frontier/frontier_base/root_data.mli b/src/lib/transition_frontier/frontier_base/root_data.mli index 494766b759f7..559d0df749a0 100644 --- a/src/lib/transition_frontier/frontier_base/root_data.mli +++ b/src/lib/transition_frontier/frontier_base/root_data.mli @@ -19,6 +19,8 @@ module Common : sig -> pending_coinbase:Pending_coinbase.t -> block_data_opt:Block_data.t option -> t + + val protocol_state : t -> Mina_state.Protocol_state.Value.t option end (* Historical root data is similar to Limited root data, except that it also diff --git a/src/lib/transition_frontier/persistent_frontier/database.ml b/src/lib/transition_frontier/persistent_frontier/database.ml index e7fd5f4566a5..7ba36a9897cd 100644 --- a/src/lib/transition_frontier/persistent_frontier/database.ml +++ b/src/lib/transition_frontier/persistent_frontier/database.ml @@ -429,21 +429,39 @@ let check ?(check_arcs = true) t ~genesis_state_hash = let%bind best_tip = get t.db ~key:Best_tip ~error:(`Corrupt (`Not_found `Best_tip)) in - let%bind root_transition = - get_transition_do t root_hash - |> Result.map_error - ~f:(const @@ `Corrupt (`Not_found `Root_transition)) + let%bind root_protocol_state = + match + get t.db ~key:Root_new ~error:() + |> Result.map ~f:Root_data.Common.protocol_state + with + | Ok (Some protocol_state) -> + Ok protocol_state + | Ok None | Error () -> + get_transition_do t root_hash + |> Result.map_error + ~f:(const @@ `Corrupt (`Not_found `Root_transition)) + |> Result.map + ~f: + (Fn.compose Mina_block.Header.protocol_state + Transition.header ) in let%bind _ = get t.db ~key:Protocol_states_for_root_scan_state ~error:(`Corrupt (`Not_found `Protocol_states_for_root_scan_state)) in let%map _ = - get_transition_do t best_tip - |> Result.map_error - ~f:(const @@ `Corrupt (`Not_found `Best_tip_transition)) + if Frozen_ledger_hash.equal best_tip root_hash then + (* in case best tip is the root, its data is fully + stored in the root data, nothing is stored as a separate + transition *) + Ok () + else + get_transition_do t best_tip + |> Result.map_error + ~f:(const @@ `Corrupt (`Not_found `Best_tip_transition)) + |> Result.ignore_m in - (root_hash, root_transition) + (root_hash, root_protocol_state) in let rec check_arcs_do pred_hash = let%bind successors = @@ -459,10 +477,7 @@ let check ?(check_arcs = true) t ~genesis_state_hash = check_arcs_do succ_hash ) in let%bind () = check_version () in - let%bind root_hash, root_block = check_base () in - let root_protocol_state = - Transition.header root_block |> Mina_block.Header.protocol_state - in + let%bind root_hash, root_protocol_state = check_base () in let%bind () = let persisted_genesis_state_hash = Mina_state.Protocol_state.genesis_state_hash root_protocol_state @@ -472,9 +487,7 @@ let check ?(check_arcs = true) t ~genesis_state_hash = else Error (`Genesis_state_mismatch persisted_genesis_state_hash) in let%map () = if check_arcs then check_arcs_do root_hash else Ok () in - Transition.header root_block - |> Mina_block.Header.protocol_state - |> Mina_state.Protocol_state.blockchain_state + Mina_state.Protocol_state.blockchain_state root_protocol_state |> Mina_state.Blockchain_state.snarked_ledger_hash ) |> Result.map_error ~f:(fun err -> `Corrupt (`Raised err)) |> Result.join