MinaProtocol / mina / 535

Committed 25 Aug 2025 05:35PM UTC coverage: 32.09% (-28.7%) from 60.772%

Build # 535

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17673 from MinaProtocol/amcie-merge-release320-to-master

amcie-merge-release320-to-master

Run Details

1010 of 3745 new or added lines in 242 files covered. (26.97%)

17403 existing lines in 378 files now uncovered.

23062 of 71866 relevant lines covered (32.09%)

24742.7 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

85.44

/src/app/cli/src/init/test_ledger_application.ml

(* test_ledger_application.ml -- code to test application of transactions to a specific ledger *)

open Core_kernel
open Async_kernel
open Mina_ledger
open Mina_base
open Mina_state

let logger = Logger.create ()

let read_privkey privkey_path =
  let password =
    lazy (Secrets.Keypair.Terminal_stdin.prompt_password "Enter password: ")
  in
  match%map Secrets.Keypair.read ~privkey_path ~password with
  | Ok keypair ->
      keypair
  | Error err ->
      eprintf "Could not read the specified keypair: %s\n"
        (Secrets.Privkey_error.to_string err) ;
      exit 1

let generate_event =
  Snark_params.Tick.Field.gen |> Quickcheck.Generator.map ~f:(fun x -> [| x |])

let mk_tx ~transfer_parties_get_actions_events ~event_elements ~action_elements
    ~(constraint_constants : Genesis_constants.Constraint_constants.t) keypair
    nonce =
  let num_acc_updates = 8 in
  let signaturespec : Transaction_snark.For_tests.Signature_transfers_spec.t =
    let fee_payer = None in
    let generated_values =
      let open Base_quickcheck.Generator.Let_syntax in
      let%bind receivers =
        Base_quickcheck.Generator.list_with_length ~length:num_acc_updates
        @@ let%map kp = Signature_lib.Keypair.gen in
           (First kp, Currency.Amount.zero)
      in
      let%bind events =
        Quickcheck.Generator.list_with_length event_elements generate_event
      in
      let%map actions =
        Quickcheck.Generator.list_with_length action_elements generate_event
      in
      (receivers, events, actions)
    in
    let receivers, events, actions =
      Quickcheck.random_value
        ~seed:(`Deterministic ("test-apply-" ^ Unsigned.UInt32.to_string nonce))
        generated_values
    in
    let zkapp_account_keypairs = [] in
    let new_zkapp_account = false in
    let snapp_update = Account_update.Update.dummy in
    let call_data = Snark_params.Tick.Field.zero in
    let preconditions = Some Account_update.Preconditions.accept in
    { fee = Currency.Fee.of_mina_int_exn 1
    ; sender = (keypair, nonce)
    ; fee_payer
    ; receivers
    ; amount =
        Currency.Amount.(
          scale
            (of_fee constraint_constants.account_creation_fee)
            num_acc_updates)
        |> Option.value_exn ~here:[%here]
    ; zkapp_account_keypairs
    ; memo = Signed_command_memo.empty
    ; new_zkapp_account
    ; snapp_update
    ; actions
    ; events
    ; transfer_parties_get_actions_events
    ; call_data
    ; preconditions
    }
  in
  let receiver_auth =
    if transfer_parties_get_actions_events then Some Control.Tag.Signature
    else None
  in
  Transaction_snark.For_tests.signature_transfers ?receiver_auth
    ~constraint_constants signaturespec

let generate_protocol_state_stub ~consensus_constants ~constraint_constants
    ledger =
  let open Staged_ledger_diff in
  Protocol_state.negative_one
    ~genesis_ledger:(lazy ledger)
    ~genesis_epoch_data:None ~constraint_constants ~consensus_constants
    ~genesis_body_reference

let apply_txs ~transfer_parties_get_actions_events ~action_elements
    ~event_elements ~constraint_constants ~first_partition_slots ~no_new_stack
    ~has_second_partition ~num_txs ~prev_protocol_state
    ~(keypair : Signature_lib.Keypair.t) ~i ledger =
  let init_nonce =
    let account_id = Account_id.of_public_key keypair.public_key in
    let loc =
      Ledger.location_of_account ledger account_id
      |> Option.value_exn ~here:[%here]
    in
    let account = Ledger.get ledger loc |> Option.value_exn ~here:[%here] in
    account.nonce
  in
  let to_nonce =
    Fn.compose (Unsigned.UInt32.add init_nonce) Unsigned.UInt32.of_int
  in
  let mk_tx' =
    mk_tx ~transfer_parties_get_actions_events ~action_elements ~event_elements
      ~constraint_constants keypair
  in
  let fork_slot =
    Option.value_map ~default:Mina_numbers.Global_slot_since_genesis.zero
      ~f:(fun f -> f.global_slot_since_genesis)
      constraint_constants.fork
  in
  let prev_protocol_state_body_hash =
    Protocol_state.body prev_protocol_state |> Protocol_state.Body.hash
  in
  let prev_protocol_state_hash =
    (Protocol_state.hashes_with_body ~body_hash:prev_protocol_state_body_hash
       prev_protocol_state )
      .state_hash
  in
  let prev_state_view =
    Protocol_state.body prev_protocol_state
    |> Mina_state.Protocol_state.Body.view
  in
  let global_slot =
    Protocol_state.consensus_state prev_protocol_state
    |> Consensus.Data.Consensus_state.curr_global_slot
    |> Mina_numbers.Global_slot_since_hard_fork.succ
    |> Mina_numbers.Global_slot_since_hard_fork.to_int
    |> Mina_numbers.Global_slot_span.of_int
    |> Mina_numbers.Global_slot_since_genesis.add fork_slot
  in
  let zkapps = List.init num_txs ~f:(Fn.compose mk_tx' to_nonce) in
  let pending_coinbase =
    Pending_coinbase.create ~depth:constraint_constants.pending_coinbase_depth
      ()
    |> Or_error.ok_exn
  in
  let zkapps' =
    List.map zkapps ~f:(fun tx ->
        { With_status.data =
            Mina_transaction.Transaction.Command (User_command.Zkapp_command tx)
        ; status = Applied
        } )
  in
  let accounts_accessed =
    List.fold_left ~init:Account_id.Set.empty zkapps ~f:(fun set txn ->
        Account_id.Set.(
          union set (of_list (Zkapp_command.accounts_referenced txn))) )
    |> Set.to_list
  in
  Ledger.unsafe_preload_accounts_from_parent ledger accounts_accessed ;
  let start = Time.now () in
  match%map
    Staged_ledger.Test_helpers.update_coinbase_stack_and_get_data_impl
      ~first_partition_slots ~is_new_stack:(not no_new_stack)
      ~no_second_partition:(not has_second_partition) ~constraint_constants
      ~logger ~global_slot ledger pending_coinbase zkapps' prev_state_view
      (prev_protocol_state_hash, prev_protocol_state_body_hash)
  with
  | Ok (b, _, _, _, _) ->
      let root = Ledger.merkle_root ledger in
      let elapsed = Time.diff (Time.now ()) start in
      printf
        !"Result of application %d: %B (took %s): new root %s\n%!"
        i b
        Time.(Span.to_string elapsed)
        (Ledger_hash.to_base58_check root) ;
      elapsed
  | Error e ->
      eprintf
        !"Error applying staged ledger: %s\n%!"
        (Staged_ledger.Staged_ledger_error.to_string e) ;
      exit 1

let test ~privkey_path ~ledger_path ?prev_block_path ~first_partition_slots
    ~no_new_stack ~has_second_partition ~num_txs_per_round ~rounds ~no_masks
    ~max_depth ~tracing ~transfer_parties_get_actions_events num_txs_final
    ~benchmark ~(genesis_constants : Genesis_constants.t)
    ~(constraint_constants : Genesis_constants.Constraint_constants.t) =
  O1trace.thread "mina"
  @@ fun () ->
  let%bind keypair = read_privkey privkey_path in
  let init_ledger =
    Ledger.create ~directory_name:ledger_path
      ~depth:constraint_constants.ledger_depth ()
  in
  let prev_protocol_state =
    let%map.Option prev_block_path = prev_block_path in
    let prev_block_data = In_channel.read_all prev_block_path in
    let prev_block =
      Binable.of_string (module Mina_block.Stable.Latest) prev_block_data
    in
    Mina_block.Stable.Latest.header prev_block
    |> Mina_block.Header.protocol_state
  in
  let consensus_constants =
    Consensus.Constants.create ~constraint_constants
      ~protocol_constants:genesis_constants.protocol
  in
  let prev_protocol_state =
    match prev_protocol_state with
    | None ->
        generate_protocol_state_stub ~consensus_constants ~constraint_constants
          init_ledger
    | Some p ->
        p
  in
  let apply =
    apply_txs ~constraint_constants ~first_partition_slots ~no_new_stack
      ~has_second_partition ~prev_protocol_state ~keypair
  in
  let mask_handler ledger =
    if no_masks then Fn.const ledger
    else
      Fn.compose (Ledger.register_mask ledger)
      @@ Ledger.Mask.create ~depth:constraint_constants.ledger_depth
  in
  let drop_old_ledger ledger =
    if not no_masks then (
      Ledger.commit ledger ;
      Ledger.remove_and_reparent_exn ledger ledger )
  in
  let stop_tracing =
    if tracing then (fun x -> Mina_tracing.stop () ; x) else ident
  in
  let results = ref [] in
  let init_root = Ledger.merkle_root init_ledger in
  let save_preparation_times time =
    if Option.is_some benchmark then results := time :: !results
  in
  let save_and_dump_benchmarks final_time =
    let calculate_mean preparation_steps =
      let prep_steps_len = Float.of_int (List.length preparation_steps) in
      let prep_steps_total_time =
        List.fold preparation_steps ~init:Float.zero ~f:(fun acc time ->
            acc +. Time.Span.to_ms time )
      in
      prep_steps_total_time /. prep_steps_len
    in
    match benchmark with
    | Some benchmark ->
        let preparation_steps_mean = calculate_mean !results in
        let json =
          `Assoc
            [ ( "final_time"
              , `String (Printf.sprintf "%.2f" (Time.Span.to_ms final_time)) )
            ; ( "preparation_steps_mean"
              , `String (Printf.sprintf "%.2f" preparation_steps_mean) )
            ]
        in
        Yojson.Safe.to_file benchmark json
    | None ->
        ()
  in
  printf !"Init root %s\n%!" (Ledger_hash.to_base58_check init_root) ;
  Deferred.List.fold (List.init rounds ~f:ident) ~init:(init_ledger, [])
    ~f:(fun (ledger, ledgers) i ->
      let%bind () =
        if tracing && i = 1 then Mina_tracing.start "." else Deferred.unit
      in
      List.hd (List.drop ledgers (max_depth - 1))
      |> Option.iter ~f:drop_old_ledger ;
      apply ~transfer_parties_get_actions_events:false ~action_elements:0
        ~event_elements:0 ~num_txs:num_txs_per_round ~i ledger
      >>| save_preparation_times >>| mask_handler ledger
      >>| Fn.flip Tuple2.create (ledger :: ledgers) )
  >>| fst
  >>= apply ~transfer_parties_get_actions_events ~num_txs:num_txs_final
        ~action_elements:genesis_constants.max_action_elements
        ~event_elements:genesis_constants.max_event_elements ~i:rounds
  >>| stop_tracing >>| save_and_dump_benchmarks

1	(* test_ledger_application.ml -- code to test application of transactions to a specific ledger *)
2		51✔
3	open Core_kernel
4	open Async_kernel
5	open Mina_ledger
6	open Mina_base
7	open Mina_state
8
9	let logger = Logger.create ()	51✔
10
11	let read_privkey privkey_path =
12	let password =	2✔
13	lazy (Secrets.Keypair.Terminal_stdin.prompt_password "Enter password: ")	2✔
14	in
15	match%map Secrets.Keypair.read ~privkey_path ~password with
16	\| Ok keypair ->	2✔
17	keypair
18	\| Error err ->	×
19	eprintf "Could not read the specified keypair: %s\n"
20	(Secrets.Privkey_error.to_string err) ;	×
21	exit 1	×
22
23	let generate_event =
24	Snark_params.Tick.Field.gen \|> Quickcheck.Generator.map ~f:(fun x -> [\| x \|])	6✔
25
26	let mk_tx ~transfer_parties_get_actions_events ~event_elements ~action_elements
27	~(constraint_constants : Genesis_constants.Constraint_constants.t) keypair
28	nonce =
29	let num_acc_updates = 8 in	3,880✔
30	let signaturespec : Transaction_snark.For_tests.Signature_transfers_spec.t =
31	let fee_payer = None in
32	let generated_values =
33	let open Base_quickcheck.Generator.Let_syntax in
34	let%bind receivers =
35	Base_quickcheck.Generator.list_with_length ~length:num_acc_updates	3,880✔
36	@@ let%map kp = Signature_lib.Keypair.gen in
37	(First kp, Currency.Amount.zero)	31,040✔
38	in
39	let%bind events =
40	Quickcheck.Generator.list_with_length event_elements generate_event	3,880✔
41	in
42	let%map actions =
43	Quickcheck.Generator.list_with_length action_elements generate_event	3,880✔
44	in
45	(receivers, events, actions)	3,880✔
46	in
47	let receivers, events, actions =
48	Quickcheck.random_value
49	~seed:(`Deterministic ("test-apply-" ^ Unsigned.UInt32.to_string nonce))	3,880✔
50	generated_values
51	in
52	let zkapp_account_keypairs = [] in	3,880✔
53	let new_zkapp_account = false in
54	let snapp_update = Account_update.Update.dummy in
55	let call_data = Snark_params.Tick.Field.zero in
56	let preconditions = Some Account_update.Preconditions.accept in
57	{ fee = Currency.Fee.of_mina_int_exn 1	3,880✔
58	; sender = (keypair, nonce)
59	; fee_payer
60	; receivers
61	; amount =
62	Currency.Amount.(
63	scale	3,880✔
64	(of_fee constraint_constants.account_creation_fee)	3,880✔
65	num_acc_updates)
66	\|> Option.value_exn ~here:[%here]	3,880✔
67	; zkapp_account_keypairs
68	; memo = Signed_command_memo.empty
69	; new_zkapp_account
70	; snapp_update
71	; actions
72	; events
73	; transfer_parties_get_actions_events
74	; call_data
75	; preconditions
76	}
77	in
78	let receiver_auth =
79	if transfer_parties_get_actions_events then Some Control.Tag.Signature	400✔
80	else None	3,480✔
81	in
82	Transaction_snark.For_tests.signature_transfers ?receiver_auth
83	~constraint_constants signaturespec
84
85	let generate_protocol_state_stub ~consensus_constants ~constraint_constants
86	ledger =
87	let open Staged_ledger_diff in	2✔
88	Protocol_state.negative_one
89	~genesis_ledger:(lazy ledger)
90	~genesis_epoch_data:None ~constraint_constants ~consensus_constants
91	~genesis_body_reference
92
93	let apply_txs ~transfer_parties_get_actions_events ~action_elements
94	~event_elements ~constraint_constants ~first_partition_slots ~no_new_stack
95	~has_second_partition ~num_txs ~prev_protocol_state
96	~(keypair : Signature_lib.Keypair.t) ~i ledger =
97	let init_nonce =	1,162✔
98	let account_id = Account_id.of_public_key keypair.public_key in
99	let loc =	1,162✔
100	Ledger.location_of_account ledger account_id	1,162✔
101	\|> Option.value_exn ~here:[%here]
102	in
103	let account = Ledger.get ledger loc \|> Option.value_exn ~here:[%here] in	1,162✔
104	account.nonce	1,162✔
105	in
106	let to_nonce =
107	Fn.compose (Unsigned.UInt32.add init_nonce) Unsigned.UInt32.of_int	1,162✔
108	in
109	let mk_tx' =	1,162✔
110	mk_tx ~transfer_parties_get_actions_events ~action_elements ~event_elements
111	~constraint_constants keypair
112	in
113	let fork_slot =	1,162✔
114	Option.value_map ~default:Mina_numbers.Global_slot_since_genesis.zero
115	~f:(fun f -> f.global_slot_since_genesis)	×
116	constraint_constants.fork
117	in
118	let prev_protocol_state_body_hash =	1,162✔
119	Protocol_state.body prev_protocol_state \|> Protocol_state.Body.hash	1,162✔
120	in
121	let prev_protocol_state_hash =	1,162✔
122	(Protocol_state.hashes_with_body ~body_hash:prev_protocol_state_body_hash	1,162✔
123	prev_protocol_state )
124	.state_hash
125	in
126	let prev_state_view =
127	Protocol_state.body prev_protocol_state	1,162✔
128	\|> Mina_state.Protocol_state.Body.view
129	in
130	let global_slot =	1,162✔
131	Protocol_state.consensus_state prev_protocol_state	1,162✔
132	\|> Consensus.Data.Consensus_state.curr_global_slot	1,162✔
133	\|> Mina_numbers.Global_slot_since_hard_fork.succ	1,162✔
134	\|> Mina_numbers.Global_slot_since_hard_fork.to_int	1,162✔
135	\|> Mina_numbers.Global_slot_span.of_int	1,162✔
136	\|> Mina_numbers.Global_slot_since_genesis.add fork_slot
137	in
138	let zkapps = List.init num_txs ~f:(Fn.compose mk_tx' to_nonce) in	1,162✔
139	let pending_coinbase =	1,162✔
140	Pending_coinbase.create ~depth:constraint_constants.pending_coinbase_depth	1,162✔
141	()
142	\|> Or_error.ok_exn
143	in
144	let zkapps' =	1,162✔
145	List.map zkapps ~f:(fun tx ->
146	{ With_status.data =	3,880✔
147	Mina_transaction.Transaction.Command (User_command.Zkapp_command tx)
148	; status = Applied
149	} )
150	in
151	let accounts_accessed =	1,162✔
152	List.fold_left ~init:Account_id.Set.empty zkapps ~f:(fun set txn ->	1,162✔
153	Account_id.Set.(	3,880✔
154	union set (of_list (Zkapp_command.accounts_referenced txn))) )	3,880✔
155	\|> Set.to_list
156	in
157	Ledger.unsafe_preload_accounts_from_parent ledger accounts_accessed ;	1,162✔
158	let start = Time.now () in	1,162✔
159	match%map
160	Staged_ledger.Test_helpers.update_coinbase_stack_and_get_data_impl	1,162✔
161	~first_partition_slots ~is_new_stack:(not no_new_stack)
162	~no_second_partition:(not has_second_partition) ~constraint_constants
163	~logger ~global_slot ledger pending_coinbase zkapps' prev_state_view
164	(prev_protocol_state_hash, prev_protocol_state_body_hash)
165	with
166	\| Ok (b, _, _, _, _) ->	1,162✔
167	let root = Ledger.merkle_root ledger in
168	let elapsed = Time.diff (Time.now ()) start in	1,162✔
169	printf	1,162✔
170	!"Result of application %d: %B (took %s): new root %s\n%!"
171	i b
172	Time.(Span.to_string elapsed)	1,162✔
173	(Ledger_hash.to_base58_check root) ;	1,162✔
174	elapsed	1,162✔
UNCOV 175	\| Error e ->	×
176	eprintf
177	!"Error applying staged ledger: %s\n%!"
178	(Staged_ledger.Staged_ledger_error.to_string e) ;	×
179	exit 1	×
180
181	let test ~privkey_path ~ledger_path ?prev_block_path ~first_partition_slots
182	~no_new_stack ~has_second_partition ~num_txs_per_round ~rounds ~no_masks
183	~max_depth ~tracing ~transfer_parties_get_actions_events num_txs_final
184	~benchmark ~(genesis_constants : Genesis_constants.t)
185	~(constraint_constants : Genesis_constants.Constraint_constants.t) =
186	O1trace.thread "mina"	2✔
187	@@ fun () ->
188	let%bind keypair = read_privkey privkey_path in	2✔
189	let init_ledger =	2✔
190	Ledger.create ~directory_name:ledger_path
191	~depth:constraint_constants.ledger_depth ()
192	in
193	let prev_protocol_state =	2✔
194	let%map.Option prev_block_path = prev_block_path in
195	let prev_block_data = In_channel.read_all prev_block_path in	×
196	let prev_block =	×
197	Binable.of_string (module Mina_block.Stable.Latest) prev_block_data
198	in
NEW 199	Mina_block.Stable.Latest.header prev_block	×
200	\|> Mina_block.Header.protocol_state
201	in
202	let consensus_constants =	2✔
203	Consensus.Constants.create ~constraint_constants
204	~protocol_constants:genesis_constants.protocol
205	in
206	let prev_protocol_state =
207	match prev_protocol_state with
208	\| None ->	2✔
209	generate_protocol_state_stub ~consensus_constants ~constraint_constants	2✔
210	init_ledger
211	\| Some p ->	×
212	p
213	in
214	let apply =
215	apply_txs ~constraint_constants ~first_partition_slots ~no_new_stack
216	~has_second_partition ~prev_protocol_state ~keypair
217	in
218	let mask_handler ledger =
219	if no_masks then Fn.const ledger	×
220	else
221	Fn.compose (Ledger.register_mask ledger)	1,160✔
222	@@ Ledger.Mask.create ~depth:constraint_constants.ledger_depth
223	in
224	let drop_old_ledger ledger =
225	if not no_masks then (	580✔
226	Ledger.commit ledger ;
227	Ledger.remove_and_reparent_exn ledger ledger )	580✔
228	in
229	let stop_tracing =
230	if tracing then (fun x -> Mina_tracing.stop () ; x) else ident	×
231	in
232	let results = ref [] in
233	let init_root = Ledger.merkle_root init_ledger in
234	let save_preparation_times time =	2✔
235	if Option.is_some benchmark then results := time :: !results	1,160✔
236	in
237	let save_and_dump_benchmarks final_time =
238	let calculate_mean preparation_steps =	2✔
239	let prep_steps_len = Float.of_int (List.length preparation_steps) in	2✔
240	let prep_steps_total_time =	2✔
241	List.fold preparation_steps ~init:Float.zero ~f:(fun acc time ->
242	acc +. Time.Span.to_ms time )	1,160✔
243	in
244	prep_steps_total_time /. prep_steps_len	2✔
245	in
246	match benchmark with
247	\| Some benchmark ->	2✔
248	let preparation_steps_mean = calculate_mean !results in
249	let json =	2✔
250	`Assoc
251	[ ( "final_time"
252	, `String (Printf.sprintf "%.2f" (Time.Span.to_ms final_time)) )	2✔
253	; ( "preparation_steps_mean"
254	, `String (Printf.sprintf "%.2f" preparation_steps_mean) )	2✔
255	]
256	in
257	Yojson.Safe.to_file benchmark json
NEW 258	\| None ->	×
259	()
260	in
261	printf !"Init root %s\n%!" (Ledger_hash.to_base58_check init_root) ;	2✔
262	Deferred.List.fold (List.init rounds ~f:ident) ~init:(init_ledger, [])	2✔
263	~f:(fun (ledger, ledgers) i ->
264	let%bind () =
265	if tracing && i = 1 then Mina_tracing.start "." else Deferred.unit	×
266	in
267	List.hd (List.drop ledgers (max_depth - 1))	1,160✔
268	\|> Option.iter ~f:drop_old_ledger ;
269	apply ~transfer_parties_get_actions_events:false ~action_elements:0	1,160✔
270	~event_elements:0 ~num_txs:num_txs_per_round ~i ledger
271	>>\| save_preparation_times >>\| mask_handler ledger	1,160✔
272	>>\| Fn.flip Tuple2.create (ledger :: ledgers) )	1,160✔
273	>>\| fst	2✔
274	>>= apply ~transfer_parties_get_actions_events ~num_txs:num_txs_final	2✔
275	~action_elements:genesis_constants.max_action_elements
276	~event_elements:genesis_constants.max_event_elements ~i:rounds
277	>>\| stop_tracing >>\| save_and_dump_benchmarks	2✔

MinaProtocol / mina / 535

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous