3547

Committed 30 Mar 2025 06:05PM UTC coverage: 60.798% (+0.02%) from 60.782%

Build # 3547

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16767 from MinaProtocol/dkijania/bench_for_ledger_test

[CI] Test ledger apply in benchmarks

Run Details

20 of 21 new or added lines in 2 files covered. (95.24%)

4 existing lines in 3 files now uncovered.

49923 of 82113 relevant lines covered (60.8%)

478807.27 hits per line

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

85.15

/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 ~event_elements ~action_elements
    ~(constraint_constants : Genesis_constants.Constraint_constants.t) keypair
    nonce =
  let num_acc_updates = 8 in
  let multispec : Transaction_snark.For_tests.Multiple_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
           ( Signature_lib.Public_key.compress kp.public_key
           , 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
    ; call_data
    ; preconditions
    }
  in
  Transaction_snark.For_tests.multiple_transfers ~constraint_constants multispec

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

MinaProtocol / mina / 3547

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