diff --git a/src/app/test_executive/dune b/src/app/test_executive/dune index b3e9cc12920..f17f533150c 100644 --- a/src/app/test_executive/dune +++ b/src/app/test_executive/dune @@ -41,6 +41,7 @@ participating_state graph_algorithms visualization + block_time ) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_coda ppx_jane ppx_deriving_yojson ppx_coda ppx_version))) diff --git a/src/app/test_executive/slot_end_test.ml b/src/app/test_executive/slot_end_test.ml new file mode 100644 index 00000000000..23abdca7c60 --- /dev/null +++ b/src/app/test_executive/slot_end_test.ml @@ -0,0 +1,199 @@ +open Core +open Integration_test_lib + +module Make (Inputs : Intf.Test.Inputs_intf) = struct + open Inputs + open Engine + open Dsl + + 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 num_extra_keys = 100 + + let slot_tx_end = 5 + + let slot_chain_end = 8 + + let sender_account_prefix = "sender-account-" + + let config = + let open Test_config in + { default with + requires_graphql = true + ; genesis_ledger = + [ { Test_Account.account_name = "receiver-key" + ; balance = "9999999" + ; timing = Untimed + } + ; { account_name = "sender-1-key"; balance = "0"; timing = Untimed } + ; { account_name = "sender-2-key"; balance = "0"; timing = Untimed } + ; { account_name = "sender-3-key"; balance = "0"; timing = Untimed } + ; { account_name = "snark-node-key"; balance = "0"; timing = Untimed } + ] + @ List.init num_extra_keys ~f:(fun i -> + { Test_Account.account_name = + sprintf "%s-%d" sender_account_prefix i + ; balance = "1000" + ; timing = Untimed + } ) + ; block_producers = + [ { node_name = "receiver"; account_name = "receiver-key" } + ; { node_name = "sender-1"; account_name = "sender-1-key" } + ; { node_name = "sender-2"; account_name = "sender-2-key" } + ; { node_name = "sender-3"; account_name = "sender-3-key" } + ] + ; snark_coordinator = + Some + { node_name = "snark-node" + ; account_name = "snark-node-key" + ; worker_nodes = 4 + } + ; txpool_max_size = 10_000_000 + ; snark_worker_fee = "0.0002" + ; num_archive_nodes = 0 + ; proof_config = + { proof_config_default with + work_delay = Some 1 + ; transaction_capacity = + Some Runtime_config.Proof_keys.Transaction_capacity.small + } + ; slot_tx_end = Some slot_tx_end + ; slot_chain_end = Some slot_chain_end + } + + let fee = Currency.Fee.of_int 10_000_000 + + let amount = Currency.Amount.of_int 10_000_000 + + let tx_delay_ms = 5000 + + let run network t = + let open Malleable_error.Let_syntax in + let logger = Logger.create () in + let num_slots = slot_chain_end + 2 in + let receiver = + String.Map.find_exn (Network.block_producers network) "receiver" + in + let%bind receiver_pub_key = pub_key_of_node receiver in + let bp_senders = + String.Map.remove (Network.block_producers network) "receiver" + |> String.Map.data + in + let sender_kps = + String.Map.fold (Network.genesis_keypairs network) ~init:[] + ~f:(fun ~key ~data acc -> + if String.is_prefix key ~prefix:sender_account_prefix then data :: acc + else acc ) + in + let sender_priv_keys = + List.map sender_kps ~f:(fun kp -> kp.keypair.private_key) + in + let pk_to_string = Signature_lib.Public_key.Compressed.to_base58_check in + [%log info] "receiver: %s" (pk_to_string receiver_pub_key) ; + let%bind () = + Malleable_error.List.iter sender_kps ~f:(fun s -> + let pk = s.keypair.public_key |> Signature_lib.Public_key.compress in + return ([%log info] "sender: %s" (pk_to_string pk)) ) + in + let window_ms = + (Network.constraint_constants network).block_window_duration_ms + in + let all_nodes = Network.all_mina_nodes network in + let%bind () = + wait_for t + (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) + in + let genesis_timestamp = + Block_time.to_time + @@ Block_time.of_int64 + (Network.genesis_constants network).protocol.genesis_state_timestamp + in + let end_t = + Time.add genesis_timestamp + (Time.Span.of_ms @@ float_of_int (num_slots * window_ms)) + in + let slot_tx_end = Mina_numbers.Global_slot.of_int slot_tx_end in + let slot_chain_end = Mina_numbers.Global_slot.of_int slot_chain_end in + let%bind () = + section_hard "spawn transaction sending" + (let num_payments = num_slots * window_ms / tx_delay_ms in + let repeat_count = Unsigned.UInt32.of_int num_payments in + let repeat_delay_ms = Unsigned.UInt32.of_int tx_delay_ms in + let num_sender_keys = List.length sender_priv_keys in + let n_bp_senders = List.length bp_senders in + let keys_per_sender = num_sender_keys / n_bp_senders in + [%log info] + "will now send %d payments from as many accounts. %d nodes will \ + send %d payments each from distinct keys" + num_payments n_bp_senders keys_per_sender ; + Malleable_error.List.fold ~init:sender_priv_keys bp_senders + ~f:(fun keys node -> + let keys0, rest = List.split_n keys keys_per_sender in + Integration_test_lib.Graphql_requests.must_send_test_payments + ~repeat_count ~repeat_delay_ms ~logger ~senders:keys0 + ~receiver_pub_key ~amount ~fee + (Network.Node.get_ingress_uri node) + >>| const rest ) + >>| const () ) + in + let%bind () = + section + (Printf.sprintf "wait until slot %d" num_slots) + Async.(at end_t >>= const Malleable_error.ok_unit) + in + let ok_if_true s = + Malleable_error.ok_if_true ~error:(Error.of_string s) ~error_type:`Soft + in + let%bind blocks = + Integration_test_lib.Graphql_requests + .must_get_best_chain_for_slot_end_test ~max_length:(2 * num_slots) ~logger + (Network.Node.get_ingress_uri receiver) + in + let%bind () = + section "blocks produced before slot_tx_end" + ( ok_if_true "only empty blocks were produced before slot_tx_end" + @@ List.exists blocks ~f:(fun block -> + Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis < slot_tx_end) + && ( block.command_transaction_count <> 0 + || block.snark_work_count <> 0 + || block.coinbase <> 0 ) ) ) + in + let%bind () = + section "blocks produced after slot_tx_end" + (Malleable_error.List.iter blocks ~f:(fun block -> + let msg = + Printf.sprintf + "non-empty block after slot_tx_end. block slot since genesis: \ + %s, txn count: %d, snark work count: %d, coinbase: %d" + (Mina_numbers.Global_slot.to_string block.slot_since_genesis) + block.command_transaction_count block.snark_work_count + block.coinbase + in + ok_if_true msg + ( Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis < slot_tx_end) + || block.command_transaction_count = 0 + && block.snark_work_count = 0 && block.coinbase = 0 ) ) ) + in + let%bind () = + section "blocks produced before slot_chain_end" + ( ok_if_true "no block produced before slot_chain_end" + @@ List.exists blocks ~f:(fun block -> + Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis < slot_chain_end) ) ) + in + section "no blocks produced after slot_chain_end" + ( ok_if_true "blocks produced after slot_chain_end" + @@ not + @@ List.exists blocks ~f:(fun block -> + Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis >= slot_chain_end) ) ) +end diff --git a/src/app/test_executive/slot_end_test.mli b/src/app/test_executive/slot_end_test.mli new file mode 100644 index 00000000000..8664ff022c1 --- /dev/null +++ b/src/app/test_executive/slot_end_test.mli @@ -0,0 +1 @@ +module Make : Integration_test_lib.Intf.Test.Functor_intf diff --git a/src/app/test_executive/test_executive.ml b/src/app/test_executive/test_executive.ml index 3d91522660b..10d894af416 100644 --- a/src/app/test_executive/test_executive.ml +++ b/src/app/test_executive/test_executive.ml @@ -60,6 +60,7 @@ let tests : test list = ; ("medium-bootstrap", (module Medium_bootstrap.Make : Intf.Test.Functor_intf)) ; ( "block-prod-prio" , (module Block_production_priority.Make : Intf.Test.Functor_intf) ) + ; ("slot-end", (module Slot_end_test.Make : Intf.Test.Functor_intf)) ] let report_test_errors ~log_error_set ~internal_error_set = diff --git a/src/config/debug.mlh b/src/config/debug.mlh index 757b3da05b2..0e77f2ed6db 100644 --- a/src/config/debug.mlh +++ b/src/config/debug.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/dev.mlh b/src/config/dev.mlh index 7f74f204f5f..a6fe3a92c51 100644 --- a/src/config/dev.mlh +++ b/src/config/dev.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/dev_medium_curves.mlh b/src/config/dev_medium_curves.mlh index d6195a6df25..9a2d5a44b68 100644 --- a/src/config/dev_medium_curves.mlh +++ b/src/config/dev_medium_curves.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/dev_snark.mlh b/src/config/dev_snark.mlh index a63977f3d7c..d873dd2d4d8 100644 --- a/src/config/dev_snark.mlh +++ b/src/config/dev_snark.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/devnet.mlh b/src/config/devnet.mlh index 3776abe847e..6b933dafc74 100644 --- a/src/config/devnet.mlh +++ b/src/config/devnet.mlh @@ -44,3 +44,5 @@ (* 2*block_window_duration *) [%%define compaction_interval 360000] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/fake_hash.mlh b/src/config/fake_hash.mlh index 62ee0d7b916..1b6d9007839 100644 --- a/src/config/fake_hash.mlh +++ b/src/config/fake_hash.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/fuzz_medium.mlh b/src/config/fuzz_medium.mlh index 0a0b88f68d0..6ef14277933 100644 --- a/src/config/fuzz_medium.mlh +++ b/src/config/fuzz_medium.mlh @@ -32,3 +32,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/fuzz_small.mlh b/src/config/fuzz_small.mlh index 9ac7986f968..ea62c09a16b 100644 --- a/src/config/fuzz_small.mlh +++ b/src/config/fuzz_small.mlh @@ -32,3 +32,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/integration_tests.mlh b/src/config/integration_tests.mlh index a4d92492e3c..b49716186c6 100644 --- a/src/config/integration_tests.mlh +++ b/src/config/integration_tests.mlh @@ -5,3 +5,6 @@ (* This profile is only used for the test executive binary, so we don't need snark keys, a valid genesis proof, etc. *) [%%import "/src/config/proof_level/none.mlh"] + +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/mainnet.mlh b/src/config/mainnet.mlh index dec3ac2da1b..2be05d2b927 100644 --- a/src/config/mainnet.mlh +++ b/src/config/mainnet.mlh @@ -44,3 +44,5 @@ (* 2*block_window_duration *) [%%define compaction_interval 360000] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/nonconsensus_mainnet.mlh b/src/config/nonconsensus_mainnet.mlh index 8210abd05e1..84ddce49d0f 100644 --- a/src/config/nonconsensus_mainnet.mlh +++ b/src/config/nonconsensus_mainnet.mlh @@ -2,3 +2,5 @@ [%%undef consensus_mechanism] [%%undef compaction_interval] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/nonconsensus_medium_curves.mlh b/src/config/nonconsensus_medium_curves.mlh index c8e9b2717e8..c005e7c6cc6 100644 --- a/src/config/nonconsensus_medium_curves.mlh +++ b/src/config/nonconsensus_medium_curves.mlh @@ -32,3 +32,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/print_versioned_types.mlh b/src/config/print_versioned_types.mlh index d9ec069101f..5575fd8a3ee 100644 --- a/src/config/print_versioned_types.mlh +++ b/src/config/print_versioned_types.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_archive_processor.mlh b/src/config/test_archive_processor.mlh index 5c241f74838..c4252d2bb17 100644 --- a/src/config/test_archive_processor.mlh +++ b/src/config/test_archive_processor.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake.mlh b/src/config/test_postake.mlh index 172e505d092..5e9a4e0284c 100644 --- a/src/config/test_postake.mlh +++ b/src/config/test_postake.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_catchup.mlh b/src/config/test_postake_catchup.mlh index aebac35870a..46f1f78bcee 100644 --- a/src/config/test_postake_catchup.mlh +++ b/src/config/test_postake_catchup.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_five_even_txns.mlh b/src/config/test_postake_five_even_txns.mlh index 252e471880f..fbd076bd5fc 100644 --- a/src/config/test_postake_five_even_txns.mlh +++ b/src/config/test_postake_five_even_txns.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_full_epoch.mlh b/src/config/test_postake_full_epoch.mlh index 8c59fcd7581..8ee4c5b49fc 100644 --- a/src/config/test_postake_full_epoch.mlh +++ b/src/config/test_postake_full_epoch.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_holy_grail.mlh b/src/config/test_postake_holy_grail.mlh index 585c4d2647e..f7f667b6df8 100644 --- a/src/config/test_postake_holy_grail.mlh +++ b/src/config/test_postake_holy_grail.mlh @@ -32,3 +32,5 @@ [%%import "/src/config/fork.mlh"] [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_medium_curves.mlh b/src/config/test_postake_medium_curves.mlh index 1a45c50ae21..3de79ef8fab 100644 --- a/src/config/test_postake_medium_curves.mlh +++ b/src/config/test_postake_medium_curves.mlh @@ -32,3 +32,5 @@ [%%import "/src/config/fork.mlh"] [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_snarkless.mlh b/src/config/test_postake_snarkless.mlh index 7509fc305ee..0d80cf85808 100644 --- a/src/config/test_postake_snarkless.mlh +++ b/src/config/test_postake_snarkless.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%define compaction_interval 360000] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_snarkless_medium_curves.mlh b/src/config/test_postake_snarkless_medium_curves.mlh index ed29909618c..56c4f61c7b1 100644 --- a/src/config/test_postake_snarkless_medium_curves.mlh +++ b/src/config/test_postake_snarkless_medium_curves.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_split.mlh b/src/config/test_postake_split.mlh index 43c9b3307ed..567460d468e 100644 --- a/src/config/test_postake_split.mlh +++ b/src/config/test_postake_split.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_split_medium_curves.mlh b/src/config/test_postake_split_medium_curves.mlh index a1675e0936b..33304688d7c 100644 --- a/src/config/test_postake_split_medium_curves.mlh +++ b/src/config/test_postake_split_medium_curves.mlh @@ -33,3 +33,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/test_postake_three_producers.mlh b/src/config/test_postake_three_producers.mlh index 70fbe36d947..c7758fb8ef1 100644 --- a/src/config/test_postake_three_producers.mlh +++ b/src/config/test_postake_three_producers.mlh @@ -34,3 +34,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/testnet_postake.mlh b/src/config/testnet_postake.mlh index a2d7d9560a0..892ba1bb23c 100644 --- a/src/config/testnet_postake.mlh +++ b/src/config/testnet_postake.mlh @@ -34,3 +34,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/testnet_postake_many_producers.mlh b/src/config/testnet_postake_many_producers.mlh index bc76e2b5f5d..551f69fc7f4 100644 --- a/src/config/testnet_postake_many_producers.mlh +++ b/src/config/testnet_postake_many_producers.mlh @@ -32,3 +32,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/testnet_postake_many_producers_medium_curves.mlh b/src/config/testnet_postake_many_producers_medium_curves.mlh index 645bf575683..4bfa8573c6a 100644 --- a/src/config/testnet_postake_many_producers_medium_curves.mlh +++ b/src/config/testnet_postake_many_producers_medium_curves.mlh @@ -34,3 +34,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/testnet_postake_medium_curves.mlh b/src/config/testnet_postake_medium_curves.mlh index 3776abe847e..6b933dafc74 100644 --- a/src/config/testnet_postake_medium_curves.mlh +++ b/src/config/testnet_postake_medium_curves.mlh @@ -44,3 +44,5 @@ (* 2*block_window_duration *) [%%define compaction_interval 360000] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/testnet_postake_snarkless.mlh b/src/config/testnet_postake_snarkless.mlh index c6660dfede4..5b85de3c0e7 100644 --- a/src/config/testnet_postake_snarkless.mlh +++ b/src/config/testnet_postake_snarkless.mlh @@ -34,3 +34,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/testnet_postake_snarkless_fake_hash.mlh b/src/config/testnet_postake_snarkless_fake_hash.mlh index 0bc5958a71c..600673f0c3d 100644 --- a/src/config/testnet_postake_snarkless_fake_hash.mlh +++ b/src/config/testnet_postake_snarkless_fake_hash.mlh @@ -35,3 +35,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/testnet_public.mlh b/src/config/testnet_public.mlh index a637dfada0f..40e6698dc7c 100644 --- a/src/config/testnet_public.mlh +++ b/src/config/testnet_public.mlh @@ -34,3 +34,5 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 4c36430d179..4f10dfe216b 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -111,207 +111,233 @@ end let generate_next_state ~constraint_constants ~previous_protocol_state ~time_controller ~staged_ledger ~transactions ~get_completed_work ~logger ~(block_data : Consensus.Data.Block_data.t) ~winner_pk ~scheduled_time - ~log_block_creation ~block_reward_threshold = + ~log_block_creation ~block_reward_threshold ~slot_tx_end ~slot_chain_end = let open Interruptible.Let_syntax in - let previous_protocol_state_body_hash = - Protocol_state.body previous_protocol_state |> Protocol_state.Body.hash + let global_slot = + Consensus.Data.Block_data.global_slot_since_genesis block_data in - let previous_protocol_state_hash = - (Protocol_state.hashes_with_body - ~body_hash:previous_protocol_state_body_hash previous_protocol_state ) - .state_hash - in - let previous_state_view = - Protocol_state.body previous_protocol_state - |> Mina_state.Protocol_state.Body.view - in - let supercharge_coinbase = - let epoch_ledger = Consensus.Data.Block_data.epoch_ledger block_data in - let global_slot = - Consensus.Data.Block_data.global_slot_since_genesis block_data - in - Staged_ledger.can_apply_supercharged_coinbase_exn ~winner:winner_pk - ~epoch_ledger ~global_slot - in - let%bind res = - Interruptible.uninterruptible - (let open Deferred.Let_syntax in - let coinbase_receiver = - Consensus.Data.Block_data.coinbase_receiver block_data + match slot_chain_end with + | Some slot_chain_end + when Mina_numbers.Global_slot.(global_slot >= slot_chain_end) -> + [%log info] "Reached slot_chain_end $slot_chain_end, not producing blocks" + ~metadata: + [ ("slot_chain_end", Mina_numbers.Global_slot.to_yojson slot_chain_end) + ] ; + Interruptible.return None + | None | Some _ -> ( + let previous_protocol_state_body_hash = + Protocol_state.body previous_protocol_state |> Protocol_state.Body.hash in - - let diff = - O1trace.sync_thread "create_staged_ledger_diff" (fun () -> - let diff = - Staged_ledger.create_diff ~constraint_constants staged_ledger - ~coinbase_receiver ~logger - ~current_state_view:previous_state_view - ~transactions_by_fee:transactions ~get_completed_work - ~log_block_creation ~supercharge_coinbase - |> Result.map_error ~f:(fun err -> - Staged_ledger.Staged_ledger_error.Pre_diff err ) - in - match (diff, block_reward_threshold) with - | Ok d, Some threshold -> - let net_return = - Option.value ~default:Currency.Amount.zero - (Staged_ledger_diff.net_return ~constraint_constants - ~supercharge_coinbase - (Staged_ledger_diff.forget d) ) - in - if Currency.Amount.(net_return >= threshold) then diff - else ( - [%log info] - "Block reward $reward is less than the min-block-reward \ - $threshold, creating empty block" - ~metadata: - [ ("threshold", Currency.Amount.to_yojson threshold) - ; ("reward", Currency.Amount.to_yojson net_return) - ] ; - Ok - Staged_ledger_diff.With_valid_signatures_and_proofs - .empty_diff ) - | _ -> - diff ) + let previous_protocol_state_hash = + (Protocol_state.hashes_with_body + ~body_hash:previous_protocol_state_body_hash previous_protocol_state ) + .state_hash in - match%map - let%bind.Deferred.Result diff = return diff in - Staged_ledger.apply_diff_unchecked staged_ledger ~constraint_constants - diff ~logger ~current_state_view:previous_state_view - ~state_and_body_hash: - (previous_protocol_state_hash, previous_protocol_state_body_hash) - ~coinbase_receiver ~supercharge_coinbase - with - | Ok - ( `Hash_after_applying next_staged_ledger_hash - , `Ledger_proof ledger_proof_opt - , `Staged_ledger transitioned_staged_ledger - , `Pending_coinbase_update (is_new_stack, pending_coinbase_update) ) - -> - (*staged_ledger remains unchanged and transitioned_staged_ledger is discarded because the external transtion created out of this diff will be applied in Transition_frontier*) - ignore - @@ Ledger.unregister_mask_exn ~loc:__LOC__ - (Staged_ledger.ledger transitioned_staged_ledger) ; - Some - ( (match diff with Ok diff -> diff | Error _ -> assert false) - , next_staged_ledger_hash - , ledger_proof_opt - , is_new_stack - , pending_coinbase_update ) - | Error (Staged_ledger.Staged_ledger_error.Unexpected e) -> - [%log error] "Failed to apply the diff: $error" - ~metadata:[ ("error", Error_json.error_to_yojson e) ] ; - None - | Error e -> - ( match diff with - | Ok diff -> - [%log error] - ~metadata: - [ ( "error" - , `String (Staged_ledger.Staged_ledger_error.to_string e) ) - ; ( "diff" - , Staged_ledger_diff.With_valid_signatures_and_proofs - .to_yojson diff ) - ] - "Error applying the diff $diff: $error" - | Error e -> - [%log error] "Error building the diff: $error" - ~metadata: - [ ( "error" - , `String (Staged_ledger.Staged_ledger_error.to_string e) ) - ] ) ; - None) - in - match res with - | None -> - Interruptible.return None - | Some - ( diff - , next_staged_ledger_hash - , ledger_proof_opt - , is_new_stack - , pending_coinbase_update ) -> - let%bind protocol_state, consensus_transition_data = - lift_sync (fun () -> - let previous_ledger_hash = - previous_protocol_state |> Protocol_state.blockchain_state - |> Blockchain_state.snarked_ledger_hash - in - let next_ledger_hash = - Option.value_map ledger_proof_opt - ~f:(fun (proof, _) -> - Ledger_proof.statement proof |> Ledger_proof.statement_target - ) - ~default:previous_ledger_hash - in - let snarked_next_available_token = - match ledger_proof_opt with - | Some (proof, _) -> - (Ledger_proof.statement proof).next_available_token_after - | None -> - previous_protocol_state |> Protocol_state.blockchain_state - |> Blockchain_state.snarked_next_available_token - in - let genesis_ledger_hash = - previous_protocol_state |> Protocol_state.blockchain_state - |> Blockchain_state.genesis_ledger_hash - in - let supply_increase = - Option.value_map ledger_proof_opt - ~f:(fun (proof, _) -> - (Ledger_proof.statement proof).supply_increase ) - ~default:Currency.Amount.zero - in - let blockchain_state = - (* We use the time of the beginning of the slot because if things - are slower than expected, we may have entered the next slot and - putting the **current** timestamp rather than the expected one - will screw things up. - - [generate_transition] will log an error if the [current_time] - has a different slot from the [scheduled_time] - *) - Blockchain_state.create_value ~timestamp:scheduled_time - ~snarked_ledger_hash:next_ledger_hash ~genesis_ledger_hash - ~snarked_next_available_token - ~staged_ledger_hash:next_staged_ledger_hash - in - let current_time = - Block_time.now time_controller - |> Block_time.to_span_since_epoch |> Block_time.Span.to_ms - in - O1trace.sync_thread "generate_consensus_transition" (fun () -> - Consensus_state_hooks.generate_transition - ~previous_protocol_state ~blockchain_state ~current_time - ~block_data ~supercharge_coinbase - ~snarked_ledger_hash:previous_ledger_hash ~genesis_ledger_hash - ~supply_increase ~logger ~constraint_constants ) ) + let previous_state_view = + Protocol_state.body previous_protocol_state + |> Mina_state.Protocol_state.Body.view + in + let supercharge_coinbase = + let epoch_ledger = Consensus.Data.Block_data.epoch_ledger block_data in + Staged_ledger.can_apply_supercharged_coinbase_exn ~winner:winner_pk + ~epoch_ledger ~global_slot in - lift_sync (fun () -> - let snark_transition = - O1trace.sync_thread "generate_snark_transition" (fun () -> - Snark_transition.create_value - ~blockchain_state: - (Protocol_state.blockchain_state protocol_state) - ~consensus_transition:consensus_transition_data - ~pending_coinbase_update () ) + let%bind res = + Interruptible.uninterruptible + (let open Deferred.Let_syntax in + let coinbase_receiver = + Consensus.Data.Block_data.coinbase_receiver block_data in - let internal_transition = - O1trace.sync_thread "generate_internal_transition" (fun () -> - Internal_transition.create ~snark_transition - ~prover_state: - (Consensus.Data.Block_data.prover_state block_data) - ~staged_ledger_diff:(Staged_ledger_diff.forget diff) - ~ledger_proof: - (Option.map ledger_proof_opt ~f:(fun (proof, _) -> proof)) ) + let diff = + match slot_tx_end with + | Some slot_tx_end + when Mina_numbers.Global_slot.(global_slot >= slot_tx_end) -> + [%log info] + "Reached slot_tx_end $slot_tx_end, producing empty block" + ~metadata: + [ ( "slot_tx_end" + , Mina_numbers.Global_slot.to_yojson slot_tx_end ) + ] ; + Result.return + Staged_ledger_diff.With_valid_signatures_and_proofs.empty_diff + | Some _ | None -> + O1trace.sync_thread "create_staged_ledger_diff" (fun () -> + let diff = + Staged_ledger.create_diff ~constraint_constants + staged_ledger ~coinbase_receiver ~logger + ~current_state_view:previous_state_view + ~transactions_by_fee:transactions ~get_completed_work + ~log_block_creation ~supercharge_coinbase + |> Result.map_error ~f:(fun err -> + Staged_ledger.Staged_ledger_error.Pre_diff err ) + in + match (diff, block_reward_threshold) with + | Ok d, Some threshold -> + let net_return = + Option.value ~default:Currency.Amount.zero + (Staged_ledger_diff.net_return ~constraint_constants + ~supercharge_coinbase + (Staged_ledger_diff.forget d) ) + in + if Currency.Amount.(net_return >= threshold) then diff + else ( + [%log info] + "Block reward $reward is less than the \ + min-block-reward $threshold, creating empty block" + ~metadata: + [ ( "threshold" + , Currency.Amount.to_yojson threshold ) + ; ("reward", Currency.Amount.to_yojson net_return) + ] ; + Ok + Staged_ledger_diff.With_valid_signatures_and_proofs + .empty_diff ) + | _ -> + diff ) in - let witness = - { Pending_coinbase_witness.pending_coinbases = - Staged_ledger.pending_coinbase_collection staged_ledger - ; is_new_stack - } + match%map + let%bind.Deferred.Result diff = return diff in + Staged_ledger.apply_diff_unchecked staged_ledger + ~constraint_constants diff ~logger + ~current_state_view:previous_state_view + ~state_and_body_hash: + (previous_protocol_state_hash, previous_protocol_state_body_hash) + ~coinbase_receiver ~supercharge_coinbase + with + | Ok + ( `Hash_after_applying next_staged_ledger_hash + , `Ledger_proof ledger_proof_opt + , `Staged_ledger transitioned_staged_ledger + , `Pending_coinbase_update (is_new_stack, pending_coinbase_update) + ) -> + (*staged_ledger remains unchanged and transitioned_staged_ledger is discarded because the external transtion created out of this diff will be applied in Transition_frontier*) + ignore + @@ Ledger.unregister_mask_exn ~loc:__LOC__ + (Staged_ledger.ledger transitioned_staged_ledger) ; + Some + ( (match diff with Ok diff -> diff | Error _ -> assert false) + , next_staged_ledger_hash + , ledger_proof_opt + , is_new_stack + , pending_coinbase_update ) + | Error (Staged_ledger.Staged_ledger_error.Unexpected e) -> + [%log error] "Failed to apply the diff: $error" + ~metadata:[ ("error", Error_json.error_to_yojson e) ] ; + None + | Error e -> + ( match diff with + | Ok diff -> + [%log error] + ~metadata: + [ ( "error" + , `String + (Staged_ledger.Staged_ledger_error.to_string e) ) + ; ( "diff" + , Staged_ledger_diff.With_valid_signatures_and_proofs + .to_yojson diff ) + ] + "Error applying the diff $diff: $error" + | Error e -> + [%log error] "Error building the diff: $error" + ~metadata: + [ ( "error" + , `String + (Staged_ledger.Staged_ledger_error.to_string e) ) + ] ) ; + None) + in + match res with + | None -> + Interruptible.return None + | Some + ( diff + , next_staged_ledger_hash + , ledger_proof_opt + , is_new_stack + , pending_coinbase_update ) -> + let%bind protocol_state, consensus_transition_data = + lift_sync (fun () -> + let previous_ledger_hash = + previous_protocol_state |> Protocol_state.blockchain_state + |> Blockchain_state.snarked_ledger_hash + in + let next_ledger_hash = + Option.value_map ledger_proof_opt + ~f:(fun (proof, _) -> + Ledger_proof.statement proof + |> Ledger_proof.statement_target ) + ~default:previous_ledger_hash + in + let snarked_next_available_token = + match ledger_proof_opt with + | Some (proof, _) -> + (Ledger_proof.statement proof).next_available_token_after + | None -> + previous_protocol_state |> Protocol_state.blockchain_state + |> Blockchain_state.snarked_next_available_token + in + let genesis_ledger_hash = + previous_protocol_state |> Protocol_state.blockchain_state + |> Blockchain_state.genesis_ledger_hash + in + let supply_increase = + Option.value_map ledger_proof_opt + ~f:(fun (proof, _) -> + (Ledger_proof.statement proof).supply_increase ) + ~default:Currency.Amount.zero + in + let blockchain_state = + (* We use the time of the beginning of the slot because if things + are slower than expected, we may have entered the next slot and + putting the **current** timestamp rather than the expected one + will screw things up. + + [generate_transition] will log an error if the [current_time] + has a different slot from the [scheduled_time] + *) + Blockchain_state.create_value ~timestamp:scheduled_time + ~snarked_ledger_hash:next_ledger_hash ~genesis_ledger_hash + ~snarked_next_available_token + ~staged_ledger_hash:next_staged_ledger_hash + in + let current_time = + Block_time.now time_controller + |> Block_time.to_span_since_epoch |> Block_time.Span.to_ms + in + O1trace.sync_thread "generate_consensus_transition" (fun () -> + Consensus_state_hooks.generate_transition + ~previous_protocol_state ~blockchain_state ~current_time + ~block_data ~supercharge_coinbase + ~snarked_ledger_hash:previous_ledger_hash + ~genesis_ledger_hash ~supply_increase ~logger + ~constraint_constants ) ) in - Some (protocol_state, internal_transition, witness) ) + lift_sync (fun () -> + let snark_transition = + O1trace.sync_thread "generate_snark_transition" (fun () -> + Snark_transition.create_value + ~blockchain_state: + (Protocol_state.blockchain_state protocol_state) + ~consensus_transition:consensus_transition_data + ~pending_coinbase_update () ) + in + let internal_transition = + O1trace.sync_thread "generate_internal_transition" (fun () -> + Internal_transition.create ~snark_transition + ~prover_state: + (Consensus.Data.Block_data.prover_state block_data) + ~staged_ledger_diff:(Staged_ledger_diff.forget diff) + ~ledger_proof: + (Option.map ledger_proof_opt ~f:(fun (proof, _) -> + proof ) ) ) + in + let witness = + { Pending_coinbase_witness.pending_coinbases = + Staged_ledger.pending_coinbase_collection staged_ledger + ; is_new_stack + } + in + Some (protocol_state, internal_transition, witness) ) ) module Precomputed = struct type t = Precomputed.t = @@ -584,6 +610,13 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system let log_bootstrap_mode () = [%log info] "Pausing block production while bootstrapping" in + let slot_tx_end = + Runtime_config.slot_tx_end_or_default precomputed_values.runtime_config + in + let slot_chain_end = + Runtime_config.slot_chain_end_or_default + precomputed_values.runtime_config + in let module Breadcrumb = Transition_frontier.Breadcrumb in let produce ivar (scheduled_time, block_data, winner_pk) = let open Interruptible.Let_syntax in @@ -667,7 +700,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~block_data ~previous_protocol_state ~time_controller ~staged_ledger:(Breadcrumb.staged_ledger crumb) ~transactions ~get_completed_work ~logger ~log_block_creation - ~winner_pk ~block_reward_threshold + ~winner_pk ~block_reward_threshold ~slot_tx_end ~slot_chain_end in match next_state_opt with | None -> @@ -919,6 +952,39 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system in let i' = Mina_numbers.Length.succ epoch_data_for_vrf.epoch in let new_global_slot = epoch_data_for_vrf.global_slot in + let log_if_slot_diff_is_less_than = + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) + in + fun ~diff_limit ~every ~message -> function + | None -> + () + | Some slot -> + let slot_diff = + let open Mina_numbers.Global_slot in + Option.map ~f:to_int @@ sub slot current_global_slot + in + Option.iter slot_diff ~f:(fun slot_diff' -> + if + slot_diff' <= diff_limit + && slot_diff' mod every = 0 + then + [%log info] message + ~metadata:[ ("slot_diff", `Int slot_diff') ] ) + in + log_if_slot_diff_is_less_than ~diff_limit:480 ~every:60 + ~message: + "Block producer will stop producing blocks after \ + $slot_diff slots" + slot_chain_end ; + log_if_slot_diff_is_less_than ~diff_limit:480 ~every:60 + ~message: + "Block producer will begin producing only empty blocks \ + after $slot_diff slots" + slot_tx_end ; let generate_genesis_proof_if_needed () = match Broadcast_pipe.Reader.peek frontier_reader with | Some transition_frontier -> diff --git a/src/lib/block_producer/dune b/src/lib/block_producer/dune index 5b8e1ce3307..43d08f862b9 100644 --- a/src/lib/block_producer/dune +++ b/src/lib/block_producer/dune @@ -51,6 +51,7 @@ unsigned_extended genesis_constants data_hash_lib + runtime_config ) (preprocess (pps ppx_coda ppx_version ppx_jane ppx_register_event)) diff --git a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml index 8b748a65348..49f90b2b491 100644 --- a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml +++ b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml @@ -545,6 +545,8 @@ let runtime_config_of_precomputed_values (precomputed_values : Genesis_proof.t) { txpool_max_size = Some precomputed_values.genesis_constants.txpool_max_size ; peer_list_url = None + ; slot_tx_end = None + ; slot_chain_end = None } ; genesis = Some diff --git a/src/lib/integration_test_cloud_engine/mina_automation.ml b/src/lib/integration_test_cloud_engine/mina_automation.ml index 3a8236a52d8..3fbf627dc42 100644 --- a/src/lib/integration_test_cloud_engine/mina_automation.ml +++ b/src/lib/integration_test_cloud_engine/mina_automation.ml @@ -123,6 +123,8 @@ module Network_config = struct ; slots_per_epoch ; slots_per_sub_window ; txpool_max_size + ; slot_tx_end + ; slot_chain_end } = test_config in @@ -215,7 +217,12 @@ module Network_config = struct in let runtime_config = { Runtime_config.daemon = - Some { txpool_max_size = Some txpool_max_size; peer_list_url = None } + Some + { txpool_max_size = Some txpool_max_size + ; peer_list_url = None + ; slot_tx_end + ; slot_chain_end + } ; genesis = Some { k = Some k diff --git a/src/lib/integration_test_lib/graphql_requests.ml b/src/lib/integration_test_lib/graphql_requests.ml index 621aa9ed4b3..7f6393899ee 100644 --- a/src/lib/integration_test_lib/graphql_requests.ml +++ b/src/lib/integration_test_lib/graphql_requests.ml @@ -192,6 +192,29 @@ module Graphql = struct } } |}] + + module Best_chain_for_slot_end_test = + [%graphql + {| + query ($max_length: Int) @encoders(module: "Encoders") { + bestChain(maxLength: $max_length) { + stateHash + commandTransactionCount + protocolState { + consensusState { + slot + slotSinceGenesis + } + } + transactions { + coinbase + } + snarkJobs { + workIds + } + } + } + |}] end (* this function will repeatedly attempt to connect to graphql port times before giving up *) @@ -712,3 +735,40 @@ let get_filtered_log_entries ~last_log_index_seen node_uri = else Deferred.Or_error.error_string "Node is not currently capturing structured log messages" + +type best_chain_block_for_slot_end_test = + { state_hash : string + ; command_transaction_count : int + ; coinbase : int + ; snark_work_count : int + ; slot : Unsigned.uint32 + ; slot_since_genesis : Unsigned.uint32 + } + +let get_best_chain_for_slot_end_test ?max_length ~logger node_uri = + let open Deferred.Or_error.Let_syntax in + let query_obj = + Graphql.Best_chain_for_slot_end_test.(make @@ makeVariables ?max_length ()) + in + let%bind result = + exec_graphql_request ~logger ~retry_delay_sec:10.0 ~node_uri + ~query_name:"GetBlockSlot" query_obj + in + match result.bestChain with + | None | Some [||] -> + Deferred.Or_error.error_string "failed to get best chains" + | Some chain -> + return + @@ List.map (Array.to_list chain) ~f:(fun block -> + { state_hash = block.stateHash + ; command_transaction_count = block.commandTransactionCount + ; coinbase = Unsigned.UInt64.to_int block.transactions.coinbase + ; snark_work_count = block.snarkJobs |> Array.length + ; slot = block.protocolState.consensusState.slot + ; slot_since_genesis = + block.protocolState.consensusState.slotSinceGenesis + } ) + +let must_get_best_chain_for_slot_end_test ?max_length ~logger node_uri = + get_best_chain_for_slot_end_test ?max_length ~logger node_uri + |> Deferred.bind ~f:Malleable_error.or_hard_error diff --git a/src/lib/integration_test_lib/test_config.ml b/src/lib/integration_test_lib/test_config.ml index a05a9ee5e11..99c5b763535 100644 --- a/src/lib/integration_test_lib/test_config.ml +++ b/src/lib/integration_test_lib/test_config.ml @@ -51,6 +51,8 @@ type t = ; slots_per_epoch : int ; slots_per_sub_window : int ; txpool_max_size : int + ; slot_tx_end : int option + ; slot_chain_end : int option } let proof_config_default : Runtime_config.Proof_keys.t = @@ -82,6 +84,8 @@ let default = ; slots_per_sub_window = 2 ; delta = 0 ; txpool_max_size = 3000 + ; slot_tx_end = None + ; slot_chain_end = None } let transaction_capacity_log_2 (config : t) = diff --git a/src/lib/ledger_catchup/dune b/src/lib/ledger_catchup/dune index b0379dfddb1..9570f3226d4 100644 --- a/src/lib/ledger_catchup/dune +++ b/src/lib/ledger_catchup/dune @@ -62,4 +62,5 @@ marlin_plonk_bindings_pasta_fp pasta mina_net2 + runtime_config )) diff --git a/src/lib/ledger_catchup/normal_catchup.ml b/src/lib/ledger_catchup/normal_catchup.ml index 2110619b58c..6b74be0a1a7 100644 --- a/src/lib/ledger_catchup/normal_catchup.ml +++ b/src/lib/ledger_catchup/normal_catchup.ml @@ -46,7 +46,8 @@ open Network_peer the [Processor] via writing them to catchup_breadcrumbs_writer. *) let verify_transition ~logger ~consensus_constants ~trust_system ~frontier - ~unprocessed_transition_cache enveloped_transition = + ~unprocessed_transition_cache ~slot_tx_end ~slot_chain_end + enveloped_transition = let sender = Envelope.Incoming.sender enveloped_transition in let genesis_state_hash = Transition_frontier.genesis_state_hash frontier in let transition_with_hash = Envelope.Incoming.data enveloped_transition in @@ -67,7 +68,7 @@ let verify_transition ~logger ~consensus_constants ~trust_system ~frontier in Transition_handler.Validator.validate_transition ~logger ~frontier ~consensus_constants ~unprocessed_transition_cache - enveloped_initially_validated_transition + enveloped_initially_validated_transition ~slot_tx_end ~slot_chain_end in let open Deferred.Let_syntax in match cached_initially_validated_transition_result with @@ -155,6 +156,10 @@ let verify_transition ~logger ~consensus_constants ~trust_system ~frontier Error (Error.of_string "mismatched protocol version") | Error `Disconnected -> Deferred.Or_error.fail @@ Error.of_string "disconnected chain" + | Error `Non_empty_staged_ledger_diff_after_stop_slot -> + Deferred.Or_error.fail @@ Error.of_string "non empty staged ledger diff" + | Error `Block_after_after_stop_slot -> + Deferred.Or_error.fail @@ Error.of_string "block after stop slot" let rec fold_until ~(init : 'accum) ~(f : @@ -511,13 +516,20 @@ let verify_transitions_and_build_breadcrumbs ~logger @@ diff verification_end_time verification_start_time) ) ] "verification of proofs complete" ; + let slot_tx_end = + Runtime_config.slot_tx_end_or_default precomputed_values.runtime_config + in + let slot_chain_end = + Runtime_config.slot_chain_end_or_default precomputed_values.runtime_config + in fold_until (List.rev tvs) ~init:[] ~f:(fun acc transition -> let open Deferred.Let_syntax in match%bind verify_transition ~logger ~consensus_constants:precomputed_values.consensus_constants - ~trust_system ~frontier ~unprocessed_transition_cache transition + ~trust_system ~frontier ~unprocessed_transition_cache ~slot_tx_end + ~slot_chain_end transition with | Error e -> List.iter acc ~f:(fun (node, vc) -> diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index 0b928a180f5..f7d8ebd8e77 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -120,7 +120,8 @@ let write_graph (_ : t) = () let verify_transition ~logger ~consensus_constants ~trust_system ~frontier - ~unprocessed_transition_cache enveloped_transition = + ~unprocessed_transition_cache ~slot_tx_end ~slot_chain_end + enveloped_transition = let sender = Envelope.Incoming.sender enveloped_transition in let genesis_state_hash = Transition_frontier.genesis_state_hash frontier in let transition_with_hash = Envelope.Incoming.data enveloped_transition in @@ -139,8 +140,8 @@ let verify_transition ~logger ~consensus_constants ~trust_system ~frontier ~f:(Fn.const initially_validated_transition) in Transition_handler.Validator.validate_transition ~logger ~frontier - ~consensus_constants ~unprocessed_transition_cache - enveloped_initially_validated_transition + ~consensus_constants ~unprocessed_transition_cache ~slot_tx_end + ~slot_chain_end enveloped_initially_validated_transition in let state_hash = Validation.block_with_hash transition_with_hash @@ -265,6 +266,17 @@ let verify_transition ~logger ~consensus_constants ~trust_system ~frontier ~metadata:[ ("state_hash", state_hash) ] "initial_validate: disconnected chain" ; Deferred.Or_error.fail @@ Error.of_string "disconnected chain" + | Error `Non_empty_staged_ledger_diff_after_stop_slot -> + [%log warn] + ~metadata:[ ("state_hash", state_hash) ] + "initial_validate: transition with non empty staged ledger diff after \ + slot_tx_end" ; + Deferred.Or_error.fail @@ Error.of_string "non empty staged ledger diff" + | Error `Block_after_after_stop_slot -> + [%log warn] + ~metadata:[ ("state_hash", state_hash) ] + "initial_validate: block after slot_chain_end" ; + Deferred.Or_error.fail @@ Error.of_string "block after stop slot" let find_map_ok ?how xs ~f = let res = Ivar.create () in @@ -606,9 +618,15 @@ let initial_validate ~(precomputed_values : Precomputed_values.t) ~logger ; ("state_hash", state_hash) ] "initial_validate: verification of proofs complete" ; + let slot_tx_end = + Runtime_config.slot_tx_end_or_default precomputed_values.runtime_config + in + let slot_chain_end = + Runtime_config.slot_chain_end_or_default precomputed_values.runtime_config + in verify_transition ~logger ~consensus_constants:precomputed_values.consensus_constants ~trust_system - ~frontier ~unprocessed_transition_cache tv + ~frontier ~unprocessed_transition_cache ~slot_tx_end ~slot_chain_end tv |> Deferred.map ~f:(Result.map_error ~f:(fun e -> `Error e)) open Frontier_base diff --git a/src/lib/mina_compile_config/dune b/src/lib/mina_compile_config/dune index 2993d166abd..a193f69b774 100644 --- a/src/lib/mina_compile_config/dune +++ b/src/lib/mina_compile_config/dune @@ -1,7 +1,7 @@ (library (name mina_compile_config) (public_name mina_compile_config) - (libraries currency) + (libraries currency mina_numbers) (preprocessor_deps ../../config.mlh) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_version ppx_base ppx_optcomp))) diff --git a/src/lib/mina_compile_config/mina_compile_config.ml b/src/lib/mina_compile_config/mina_compile_config.ml index 0fd03ab90ad..b3c1f79027c 100644 --- a/src/lib/mina_compile_config/mina_compile_config.ml +++ b/src/lib/mina_compile_config/mina_compile_config.ml @@ -48,3 +48,27 @@ let rpc_heartbeat_timeout_sec = 60.0 let rpc_heartbeat_send_every_sec = 10.0 (*same as the default*) [%%inject "generate_genesis_proof", generate_genesis_proof] + +[%%ifndef slot_tx_end] + +let slot_tx_end : Mina_numbers.Global_slot.t option = None + +[%%else] + +[%%inject "slot_tx_end", slot_tx_end] + +let slot_tx_end = Some (Mina_numbers.Global_slot.of_int slot_tx_end) + +[%%endif] + +[%%ifndef slot_chain_end] + +let slot_chain_end : Mina_numbers.Global_slot.t option = None + +[%%else] + +[%%inject "slot_chain_end", slot_chain_end] + +let slot_chain_end = Some (Mina_numbers.Global_slot.of_int slot_chain_end) + +[%%endif] diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index c760df6b736..fa9006be8d3 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1562,11 +1562,16 @@ let create ?wallets (config : Config.t) = | Some net -> Mina_networking.peers net ) in + let slot_tx_end = + Runtime_config.slot_tx_end_or_default + config.Config.precomputed_values.runtime_config + in let txn_pool_config = Network_pool.Transaction_pool.Resource_pool.make_config ~verifier ~trust_system:config.trust_system ~pool_max_size: config.precomputed_values.genesis_constants.txpool_max_size + ~slot_tx_end in let first_received_message_signal = Ivar.create () in let online_status, notify_online_impl = diff --git a/src/lib/network_pool/indexed_pool.ml b/src/lib/network_pool/indexed_pool.ml index d1d43def107..40ed92f83a3 100644 --- a/src/lib/network_pool/indexed_pool.ml +++ b/src/lib/network_pool/indexed_pool.ml @@ -47,6 +47,7 @@ type t = ; constraint_constants : Genesis_constants.Constraint_constants.t ; consensus_constants : Consensus.Constants.t ; time_controller : Block_time.Controller.t + ; slot_tx_end : Mina_numbers.Global_slot.t option } [@@deriving sexp_of, equal, compare] @@ -72,6 +73,7 @@ module Command_error = struct * [ `Current_global_slot of Mina_numbers.Global_slot.t ] | Unwanted_fee_token of Token_id.t | Invalid_transaction + | After_slot_tx_end [@@deriving sexp_of, to_yojson] end @@ -298,7 +300,8 @@ module For_tests = struct [%test_eq: int] (Map.length all_by_hash) size end -let empty ~constraint_constants ~consensus_constants ~time_controller : t = +let empty ~constraint_constants ~consensus_constants ~time_controller + ~slot_tx_end : t = { applicable_by_fee = Currency.Fee.Map.empty ; all_by_sender = Account_id.Map.empty ; all_by_fee = Currency.Fee.Map.empty @@ -308,6 +311,7 @@ let empty ~constraint_constants ~consensus_constants ~time_controller : t = ; constraint_constants ; consensus_constants ; time_controller + ; slot_tx_end } let size : t -> int = fun t -> t.size @@ -725,10 +729,25 @@ let rec add_from_gossip_exn : * Transaction_hash.User_command_with_valid_signature.t Sequence.t , Command_error.t ) Result.t = - fun ({ constraint_constants; consensus_constants; time_controller; _ } as t) - ~verify cmd0 current_nonce balance -> + fun ( { constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + ; _ + } as t ) ~verify cmd0 current_nonce balance -> let open Command_error in let open Result.Let_syntax in + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) + in + let%bind () = + Result.ok_if_true ~error:After_slot_tx_end + @@ Option.value_map slot_tx_end ~default:true ~f:(fun slot_tx_end' -> + Global_slot.(current_global_slot < slot_tx_end') ) + in let unchecked_cmd = match cmd0 with | `Unchecked x -> @@ -804,6 +823,7 @@ let rec add_from_gossip_exn : ; constraint_constants ; consensus_constants ; time_controller + ; slot_tx_end } , Sequence.empty ) | Some (queued_cmds, reserved_currency) -> @@ -966,9 +986,24 @@ let add_from_backtrack : t -> Transaction_hash.User_command_with_valid_signature.t -> (t, Command_error.t) Result.t = - fun ({ constraint_constants; consensus_constants; time_controller; _ } as t) - cmd -> + fun ( { constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + ; _ + } as t ) cmd -> let open Result.Let_syntax in + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) + in + let%bind () = + Result.ok_if_true ~error:Command_error.After_slot_tx_end + @@ Option.value_map slot_tx_end ~default:true ~f:(fun slot_tx_end' -> + Global_slot.(current_global_slot < slot_tx_end') ) + in let unchecked = Transaction_hash.User_command_with_valid_signature.command cmd in @@ -1004,6 +1039,7 @@ let add_from_backtrack : ; constraint_constants ; consensus_constants ; time_controller + ; slot_tx_end } | Some (queue, currency_reserved) -> let first_queued = F_sequence.head_exn queue in @@ -1047,6 +1083,7 @@ let add_from_backtrack : ; constraint_constants ; consensus_constants ; time_controller + ; slot_tx_end } (* Only show stdout for failed inline tests. *) @@ -1075,8 +1112,11 @@ let%test_module _ = let time_controller = Block_time.Controller.basic ~logger + let slot_tx_end = None + let empty = empty ~constraint_constants ~consensus_constants ~time_controller + ~slot_tx_end let%test_unit "empty invariants" = assert_invariants empty @@ -1217,7 +1257,11 @@ let%test_module _ = !"Expired user command. Current global slot is \ %{sexp:Mina_numbers.Global_slot.t} but user command is \ only valid until %{sexp:Mina_numbers.Global_slot.t}" - current_global_slot valid_until () ) + current_global_slot valid_until () + | Error After_slot_tx_end -> + failwith + "Transaction was submitted after the slot defined to \ + stop accepting transactions" ) in go cmds ) diff --git a/src/lib/network_pool/indexed_pool.mli b/src/lib/network_pool/indexed_pool.mli index fa2fb734007..4cf2f696e40 100644 --- a/src/lib/network_pool/indexed_pool.mli +++ b/src/lib/network_pool/indexed_pool.mli @@ -27,6 +27,7 @@ module Command_error : sig * [ `Current_global_slot of Mina_numbers.Global_slot.t ] | Unwanted_fee_token of Token_id.t | Invalid_transaction + | After_slot_tx_end [@@deriving sexp_of, to_yojson] end @@ -42,6 +43,7 @@ val empty : constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t + -> slot_tx_end:Mina_numbers.Global_slot.t option -> t (** How many transactions are currently in the pool *) diff --git a/src/lib/network_pool/intf.ml b/src/lib/network_pool/intf.ml index b93cea139f2..b75415c3deb 100644 --- a/src/lib/network_pool/intf.ml +++ b/src/lib/network_pool/intf.ml @@ -309,6 +309,7 @@ module type Transaction_pool_diff_intf = sig | Unwanted_fee_token | Expired | Overloaded + | After_slot_tx_end [@@deriving sexp, yojson] val to_string_hum : t -> string @@ -338,6 +339,7 @@ module type Transaction_resource_pool_intf = sig trust_system:Trust_system.t -> pool_max_size:int -> verifier:Verifier.t + -> slot_tx_end:Mina_numbers.Global_slot.t option -> Config.t val member : t -> Transaction_hash.User_command_with_valid_signature.t -> bool diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 646d4476f22..2fc992c8bb7 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -65,7 +65,7 @@ module Diff_versioned = struct module Stable = struct [@@@no_toplevel_latest_type] - module V1 = struct + module V2 = struct type t = | Insufficient_replace_fee | Invalid_signature @@ -79,10 +79,54 @@ module Diff_versioned = struct | Unwanted_fee_token | Expired | Overloaded + | After_slot_tx_end [@@deriving sexp, yojson] let to_latest = Fn.id end + + module V1 = struct + type t = + | Insufficient_replace_fee + | Invalid_signature + | Duplicate + | Sender_account_does_not_exist + | Invalid_nonce + | Insufficient_funds + | Insufficient_fee + | Overflow + | Bad_token + | Unwanted_fee_token + | Expired + | Overloaded + [@@deriving sexp, yojson] + + let to_latest = function + | Insufficient_replace_fee -> + V2.Insufficient_replace_fee + | Invalid_signature -> + V2.Invalid_signature + | Duplicate -> + V2.Duplicate + | Sender_account_does_not_exist -> + V2.Sender_account_does_not_exist + | Invalid_nonce -> + V2.Invalid_nonce + | Insufficient_funds -> + V2.Insufficient_funds + | Insufficient_fee -> + V2.Insufficient_fee + | Overflow -> + V2.Overflow + | Bad_token -> + V2.Bad_token + | Unwanted_fee_token -> + V2.Unwanted_fee_token + | Expired -> + V2.Expired + | Overloaded -> + V2.Overloaded + end end] (* IMPORTANT! Do not change the names of these errors as to adjust the @@ -101,6 +145,7 @@ module Diff_versioned = struct | Unwanted_fee_token | Expired | Overloaded + | After_slot_tx_end [@@deriving sexp, yojson] let to_string_hum = function @@ -133,6 +178,9 @@ module Diff_versioned = struct "This transaction has expired" | Overloaded -> "The diff containing this transaction was too large" + | After_slot_tx_end -> + "This transaction was submitted after the slot defined to stop \ + accepting transactions" end module Rejected = struct @@ -140,11 +188,20 @@ module Diff_versioned = struct module Stable = struct [@@@no_toplevel_latest_type] + module V2 = struct + type t = (User_command.Stable.V1.t * Diff_error.Stable.V2.t) list + [@@deriving sexp, yojson] + + let to_latest = Fn.id + end + module V1 = struct type t = (User_command.Stable.V1.t * Diff_error.Stable.V1.t) list [@@deriving sexp, yojson] - let to_latest = Fn.id + let to_latest = + List.map ~f:(fun (cmd, error) -> + (cmd, Diff_error.Stable.V1.to_latest error) ) end end] @@ -224,8 +281,14 @@ struct themselves banned. *) ; verifier : (Verifier.t[@sexp.opaque]) + ; slot_tx_end : Mina_numbers.Global_slot.t option } - [@@deriving sexp_of, make] + [@@deriving sexp_of] + + (* remove next line if there's a way to force [@@deriving make] write a + named parameter instead of an optional parameter *) + let make ~trust_system ~pool_max_size ~verifier ~slot_tx_end = + { trust_system; pool_max_size; verifier; slot_tx_end } end let make_config = Config.make @@ -393,6 +456,8 @@ struct ; ( "current_global_slot" , Mina_numbers.Global_slot.to_yojson current_global_slot ) ] ) + | After_slot_tx_end -> + ("after_slot_tx_end", []) let balance_of_account ~global_slot (account : Account.t) = match account.timing with @@ -699,7 +764,7 @@ struct let t = { pool = Indexed_pool.empty ~constraint_constants ~consensus_constants - ~time_controller + ~time_controller ~slot_tx_end:config.Config.slot_tx_end ; locally_generated_uncommitted = Hashtbl.create ( module Transaction_hash.User_command_with_valid_signature.Stable @@ -850,6 +915,7 @@ struct | Unwanted_fee_token | Expired | Overloaded + | After_slot_tx_end [@@deriving sexp, yojson] let to_string_hum = Diff_versioned.Diff_error.to_string_hum @@ -1123,6 +1189,8 @@ struct , Mina_numbers.Global_slot.to_yojson current_global_slot ) ] ) + | After_slot_tx_end -> + (After_slot_tx_end, []) in let yojson_fail_reason = Fn.compose @@ -1144,7 +1212,9 @@ struct | Unwanted_fee_token _ -> "unwanted fee token" | Expired _ -> - "expired" ) + "expired" + | After_slot_tx_end -> + "after slot tx end" ) in match add_res with | Ok (verified, pool', dropped) -> @@ -1564,12 +1634,13 @@ let%test_module _ = , Time.t * [ `Batch of int ] ) Hashtbl.t ) - let setup_test () = + let setup_test ~slot_tx_end () = let tf, best_tip_diff_w = Mock_transition_frontier.create () in let tf_pipe_r, _tf_pipe_w = Broadcast_pipe.create @@ Some tf in let trust_system = Trust_system.null () in let config = Test.Resource_pool.make_config ~trust_system ~pool_max_size ~verifier + ~slot_tx_end in let pool_, _, _ = Test.create ~config ~logger ~constraint_constants ~consensus_constants @@ -1647,7 +1718,7 @@ let%test_module _ = let%test_unit "transactions are removed in linear case" = Thread_safe.block_on_async_exn (fun () -> let%bind assert_pool_txs, pool, best_tip_diff_w, _frontier = - setup_test () + setup_test ~slot_tx_end:None () in assert_pool_txs [] ; let%bind apply_res = @@ -1711,7 +1782,7 @@ let%test_module _ = let%test_unit "Transactions are removed and added back in fork changes" = Thread_safe.block_on_async_exn (fun () -> let%bind assert_pool_txs, pool, best_tip_diff_w, (_, best_tip_ref) = - setup_test () + setup_test ~slot_tx_end:None () in assert_pool_txs [] ; let%bind apply_res = @@ -1741,7 +1812,7 @@ let%test_module _ = let%test_unit "invalid transactions are not accepted" = Thread_safe.block_on_async_exn (fun () -> let%bind assert_pool_txs, pool, best_tip_diff_w, (_, best_tip_ref) = - setup_test () + setup_test ~slot_tx_end:None () in assert_pool_txs [] ; best_tip_ref := @@ -1795,7 +1866,7 @@ let%test_module _ = changes" = Thread_safe.block_on_async_exn (fun () -> let%bind assert_pool_txs, pool, best_tip_diff_w, (_, best_tip_ref) = - setup_test () + setup_test ~slot_tx_end:None () in assert_pool_txs [] ; best_tip_ref := @@ -1861,7 +1932,7 @@ let%test_module _ = let%test_unit "expired transactions are not accepted" = Thread_safe.block_on_async_exn (fun () -> let%bind assert_pool_txs, pool, _best_tip_diff_w, (_, _best_tip_ref) = - setup_test () + setup_test ~slot_tx_end:None () in assert_pool_txs [] ; let curr_slot = current_global_slot () in @@ -1903,7 +1974,7 @@ let%test_module _ = removed from the pool when best tip changes" = Thread_safe.block_on_async_exn (fun () -> let%bind assert_pool_txs, pool, best_tip_diff_w, (_, best_tip_ref) = - setup_test () + setup_test ~slot_tx_end:None () in assert_pool_txs [] ; let curr_slot = current_global_slot () in @@ -2021,7 +2092,7 @@ let%test_module _ = let trust_system = Trust_system.null () in let config = Test.Resource_pool.make_config ~trust_system ~pool_max_size - ~verifier + ~verifier ~slot_tx_end:None in let pool_, _, _ = Test.create ~config ~logger ~constraint_constants @@ -2075,7 +2146,7 @@ let%test_module _ = Thread_safe.block_on_async_exn @@ fun () -> let%bind assert_pool_txs, pool, _best_tip_diff_w, frontier = - setup_test () + setup_test ~slot_tx_end:None () in let set_sender idx (tx : Signed_command.t) = let sender_kp = test_keys.(idx) in @@ -2166,7 +2237,7 @@ let%test_module _ = Thread_safe.block_on_async_exn @@ fun () -> let%bind assert_pool_txs, pool, best_tip_diff_w, (_, best_tip_ref) = - setup_test () + setup_test ~slot_tx_end:None () in let txs = [ mk_payment 0 5_000_000_000 0 9 20_000_000_000 @@ -2208,7 +2279,7 @@ let%test_module _ = Thread_safe.block_on_async_exn (fun () -> let%bind _assert_pool_txs, pool, best_tip_diff_w, (_, best_tip_ref) = - setup_test () + setup_test ~slot_tx_end:None () in let mock_ledger = Account_id.Map.of_alist_exn @@ -2276,7 +2347,7 @@ let%test_module _ = let%test_unit "rebroadcastable transaction behavior" = Thread_safe.block_on_async_exn (fun () -> let%bind assert_pool_txs, pool, best_tip_diff_w, _frontier = - setup_test () + setup_test ~slot_tx_end:None () in assert_pool_txs [] ; let local_cmds = List.take independent_cmds 5 in @@ -2379,4 +2450,49 @@ let%test_module _ = assert_pool_txs (List.drop local_cmds' 4 @ remote_cmds') ; assert_rebroadcastable pool [] ; Deferred.unit ) + + let%test_unit "transactions added before slot_tx_end are accepted" = + Thread_safe.block_on_async_exn (fun () -> + let curr_slot = current_global_slot () in + let%bind assert_pool_txs, pool, _best_tip_diff_w, (_, _best_tip_ref) = + setup_test + ~slot_tx_end: + Mina_numbers.Global_slot.(Option.some @@ succ @@ succ curr_slot) + () + in + assert_pool_txs [] ; + let%bind apply_res = + Test.Resource_pool.Diff.unsafe_apply pool + @@ Envelope.Incoming.local + (extract_signed_commands independent_cmds) + in + [%test_eq: pool_apply] (Ok independent_cmds') + (accepted_commands apply_res) ; + assert_pool_txs independent_cmds' ; + Deferred.unit ) + + let test_txns_rejects slot_tx_end = + Thread_safe.block_on_async_exn (fun () -> + let%bind assert_pool_txs, pool, _best_tip_diff_w, (_, _best_tip_ref) = + setup_test ~slot_tx_end:(Some slot_tx_end) () + in + assert_pool_txs [] ; + let%bind apply_res = + Test.Resource_pool.Diff.unsafe_apply pool + @@ Envelope.Incoming.local + (extract_signed_commands independent_cmds) + in + [%test_eq: pool_apply] (Ok []) (accepted_commands apply_res) ; + assert_pool_txs [] ; + Deferred.unit ) + + let%test_unit "transactions added at slot_tx_end are rejected" = + let curr_slot = current_global_slot () in + test_txns_rejects curr_slot + + let%test_unit "transactions added after slot_tx_end are rejected" = + let curr_slot = current_global_slot () in + test_txns_rejects + Mina_numbers.Global_slot.( + Option.value_exn @@ sub curr_slot @@ succ zero) end ) diff --git a/src/lib/runtime_config/dune b/src/lib/runtime_config/dune index 019b5915c8f..c4fd7cc1992 100644 --- a/src/lib/runtime_config/dune +++ b/src/lib/runtime_config/dune @@ -33,6 +33,7 @@ with_hash signature_lib staged_ledger + mina_compile_config ) (instrumentation (backend bisect_ppx)) - (preprocess (pps ppx_custom_printf ppx_sexp_conv ppx_let ppx_deriving_yojson ppx_dhall_type ppx_version ppx_compare))) + (preprocess (pps ppx_custom_printf ppx_sexp_conv ppx_let ppx_deriving_yojson ppx_dhall_type ppx_version ppx_compare))) \ No newline at end of file diff --git a/src/lib/runtime_config/runtime_config.ml b/src/lib/runtime_config/runtime_config.ml index 42106f438e3..e3a5d3df229 100644 --- a/src/lib/runtime_config/runtime_config.ml +++ b/src/lib/runtime_config/runtime_config.ml @@ -378,10 +378,13 @@ module Json_layout = struct type t = { txpool_max_size : int option [@default None] ; peer_list_url : string option [@default None] + ; slot_tx_end : int option [@default None] + ; slot_chain_end : int option [@default None] } [@@deriving yojson, dhall_type] - let fields = [| "txpool_max_size"; "peer_list_url" |] + let fields = + [| "txpool_max_size"; "peer_list_url"; "slot_tx_end"; "slot_chain_end" |] let of_yojson json = of_yojson_generic ~fields of_yojson json end @@ -1090,7 +1093,11 @@ module Daemon = struct a command line argument. Putting it in the config makes the network explicitly rely on a certain number of nodes, reducing decentralisation. See #14766 *) type t = Json_layout.Daemon.t = - { txpool_max_size : int option; peer_list_url : string option } + { txpool_max_size : int option + ; peer_list_url : string option + ; slot_tx_end : int option + ; slot_chain_end : int option + } [@@deriving bin_io_unversioned] let to_json_layout : t -> Json_layout.Daemon.t = Fn.id @@ -1107,12 +1114,19 @@ module Daemon = struct { txpool_max_size = opt_fallthrough ~default:t1.txpool_max_size t2.txpool_max_size ; peer_list_url = opt_fallthrough ~default:t1.peer_list_url t2.peer_list_url + ; slot_tx_end = opt_fallthrough ~default:t1.slot_tx_end t2.slot_tx_end + ; slot_chain_end = + opt_fallthrough ~default:t1.slot_chain_end t2.slot_chain_end } let gen = let open Quickcheck.Generator.Let_syntax in let%map txpool_max_size = Int.gen_incl 0 1000 in - { txpool_max_size = Some txpool_max_size; peer_list_url = None } + { txpool_max_size = Some txpool_max_size + ; peer_list_url = None + ; slot_tx_end = None + ; slot_chain_end = None + } end module Epoch_data = struct @@ -1367,6 +1381,16 @@ let make_fork_config ~staged_ledger ~global_slot ~blockchain_length in combine runtime_config update +let slot_tx_end_or_default, slot_chain_end_or_default = + let f compile get_runtime t = + Option.value_map t.daemon ~default:compile ~f:(fun daemon -> + Option.merge compile ~f:(fun _c r -> r) + @@ Option.map ~f:Mina_numbers.Global_slot.of_int + @@ get_runtime daemon ) + in + ( f Mina_compile_config.slot_tx_end (fun d -> d.slot_tx_end) + , f Mina_compile_config.slot_chain_end (fun d -> d.slot_chain_end) ) + module Test_configs = struct let bootstrap = lazy diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml index 06cc0f9d7dc..07cfc79a521 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml @@ -114,7 +114,7 @@ let%test_module "transaction_status" = let create_pool ~frontier_broadcast_pipe = let config = Transaction_pool.Resource_pool.make_config ~trust_system ~pool_max_size - ~verifier + ~verifier ~slot_tx_end:None in let transaction_pool, _, local_sink = Transaction_pool.create ~config diff --git a/src/lib/transition_frontier_controller/transition_frontier_controller.ml b/src/lib/transition_frontier_controller/transition_frontier_controller.ml index 15c647b1ab2..66f548df443 100644 --- a/src/lib/transition_frontier_controller/transition_frontier_controller.ml +++ b/src/lib/transition_frontier_controller/transition_frontier_controller.ml @@ -102,7 +102,7 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller (Precomputed_values.consensus_constants precomputed_values) ~logger ~trust_system ~time_controller ~frontier ~transition_reader:network_transition_reader ~valid_transition_writer - ~unprocessed_transition_cache ; + ~unprocessed_transition_cache ~precomputed_values ; Strict_pipe.Reader.iter_without_pushback valid_transition_reader ~f:(fun (`Block b, `Valid_cb vc) -> Strict_pipe.Writer.write primary_transition_writer (`Block b, `Valid_cb vc) ) diff --git a/src/lib/transition_handler/dune b/src/lib/transition_handler/dune index 9bfa788747a..06deaa49115 100644 --- a/src/lib/transition_handler/dune +++ b/src/lib/transition_handler/dune @@ -45,6 +45,8 @@ mina_net2 result mina_numbers + staged_ledger_diff + runtime_config ) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_coda ppx_version ppx_jane))) diff --git a/src/lib/transition_handler/validator.ml b/src/lib/transition_handler/validator.ml index 6cd8dbceb3d..ab53fc77f60 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -8,7 +8,8 @@ open Mina_block open Network_peer let validate_transition ~consensus_constants ~logger ~frontier - ~unprocessed_transition_cache enveloped_transition = + ~unprocessed_transition_cache ~slot_tx_end ~slot_chain_end + enveloped_transition = let open Result.Let_syntax in let transition = Envelope.Incoming.data enveloped_transition @@ -16,6 +17,37 @@ let validate_transition ~consensus_constants ~logger ~frontier in let transition_hash = State_hash.With_state_hashes.state_hash transition in let root_breadcrumb = Transition_frontier.root frontier in + let transition_data = With_hash.data transition in + let block_slot = + Consensus.Data.Consensus_state.curr_global_slot + @@ Protocol_state.consensus_state @@ Header.protocol_state + @@ Mina_block.header transition_data + in + let%bind () = + match slot_chain_end with + | Some slot_chain_end + when Mina_numbers.Global_slot.(block_slot >= slot_chain_end) -> + [%log info] "Block after slot_chain_end, rejecting" ; + Result.fail `Block_after_after_stop_slot + | None | Some _ -> + Result.return () + in + let%bind () = + match slot_tx_end with + | Some slot_tx_end when Mina_numbers.Global_slot.(block_slot >= slot_tx_end) + -> + [%log info] "Block after slot_tx_end, validating it is empty" ; + let staged_ledger_diff = + Body.staged_ledger_diff @@ body transition_data + in + Result.ok_if_true + ( Staged_ledger_diff.compare Staged_ledger_diff.empty_diff + staged_ledger_diff + = 0 ) + ~error:`Non_empty_staged_ledger_diff_after_stop_slot + | None | Some _ -> + Result.(Ok ()) + in let%bind () = Option.fold (Transition_frontier.find frontier transition_hash) @@ -57,7 +89,7 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier * [ `Valid_cb of Mina_net2.Validation_callback.t option ] , drop_head buffered , unit ) - Writer.t ) ~unprocessed_transition_cache = + Writer.t ) ~unprocessed_transition_cache ~precomputed_values = let module Lru = Core_extended_cache.Lru in O1trace.background_thread "validate_blocks_against_frontier" (fun () -> Reader.iter transition_reader @@ -68,9 +100,18 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier in let transition = With_hash.data transition_with_hash in let sender = Envelope.Incoming.sender transition_env in + let slot_tx_end = + Runtime_config.slot_tx_end_or_default + precomputed_values.Precomputed_values.runtime_config + in + let slot_chain_end = + Runtime_config.slot_chain_end_or_default + precomputed_values.runtime_config + in match validate_transition ~consensus_constants ~logger ~frontier - ~unprocessed_transition_cache transition_env + ~unprocessed_transition_cache ~slot_tx_end ~slot_chain_end + transition_env with | Ok cached_transition -> let%map () = @@ -123,4 +164,34 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier , Envelope.Sender.to_yojson (Envelope.Incoming.sender transition_env) ) ; ("transition", Mina_block.to_yojson transition) - ] ) ) ) ) + ] ) ) + | Error `Non_empty_staged_ledger_diff_after_stop_slot -> + [%log error] + ~metadata: + [ ("state_hash", State_hash.to_yojson transition_hash) + ; ( "reason" + , `String "not empty staged ledger diff after slot_tx_end" + ) + ; ( "block_slot" + , Mina_numbers.Global_slot.to_yojson + @@ Consensus.Data.Consensus_state.curr_global_slot + @@ Protocol_state.consensus_state @@ Header.protocol_state + @@ Mina_block.header @@ transition ) + ] + "Validation error: external transition with state hash \ + $state_hash was rejected for reason $reason" ; + Deferred.unit + | Error `Block_after_after_stop_slot -> + [%log error] + ~metadata: + [ ("state_hash", State_hash.to_yojson transition_hash) + ; ("reason", `String "block after slot_chain_end") + ; ( "block_slot" + , Mina_numbers.Global_slot.to_yojson + @@ Consensus.Data.Consensus_state.curr_global_slot + @@ Protocol_state.consensus_state @@ Header.protocol_state + @@ Mina_block.header @@ transition ) + ] + "Validation error: external transition with state hash \ + $state_hash was rejected for reason $reason" ; + Deferred.unit ) )