MinaProtocol / mina / 584

Committed 11 Sep 2025 07:15PM UTC coverage: 14.436% (-19.8%) from 34.248%

Build # 584

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17778 from MinaProtocol/dkijania/publish_mina_logproc

[CI] Publish logproc in nightly

Run Details

9561 of 66228 relevant lines covered (14.44%)

279.58 hits per line

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

1.92

/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: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 ~signature_kind:Mina_signature_kind.Testnet 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 module Test_genesis_ledger = Genesis_ledger.Make (struct
    include Test_genesis_ledger

    let directory = `Path ledger_path

    let depth = constraint_constants.ledger_depth

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

MinaProtocol / mina / 584

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