From b5b3234ea3ea0503224d9030aed071bbb119d1c9 Mon Sep 17 00:00:00 2001 From: Quantifier Date: Tue, 4 Jul 2023 20:08:31 +0000 Subject: [PATCH] (test) Continue rewriting --- .../block_production_priority.ml | 16 ++---- ...ock_production_timed_accounts_test.ml.todo | 14 ++--- src/app/test_executive/block_reward_test.ml | 14 +---- .../test_executive/chain_reliability_test.ml | 16 ++---- src/app/test_executive/delegation_test.ml | 19 ++----- src/app/test_executive/gossip_consistency.ml | 14 +---- src/app/test_executive/medium_bootstrap.ml | 21 ++----- src/app/test_executive/payments_test.ml | 52 +++++------------ .../test_executive/peers_reliability_test.ml | 41 ++++--------- src/app/test_executive/snarkyjs.ml | 17 ++---- .../test_executive/verification_key_update.ml | 45 ++++----------- src/app/test_executive/zkapps.ml | 57 +++++++------------ src/app/test_executive/zkapps_nonce_test.ml | 53 ++++++----------- src/app/test_executive/zkapps_timing.ml | 54 +++++++----------- 14 files changed, 126 insertions(+), 307 deletions(-) diff --git a/src/app/test_executive/block_production_priority.ml b/src/app/test_executive/block_production_priority.ml index 76b0dfd978e..c51931ef13c 100644 --- a/src/app/test_executive/block_production_priority.ml +++ b/src/app/test_executive/block_production_priority.ml @@ -2,19 +2,11 @@ open Core open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "block-prod-prio" let num_extra_keys = 1000 @@ -112,7 +104,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let window_ms = (Network.constraint_constants network).block_window_duration_ms in - let%bind () = Wait_for.all_nodes_to_initialize network t in + let%bind () = Wait_for.all_nodes_to_initialize t network in let%bind () = section_hard "wait for 3 blocks to be produced (warm-up)" (Wait_for.blocks_to_be_produced t 3) @@ -222,7 +214,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct [%log info] "Observer %s started again, will now wait for this node to initialize" (Network.Node.id observer) ; - let%bind () = Wait_for.node_to_initialize t observer in + let%bind () = Wait_for.nodes_to_initialize t [ observer ] in Wait_for.with_timeouts t ~condition:(Wait_condition.nodes_to_synchronize [ receiver; observer ]) ~soft_timeout:(Network_time_span.Slots 3) diff --git a/src/app/test_executive/block_production_timed_accounts_test.ml.todo b/src/app/test_executive/block_production_timed_accounts_test.ml.todo index 33e24bd54ea..dea553e5b6c 100644 --- a/src/app/test_executive/block_production_timed_accounts_test.ml.todo +++ b/src/app/test_executive/block_production_timed_accounts_test.ml.todo @@ -1,16 +1,12 @@ open Integration_test_lib open Core_kernel -module Make (Engine : Intf.Engine.S) (Dsl : Intf.Dsl.S with module Engine := Engine) = struct - open Engine - open Dsl +module Make (Inputs : Intf.Test.Inputs_intf) = struct + open Inputs.Dsl + open Inputs.Engine + open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t + let test_name = "block_prod_timed" let block_producer_balance = "1000" diff --git a/src/app/test_executive/block_reward_test.ml b/src/app/test_executive/block_reward_test.ml index 01ac94a3242..b9e3fb17c46 100644 --- a/src/app/test_executive/block_reward_test.ml +++ b/src/app/test_executive/block_reward_test.ml @@ -3,19 +3,11 @@ open Integration_test_lib open Mina_base module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "block-reward" let config = @@ -30,7 +22,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let run network t = let open Malleable_error.Let_syntax in let logger = Logger.create ~prefix:(test_name ^ " test: ") () in - let%bind () = Wait_for.all_nodes_to_initialize network t in + let%bind () = Wait_for.all_nodes_to_initialize t network in let node = get_bp_node network "node" in let%bind bp_pk = pub_key_of_node node in let bp_pk_account_id = Account_id.create bp_pk Token_id.default in diff --git a/src/app/test_executive/chain_reliability_test.ml b/src/app/test_executive/chain_reliability_test.ml index 25a12ad0a92..e970a3ac6d2 100644 --- a/src/app/test_executive/chain_reliability_test.ml +++ b/src/app/test_executive/chain_reliability_test.ml @@ -2,19 +2,11 @@ open Core open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "chain-reliability" let config = @@ -38,7 +30,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let open Malleable_error.Let_syntax in let logger = Logger.create ~prefix:(test_name ^ "test: ") () in let all_nodes = Network.all_nodes network in - let%bind () = Wait_for.all_nodes_to_initialize network t in + let%bind () = Wait_for.all_nodes_to_initialize t network in let node_a = get_bp_node network "node-a" in let node_b = get_bp_node network "node-b" in let node_c = get_bp_node network "node-c" in @@ -55,7 +47,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct [%log info] "%s started again, will now wait for this node to initialize" (Node.id node_c) ; - let%bind () = Wait_for.node_to_initialize t node_c in + let%bind () = Wait_for.nodes_to_initialize t [ node_c ] in Wait_for.with_timeouts t ~condition: (Wait_condition.nodes_to_synchronize [ node_a; node_b; node_c ]) diff --git a/src/app/test_executive/delegation_test.ml b/src/app/test_executive/delegation_test.ml index 937185467fe..b103f46ba5f 100644 --- a/src/app/test_executive/delegation_test.ml +++ b/src/app/test_executive/delegation_test.ml @@ -2,19 +2,11 @@ open Core_kernel open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "delegation" let config = @@ -37,7 +29,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let logger = Logger.create ~prefix:(test_name ^ "test: ") () in (* fee for user commands *) let fee = Currency.Fee.of_nanomina_int_exn 10_000_000 in - let%bind () = Wait_for.all_nodes_to_initialize network t in + let%bind () = Wait_for.all_nodes_to_initialize t network in let node_a = get_bp_node network "node-a" in let node_b = get_bp_node network "node-b" in let%bind () = @@ -55,9 +47,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~sender_pub_key:delegation_sender_pub_key ~receiver_pub_key:delegation_receiver_pub_key ~fee in - wait_for t - (Wait_condition.signed_command_to_be_included_in_frontier - ~txn_hash:hash ~node_included_in:`Any_node ) ) + Wait_for.signed_command_to_be_included_in_frontier t ~txn_hash:hash + ~node_included_in:`Any_node ) in section_hard "Running replayer" (let%bind logs = diff --git a/src/app/test_executive/gossip_consistency.ml b/src/app/test_executive/gossip_consistency.ml index f64801e9c3c..a95370520a0 100644 --- a/src/app/test_executive/gossip_consistency.ml +++ b/src/app/test_executive/gossip_consistency.ml @@ -2,19 +2,11 @@ open Core open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "gossip-consis" let config = @@ -35,7 +27,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let open Malleable_error.Let_syntax in let logger = Logger.create ~prefix:(test_name ^ " test: ") () in [%log info] "starting..." ; - let%bind () = Wait_for.all_nodes_to_initialize network t in + let%bind () = Wait_for.all_nodes_to_initialize t network in [%log info] "done waiting for initializations" ; let receiver_bp = get_bp_node network "node-a" in let%bind receiver_pub_key = pub_key_of_node receiver_bp in diff --git a/src/app/test_executive/medium_bootstrap.ml b/src/app/test_executive/medium_bootstrap.ml index e54090eeb67..3e22b0c69bd 100644 --- a/src/app/test_executive/medium_bootstrap.ml +++ b/src/app/test_executive/medium_bootstrap.ml @@ -3,19 +3,11 @@ open Async open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "medium-bootstrap" let config = @@ -46,11 +38,10 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (* this test is the medium bootstrap test *) let run network t = - let open Network in + let module Node = Network.Node in let open Malleable_error.Let_syntax in let logger = Logger.create ~prefix:(test_name ^ " test: ") () in - let all_nodes = Network.all_nodes network in - let%bind () = Wait_for.all_nodes_to_initialize network t in + let%bind () = Wait_for.all_nodes_to_initialize t network in let node_a = get_bp_node network "node-a" in let node_b = get_bp_node network "node-b" in let node_c = get_bp_node network "node-c" in @@ -67,13 +58,13 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct [%log info] "%s started again, will now wait for this node to initialize" (Node.id node_c) ; - let%bind () = Wait_for.node_to_initialize t node_c in + let%bind () = Wait_for.nodes_to_initialize t [ node_c ] in Wait_for.nodes_to_synchronize t [ node_a; node_b; node_c ] ) in section "network is fully connected after one node was restarted" (let%bind () = Malleable_error.lift (after (Time.Span.of_sec 240.0)) in let%bind final_connectivity_data = - fetch_connectivity_data ~logger (Core.String.Map.data all_nodes) + fetch_connectivity_data ~logger (all_nodes network) in assert_peers_completely_connected final_connectivity_data ) end diff --git a/src/app/test_executive/payments_test.ml b/src/app/test_executive/payments_test.ml index 547dfee53ef..72d5b2c0c58 100644 --- a/src/app/test_executive/payments_test.ml +++ b/src/app/test_executive/payments_test.ml @@ -4,19 +4,11 @@ open Integration_test_lib open Mina_base module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "payments" (* TODO: refactor all currency values to decimal represenation *) @@ -83,17 +75,9 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let open Network in let open Malleable_error.Let_syntax in let logger = Logger.create ~prefix:(test_name ^ " test: ") () in - let%bind () = Wait_for.all_nodes_to_initialize network t in - let untimed_node_a = - Core.String.Map.find_exn - (Network.block_producers network) - "untimed-node-a" - in - let untimed_node_b = - Core.String.Map.find_exn - (Network.block_producers network) - "untimed-node-b" - in + let%bind () = Wait_for.all_nodes_to_initialize t network in + let untimed_node_a = get_bp_node network "untimed-node-a" in + let untimed_node_b = get_bp_node network "untimed-node-b" in let timed_node_c = get_bp_node network "timed-node-c" in let fish1 = get_genesis_keypair network "fish1" in let fish2 = get_genesis_keypair network "fish2" in @@ -102,9 +86,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~f:(fun { Signature_lib.Keypair.public_key; _ } -> public_key |> Signature_lib.Public_key.to_bigstring |> Bigstring.to_string ) ) ; - let snark_coordinator = - Core.String.Map.find_exn (Network.all_nodes network) "snark-node" - in + let snark_coordinator = get_node network "snark-node" in let snark_node_key1 = get_genesis_keypair network "snark-node-key1" in let snark_node_key2 = get_genesis_keypair network "snark-node-key2" in [%log info] "snark node keypairs: %s" @@ -115,7 +97,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (* create a signed txn which we'll use to make a successfull txn, and then a replay attack *) let amount = Currency.Amount.of_mina_string_exn "10" in let fee = Currency.Fee.of_mina_string_exn "1" in - let test_constants = Engine.Network.constraint_constants network in + let test_constants = Network.constraint_constants network in let receiver_pub_key = fish1.keypair.public_key |> Signature_lib.Public_key.compress in @@ -189,9 +171,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~raw_signature: (Mina_base.Signature.Raw.encode signed_cmmd.signature) in - wait_for t - (Wait_condition.signed_command_to_be_included_in_frontier - ~txn_hash:hash ~node_included_in:(`Node untimed_node_b) ) ) + Wait_for.signed_command_to_be_included_in_frontier t ~txn_hash:hash + ~node_included_in:(`Node untimed_node_b) ) in let%bind () = section @@ -383,9 +364,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Network.Node.must_send_payment ~logger timed_node_c ~sender_pub_key ~receiver_pub_key ~amount ~fee in - wait_for t - (Wait_condition.signed_command_to_be_included_in_frontier - ~txn_hash:hash ~node_included_in:(`Node timed_node_c) ) ) + Wait_for.signed_command_to_be_included_in_frontier t ~txn_hash:hash + ~node_included_in:(`Node timed_node_c) ) in let%bind () = section "unable to send payment from timed account using illiquid tokens" @@ -459,9 +439,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct send_payments ~logger ~sender_pub_key ~receiver_pub_key ~amount:Currency.Amount.one ~fee ~node:sender 10 in - wait_for t - (Wait_condition.ledger_proofs_emitted_since_genesis - ~test_config:config ~num_proofs:1 ) ) + Wait_for.ledger_proofs_emitted_since_genesis t ~test_config:config + ~num_proofs:1 ) in let%bind () = section_hard @@ -539,9 +518,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct send_payments ~logger ~sender_pub_key ~receiver_pub_key ~amount:Currency.Amount.one ~fee ~node:sender 12 in - wait_for t - (Wait_condition.ledger_proofs_emitted_since_genesis ~num_proofs:2 - ~test_config:config ) ) + Wait_for.ledger_proofs_emitted_since_genesis t ~num_proofs:2 + ~test_config:config ) in let%bind () = section_hard diff --git a/src/app/test_executive/peers_reliability_test.ml b/src/app/test_executive/peers_reliability_test.ml index 7cfc9d6ce7a..9ad34cbcaef 100644 --- a/src/app/test_executive/peers_reliability_test.ml +++ b/src/app/test_executive/peers_reliability_test.ml @@ -3,19 +3,11 @@ open Async open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - (* TODO: find a way to avoid this type alias (first class module signatures restrictions make this tricky) *) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "peers-reliability" let config = @@ -46,15 +38,9 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (List.map (Core.String.Map.data all_nodes) ~f:(fun n -> `String (Node.id n) ) ) ) ] ; - let node_a = - Core.String.Map.find_exn (Network.block_producers network) "node-a" - in - let node_b = - Core.String.Map.find_exn (Network.block_producers network) "node-b" - in - let node_c = - Core.String.Map.find_exn (Network.block_producers network) "node-c" - in + let node_a = get_bp_node network "node-a" in + let node_b = get_bp_node network "node-b" in + let node_c = get_bp_node network "node-c" in (* witness the node_c frontier load on initialization *) let%bind () = wait_for t @@ -142,7 +128,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ~constraint_constants:(Network.constraint_constants network) parties_spec in - let%bind () = send_zkapp ~logger node_c parties_create_accounts in + let%bind () = Zkapp.send ~logger node_c parties_create_accounts in wait_for_zkapp parties_create_accounts ) in let%bind () = @@ -158,8 +144,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in () ) in - [%log info] "%s test: zkApp account was created on node about to be stopped" - test_name ; + [%log info] "zkApp account was created on node about to be stopped" ; let%bind () = section "blocks are produced" (wait_for t (Wait_condition.blocks_to_be_produced 1)) @@ -167,9 +152,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%bind () = section "short bootstrap" (let%bind () = Node.stop node_c in - [%log info] - "%s test: %s stopped, will now wait for blocks to be produced" - test_name (Node.id node_c) ; + [%log info] "%s stopped, will now wait for blocks to be produced" + (Node.id node_c) ; let%bind () = wait_for t ( Wait_condition.blocks_to_be_produced 1 @@ -180,16 +164,15 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = Node.start ~fresh_state:true node_c in [%log info] - "%s test: %s started again, will now wait for this node to \ - initialize" - test_name (Node.id node_c) ; + "%s started again, will now wait for this node to initialize" + (Node.id node_c) ; (* we've witnessed the loading of the node_c frontier on initialization so the event here must be the frontier loading on the node_c restart *) let%bind () = wait_for t @@ Wait_condition.persisted_frontier_loaded node_c in - let%bind () = wait_for t @@ Wait_condition.node_to_initialize node_c in + let%bind () = Wait_for.nodes_to_initialize t [ node_c ] in wait_for t ( Wait_condition.nodes_to_synchronize [ node_a; node_b; node_c ] |> Wait_condition.with_timeouts diff --git a/src/app/test_executive/snarkyjs.ml b/src/app/test_executive/snarkyjs.ml index 578ed31df57..e025c2a56b5 100644 --- a/src/app/test_executive/snarkyjs.ml +++ b/src/app/test_executive/snarkyjs.ml @@ -3,18 +3,11 @@ open Async open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "snarkyjs" let config = @@ -43,15 +36,13 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let run network t = let open Malleable_error.Let_syntax in let logger = Logger.create ~prefix:(test_name ^ " test: ") () in - let node = - Core.String.Map.find_exn (Network.block_producers network) "node" - in + let node = get_bp_node network "node" in let%bind fee_payer_key = priv_key_of_node node in let graphql_uri = Network.Node.graphql_uri node in let%bind () = [%log info] "Waiting for nodes to be initialized" ; - let%bind () = wait_for t (Wait_condition.node_to_initialize node) in + let%bind () = Wait_for.nodes_to_initialize t [ node ] in [%log info] "Running test script" ; let%bind.Deferred result = let%bind.Deferred process = diff --git a/src/app/test_executive/verification_key_update.ml b/src/app/test_executive/verification_key_update.ml index 8da825282c0..d50d4123d0c 100644 --- a/src/app/test_executive/verification_key_update.ml +++ b/src/app/test_executive/verification_key_update.ml @@ -40,8 +40,6 @@ let zkapp_kp = Keypair.create () let zkapp_pk = Public_key.compress zkapp_kp.public_key -let zkapp_account_id = Account_id.create zkapp_pk Token_id.default - module Trivial_rule1 = Make_trivial_rule (struct let id = 1 @@ -55,18 +53,11 @@ module Trivial_rule2 = Make_trivial_rule (struct end) module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "verification-key" let config = @@ -98,19 +89,14 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ; snark_worker_fee = "0.0001" } - let logger = Logger.create ~prefix:(test_name ^ " test: ") () - let run network t = let open Malleable_error.Let_syntax in + let logger = Logger.create ~prefix:(test_name ^ " test: ") () in let%bind () = section_hard "Wait for nodes to initialize" - (wait_for t - (Wait_condition.nodes_to_initialize - (Core.String.Map.data (Network.all_nodes network)) ) ) - in - let whale1 = - Core.String.Map.find_exn (Network.block_producers network) "whale1" + (Wait_for.all_nodes_to_initialize t network) in + let whale1 = get_bp_node network "whale1" in let%bind whale1_pk = pub_key_of_node whale1 in let%bind whale1_sk = priv_key_of_node whale1 in let constraint_constants = Network.constraint_constants network in @@ -193,8 +179,6 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ; authorization_kind = Signature } in - - (* TODO: This is a pain. *) { body = body vk; authorization = Signature Signature.dummy } in let zkapp_command_create_account = @@ -305,24 +289,17 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct call_forest_to_zkapp ~call_forest:call_forest_update_vk2 ~nonce:Account.Nonce.(of_int 1) in - let with_timeout = - let soft_slots = 3 in - let soft_timeout = Network_time_span.Slots soft_slots in - let hard_timeout = Network_time_span.Slots (soft_slots * 2) in - Wait_condition.with_timeouts ~soft_timeout ~hard_timeout - in let wait_for_zkapp ~has_failures zkapp_command = let%map () = - wait_for t @@ with_timeout - @@ Wait_condition.zkapp_to_be_included_in_frontier ~has_failures - ~zkapp_command + Wait_for.zkapp_to_be_included_in_frontier t ~has_failures ~zkapp_command + ~soft_slots:3 in [%log info] "zkApp transaction included in transition frontier" in let%bind () = section "Send a zkApp to create a zkApp account" - (send_zkapp ~logger whale1 zkapp_command_create_account) + (Zkapp.send ~logger whale1 zkapp_command_create_account) in let%bind () = section @@ -333,21 +310,21 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct section "Send zkApp to update verification key to v1 and then refers to v1 in \ the subsequent account update" - (send_zkapp ~logger whale1 zkapp_command_update_vk1) + (Zkapp.send ~logger whale1 zkapp_command_update_vk1) in let%bind () = section "Send zkApp to update to a new verification key v2 and then refers to \ the old key v1" - (send_invalid_zkapp ~logger whale1 zkapp_command_update_vk2_refers_vk1 + (Zkapp.send_invalid ~logger whale1 zkapp_command_update_vk2_refers_vk1 "Verification_failed" ) in let%bind () = section "Send zkApp to update to a new verification key v2 and then refers to \ that" - (send_zkapp ~logger whale1 zkapp_command_update_vk2) + (Zkapp.send ~logger whale1 zkapp_command_update_vk2) in let%bind () = section diff --git a/src/app/test_executive/zkapps.ml b/src/app/test_executive/zkapps.ml index 807e677172f..2b089cb933d 100644 --- a/src/app/test_executive/zkapps.ml +++ b/src/app/test_executive/zkapps.ml @@ -4,18 +4,11 @@ open Integration_test_lib open Mina_base module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "zkapps" let config = @@ -59,7 +52,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let send_zkapp ~logger node zkapp_command = incr transactions_sent ; - send_zkapp ~logger node zkapp_command + Zkapp.send ~logger node zkapp_command let send_padding_transactions ~fee ~logger ~n nodes = let sender = List.nth_exn nodes 0 in @@ -105,7 +98,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in match expected_failure with | Some failure -> - send_invalid_payment ~logger ~sender_pub_key:sender_pk + Zkapp.send_invalid_payment ~logger ~sender_pub_key:sender_pk ~receiver_pub_key:receiver_pk ~amount ~fee ~nonce ~memo ~valid_until ~raw_signature ~expected_failure:failure node | None -> @@ -124,13 +117,9 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (* TODO: capture snark worker processes' failures *) let%bind () = section_hard "Wait for nodes to initialize" - (wait_for t - ( Wait_condition.nodes_to_initialize - @@ (Network.all_nodes network |> Core.String.Map.data) ) ) - in - let node = - Core.String.Map.find_exn (Network.block_producers network) "node-a" + (Wait_for.all_nodes_to_initialize t network) in + let node = get_bp_node network "node-a" in let constraint_constants = Network.constraint_constants network in let fish1_kp = (get_genesis_keypair network "fish1").keypair in let fish2_kp = (get_genesis_keypair network "fish2").keypair in @@ -538,17 +527,10 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct , zkapp_command_token_transfer , zkapp_command_token_transfer2 ) in - let with_timeout = - let soft_slots = 4 in - let soft_timeout = Network_time_span.Slots soft_slots in - let hard_timeout = Network_time_span.Slots (soft_slots * 2) in - Wait_condition.with_timeouts ~soft_timeout ~hard_timeout - in let wait_for_zkapp zkapp_command = let%map () = - wait_for t @@ with_timeout - @@ Wait_condition.zkapp_to_be_included_in_frontier ~has_failures:false - ~zkapp_command + Wait_for.zkapp_to_be_included_in_frontier t ~has_failures:false + ~zkapp_command ~soft_slots:4 in [%log info] "ZkApp transaction included in transition frontier" in @@ -690,7 +672,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct [%log info] "Verifying permissions for account" ~metadata:[ ("account_id", Account_id.to_yojson account_id) ] ; let%bind ledger_permissions = - get_account_permissions ~logger node account_id + Zkapp.get_account_permissions ~logger node account_id in if Permissions.equal ledger_permissions permissions_updated then ( [%log info] "Ledger, updated permissions are equal" ; @@ -710,7 +692,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = section_hard "Send a zkapp with an insufficient fee" - (send_invalid_zkapp ~logger node zkapp_command_insufficient_fee + (Zkapp.send_invalid ~logger node zkapp_command_insufficient_fee "Insufficient fee" ) in (* Won't be accepted until the previous transactions are applied *) @@ -720,33 +702,33 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = section_hard "Send a zkapp with an invalid proof" - (send_invalid_zkapp ~logger node zkapp_command_invalid_proof + (Zkapp.send_invalid ~logger node zkapp_command_invalid_proof "Verification_failed" ) in let%bind () = section_hard "Send a zkapp with an insufficient replace fee" - (send_invalid_zkapp ~logger node zkapp_command_insufficient_replace_fee + (Zkapp.send_invalid ~logger node zkapp_command_insufficient_replace_fee "Insufficient_replace_fee" ) in let%bind () = section_hard "Send a zkApp transaction with an invalid nonce" - (send_invalid_zkapp ~logger node zkapp_command_invalid_nonce + (Zkapp.send_invalid ~logger node zkapp_command_invalid_nonce "Invalid_nonce" ) in let%bind () = section_hard "Send a zkApp transaction with insufficient_funds, fee too high" - (send_invalid_zkapp ~logger node zkapp_command_insufficient_funds + (Zkapp.send_invalid ~logger node zkapp_command_insufficient_funds "Insufficient_funds" ) in let%bind () = section_hard "Send a zkApp transaction with an invalid signature" - (send_invalid_zkapp ~logger node zkapp_command_invalid_signature + (Zkapp.send_invalid ~logger node zkapp_command_invalid_signature "Verification_failed" ) in let%bind () = section_hard "Send a zkApp transaction with a nonexistent fee payer" - (send_invalid_zkapp ~logger node zkapp_command_nonexistent_fee_payer + (Zkapp.send_invalid ~logger node zkapp_command_nonexistent_fee_payer "Fee_payer_account_not_found" ) in let%bind () = @@ -793,7 +775,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct [%log info] "Verifying updates for account" ~metadata:[ ("account_id", Account_id.to_yojson account_id) ] ; let%bind ledger_update = - get_account_update ~logger node account_id + Zkapp.get_account_update ~logger node account_id in if compatible_updates ~ledger_update @@ -827,9 +809,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = section_hard "Wait for proof to be emitted" - (wait_for t - (Wait_condition.ledger_proofs_emitted_since_genesis - ~test_config:config ~num_proofs:1 ) ) + (Wait_for.ledger_proofs_emitted_since_genesis t ~test_config:config + ~num_proofs:1 ) in Event_router.cancel (event_router t) snark_work_event_subscription () ; Event_router.cancel (event_router t) snark_work_failure_subscription () ; diff --git a/src/app/test_executive/zkapps_nonce_test.ml b/src/app/test_executive/zkapps_nonce_test.ml index 1df6bf1e63d..967b80ee7bc 100644 --- a/src/app/test_executive/zkapps_nonce_test.ml +++ b/src/app/test_executive/zkapps_nonce_test.ml @@ -4,18 +4,11 @@ open Integration_test_lib open Mina_base module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "zkapps-nonce" let config = @@ -63,10 +56,6 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct if !transactions_sent >= needed_for_padding then 0 else needed_for_padding - !transactions_sent - let send_zkapp ~logger node zkapp_command = - incr transactions_sent ; - send_zkapp ~logger node zkapp_command - let send_padding_transactions ~fee ~logger ~n nodes = let sender = List.nth_exn nodes 0 in let receiver = List.nth_exn nodes 1 in @@ -90,24 +79,16 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let fish1_account_id = Mina_base.Account_id.create fish1_pk Mina_base.Token_id.default in - let with_timeout ~soft_slots = - let soft_timeout = Network_time_span.Slots soft_slots in - let hard_timeout = Network_time_span.Slots (soft_slots * 2) in - Wait_condition.with_timeouts ~soft_timeout ~hard_timeout - in let wait_for_zkapp ~has_failures zkapp_command = let%map () = - wait_for t @@ with_timeout ~soft_slots:4 - @@ Wait_condition.zkapp_to_be_included_in_frontier ~has_failures - ~zkapp_command + Wait_for.zkapp_to_be_included_in_frontier t ~has_failures ~zkapp_command + ~soft_slots:4 in [%log info] "zkApp transaction included in transition frontier" in (*Wait for first BP to start sending payments and avoid partially filling blocks*) let first_bp = List.hd_exn block_producer_nodes in - let%bind () = - wait_for t (Wait_condition.nodes_to_initialize [ first_bp ]) - in + let%bind () = Wait_for.nodes_to_initialize t [ first_bp ] in (*Start sending padding transactions to get snarked ledger sooner*) let%bind () = let fee = Currency.Fee.of_nanomina_int_exn 3_000_000 in @@ -116,17 +97,16 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in (*wait for the rest*) let%bind () = - wait_for t - (Wait_condition.nodes_to_initialize - (List.filter - ~f:(fun n -> - String.(Network.Node.id n <> Network.Node.id first_bp) ) - (Core.String.Map.data (Network.all_nodes network)) ) ) + Wait_for.nodes_to_initialize t + ( List.filter ~f:(fun n -> + String.(Network.Node.id n <> Network.Node.id first_bp) ) + @@ all_nodes network ) in let keymap = - List.fold [ fish1_kp ] ~init:Signature_lib.Public_key.Compressed.Map.empty + let open Signature_lib.Public_key.Compressed.Map in + List.fold [ fish1_kp ] ~init:empty ~f:(fun map { private_key; public_key } -> - Signature_lib.Public_key.Compressed.Map.add_exn map + add_exn map ~key:(Signature_lib.Public_key.compress public_key) ~data:private_key ) in @@ -265,7 +245,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct section_hard "Send a zkapp commands with fee payer nonce increments and nonce \ preconditions" - (send_zkapp_batch ~logger node + (Zkapp.send_batch ~logger node [ invalid_nonce_zkapp_cmd_from_fish1; valid_zkapp_cmd_from_fish1 ] ) in let%bind () = @@ -284,7 +264,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct section_hard "Send zkapp commands with account updates for fish1 that sets send \ permission to Proof and then tries to send funds " - (send_zkapp_batch ~logger node + (Zkapp.send_batch ~logger node [ set_permission_zkapp_cmd_from_fish1 ; valid_fee_invalid_permission_zkapp_cmd_from_fish1 ; invalid_fee_invalid_permission_zkapp_cmd_from_fish1 @@ -346,9 +326,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%bind () = (*wait for blocks required to produce 2 proofs given 0.75 slot fill rate + some buffer*) section_hard "Wait for proof to be emitted" - ( wait_for t - @@ Wait_condition.ledger_proofs_emitted_since_genesis - ~test_config:config ~num_proofs ) + (Wait_for.ledger_proofs_emitted_since_genesis t ~test_config:config + ~num_proofs ) in Event_router.cancel (event_router t) snark_work_event_subscription () ; Event_router.cancel (event_router t) snark_work_failure_subscription () ; diff --git a/src/app/test_executive/zkapps_timing.ml b/src/app/test_executive/zkapps_timing.ml index 560234a4cc8..453fc0ba3a6 100644 --- a/src/app/test_executive/zkapps_timing.ml +++ b/src/app/test_executive/zkapps_timing.ml @@ -3,18 +3,11 @@ open Async open Integration_test_lib module Make (Inputs : Intf.Test.Inputs_intf) = struct - open Inputs - open Engine - open Dsl + open Inputs.Dsl + open Inputs.Engine open Test_common.Make (Inputs) - type network = Network.t - - type node = Network.Node.t - - type dsl = Dsl.t - let test_name = "zkapps-timing" let config = @@ -46,11 +39,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let run network t = let open Malleable_error.Let_syntax in let logger = Logger.create ~prefix:(test_name ^ " test: ") () in - let all_nodes = Network.all_nodes network in - let%bind () = - wait_for t - (Wait_condition.nodes_to_initialize (Core.String.Map.data all_nodes)) - in + let%bind () = Wait_for.all_nodes_to_initialize t network in let block_producer_nodes = Network.block_producers network |> Core.String.Map.data in @@ -358,23 +347,16 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Transaction_snark.For_tests.update_states ~constraint_constants zkapp_command_spec in - let with_timeout = - let soft_slots = 3 in - let soft_timeout = Network_time_span.Slots soft_slots in - let hard_timeout = Network_time_span.Slots (soft_slots * 2) in - Wait_condition.with_timeouts ~soft_timeout ~hard_timeout - in let wait_for_zkapp ~has_failures zkapp_command = let%map () = - wait_for t @@ with_timeout - @@ Wait_condition.zkapp_to_be_included_in_frontier ~has_failures - ~zkapp_command + Wait_for.zkapp_to_be_included_in_frontier t ~has_failures ~zkapp_command + ~soft_slots:3 in [%log info] "zkApp transaction included in transition frontier" in let%bind () = section "Send a zkApp to create a zkApp account with timing" - (send_zkapp ~logger node zkapp_command_create_account_with_timing) + (Zkapp.send ~logger node zkapp_command_create_account_with_timing) in let%bind () = section @@ -385,7 +367,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = section "Send zkApp to create a 2nd zkApp account with timing" - (send_zkapp ~logger node zkapp_command_create_second_account_with_timing) + (Zkapp.send ~logger node zkapp_command_create_second_account_with_timing) in let%bind () = section @@ -396,7 +378,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = section "Send zkApp to create a 3rd zkApp account with timing" - (send_zkapp ~logger node zkapp_command_create_third_account_with_timing) + (Zkapp.send ~logger node zkapp_command_create_third_account_with_timing) in let%bind () = section @@ -408,9 +390,11 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%bind () = section "Verify zkApp timing in ledger" (let%bind ledger_update = - get_account_update ~logger node timing_account_id + Zkapp.get_account_update ~logger node timing_account_id in - if compatible_updates ~ledger_update ~requested_update:timing_update + if + Zkapp.compatible_updates ~ledger_update + ~requested_update:timing_update then ( [%log info] "Ledger timing and requested timing update are compatible" ; @@ -437,7 +421,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = section "Send invalid zkApp with zero vesting period in timing" - (send_invalid_zkapp ~logger node zkapp_command_with_zero_vesting_period + (Zkapp.send_invalid ~logger node zkapp_command_with_zero_vesting_period "Zero vesting period" ) in (* let%bind before_balance = @@ -445,7 +429,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in *) let%bind () = section "Send a zkApp with transfer from timed account that succeeds" - (send_zkapp ~logger node zkapp_command_transfer_from_timed_account) + (Zkapp.send ~logger node zkapp_command_transfer_from_timed_account) in let%bind () = section "Waiting for zkApp with transfer from timed account that succeeds" @@ -566,7 +550,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct section "Send a zkApp transfer from timed account with all its available funds \ at current global slot" - (send_zkapp ~logger node zkapp_command_transfer_from_third_timed_account) + (Zkapp.send ~logger node zkapp_command_transfer_from_third_timed_account) in let%bind () = section @@ -620,7 +604,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct assert ( Currency.Amount.( < ) proposed_balance (Option.value_exn locked_balance |> Currency.Balance.to_amount) ) ; - send_zkapp ~logger node + Zkapp.send ~logger node zkapp_command_invalid_transfer_from_timed_account ) in let%bind () = @@ -670,7 +654,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in let%bind () = section "Send a zkApp with invalid timing update" - (send_zkapp ~logger node zkapp_command_update_timing) + (Zkapp.send ~logger node zkapp_command_update_timing) in let%bind () = section "Wait for snapp with invalid timing update" @@ -679,10 +663,10 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let%bind () = section "Verify timing has not changed" (let%bind ledger_update = - get_account_update ~logger node timing_account_id + Zkapp.get_account_update ~logger node timing_account_id in if - compatible_item ledger_update.timing timing_update.timing + Zkapp.compatible_item ledger_update.timing timing_update.timing ~equal:Mina_base.Account_update.Update.Timing_info.equal then ( [%log info]