From 11dc67b6f998698764bbc5cd9b4339a6bc9cef18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 25 Sep 2023 09:54:20 +0000 Subject: [PATCH 01/36] Add slot_tx_end to compile config --- src/config/debug.mlh | 1 + src/config/dev.mlh | 1 + src/config/dev_medium_curves.mlh | 1 + src/config/dev_snark.mlh | 1 + src/config/devnet.mlh | 1 + src/config/fake_hash.mlh | 1 + src/config/fuzz_medium.mlh | 1 + src/config/fuzz_small.mlh | 1 + src/config/mainnet.mlh | 1 + src/config/nonconsensus_mainnet.mlh | 1 + src/config/nonconsensus_medium_curves.mlh | 1 + src/config/print_versioned_types.mlh | 1 + src/config/test_archive_processor.mlh | 1 + src/config/test_postake.mlh | 1 + src/config/test_postake_catchup.mlh | 1 + src/config/test_postake_five_even_txns.mlh | 1 + src/config/test_postake_full_epoch.mlh | 1 + src/config/test_postake_holy_grail.mlh | 1 + src/config/test_postake_medium_curves.mlh | 1 + src/config/test_postake_snarkless.mlh | 1 + src/config/test_postake_snarkless_medium_curves.mlh | 1 + src/config/test_postake_split.mlh | 1 + src/config/test_postake_split_medium_curves.mlh | 1 + src/config/test_postake_three_producers.mlh | 1 + src/config/testnet_postake.mlh | 1 + src/config/testnet_postake_many_producers.mlh | 1 + .../testnet_postake_many_producers_medium_curves.mlh | 1 + src/config/testnet_postake_medium_curves.mlh | 1 + src/config/testnet_postake_snarkless.mlh | 1 + src/config/testnet_postake_snarkless_fake_hash.mlh | 1 + src/config/testnet_public.mlh | 1 + src/lib/mina_compile_config/mina_compile_config.ml | 12 ++++++++++++ 32 files changed, 43 insertions(+) diff --git a/src/config/debug.mlh b/src/config/debug.mlh index 757b3da05b2..41b3e0453c7 100644 --- a/src/config/debug.mlh +++ b/src/config/debug.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/dev.mlh b/src/config/dev.mlh index 7f74f204f5f..a411bac7c97 100644 --- a/src/config/dev.mlh +++ b/src/config/dev.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/dev_medium_curves.mlh b/src/config/dev_medium_curves.mlh index d6195a6df25..1a633801d7d 100644 --- a/src/config/dev_medium_curves.mlh +++ b/src/config/dev_medium_curves.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/dev_snark.mlh b/src/config/dev_snark.mlh index a63977f3d7c..4750099699e 100644 --- a/src/config/dev_snark.mlh +++ b/src/config/dev_snark.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/devnet.mlh b/src/config/devnet.mlh index 3776abe847e..cec8264e76e 100644 --- a/src/config/devnet.mlh +++ b/src/config/devnet.mlh @@ -44,3 +44,4 @@ (* 2*block_window_duration *) [%%define compaction_interval 360000] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/config/fake_hash.mlh b/src/config/fake_hash.mlh index 62ee0d7b916..c21fd79e96c 100644 --- a/src/config/fake_hash.mlh +++ b/src/config/fake_hash.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/fuzz_medium.mlh b/src/config/fuzz_medium.mlh index 0a0b88f68d0..3c092fa53dd 100644 --- a/src/config/fuzz_medium.mlh +++ b/src/config/fuzz_medium.mlh @@ -32,3 +32,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/fuzz_small.mlh b/src/config/fuzz_small.mlh index 9ac7986f968..f52996f385b 100644 --- a/src/config/fuzz_small.mlh +++ b/src/config/fuzz_small.mlh @@ -32,3 +32,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/mainnet.mlh b/src/config/mainnet.mlh index dec3ac2da1b..e0d5085e36d 100644 --- a/src/config/mainnet.mlh +++ b/src/config/mainnet.mlh @@ -44,3 +44,4 @@ (* 2*block_window_duration *) [%%define compaction_interval 360000] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/config/nonconsensus_mainnet.mlh b/src/config/nonconsensus_mainnet.mlh index 8210abd05e1..f8fec503973 100644 --- a/src/config/nonconsensus_mainnet.mlh +++ b/src/config/nonconsensus_mainnet.mlh @@ -2,3 +2,4 @@ [%%undef consensus_mechanism] [%%undef compaction_interval] +[%%undef slot_tx_end] diff --git a/src/config/nonconsensus_medium_curves.mlh b/src/config/nonconsensus_medium_curves.mlh index c8e9b2717e8..1bf7f1ec0f6 100644 --- a/src/config/nonconsensus_medium_curves.mlh +++ b/src/config/nonconsensus_medium_curves.mlh @@ -32,3 +32,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/config/print_versioned_types.mlh b/src/config/print_versioned_types.mlh index d9ec069101f..a13f3a00ebe 100644 --- a/src/config/print_versioned_types.mlh +++ b/src/config/print_versioned_types.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_archive_processor.mlh b/src/config/test_archive_processor.mlh index 5c241f74838..e894c4a2cf0 100644 --- a/src/config/test_archive_processor.mlh +++ b/src/config/test_archive_processor.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake.mlh b/src/config/test_postake.mlh index 172e505d092..11533a08d23 100644 --- a/src/config/test_postake.mlh +++ b/src/config/test_postake.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_catchup.mlh b/src/config/test_postake_catchup.mlh index aebac35870a..0989d942194 100644 --- a/src/config/test_postake_catchup.mlh +++ b/src/config/test_postake_catchup.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_five_even_txns.mlh b/src/config/test_postake_five_even_txns.mlh index 252e471880f..aafe48cf042 100644 --- a/src/config/test_postake_five_even_txns.mlh +++ b/src/config/test_postake_five_even_txns.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_full_epoch.mlh b/src/config/test_postake_full_epoch.mlh index 8c59fcd7581..4af1ddbc8ba 100644 --- a/src/config/test_postake_full_epoch.mlh +++ b/src/config/test_postake_full_epoch.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_holy_grail.mlh b/src/config/test_postake_holy_grail.mlh index 585c4d2647e..82bb0a0353d 100644 --- a/src/config/test_postake_holy_grail.mlh +++ b/src/config/test_postake_holy_grail.mlh @@ -32,3 +32,4 @@ [%%import "/src/config/fork.mlh"] [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_medium_curves.mlh b/src/config/test_postake_medium_curves.mlh index 1a45c50ae21..e378af3a161 100644 --- a/src/config/test_postake_medium_curves.mlh +++ b/src/config/test_postake_medium_curves.mlh @@ -32,3 +32,4 @@ [%%import "/src/config/fork.mlh"] [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_snarkless.mlh b/src/config/test_postake_snarkless.mlh index 7509fc305ee..9ead1972302 100644 --- a/src/config/test_postake_snarkless.mlh +++ b/src/config/test_postake_snarkless.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%define compaction_interval 360000] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_snarkless_medium_curves.mlh b/src/config/test_postake_snarkless_medium_curves.mlh index ed29909618c..083edc1134f 100644 --- a/src/config/test_postake_snarkless_medium_curves.mlh +++ b/src/config/test_postake_snarkless_medium_curves.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_split.mlh b/src/config/test_postake_split.mlh index 43c9b3307ed..7806348ad33 100644 --- a/src/config/test_postake_split.mlh +++ b/src/config/test_postake_split.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_split_medium_curves.mlh b/src/config/test_postake_split_medium_curves.mlh index a1675e0936b..84d2053292e 100644 --- a/src/config/test_postake_split_medium_curves.mlh +++ b/src/config/test_postake_split_medium_curves.mlh @@ -33,3 +33,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/test_postake_three_producers.mlh b/src/config/test_postake_three_producers.mlh index 70fbe36d947..5e77d239e85 100644 --- a/src/config/test_postake_three_producers.mlh +++ b/src/config/test_postake_three_producers.mlh @@ -34,3 +34,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/testnet_postake.mlh b/src/config/testnet_postake.mlh index a2d7d9560a0..161f17f9e64 100644 --- a/src/config/testnet_postake.mlh +++ b/src/config/testnet_postake.mlh @@ -34,3 +34,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/config/testnet_postake_many_producers.mlh b/src/config/testnet_postake_many_producers.mlh index bc76e2b5f5d..a5aee8b80d6 100644 --- a/src/config/testnet_postake_many_producers.mlh +++ b/src/config/testnet_postake_many_producers.mlh @@ -32,3 +32,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_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..0a34b1710c2 100644 --- a/src/config/testnet_postake_many_producers_medium_curves.mlh +++ b/src/config/testnet_postake_many_producers_medium_curves.mlh @@ -34,3 +34,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/config/testnet_postake_medium_curves.mlh b/src/config/testnet_postake_medium_curves.mlh index 3776abe847e..cec8264e76e 100644 --- a/src/config/testnet_postake_medium_curves.mlh +++ b/src/config/testnet_postake_medium_curves.mlh @@ -44,3 +44,4 @@ (* 2*block_window_duration *) [%%define compaction_interval 360000] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/config/testnet_postake_snarkless.mlh b/src/config/testnet_postake_snarkless.mlh index c6660dfede4..4052d5d993a 100644 --- a/src/config/testnet_postake_snarkless.mlh +++ b/src/config/testnet_postake_snarkless.mlh @@ -34,3 +34,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/testnet_postake_snarkless_fake_hash.mlh b/src/config/testnet_postake_snarkless_fake_hash.mlh index 0bc5958a71c..d2b3796491c 100644 --- a/src/config/testnet_postake_snarkless_fake_hash.mlh +++ b/src/config/testnet_postake_snarkless_fake_hash.mlh @@ -35,3 +35,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 0] +[%%undef slot_tx_end] diff --git a/src/config/testnet_public.mlh b/src/config/testnet_public.mlh index a637dfada0f..37852b31d61 100644 --- a/src/config/testnet_public.mlh +++ b/src/config/testnet_public.mlh @@ -34,3 +34,4 @@ [%%import "/src/config/features/dev.mlh"] [%%undef compaction_interval] [%%define vrf_poll_interval 5000] +[%%undef slot_tx_end] diff --git a/src/lib/mina_compile_config/mina_compile_config.ml b/src/lib/mina_compile_config/mina_compile_config.ml index 0fd03ab90ad..04cd4572650 100644 --- a/src/lib/mina_compile_config/mina_compile_config.ml +++ b/src/lib/mina_compile_config/mina_compile_config.ml @@ -48,3 +48,15 @@ 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 = None + +[%%else] + +[%%inject "slot_tx_end", slot_tx_end] + +let slot_tx_end = Some slot_tx_end + +[%%endif] From 7aefd8ae38014fc3a16afe2f74f32a12b0308f9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 25 Sep 2023 09:56:24 +0000 Subject: [PATCH 02/36] Create CLI flag. Add config to daemon config --- src/app/cli/src/cli_entrypoint/dune | 1 + .../src/cli_entrypoint/mina_cli_entrypoint.ml | 17 ++++++++++++++++- src/lib/mina_lib/config.ml | 1 + src/lib/mina_lib/mina_lib.ml | 3 ++- 4 files changed, 20 insertions(+), 2 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/dune b/src/app/cli/src/cli_entrypoint/dune index 7315fbe4bf7..a0b3a706c33 100644 --- a/src/app/cli/src/cli_entrypoint/dune +++ b/src/app/cli/src/cli_entrypoint/dune @@ -63,6 +63,7 @@ blockchain_snark snarky.backendless o1trace + mina_numbers ) (preprocessor_deps ../../../../config.mlh) (instrumentation (backend bisect_ppx)) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index 2f40840c6a2..08675d1f604 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -430,6 +430,15 @@ let setup_daemon logger = for the associated private key that is being tracked by this daemon. \ You cannot provide both `uptime-submitter-key` and \ `uptime-submitter-pubkey`." + and slot_tx_end = + flag "--slot-tx-end" ~aliases:[ "slot-tx-end" ] + ~doc: + (sprintf + "SLOT Slot after which the node will stop accepting transactions. \ + (default: %s)" + (Option.value_map Mina_compile_config.slot_tx_end ~default:"none" + ~f:string_of_int ) ) + (optional int) in let to_pubsub_topic_mode_option = let open Gossip_net.Libp2p in @@ -1270,6 +1279,11 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; "Cannot provide both uptime submitter public key and uptime \ submitter keyfile" in + let slot_tx_end = + Option.value_map slot_tx_end + ~default:Mina_compile_config.slot_tx_end ~f:(fun slot -> + Some (Mina_numbers.Global_slot.of_int slot) ) + in let start_time = Time.now () in let%map coda = Mina_lib.create ~wallets @@ -1300,7 +1314,8 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; ~log_block_creation ~precomputed_values ~start_time ?precomputed_blocks_path ~log_precomputed_blocks ~upload_blocks_to_gcloud ~block_reward_threshold ~uptime_url - ~uptime_submitter_keypair ~stop_time ~node_status_url () ) + ~uptime_submitter_keypair ~stop_time ~node_status_url + ~slot_tx_end () ) in { Coda_initialization.coda ; client_trustlist diff --git a/src/lib/mina_lib/config.ml b/src/lib/mina_lib/config.ml index 4bdf35b6045..32cfeeb29e4 100644 --- a/src/lib/mina_lib/config.ml +++ b/src/lib/mina_lib/config.ml @@ -59,5 +59,6 @@ type t = ; uptime_url : Uri.t option [@default None] ; uptime_submitter_keypair : Keypair.t option [@default None] ; stop_time : int + ; slot_tx_end : Mina_numbers.Global_slot.t option [@default None] } [@@deriving make] diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index ddddaa71d44..4f3968bdf11 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1212,7 +1212,8 @@ let start t = ~log_block_creation:t.config.log_block_creation ~precomputed_values:t.config.precomputed_values ~block_reward_threshold:t.config.block_reward_threshold - ~block_produced_bvar:t.components.block_produced_bvar ; + ~block_produced_bvar:t.components.block_produced_bvar + ~slot_tx_end:t.config.slot_tx_end ; perform_compaction t ; let () = match t.config.node_status_url with From b273c44d7eb5db51a0db79803f14d3692ccab311 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 25 Sep 2023 09:57:29 +0000 Subject: [PATCH 03/36] Create block after stop slot using empty staged ledger diff --- src/lib/block_producer/block_producer.ml | 79 ++++++++++++++---------- 1 file changed, 47 insertions(+), 32 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 4c36430d179..9501e845e72 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -111,7 +111,8 @@ 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 ~consensus_constants + ~slot_tx_end = let open Interruptible.Let_syntax in let previous_protocol_state_body_hash = Protocol_state.body previous_protocol_state |> Protocol_state.Body.hash @@ -142,37 +143,50 @@ let generate_next_state ~constraint_constants ~previous_protocol_state 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 ) + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) 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) ) + match slot_tx_end with + | Some slot_tx_end' + when Mina_numbers.Global_slot.(current_global_slot > slot_tx_end') + -> + Ok + Staged_ledger_diff.With_valid_signatures_and_proofs.empty_diff + | None | Some _ -> ( + 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 - 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 ) + 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 match%map let%bind.Deferred.Result diff = return diff in @@ -542,7 +556,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~consensus_local_state ~coinbase_receiver ~frontier_reader ~transition_writer ~set_next_producer_timing ~log_block_creation ~(precomputed_values : Precomputed_values.t) ~block_reward_threshold - ~block_produced_bvar = + ~block_produced_bvar ~slot_tx_end = O1trace.sync_thread "produce_blocks" (fun () -> let constraint_constants = precomputed_values.constraint_constants in let consensus_constants = precomputed_values.consensus_constants in @@ -667,7 +681,8 @@ 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 ~consensus_constants + ~slot_tx_end in match next_state_opt with | None -> From ef37fafc3cafc8bbf7fea1f143ed04711e035a3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 25 Sep 2023 15:28:45 +0000 Subject: [PATCH 04/36] Split CLI flag into enable/disable --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 26 +++++++++++++++---- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index 08675d1f604..8263885b74a 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -430,8 +430,8 @@ let setup_daemon logger = for the associated private key that is being tracked by this daemon. \ You cannot provide both `uptime-submitter-key` and \ `uptime-submitter-pubkey`." - and slot_tx_end = - flag "--slot-tx-end" ~aliases:[ "slot-tx-end" ] + and enable_slot_tx_end = + flag "--enable-slot-tx-end" ~aliases:[ "enable-slot-tx-end" ] ~doc: (sprintf "SLOT Slot after which the node will stop accepting transactions. \ @@ -439,6 +439,14 @@ let setup_daemon logger = (Option.value_map Mina_compile_config.slot_tx_end ~default:"none" ~f:string_of_int ) ) (optional int) + and disable_slot_tx_end = + flag "--slot-tx-end" ~aliases:[ "slot-tx-end" ] no_arg + ~doc: + (sprintf + "Disable feature to stop accepting transactions. (this feature is \ + %s by default)" + (Option.value_map Mina_compile_config.slot_tx_end ~default:"disable" + ~f:(fun slot -> "enabled at slot " ^ string_of_int slot) ) ) in let to_pubsub_topic_mode_option = let open Gossip_net.Libp2p in @@ -1280,9 +1288,17 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; submitter keyfile" in let slot_tx_end = - Option.value_map slot_tx_end - ~default:Mina_compile_config.slot_tx_end ~f:(fun slot -> - Some (Mina_numbers.Global_slot.of_int slot) ) + match (enable_slot_tx_end, disable_slot_tx_end) with + | Some slot, false -> + Some (Mina_numbers.Global_slot.of_int slot) + | None, true -> + None + | None, false -> + Mina_compile_config.slot_tx_end + | Some _, true -> + failwith + "Cannot provide both --enable-slot-tx-end and \ + --disable-slot-tx-end" in let start_time = Time.now () in let%map coda = From 7cd90d54bbf14bc8fd709096e697ccc4c33515b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 27 Sep 2023 07:49:49 +0000 Subject: [PATCH 05/36] Add stop tx feature to validator --- src/lib/ledger_catchup/ledger_catchup.ml | 6 +-- src/lib/ledger_catchup/ledger_catchup.mli | 1 + src/lib/ledger_catchup/normal_catchup.ml | 35 ++++++++----- src/lib/ledger_catchup/super_catchup.ml | 51 +++++++++++-------- src/lib/mina_intf/dune | 1 + .../transition_frontier_components_intf.ml | 1 + src/lib/mina_lib/mina_lib.ml | 1 + .../transition_frontier_controller.ml | 6 +-- src/lib/transition_handler/dune | 1 + src/lib/transition_handler/validator.ml | 43 ++++++++++++++-- .../transition_router/transition_router.ml | 24 +++++---- 11 files changed, 116 insertions(+), 54 deletions(-) diff --git a/src/lib/ledger_catchup/ledger_catchup.ml b/src/lib/ledger_catchup/ledger_catchup.ml index 72ed96457fd..a4b0bac3abb 100644 --- a/src/lib/ledger_catchup/ledger_catchup.ml +++ b/src/lib/ledger_catchup/ledger_catchup.ml @@ -3,13 +3,13 @@ module Best_tip_lru = Best_tip_lru let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache : unit = + ~unprocessed_transition_cache ~slot_tx_end : unit = match Transition_frontier.catchup_tree frontier with | Hash _ -> Normal_catchup.run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache + ~unprocessed_transition_cache ~slot_tx_end | Full _ -> Super_catchup.run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache + ~unprocessed_transition_cache ~slot_tx_end diff --git a/src/lib/ledger_catchup/ledger_catchup.mli b/src/lib/ledger_catchup/ledger_catchup.mli index 2e969057892..5914c8cb6aa 100644 --- a/src/lib/ledger_catchup/ledger_catchup.mli +++ b/src/lib/ledger_catchup/ledger_catchup.mli @@ -36,4 +36,5 @@ val run : Strict_pipe.Writer.t -> unprocessed_transition_cache: Transition_handler.Unprocessed_transition_cache.t + -> slot_tx_end:Mina_numbers.Global_slot.t option -> unit diff --git a/src/lib/ledger_catchup/normal_catchup.ml b/src/lib/ledger_catchup/normal_catchup.ml index 2110619b58c..e5081d903f1 100644 --- a/src/lib/ledger_catchup/normal_catchup.ml +++ b/src/lib/ledger_catchup/normal_catchup.ml @@ -46,7 +46,7 @@ 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 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 @@ -66,7 +66,7 @@ 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 + ~consensus_constants ~unprocessed_transition_cache ~slot_tx_end enveloped_initially_validated_transition in let open Deferred.Let_syntax in @@ -155,6 +155,8 @@ 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" let rec fold_until ~(init : 'accum) ~(f : @@ -465,7 +467,7 @@ let download_transitions ~target_hash ~logger ~trust_system ~network let verify_transitions_and_build_breadcrumbs ~logger ~(precomputed_values : Precomputed_values.t) ~trust_system ~verifier ~frontier ~unprocessed_transition_cache ~transitions ~target_hash ~subtrees - = + ~slot_tx_end = let open Deferred.Or_error.Let_syntax in let verification_start_time = Core.Time.now () in let%bind transitions_with_initial_validation, initial_hash = @@ -517,7 +519,8 @@ let verify_transitions_and_build_breadcrumbs ~logger 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 + transition with | Error e -> List.iter acc ~f:(fun (node, vc) -> @@ -619,7 +622,7 @@ let garbage_collect_subtrees ~logger ~subtrees = let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache : unit = + ~unprocessed_transition_cache ~slot_tx_end : unit = let hash_tree = match Transition_frontier.catchup_tree frontier with | Hash t -> @@ -787,7 +790,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier verify_transitions_and_build_breadcrumbs ~logger ~precomputed_values ~trust_system ~verifier ~frontier ~unprocessed_transition_cache ~transitions ~target_hash - ~subtrees + ~subtrees ~slot_tx_end with | Ok trees_of_breadcrumbs -> [%log trace] @@ -901,7 +904,7 @@ let%test_module "Ledger_catchup tests" = Strict_pipe.Reader.t } - let run_catchup ~network ~frontier = + let run_catchup ~network ~frontier ~slot_tx_end = let catchup_job_reader, catchup_job_writer = Strict_pipe.create ~name:(__MODULE__ ^ __LOC__) (Buffered (`Capacity 10, `Overflow Crash)) @@ -915,14 +918,15 @@ let%test_module "Ledger_catchup tests" = in run ~logger ~precomputed_values ~verifier ~trust_system ~network ~frontier ~catchup_breadcrumbs_writer ~catchup_job_reader - ~unprocessed_transition_cache ; + ~unprocessed_transition_cache ~slot_tx_end ; { cache = unprocessed_transition_cache ; job_writer = catchup_job_writer ; breadcrumbs_reader = catchup_breadcrumbs_reader } - let run_catchup_with_target ~network ~frontier ~target_breadcrumb = - let test = run_catchup ~network ~frontier in + let run_catchup_with_target ~network ~frontier ~target_breadcrumb + ~slot_tx_end = + let test = run_catchup ~network ~frontier ~slot_tx_end in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb in @@ -934,12 +938,12 @@ let%test_module "Ledger_catchup tests" = (parent_hash, [ Rose_tree.T ((target_transition, None), []) ]) ; (`Test test, `Cached_transition target_transition) - let test_successful_catchup ~my_net ~target_best_tip_path = + let test_successful_catchup ~my_net ~target_best_tip_path ~slot_tx_end = let open Fake_network in let target_breadcrumb = List.last_exn target_best_tip_path in let `Test { breadcrumbs_reader; _ }, _ = run_catchup_with_target ~network:my_net.network - ~frontier:my_net.state.frontier ~target_breadcrumb + ~frontier:my_net.state.frontier ~target_breadcrumb ~slot_tx_end in (* TODO: expose Strict_pipe.read *) let%map cached_catchup_breadcrumbs = @@ -999,7 +1003,8 @@ let%test_module "Ledger_catchup tests" = (best_tip peer_net.state.frontier)) in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path ) ) + test_successful_catchup ~my_net ~target_best_tip_path + ~slot_tx_end:None ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1015,7 +1020,8 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path ) ) + test_successful_catchup ~my_net ~target_best_tip_path + ~slot_tx_end:None ) ) let%test_unit "catchup fails if one of the parent transitions fail" = Quickcheck.test ~trials:1 @@ -1050,6 +1056,7 @@ let%test_module "Ledger_catchup tests" = let `Test { cache; _ }, `Cached_transition cached_transition = run_catchup_with_target ~network:my_net.network ~frontier:my_net.state.frontier ~target_breadcrumb + ~slot_tx_end:None in let cached_failing_transition = Transition_handler.Unprocessed_transition_cache.register_exn diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index 0b928a180f5..b01ab77d935 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -120,7 +120,7 @@ let write_graph (_ : t) = () let verify_transition ~logger ~consensus_constants ~trust_system ~frontier - ~unprocessed_transition_cache enveloped_transition = + ~unprocessed_transition_cache ~slot_tx_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,7 +139,7 @@ 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 + ~consensus_constants ~unprocessed_transition_cache ~slot_tx_end enveloped_initially_validated_transition in let state_hash = @@ -265,6 +265,12 @@ 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 \ + stop slot" ; + Deferred.Or_error.fail @@ Error.of_string "non empty staged ledger diff" let find_map_ok ?how xs ~f = let res = Ivar.create () in @@ -558,7 +564,7 @@ end let initial_validate ~(precomputed_values : Precomputed_values.t) ~logger ~trust_system ~(batcher : _ Initial_validate_batcher.t) ~frontier - ~unprocessed_transition_cache transition = + ~unprocessed_transition_cache ~slot_tx_end transition = let verification_start_time = Core.Time.now () in let open Deferred.Result.Let_syntax in let state_hash = @@ -608,7 +614,7 @@ let initial_validate ~(precomputed_values : Precomputed_values.t) ~logger "initial_validate: verification of proofs complete" ; verify_transition ~logger ~consensus_constants:precomputed_values.consensus_constants ~trust_system - ~frontier ~unprocessed_transition_cache tv + ~frontier ~unprocessed_transition_cache ~slot_tx_end tv |> Deferred.map ~f:(Result.map_error ~f:(fun e -> `Error e)) open Frontier_base @@ -710,7 +716,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger | `Invalid_staged_ledger_hash of Error.t | `Fatal_error of exn ] ) Result.t - Deferred.t ) = + Deferred.t ) ~slot_tx_end = (* setup_state_machine_runner returns a fully configured lambda function, which is the state machine runner *) let initial_validation_batcher = Initial_validate_batcher.create ~verifier ~precomputed_values @@ -807,7 +813,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger step ( initial_validate ~precomputed_values ~logger ~trust_system ~batcher:initial_validation_batcher ~frontier - ~unprocessed_transition_cache + ~unprocessed_transition_cache ~slot_tx_end { external_block with data = { With_hash.data = external_block.data @@ -998,6 +1004,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger (* TODO: In the future, this could take over scheduling bootstraps too. *) let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func + ~slot_tx_end ~(catchup_job_reader : ( State_hash.t * ( ( Mina_block.initial_valid_block Envelope.Incoming.t @@ -1118,7 +1125,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func let run_state_machine = setup_state_machine_runner ~t ~verifier ~downloader ~logger ~precomputed_values ~trust_system ~frontier ~unprocessed_transition_cache - ~catchup_breadcrumbs_writer ~build_func + ~catchup_breadcrumbs_writer ~build_func ~slot_tx_end in (* TODO: Maybe add everything from transition frontier at the beginning? *) (* TODO: Print out the hashes you're adding *) @@ -1328,11 +1335,11 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache : unit = + ~unprocessed_transition_cache ~slot_tx_end : unit = O1trace.background_thread "perform_super_catchup" (fun () -> run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~precomputed_values ~unprocessed_transition_cache - ~catchup_breadcrumbs_writer + ~catchup_breadcrumbs_writer ~slot_tx_end ~build_func:Transition_frontier.Breadcrumb.build ) (* Unit tests *) @@ -1413,7 +1420,7 @@ let%test_module "Ledger_catchup tests" = Strict_pipe.Reader.t } - let setup_catchup_pipes ~network ~frontier = + let setup_catchup_pipes ~network ~frontier ~slot_tx_end = let catchup_job_reader, catchup_job_writer = Strict_pipe.create ~name:(__MODULE__ ^ __LOC__) (Buffered (`Capacity 10, `Overflow Crash)) @@ -1427,7 +1434,7 @@ let%test_module "Ledger_catchup tests" = in run ~logger ~precomputed_values ~verifier ~trust_system ~network ~frontier ~catchup_breadcrumbs_writer ~catchup_job_reader - ~unprocessed_transition_cache ; + ~unprocessed_transition_cache ~slot_tx_end ; { cache = unprocessed_transition_cache ; job_writer = catchup_job_writer ; breadcrumbs_reader = catchup_breadcrumbs_reader @@ -1453,8 +1460,9 @@ let%test_module "Ledger_catchup tests" = ; breadcrumbs_reader = catchup_breadcrumbs_reader } *) - let setup_catchup_with_target ~network ~frontier ~target_breadcrumb = - let test = setup_catchup_pipes ~network ~frontier in + let setup_catchup_with_target ~network ~frontier ~target_breadcrumb + ~slot_tx_end = + let test = setup_catchup_pipes ~network ~frontier ~slot_tx_end in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb in @@ -1503,12 +1511,12 @@ let%test_module "Ledger_catchup tests" = (n + 1) else Deferred.return b_list - let test_successful_catchup ~my_net ~target_best_tip_path = + let test_successful_catchup ~my_net ~target_best_tip_path ~slot_tx_end = let open Fake_network in let target_breadcrumb = List.last_exn target_best_tip_path in let `Test { breadcrumbs_reader; _ }, _ = setup_catchup_with_target ~network:my_net.network - ~frontier:my_net.state.frontier ~target_breadcrumb + ~frontier:my_net.state.frontier ~target_breadcrumb ~slot_tx_end in let%map breadcrumb_list = call_read ~breadcrumbs_reader ~target_best_tip_path ~my_peer:my_net [] 0 @@ -1559,7 +1567,8 @@ let%test_module "Ledger_catchup tests" = (best_tip peer_net.state.frontier)) in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path ) ) + test_successful_catchup ~my_net ~target_best_tip_path + ~slot_tx_end:None ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1575,7 +1584,8 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path ) ) + test_successful_catchup ~my_net ~target_best_tip_path + ~slot_tx_end:None ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1591,7 +1601,8 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path ) ) + test_successful_catchup ~my_net ~target_best_tip_path + ~slot_tx_end:None ) ) let%test_unit "when catchup fails to download state hashes, catchup will \ properly clear the unprocessed_transition_cache of the \ @@ -1614,7 +1625,7 @@ let%test_module "Ledger_catchup tests" = let target_breadcrumb = List.last_exn target_best_tip_path in let test = setup_catchup_pipes ~network:my_net.network - ~frontier:my_net.state.frontier + ~frontier:my_net.state.frontier ~slot_tx_end:None in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb @@ -1712,7 +1723,7 @@ let%test_module "Ledger_catchup tests" = let target_breadcrumb = List.last_exn target_best_tip_path in let test = setup_catchup_pipes ~network:my_net.network - ~frontier:my_net.state.frontier + ~frontier:my_net.state.frontier ~slot_tx_end:None in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb diff --git a/src/lib/mina_intf/dune b/src/lib/mina_intf/dune index b8e732c984e..eb8d3399c24 100644 --- a/src/lib/mina_intf/dune +++ b/src/lib/mina_intf/dune @@ -25,6 +25,7 @@ block_time verifier rose_tree + mina_numbers ) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_jane ppx_version ppx_deriving.std ppx_deriving_yojson))) diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index a269a501071..44591b28ab6 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -336,6 +336,7 @@ module type Transition_router_intf = sig -> precomputed_values:Precomputed_values.t -> catchup_mode:[ `Normal | `Super ] -> notify_online:(unit -> unit Deferred.t) + -> slot_tx_end:Mina_numbers.Global_slot.t option -> ( [ `Transition of Mina_block.Validated.t ] * [ `Source of [ `Gossip | `Catchup | `Internal ] ] * [ `Valid_cb of Mina_net2.Validation_callback.t option ] ) diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 4f3968bdf11..fd997de4f01 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1777,6 +1777,7 @@ let create ?wallets (config : Config.t) = ~catchup_mode ~network_transition_reader:block_reader ~producer_transition_reader ~most_recent_valid_block ~precomputed_values:config.precomputed_values ~notify_online + ~slot_tx_end:config.slot_tx_end in let ( valid_transitions_for_network , valid_transitions_for_api diff --git a/src/lib/transition_frontier_controller/transition_frontier_controller.ml b/src/lib/transition_frontier_controller/transition_frontier_controller.ml index 15c647b1ab2..e520320a828 100644 --- a/src/lib/transition_frontier_controller/transition_frontier_controller.ml +++ b/src/lib/transition_frontier_controller/transition_frontier_controller.ml @@ -5,7 +5,7 @@ open Mina_block let run ~logger ~trust_system ~verifier ~network ~time_controller ~collected_transitions ~frontier ~network_transition_reader - ~producer_transition_reader ~clear_reader ~precomputed_values = + ~producer_transition_reader ~clear_reader ~precomputed_values ~slot_tx_end = let valid_transition_pipe_capacity = 50 in let start_time = Time.now () in let f_drop_head name head valid_cb = @@ -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 ~slot_tx_end ; 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) ) @@ -115,7 +115,7 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller ~processed_transition_writer ; Ledger_catchup.run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache ; + ~unprocessed_transition_cache ~slot_tx_end ; Strict_pipe.Reader.iter_without_pushback clear_reader ~f:(fun _ -> let open Strict_pipe.Writer in kill valid_transition_writer ; diff --git a/src/lib/transition_handler/dune b/src/lib/transition_handler/dune index 9bfa788747a..01c7ce77103 100644 --- a/src/lib/transition_handler/dune +++ b/src/lib/transition_handler/dune @@ -45,6 +45,7 @@ mina_net2 result mina_numbers + staged_ledger_diff ) (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..e8a27dca95f 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -8,7 +8,7 @@ open Mina_block open Network_peer let validate_transition ~consensus_constants ~logger ~frontier - ~unprocessed_transition_cache enveloped_transition = + ~unprocessed_transition_cache ~slot_tx_end enveloped_transition = let open Result.Let_syntax in let transition = Envelope.Incoming.data enveloped_transition @@ -16,6 +16,26 @@ 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_tx_end with + | Some slot when Mina_numbers.Global_slot.(block_slot >= slot) -> + 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 +77,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 ~slot_tx_end = let module Lru = Core_extended_cache.Lru in O1trace.background_thread "validate_blocks_against_frontier" (fun () -> Reader.iter transition_reader @@ -70,7 +90,7 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier let sender = Envelope.Incoming.sender transition_env in match validate_transition ~consensus_constants ~logger ~frontier - ~unprocessed_transition_cache transition_env + ~unprocessed_transition_cache ~slot_tx_end transition_env with | Ok cached_transition -> let%map () = @@ -123,4 +143,19 @@ 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 stop slot" ) + ; ( "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 ) ) diff --git a/src/lib/transition_router/transition_router.ml b/src/lib/transition_router/transition_router.ml index 6d11d7b7657..5e66d8adbd8 100644 --- a/src/lib/transition_router/transition_router.ml +++ b/src/lib/transition_router/transition_router.ml @@ -58,7 +58,7 @@ let start_transition_frontier_controller ~logger ~trust_system ~verifier ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~collected_transitions ~transition_reader_ref ~transition_writer_ref - ~frontier_w ~precomputed_values frontier = + ~frontier_w ~precomputed_values ~slot_tx_end frontier = [%str_log info] Starting_transition_frontier_controller ; let ( transition_frontier_controller_reader , transition_frontier_controller_writer ) = @@ -87,7 +87,7 @@ let start_transition_frontier_controller ~logger ~trust_system ~verifier Transition_frontier_controller.run ~logger ~trust_system ~verifier ~network ~time_controller ~collected_transitions ~frontier ~network_transition_reader:!transition_reader_ref - ~producer_transition_reader ~clear_reader ~precomputed_values + ~producer_transition_reader ~clear_reader ~precomputed_values ~slot_tx_end in Strict_pipe.Reader.iter new_verified_transition_reader ~f: @@ -100,7 +100,7 @@ let start_bootstrap_controller ~logger ~trust_system ~verifier ~network ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~transition_reader_ref ~transition_writer_ref ~consensus_local_state ~frontier_w ~initial_root_transition ~persistent_root ~persistent_frontier - ~best_seen_transition ~precomputed_values ~catchup_mode = + ~best_seen_transition ~precomputed_values ~catchup_mode ~slot_tx_end = [%str_log info] Starting_bootstrap_controller ; [%log info] "Starting Bootstrap Controller phase" ; let bootstrap_controller_reader, bootstrap_controller_writer = @@ -138,7 +138,8 @@ let start_bootstrap_controller ~logger ~trust_system ~verifier ~network ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~collected_transitions ~transition_reader_ref - ~transition_writer_ref ~frontier_w ~precomputed_values new_frontier ) + ~transition_writer_ref ~frontier_w ~precomputed_values ~slot_tx_end + new_frontier ) let download_best_tip ~notify_online ~logger ~network ~verifier ~trust_system ~most_recent_valid_block_writer ~genesis_constants ~precomputed_values = @@ -307,7 +308,8 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~producer_transition_writer_ref ~clear_reader ~verified_transition_writer ~transition_reader_ref ~transition_writer_ref ~most_recent_valid_block_writer ~persistent_root ~persistent_frontier - ~consensus_local_state ~precomputed_values ~catchup_mode ~notify_online = + ~consensus_local_state ~precomputed_values ~catchup_mode ~notify_online + ~slot_tx_end = let%bind () = if is_demo_mode then return () else wait_for_high_connectivity ~logger ~network ~is_seed @@ -335,7 +337,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~clear_reader ~transition_reader_ref ~consensus_local_state ~transition_writer_ref ~frontier_w ~persistent_root ~persistent_frontier ~initial_root_transition ~catchup_mode ~best_seen_transition:best_tip - ~precomputed_values + ~precomputed_values ~slot_tx_end | best_tip, Some frontier -> ( match best_tip with | Some best_tip @@ -364,6 +366,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~transition_writer_ref ~frontier_w ~persistent_root ~persistent_frontier ~initial_root_transition ~catchup_mode ~best_seen_transition:(Some best_tip) ~precomputed_values + ~slot_tx_end | _ -> if Option.is_some best_tip then [%log info] @@ -420,7 +423,8 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~collected_transitions ~transition_reader_ref - ~transition_writer_ref ~frontier_w ~precomputed_values frontier ) + ~transition_writer_ref ~frontier_w ~precomputed_values ~slot_tx_end + frontier ) let wait_till_genesis ~logger ~time_controller ~(precomputed_values : Precomputed_values.t) = @@ -468,7 +472,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode ~producer_transition_reader ~most_recent_valid_block: (most_recent_valid_block_reader, most_recent_valid_block_writer) - ~precomputed_values ~catchup_mode ~notify_online = + ~precomputed_values ~catchup_mode ~notify_online ~slot_tx_end = let initialization_finish_signal = Ivar.create () in let clear_reader, clear_writer = Strict_pipe.create ~name:"clear" Synchronous @@ -544,7 +548,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode ~producer_transition_writer_ref ~clear_reader ~verified_transition_writer ~transition_reader_ref ~transition_writer_ref ~most_recent_valid_block_writer - ~consensus_local_state ~precomputed_values ~notify_online + ~consensus_local_state ~precomputed_values ~notify_online ~slot_tx_end in Ivar.fill_if_empty initialization_finish_signal () ; let valid_transition_reader1, valid_transition_reader2 = @@ -610,7 +614,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode ~consensus_local_state ~frontier_w ~persistent_root ~persistent_frontier ~initial_root_transition ~best_seen_transition:(Some enveloped_transition) - ~precomputed_values ~catchup_mode ) + ~precomputed_values ~catchup_mode ~slot_tx_end ) else Deferred.unit | None -> Deferred.unit From 6be8cd72f3897ee69dc40519c4d0d0f64cf54669 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 27 Sep 2023 08:24:54 +0000 Subject: [PATCH 06/36] Add stop slot feature to mina commands --- src/lib/mina_commands/mina_commands.ml | 114 ++++++++++++++++--------- 1 file changed, 76 insertions(+), 38 deletions(-) diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index 80f3fc676bc..581a9d02495 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -69,49 +69,87 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) (* hack to get types to work out *) let%map () = return () in let open Deferred.Let_syntax in - let%map result = Mina_lib.add_transactions t [ user_command_input ] in - txn_count := !txn_count + 1 ; - match result with - | Ok ([], [ failed_txn ]) -> - Error - (Error.of_string - (sprintf !"%s" - ( Network_pool.Transaction_pool.Resource_pool.Diff.Diff_error - .to_yojson (snd failed_txn) - |> Yojson.Safe.to_string ) ) ) - | Ok ([ Signed_command txn ], []) -> - [%log' info (Mina_lib.top_level_logger t)] - ~metadata:[ ("command", User_command.to_yojson (Signed_command txn)) ] - "Scheduled payment $command" ; - Ok txn - | Ok (valid_commands, invalid_commands) -> - [%log' info (Mina_lib.top_level_logger t)] + let config = Mina_lib.config t in + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:config.precomputed_values.consensus_constants + (Block_time.now (Mina_lib.time_controller t)) )) + in + match config.slot_tx_end with + | Some slot when Global_slot.(current_global_slot >= slot) -> + [%log' error (Mina_lib.top_level_logger t)] ~metadata: - [ ( "valid_commands" - , `List (List.map ~f:User_command.to_yojson valid_commands) ) - ; ( "invalid_commands" - , `List - (List.map - ~f: - (Fn.compose - Network_pool.Transaction_pool.Resource_pool.Diff - .Diff_error - .to_yojson snd ) - invalid_commands ) ) + [ ("slot_tx_end", Global_slot.to_yojson slot) + ; ("current_global_slot", Global_slot.to_yojson current_global_slot) ] - "Invalid result from scheduling a payment" ; - Error (Error.of_string "Internal error while scheduling a payment") - | Error e -> - Error e + "Cannot send transaction after stop slot $slot_tx_end" ; + Deferred.Or_error.error_string "Cannot send transaction after stop slot" + | None | Some _ -> ( + let%map result = Mina_lib.add_transactions t [ user_command_input ] in + txn_count := !txn_count + 1 ; + match result with + | Ok ([], [ failed_txn ]) -> + Error + (Error.of_string + (sprintf !"%s" + ( Network_pool.Transaction_pool.Resource_pool.Diff.Diff_error + .to_yojson (snd failed_txn) + |> Yojson.Safe.to_string ) ) ) + | Ok ([ Signed_command txn ], []) -> + [%log' info (Mina_lib.top_level_logger t)] + ~metadata: + [ ("command", User_command.to_yojson (Signed_command txn)) ] + "Scheduled payment $command" ; + Ok txn + | Ok (valid_commands, invalid_commands) -> + [%log' info (Mina_lib.top_level_logger t)] + ~metadata: + [ ( "valid_commands" + , `List (List.map ~f:User_command.to_yojson valid_commands) ) + ; ( "invalid_commands" + , `List + (List.map + ~f: + (Fn.compose + Network_pool.Transaction_pool.Resource_pool.Diff + .Diff_error + .to_yojson snd ) + invalid_commands ) ) + ] + "Invalid result from scheduling a payment" ; + Error (Error.of_string "Internal error while scheduling a payment") + | Error e -> + Error e ) let setup_and_submit_user_commands t user_command_list = let open Participating_state.Let_syntax in - let%map _is_active = Mina_lib.active_or_bootstrapping t in - [%log' warn (Mina_lib.top_level_logger t)] - "batch-send-payments does not yet report errors" - ~metadata: - [ ("mina_command", `String "scheduling a batch of user transactions") ] ; - Mina_lib.add_transactions t user_command_list + let config = Mina_lib.config t in + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:config.precomputed_values.consensus_constants + (Block_time.now (Mina_lib.time_controller t)) )) + in + match config.slot_tx_end with + | Some slot when Global_slot.(current_global_slot >= slot) -> + [%log' error (Mina_lib.top_level_logger t)] + ~metadata: + [ ("slot_tx_end", Global_slot.to_yojson slot) + ; ("current_global_slot", Global_slot.to_yojson current_global_slot) + ] + "Cannot send transaction after stop slot $slot_tx_end" ; + Participating_state.return + @@ Deferred.Or_error.error_string + "Cannot send transaction after stop slot" + | None | Some _ -> + let%map _is_active = Mina_lib.active_or_bootstrapping t in + [%log' warn (Mina_lib.top_level_logger t)] + "batch-send-payments does not yet report errors" + ~metadata: + [ ("mina_command", `String "scheduling a batch of user transactions") + ] ; + Mina_lib.add_transactions t user_command_list module Receipt_chain_verifier = Merkle_list_verifier.Make (struct type proof_elem = User_command.t From c638cf0dff280649900a19027957829b23e784e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Fri, 3 Nov 2023 08:25:27 +0000 Subject: [PATCH 07/36] Add slot_chain_end to compile config --- src/config/debug.mlh | 1 + src/config/dev.mlh | 1 + src/config/dev_medium_curves.mlh | 1 + src/config/dev_snark.mlh | 1 + src/config/devnet.mlh | 1 + src/config/fake_hash.mlh | 1 + src/config/fuzz_medium.mlh | 1 + src/config/fuzz_small.mlh | 1 + src/config/integration_tests_slot_tx_end.mlh | 5 +++++ src/config/mainnet.mlh | 1 + src/config/nonconsensus_mainnet.mlh | 1 + src/config/nonconsensus_medium_curves.mlh | 1 + src/config/print_versioned_types.mlh | 1 + src/config/test_archive_processor.mlh | 1 + src/config/test_postake.mlh | 1 + src/config/test_postake_catchup.mlh | 1 + src/config/test_postake_five_even_txns.mlh | 1 + src/config/test_postake_full_epoch.mlh | 1 + src/config/test_postake_holy_grail.mlh | 1 + src/config/test_postake_medium_curves.mlh | 1 + src/config/test_postake_snarkless.mlh | 1 + src/config/test_postake_snarkless_medium_curves.mlh | 1 + src/config/test_postake_split.mlh | 1 + src/config/test_postake_split_medium_curves.mlh | 1 + src/config/test_postake_three_producers.mlh | 1 + src/config/testnet_postake.mlh | 1 + src/config/testnet_postake_many_producers.mlh | 1 + .../testnet_postake_many_producers_medium_curves.mlh | 1 + src/config/testnet_postake_medium_curves.mlh | 1 + src/config/testnet_postake_snarkless.mlh | 1 + src/config/testnet_postake_snarkless_fake_hash.mlh | 1 + src/config/testnet_public.mlh | 1 + src/lib/mina_compile_config/mina_compile_config.ml | 12 ++++++++++++ 33 files changed, 48 insertions(+) create mode 100644 src/config/integration_tests_slot_tx_end.mlh diff --git a/src/config/debug.mlh b/src/config/debug.mlh index 41b3e0453c7..0e77f2ed6db 100644 --- a/src/config/debug.mlh +++ b/src/config/debug.mlh @@ -34,3 +34,4 @@ [%%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 a411bac7c97..a6fe3a92c51 100644 --- a/src/config/dev.mlh +++ b/src/config/dev.mlh @@ -34,3 +34,4 @@ [%%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 1a633801d7d..9a2d5a44b68 100644 --- a/src/config/dev_medium_curves.mlh +++ b/src/config/dev_medium_curves.mlh @@ -34,3 +34,4 @@ [%%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 4750099699e..d873dd2d4d8 100644 --- a/src/config/dev_snark.mlh +++ b/src/config/dev_snark.mlh @@ -34,3 +34,4 @@ [%%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 cec8264e76e..6b933dafc74 100644 --- a/src/config/devnet.mlh +++ b/src/config/devnet.mlh @@ -45,3 +45,4 @@ [%%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 c21fd79e96c..1b6d9007839 100644 --- a/src/config/fake_hash.mlh +++ b/src/config/fake_hash.mlh @@ -34,3 +34,4 @@ [%%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 3c092fa53dd..6ef14277933 100644 --- a/src/config/fuzz_medium.mlh +++ b/src/config/fuzz_medium.mlh @@ -33,3 +33,4 @@ [%%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 f52996f385b..ea62c09a16b 100644 --- a/src/config/fuzz_small.mlh +++ b/src/config/fuzz_small.mlh @@ -33,3 +33,4 @@ [%%undef compaction_interval] [%%define vrf_poll_interval 0] [%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/integration_tests_slot_tx_end.mlh b/src/config/integration_tests_slot_tx_end.mlh new file mode 100644 index 00000000000..73666c744e5 --- /dev/null +++ b/src/config/integration_tests_slot_tx_end.mlh @@ -0,0 +1,5 @@ +(* same as integration_tests *) +[%%import "/src/config/integration_tests.mlh"] + +[%%define slot_tx_end 8] +[%%define slot_chain_end 15] diff --git a/src/config/mainnet.mlh b/src/config/mainnet.mlh index e0d5085e36d..2be05d2b927 100644 --- a/src/config/mainnet.mlh +++ b/src/config/mainnet.mlh @@ -45,3 +45,4 @@ [%%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 f8fec503973..84ddce49d0f 100644 --- a/src/config/nonconsensus_mainnet.mlh +++ b/src/config/nonconsensus_mainnet.mlh @@ -3,3 +3,4 @@ [%%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 1bf7f1ec0f6..c005e7c6cc6 100644 --- a/src/config/nonconsensus_medium_curves.mlh +++ b/src/config/nonconsensus_medium_curves.mlh @@ -33,3 +33,4 @@ [%%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 a13f3a00ebe..5575fd8a3ee 100644 --- a/src/config/print_versioned_types.mlh +++ b/src/config/print_versioned_types.mlh @@ -34,3 +34,4 @@ [%%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 e894c4a2cf0..c4252d2bb17 100644 --- a/src/config/test_archive_processor.mlh +++ b/src/config/test_archive_processor.mlh @@ -34,3 +34,4 @@ [%%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 11533a08d23..5e9a4e0284c 100644 --- a/src/config/test_postake.mlh +++ b/src/config/test_postake.mlh @@ -34,3 +34,4 @@ [%%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 0989d942194..46f1f78bcee 100644 --- a/src/config/test_postake_catchup.mlh +++ b/src/config/test_postake_catchup.mlh @@ -34,3 +34,4 @@ [%%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 aafe48cf042..fbd076bd5fc 100644 --- a/src/config/test_postake_five_even_txns.mlh +++ b/src/config/test_postake_five_even_txns.mlh @@ -34,3 +34,4 @@ [%%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 4af1ddbc8ba..8ee4c5b49fc 100644 --- a/src/config/test_postake_full_epoch.mlh +++ b/src/config/test_postake_full_epoch.mlh @@ -34,3 +34,4 @@ [%%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 82bb0a0353d..f7f667b6df8 100644 --- a/src/config/test_postake_holy_grail.mlh +++ b/src/config/test_postake_holy_grail.mlh @@ -33,3 +33,4 @@ [%%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 e378af3a161..3de79ef8fab 100644 --- a/src/config/test_postake_medium_curves.mlh +++ b/src/config/test_postake_medium_curves.mlh @@ -33,3 +33,4 @@ [%%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 9ead1972302..0d80cf85808 100644 --- a/src/config/test_postake_snarkless.mlh +++ b/src/config/test_postake_snarkless.mlh @@ -34,3 +34,4 @@ [%%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 083edc1134f..56c4f61c7b1 100644 --- a/src/config/test_postake_snarkless_medium_curves.mlh +++ b/src/config/test_postake_snarkless_medium_curves.mlh @@ -34,3 +34,4 @@ [%%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 7806348ad33..567460d468e 100644 --- a/src/config/test_postake_split.mlh +++ b/src/config/test_postake_split.mlh @@ -34,3 +34,4 @@ [%%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 84d2053292e..33304688d7c 100644 --- a/src/config/test_postake_split_medium_curves.mlh +++ b/src/config/test_postake_split_medium_curves.mlh @@ -34,3 +34,4 @@ [%%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 5e77d239e85..c7758fb8ef1 100644 --- a/src/config/test_postake_three_producers.mlh +++ b/src/config/test_postake_three_producers.mlh @@ -35,3 +35,4 @@ [%%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 161f17f9e64..892ba1bb23c 100644 --- a/src/config/testnet_postake.mlh +++ b/src/config/testnet_postake.mlh @@ -35,3 +35,4 @@ [%%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 a5aee8b80d6..551f69fc7f4 100644 --- a/src/config/testnet_postake_many_producers.mlh +++ b/src/config/testnet_postake_many_producers.mlh @@ -33,3 +33,4 @@ [%%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 0a34b1710c2..4bfa8573c6a 100644 --- a/src/config/testnet_postake_many_producers_medium_curves.mlh +++ b/src/config/testnet_postake_many_producers_medium_curves.mlh @@ -35,3 +35,4 @@ [%%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 cec8264e76e..6b933dafc74 100644 --- a/src/config/testnet_postake_medium_curves.mlh +++ b/src/config/testnet_postake_medium_curves.mlh @@ -45,3 +45,4 @@ [%%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 4052d5d993a..5b85de3c0e7 100644 --- a/src/config/testnet_postake_snarkless.mlh +++ b/src/config/testnet_postake_snarkless.mlh @@ -35,3 +35,4 @@ [%%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 d2b3796491c..600673f0c3d 100644 --- a/src/config/testnet_postake_snarkless_fake_hash.mlh +++ b/src/config/testnet_postake_snarkless_fake_hash.mlh @@ -36,3 +36,4 @@ [%%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 37852b31d61..40e6698dc7c 100644 --- a/src/config/testnet_public.mlh +++ b/src/config/testnet_public.mlh @@ -35,3 +35,4 @@ [%%undef compaction_interval] [%%define vrf_poll_interval 5000] [%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/lib/mina_compile_config/mina_compile_config.ml b/src/lib/mina_compile_config/mina_compile_config.ml index 04cd4572650..dbc5380264d 100644 --- a/src/lib/mina_compile_config/mina_compile_config.ml +++ b/src/lib/mina_compile_config/mina_compile_config.ml @@ -60,3 +60,15 @@ let slot_tx_end = None let slot_tx_end = Some slot_tx_end [%%endif] + +[%%ifndef slot_chain_end] + +let slot_chain_end = None + +[%%else] + +[%%inject "slot_chain_end", slot_chain_end] + +let slot_chain_end = Some slot_chain_end + +[%%endif] From f13a7a4b22eebd45513902c9f605b31536105e27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Fri, 3 Nov 2023 08:26:23 +0000 Subject: [PATCH 08/36] Update slot transaction and chain end flags in CLI entrypoint --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 46 +++++++++++-------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index 8263885b74a..dff7747e2e2 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -430,23 +430,24 @@ let setup_daemon logger = for the associated private key that is being tracked by this daemon. \ You cannot provide both `uptime-submitter-key` and \ `uptime-submitter-pubkey`." - and enable_slot_tx_end = - flag "--enable-slot-tx-end" ~aliases:[ "enable-slot-tx-end" ] + and slot_tx_end = + flag "--slot-tx-end" ~aliases:[ "slot-tx-end" ] ~doc: (sprintf - "SLOT Slot after which the node will stop accepting transactions. \ - (default: %s)" + "SLOT Slot after which the node will stop accepting transactions, or\n\ + \ `none` to disable the feature. (default: %s)" (Option.value_map Mina_compile_config.slot_tx_end ~default:"none" ~f:string_of_int ) ) - (optional int) - and disable_slot_tx_end = - flag "--slot-tx-end" ~aliases:[ "slot-tx-end" ] no_arg + (optional string) + and slot_chain_end = + flag "--slot-network-end" ~aliases:[ "slot-network-end" ] ~doc: (sprintf - "Disable feature to stop accepting transactions. (this feature is \ - %s by default)" - (Option.value_map Mina_compile_config.slot_tx_end ~default:"disable" - ~f:(fun slot -> "enabled at slot " ^ string_of_int slot) ) ) + "SLOT Slot after which the node will stop producing/validating \ + blocks, or `none` to disable the feature. (default: %s)" + (Option.value_map Mina_compile_config.slot_chain_end ~default:"none" + ~f:string_of_int ) ) + (optional string) in let to_pubsub_topic_mode_option = let open Gossip_net.Libp2p in @@ -1288,17 +1289,22 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; submitter keyfile" in let slot_tx_end = - match (enable_slot_tx_end, disable_slot_tx_end) with - | Some slot, false -> - Some (Mina_numbers.Global_slot.of_int slot) - | None, true -> + match slot_tx_end with + | Some "none" -> None - | None, false -> + | Some slot -> + Some (Mina_numbers.Global_slot.of_string slot) + | None -> Mina_compile_config.slot_tx_end - | Some _, true -> - failwith - "Cannot provide both --enable-slot-tx-end and \ - --disable-slot-tx-end" + in + let _slot_chain_end = + match slot_chain_end with + | Some "none" -> + None + | Some slot -> + Some (Mina_numbers.Global_slot.of_string slot) + | None -> + Mina_compile_config.slot_chain_end in let start_time = Time.now () in let%map coda = From 5aaba0a4662a55848d21b2d96c2302581087d171 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Fri, 3 Nov 2023 08:36:56 +0000 Subject: [PATCH 09/36] Convert slot numbers to global slot type --- src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml | 4 ++-- src/lib/mina_compile_config/dune | 2 +- src/lib/mina_compile_config/mina_compile_config.ml | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index dff7747e2e2..340fc7835e0 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -437,7 +437,7 @@ let setup_daemon logger = "SLOT Slot after which the node will stop accepting transactions, or\n\ \ `none` to disable the feature. (default: %s)" (Option.value_map Mina_compile_config.slot_tx_end ~default:"none" - ~f:string_of_int ) ) + ~f:Mina_numbers.Global_slot.to_string ) ) (optional string) and slot_chain_end = flag "--slot-network-end" ~aliases:[ "slot-network-end" ] @@ -446,7 +446,7 @@ let setup_daemon logger = "SLOT Slot after which the node will stop producing/validating \ blocks, or `none` to disable the feature. (default: %s)" (Option.value_map Mina_compile_config.slot_chain_end ~default:"none" - ~f:string_of_int ) ) + ~f:Mina_numbers.Global_slot.to_string ) ) (optional string) in let to_pubsub_topic_mode_option = 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 dbc5380264d..3f57f721c92 100644 --- a/src/lib/mina_compile_config/mina_compile_config.ml +++ b/src/lib/mina_compile_config/mina_compile_config.ml @@ -57,7 +57,7 @@ let slot_tx_end = None [%%inject "slot_tx_end", slot_tx_end] -let slot_tx_end = Some slot_tx_end +let slot_tx_end = Some (Mina_numbers.Global_slot.of_int slot_tx_end) [%%endif] @@ -69,6 +69,6 @@ let slot_chain_end = None [%%inject "slot_chain_end", slot_chain_end] -let slot_chain_end = Some slot_chain_end +let slot_chain_end = Some (Mina_numbers.Global_slot.of_int slot_chain_end) [%%endif] From fabb4c9a69b1a6c6954d615495d11b3913297394 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Fri, 3 Nov 2023 08:37:56 +0000 Subject: [PATCH 10/36] Move txn slot check from mina_commands to graphql --- src/lib/mina_commands/mina_commands.ml | 114 +++++++++---------------- src/lib/mina_graphql/mina_graphql.ml | 2 + 2 files changed, 40 insertions(+), 76 deletions(-) diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index 581a9d02495..80f3fc676bc 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -69,87 +69,49 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) (* hack to get types to work out *) let%map () = return () in let open Deferred.Let_syntax in - let config = Mina_lib.config t in - let current_global_slot = - Consensus.Data.Consensus_time.( - to_global_slot - (of_time_exn ~constants:config.precomputed_values.consensus_constants - (Block_time.now (Mina_lib.time_controller t)) )) - in - match config.slot_tx_end with - | Some slot when Global_slot.(current_global_slot >= slot) -> - [%log' error (Mina_lib.top_level_logger t)] + let%map result = Mina_lib.add_transactions t [ user_command_input ] in + txn_count := !txn_count + 1 ; + match result with + | Ok ([], [ failed_txn ]) -> + Error + (Error.of_string + (sprintf !"%s" + ( Network_pool.Transaction_pool.Resource_pool.Diff.Diff_error + .to_yojson (snd failed_txn) + |> Yojson.Safe.to_string ) ) ) + | Ok ([ Signed_command txn ], []) -> + [%log' info (Mina_lib.top_level_logger t)] + ~metadata:[ ("command", User_command.to_yojson (Signed_command txn)) ] + "Scheduled payment $command" ; + Ok txn + | Ok (valid_commands, invalid_commands) -> + [%log' info (Mina_lib.top_level_logger t)] ~metadata: - [ ("slot_tx_end", Global_slot.to_yojson slot) - ; ("current_global_slot", Global_slot.to_yojson current_global_slot) + [ ( "valid_commands" + , `List (List.map ~f:User_command.to_yojson valid_commands) ) + ; ( "invalid_commands" + , `List + (List.map + ~f: + (Fn.compose + Network_pool.Transaction_pool.Resource_pool.Diff + .Diff_error + .to_yojson snd ) + invalid_commands ) ) ] - "Cannot send transaction after stop slot $slot_tx_end" ; - Deferred.Or_error.error_string "Cannot send transaction after stop slot" - | None | Some _ -> ( - let%map result = Mina_lib.add_transactions t [ user_command_input ] in - txn_count := !txn_count + 1 ; - match result with - | Ok ([], [ failed_txn ]) -> - Error - (Error.of_string - (sprintf !"%s" - ( Network_pool.Transaction_pool.Resource_pool.Diff.Diff_error - .to_yojson (snd failed_txn) - |> Yojson.Safe.to_string ) ) ) - | Ok ([ Signed_command txn ], []) -> - [%log' info (Mina_lib.top_level_logger t)] - ~metadata: - [ ("command", User_command.to_yojson (Signed_command txn)) ] - "Scheduled payment $command" ; - Ok txn - | Ok (valid_commands, invalid_commands) -> - [%log' info (Mina_lib.top_level_logger t)] - ~metadata: - [ ( "valid_commands" - , `List (List.map ~f:User_command.to_yojson valid_commands) ) - ; ( "invalid_commands" - , `List - (List.map - ~f: - (Fn.compose - Network_pool.Transaction_pool.Resource_pool.Diff - .Diff_error - .to_yojson snd ) - invalid_commands ) ) - ] - "Invalid result from scheduling a payment" ; - Error (Error.of_string "Internal error while scheduling a payment") - | Error e -> - Error e ) + "Invalid result from scheduling a payment" ; + Error (Error.of_string "Internal error while scheduling a payment") + | Error e -> + Error e let setup_and_submit_user_commands t user_command_list = let open Participating_state.Let_syntax in - let config = Mina_lib.config t in - let current_global_slot = - Consensus.Data.Consensus_time.( - to_global_slot - (of_time_exn ~constants:config.precomputed_values.consensus_constants - (Block_time.now (Mina_lib.time_controller t)) )) - in - match config.slot_tx_end with - | Some slot when Global_slot.(current_global_slot >= slot) -> - [%log' error (Mina_lib.top_level_logger t)] - ~metadata: - [ ("slot_tx_end", Global_slot.to_yojson slot) - ; ("current_global_slot", Global_slot.to_yojson current_global_slot) - ] - "Cannot send transaction after stop slot $slot_tx_end" ; - Participating_state.return - @@ Deferred.Or_error.error_string - "Cannot send transaction after stop slot" - | None | Some _ -> - let%map _is_active = Mina_lib.active_or_bootstrapping t in - [%log' warn (Mina_lib.top_level_logger t)] - "batch-send-payments does not yet report errors" - ~metadata: - [ ("mina_command", `String "scheduling a batch of user transactions") - ] ; - Mina_lib.add_transactions t user_command_list + let%map _is_active = Mina_lib.active_or_bootstrapping t in + [%log' warn (Mina_lib.top_level_logger t)] + "batch-send-payments does not yet report errors" + ~metadata: + [ ("mina_command", `String "scheduling a batch of user transactions") ] ; + Mina_lib.add_transactions t user_command_list module Receipt_chain_verifier = Merkle_list_verifier.Make (struct type proof_elem = User_command.t diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index 59d633334e6..93e70a8d868 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -3065,6 +3065,8 @@ module Mutations = struct Some (Mina_commands.reset_trust_status coda ip_address) ) let send_user_command coda user_command_input = + match (Mina_lib.config coda).slot_tx_end with + _ -> match Mina_commands.setup_and_submit_user_command coda user_command_input with From d9cdec8e02434b5b74f7e7a7621afb7b11db1901 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Fri, 3 Nov 2023 08:38:48 +0000 Subject: [PATCH 11/36] Add SlotTxEndTest to test suite --- src/app/test_executive/dune | 1 + src/app/test_executive/slot_tx_end_test.ml | 169 ++++++++++++++++++ src/app/test_executive/slot_tx_end_test.mli | 1 + src/app/test_executive/test_executive.ml | 1 + .../integration_test_lib/graphql_requests.ml | 60 +++++++ 5 files changed, 232 insertions(+) create mode 100644 src/app/test_executive/slot_tx_end_test.ml create mode 100644 src/app/test_executive/slot_tx_end_test.mli diff --git a/src/app/test_executive/dune b/src/app/test_executive/dune index b3e9cc12920..70fd4f706f5 100644 --- a/src/app/test_executive/dune +++ b/src/app/test_executive/dune @@ -41,6 +41,7 @@ participating_state graph_algorithms visualization + mina_compile_config ) (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_tx_end_test.ml b/src/app/test_executive/slot_tx_end_test.ml new file mode 100644 index 00000000000..c65c4de22e2 --- /dev/null +++ b/src/app/test_executive/slot_tx_end_test.ml @@ -0,0 +1,169 @@ +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 = 1000 + + let slot_tx_end = Mina_compile_config.slot_tx_end + + let slot_chain_end = Mina_compile_config.slot_chain_end + + let config = + let open Test_config in + { default with + requires_graphql = true + ; genesis_ledger = + [ { Test_Account.account_name = "bp-1-key" + ; balance = "9999999" + ; timing = Untimed + } + ; { account_name = "bp-2-key"; balance = "9999999"; timing = Untimed } + ; { account_name = "snark-node-key"; balance = "0"; timing = Untimed } + ; { account_name = "receiver-key"; balance = "0"; timing = Untimed } + ; { account_name = "sender-key"; balance = "9999999"; timing = Untimed } + ; { account_name = "fish-key"; balance = "100"; timing = Untimed } + ] + ; block_producers = + [ { node_name = "bp-1"; account_name = "bp-1-key" } + ; { node_name = "bp-2"; account_name = "bp-2-key" } + ; { node_name = "fish"; account_name = "fish-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.0001" + ; proof_config = + { proof_config_default with + work_delay = Some 1 + ; transaction_capacity = + Some Runtime_config.Proof_keys.Transaction_capacity.small + } + } + + let fee = Currency.Fee.of_int 10_000_000 + + let amount = Currency.Amount.of_int 10_000_000 + + let tx_delay_ms = 500 + + let run network t = + let open Malleable_error.Let_syntax in + let logger = Logger.create () in + if Option.is_none slot_tx_end && Option.is_none slot_chain_end then ( + [%log info] + "slot_tx_end and slot_chain_end are both None. This test doesn't apply." ; + Malleable_error.ok_unit ) + else + let num_slots = + match (slot_tx_end, slot_chain_end) with + | None, None -> + assert false + | Some slot, None | None, Some slot | Some _, Some slot -> + Mina_numbers.Global_slot.to_int slot + 5 + in + let fish = String.Map.find_exn (Network.block_producers network) "fish" in + let%bind fish_pub_key = pub_key_of_node fish in + let fish_kp = + String.Map.find_exn (Network.genesis_keypairs network) "sender-key" + in + let fish_priv_key = fish_kp.keypair.private_key in + let window_ms = + (Network.constraint_constants network).block_window_duration_ms + in + let all_nodes = Network.all_nodes network in + let%bind () = + wait_for t + (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) + in + let%bind () = + section_hard "wait for 3 blocks to be produced (warm-up)" + (wait_for t (Wait_condition.blocks_to_be_produced 3)) + in + let end_t = + Time.add (Time.now ()) + (Time.Span.of_ms @@ float_of_int (num_slots * window_ms)) + 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 keys_per_sender = 1 in + [%log info] + "will now send %d payments from as many accounts. %d nodes will \ + send %d payments each from distinct keys" + num_payments 1 keys_per_sender ; + Integration_test_lib.Graphql_requests.must_send_test_payments + ~repeat_count ~repeat_delay_ms ~logger ~senders:[ fish_priv_key ] + ~receiver_pub_key:fish_pub_key ~amount ~fee + (Network.Node.get_ingress_uri fish) ) + in + let%bind () = + section "wait for payments to be processed" + Async.(at end_t >>= const Malleable_error.ok_unit) + in + (* let event_router = event_router t in + let event_subscription = + Event_router.on event_router Block_produced + ~f:(fun + node + { Event_type.Block_produced.block_height + ; epoch + ; global_slot + ; snarked_ledger_generated + ; state_hash + } + -> + [%log info] "block produced" ; + Async.Deferred.return `Continue ) + in + Async.Deferred.Let_syntax.let%bind () = + Event_router.await event_router event_subscription + in *) + let ok_if_true s = + Malleable_error.ok_if_true ~error:(Error.of_string s) ~error_type:`Soft + in + + section "checked produced blocks" + (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 fish) + in + let%bind () = + Malleable_error.List.iter blocks ~f:(fun block -> + let%bind () = + Option.value_map slot_tx_end ~default:Malleable_error.ok_unit + ~f:(fun slot_tx_end -> + ok_if_true "block with transactions after slot_tx_end" + ( 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 + Option.value_map slot_chain_end ~default:Malleable_error.ok_unit + ~f:(fun slot_chain_end -> + ok_if_true "block produced for slot after slot_chain_end" + Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis < slot_chain_end) ) ) + in + ok_if_true "" true ) +end diff --git a/src/app/test_executive/slot_tx_end_test.mli b/src/app/test_executive/slot_tx_end_test.mli new file mode 100644 index 00000000000..8664ff022c1 --- /dev/null +++ b/src/app/test_executive/slot_tx_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 2142a6ce70e..05c5cef465c 100644 --- a/src/app/test_executive/test_executive.ml +++ b/src/app/test_executive/test_executive.ml @@ -61,6 +61,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-tx-end", (module Slot_tx_end_test.Make : Intf.Test.Functor_intf)) ] let report_test_errors ~log_error_set ~internal_error_set = 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 From d2f36490018f7119b2a9b69a268c8948cfb4e129 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Sun, 5 Nov 2023 19:28:10 +0000 Subject: [PATCH 12/36] Add slot_tx_end and slot_chain_end definitions to integration_tests.mlh (to be reverted later) --- src/config/integration_tests.mlh | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/config/integration_tests.mlh b/src/config/integration_tests.mlh index a4d92492e3c..8ea9e224c40 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"] + +[%%define slot_tx_end 8] +[%%define slot_chain_end 15] From 737b567e5802538cc03f85d1d03d764f0ee1005d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Fri, 10 Nov 2023 12:00:51 +0000 Subject: [PATCH 13/36] Removed one BP --- src/app/test_executive/slot_tx_end_test.ml | 84 +++++++++++++++------- 1 file changed, 60 insertions(+), 24 deletions(-) diff --git a/src/app/test_executive/slot_tx_end_test.ml b/src/app/test_executive/slot_tx_end_test.ml index c65c4de22e2..a50fc1a47ea 100644 --- a/src/app/test_executive/slot_tx_end_test.ml +++ b/src/app/test_executive/slot_tx_end_test.ml @@ -15,31 +15,39 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct type dsl = Dsl.t - let _num_extra_keys = 1000 + let num_extra_keys = 100 let slot_tx_end = Mina_compile_config.slot_tx_end let slot_chain_end = Mina_compile_config.slot_chain_end + let sender_account_prefix = "sender-account-" + let config = let open Test_config in { default with requires_graphql = true ; genesis_ledger = - [ { Test_Account.account_name = "bp-1-key" + [ { Test_Account.account_name = "bp-receiver-key" ; balance = "9999999" ; timing = Untimed } - ; { account_name = "bp-2-key"; balance = "9999999"; timing = Untimed } + ; { account_name = "bp-sender-key-1"; balance = "0"; timing = Untimed } + ; { account_name = "bp-sender-key-2"; balance = "0"; timing = Untimed } + ; { account_name = "bp-sender-key-3"; balance = "0"; timing = Untimed } ; { account_name = "snark-node-key"; balance = "0"; timing = Untimed } - ; { account_name = "receiver-key"; balance = "0"; timing = Untimed } - ; { account_name = "sender-key"; balance = "9999999"; timing = Untimed } - ; { account_name = "fish-key"; balance = "100"; 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 = "bp-1"; account_name = "bp-1-key" } - ; { node_name = "bp-2"; account_name = "bp-2-key" } - ; { node_name = "fish"; account_name = "fish-key" } + [ { node_name = "bp-receiver"; account_name = "bp-receiver-key" } + ; { node_name = "bp-sender-1"; account_name = "bp-sender-key-1" } + ; { node_name = "bp-sender-2"; account_name = "bp-sender-key-2" } + ; { node_name = "bp-sender-3"; account_name = "bp-sender-key-3" } ] ; snark_coordinator = Some @@ -48,7 +56,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ; worker_nodes = 4 } ; txpool_max_size = 10_000_000 - ; snark_worker_fee = "0.0001" + ; snark_worker_fee = "0.0002" + ; num_archive_nodes = 0 ; proof_config = { proof_config_default with work_delay = Some 1 @@ -61,7 +70,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let amount = Currency.Amount.of_int 10_000_000 - let tx_delay_ms = 500 + let tx_delay_ms = 5000 let run network t = let open Malleable_error.Let_syntax in @@ -78,12 +87,33 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct | Some slot, None | None, Some slot | Some _, Some slot -> Mina_numbers.Global_slot.to_int slot + 5 in - let fish = String.Map.find_exn (Network.block_producers network) "fish" in - let%bind fish_pub_key = pub_key_of_node fish in - let fish_kp = - String.Map.find_exn (Network.genesis_keypairs network) "sender-key" + let receiver = + String.Map.find_exn (Network.block_producers network) "bp-receiver" + in + let%bind receiver_pub_key = pub_key_of_node receiver in + let bp_senders = + String.Map.remove (Network.block_producers network) "bp-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 fish_priv_key = fish_kp.keypair.private_key in let window_ms = (Network.constraint_constants network).block_window_duration_ms in @@ -105,15 +135,22 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (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 keys_per_sender = 1 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 1 keys_per_sender ; - Integration_test_lib.Graphql_requests.must_send_test_payments - ~repeat_count ~repeat_delay_ms ~logger ~senders:[ fish_priv_key ] - ~receiver_pub_key:fish_pub_key ~amount ~fee - (Network.Node.get_ingress_uri fish) ) + 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 "wait for payments to be processed" @@ -140,13 +177,12 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let ok_if_true s = Malleable_error.ok_if_true ~error:(Error.of_string s) ~error_type:`Soft in - section "checked produced blocks" (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 fish) + (Network.Node.get_ingress_uri receiver) in let%bind () = Malleable_error.List.iter blocks ~f:(fun block -> From c08d084bea9005a8ca1191dfcf83407717a79eff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Wed, 15 Nov 2023 12:12:54 +0000 Subject: [PATCH 14/36] Fix stop tx slot comparison --- src/lib/block_producer/block_producer.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 9501e845e72..c742e0261da 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -151,8 +151,8 @@ let generate_next_state ~constraint_constants ~previous_protocol_state in match slot_tx_end with | Some slot_tx_end' - when Mina_numbers.Global_slot.(current_global_slot > slot_tx_end') - -> + when Mina_numbers.Global_slot.( + current_global_slot >= slot_tx_end') -> Ok Staged_ledger_diff.With_valid_signatures_and_proofs.empty_diff | None | Some _ -> ( From 07d6076b3534c14fab93c5044577b48d38fa0423 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Wed, 15 Nov 2023 16:13:33 +0000 Subject: [PATCH 15/36] Add missing slot_chain_end features --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 4 +- src/lib/block_producer/block_producer.ml | 430 +++++++++--------- src/lib/mina_lib/config.ml | 1 + src/lib/mina_lib/mina_lib.ml | 2 +- 4 files changed, 228 insertions(+), 209 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index 340fc7835e0..682b027f96d 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -1297,7 +1297,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; | None -> Mina_compile_config.slot_tx_end in - let _slot_chain_end = + let slot_chain_end = match slot_chain_end with | Some "none" -> None @@ -1337,7 +1337,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; ?precomputed_blocks_path ~log_precomputed_blocks ~upload_blocks_to_gcloud ~block_reward_threshold ~uptime_url ~uptime_submitter_keypair ~stop_time ~node_status_url - ~slot_tx_end () ) + ~slot_tx_end ~slot_chain_end () ) in { Coda_initialization.coda ; client_trustlist diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index c742e0261da..0d2fccb2663 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -112,220 +112,238 @@ 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 ~consensus_constants - ~slot_tx_end = + ~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 current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) 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.(current_global_slot >= 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 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 + in - let diff = - O1trace.sync_thread "create_staged_ledger_diff" (fun () -> - let current_global_slot = - Consensus.Data.Consensus_time.( - to_global_slot - (of_time_exn ~constants:consensus_constants - (Block_time.now time_controller) )) - in - match slot_tx_end with - | Some slot_tx_end' - when Mina_numbers.Global_slot.( - current_global_slot >= slot_tx_end') -> - Ok - Staged_ledger_diff.With_valid_signatures_and_proofs.empty_diff - | None | Some _ -> ( - 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 ) + let diff = + O1trace.sync_thread "create_staged_ledger_diff" (fun () -> + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) 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) ) + match slot_tx_end with + | Some slot_tx_end' + when Mina_numbers.Global_slot.( + current_global_slot >= slot_tx_end') -> + Ok + Staged_ledger_diff.With_valid_signatures_and_proofs + .empty_diff + | None | Some _ -> ( + 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 - 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 - 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" + 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 + 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 -> - [%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 -> + ( 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_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. + |> 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 - 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 - } + [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 = @@ -556,7 +574,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~consensus_local_state ~coinbase_receiver ~frontier_reader ~transition_writer ~set_next_producer_timing ~log_block_creation ~(precomputed_values : Precomputed_values.t) ~block_reward_threshold - ~block_produced_bvar ~slot_tx_end = + ~block_produced_bvar ~slot_tx_end ~slot_chain_end = O1trace.sync_thread "produce_blocks" (fun () -> let constraint_constants = precomputed_values.constraint_constants in let consensus_constants = precomputed_values.consensus_constants in @@ -682,7 +700,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~staged_ledger:(Breadcrumb.staged_ledger crumb) ~transactions ~get_completed_work ~logger ~log_block_creation ~winner_pk ~block_reward_threshold ~consensus_constants - ~slot_tx_end + ~slot_tx_end ~slot_chain_end in match next_state_opt with | None -> diff --git a/src/lib/mina_lib/config.ml b/src/lib/mina_lib/config.ml index 32cfeeb29e4..ae780f98612 100644 --- a/src/lib/mina_lib/config.ml +++ b/src/lib/mina_lib/config.ml @@ -60,5 +60,6 @@ type t = ; uptime_submitter_keypair : Keypair.t option [@default None] ; stop_time : int ; slot_tx_end : Mina_numbers.Global_slot.t option [@default None] + ; slot_chain_end : Mina_numbers.Global_slot.t option [@default None] } [@@deriving make] diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index fd997de4f01..586e6067c25 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1213,7 +1213,7 @@ let start t = ~precomputed_values:t.config.precomputed_values ~block_reward_threshold:t.config.block_reward_threshold ~block_produced_bvar:t.components.block_produced_bvar - ~slot_tx_end:t.config.slot_tx_end ; + ~slot_tx_end:t.config.slot_tx_end ~slot_chain_end:t.config.slot_chain_end ; perform_compaction t ; let () = match t.config.node_status_url with From 4628a04c31d8e47e7151dc947a07e88ae2cc7d35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Fri, 17 Nov 2023 17:36:03 +0000 Subject: [PATCH 16/36] Better test structure --- src/app/test_executive/slot_tx_end_test.ml | 85 +++++++++++----------- src/lib/mina_graphql/mina_graphql.ml | 30 ++++---- 2 files changed, 57 insertions(+), 58 deletions(-) diff --git a/src/app/test_executive/slot_tx_end_test.ml b/src/app/test_executive/slot_tx_end_test.ml index a50fc1a47ea..05f62d42b64 100644 --- a/src/app/test_executive/slot_tx_end_test.ml +++ b/src/app/test_executive/slot_tx_end_test.ml @@ -156,50 +156,49 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct section "wait for payments to be processed" Async.(at end_t >>= const Malleable_error.ok_unit) in - (* let event_router = event_router t in - let event_subscription = - Event_router.on event_router Block_produced - ~f:(fun - node - { Event_type.Block_produced.block_height - ; epoch - ; global_slot - ; snarked_ledger_generated - ; state_hash - } - -> - [%log info] "block produced" ; - Async.Deferred.return `Continue ) - in - Async.Deferred.Let_syntax.let%bind () = - Event_router.await event_router event_subscription - in *) let ok_if_true s = Malleable_error.ok_if_true ~error:(Error.of_string s) ~error_type:`Soft in - section "checked produced blocks" - (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 () = - Malleable_error.List.iter blocks ~f:(fun block -> - let%bind () = - Option.value_map slot_tx_end ~default:Malleable_error.ok_unit - ~f:(fun slot_tx_end -> - ok_if_true "block with transactions after slot_tx_end" - ( 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 - Option.value_map slot_chain_end ~default:Malleable_error.ok_unit - ~f:(fun slot_chain_end -> - ok_if_true "block produced for slot after slot_chain_end" - Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_chain_end) ) ) - in - ok_if_true "" true ) + 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 "check blocks after slot_tx_end" + (Malleable_error.List.iter blocks ~f:(fun block -> + Option.value_map slot_tx_end ~default:Malleable_error.ok_unit + ~f:(fun slot_tx_end -> + let msg = + Printf.sprintf + "block with transactions 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 + section "check for blocks after slot_chain_end" + (Malleable_error.List.iter blocks ~f:(fun block -> + Option.value_map slot_chain_end ~default:Malleable_error.ok_unit + ~f:(fun slot_chain_end -> + let msg = + Printf.sprintf + "block produced for slot %s after slot_chain_end (%s)" + (Mina_numbers.Global_slot.to_string + block.slot_since_genesis ) + (Mina_numbers.Global_slot.to_string slot_chain_end) + in + ok_if_true msg + Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis < slot_chain_end) ) ) ) end diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index 93e70a8d868..07f0c1e80dd 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -3066,21 +3066,21 @@ module Mutations = struct let send_user_command coda user_command_input = match (Mina_lib.config coda).slot_tx_end with - _ -> - match - Mina_commands.setup_and_submit_user_command coda user_command_input - with - | `Active f -> ( - match%map f with - | Ok user_command -> - Ok - { Types.UserCommand.With_status.data = user_command - ; status = Unknown - } - | Error e -> - Error ("Couldn't send user_command: " ^ Error.to_string_hum e) ) - | `Bootstrapping -> - return (Error "Daemon is bootstrapping") + | _ -> ( + match + Mina_commands.setup_and_submit_user_command coda user_command_input + with + | `Active f -> ( + match%map f with + | Ok user_command -> + Ok + { Types.UserCommand.With_status.data = user_command + ; status = Unknown + } + | Error e -> + Error ("Couldn't send user_command: " ^ Error.to_string_hum e) ) + | `Bootstrapping -> + return (Error "Daemon is bootstrapping") ) let find_identity ~public_key coda = Result.of_option From cdd6a706bf1192d2d0bf1bf8bf362d529021890a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Fri, 17 Nov 2023 17:37:09 +0000 Subject: [PATCH 17/36] Change build configs --- src/config/integration_tests.mlh | 4 ++-- src/config/integration_tests_slot_tx_end.mlh | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/config/integration_tests.mlh b/src/config/integration_tests.mlh index 8ea9e224c40..b49716186c6 100644 --- a/src/config/integration_tests.mlh +++ b/src/config/integration_tests.mlh @@ -6,5 +6,5 @@ snark keys, a valid genesis proof, etc. *) [%%import "/src/config/proof_level/none.mlh"] -[%%define slot_tx_end 8] -[%%define slot_chain_end 15] +[%%undef slot_tx_end] +[%%undef slot_chain_end] diff --git a/src/config/integration_tests_slot_tx_end.mlh b/src/config/integration_tests_slot_tx_end.mlh index 73666c744e5..433fba72802 100644 --- a/src/config/integration_tests_slot_tx_end.mlh +++ b/src/config/integration_tests_slot_tx_end.mlh @@ -1,5 +1,5 @@ (* same as integration_tests *) [%%import "/src/config/integration_tests.mlh"] -[%%define slot_tx_end 8] +[%%define slot_tx_end 10] [%%define slot_chain_end 15] From 840ea3521a8e2e4b2ad6897a53bab455c75ad8ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Tue, 28 Nov 2023 09:51:03 +0000 Subject: [PATCH 18/36] Remove CLI configuration flags. Use compile config directly. --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 39 +--------------- src/lib/block_producer/block_producer.ml | 18 ++++---- src/lib/ledger_catchup/ledger_catchup.ml | 6 +-- src/lib/ledger_catchup/ledger_catchup.mli | 1 - src/lib/ledger_catchup/normal_catchup.ml | 33 ++++++-------- src/lib/ledger_catchup/super_catchup.ml | 45 +++++++++---------- src/lib/mina_graphql/dune | 1 + src/lib/mina_graphql/mina_graphql.ml | 2 +- .../transition_frontier_components_intf.ml | 1 - src/lib/mina_lib/config.ml | 2 - src/lib/mina_lib/mina_lib.ml | 4 +- .../transition_frontier_controller.ml | 6 +-- src/lib/transition_handler/dune | 1 + src/lib/transition_handler/validator.ml | 8 ++-- .../transition_router/transition_router.ml | 24 +++++----- 15 files changed, 67 insertions(+), 124 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index 682b027f96d..2f40840c6a2 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -430,24 +430,6 @@ let setup_daemon logger = for the associated private key that is being tracked by this daemon. \ You cannot provide both `uptime-submitter-key` and \ `uptime-submitter-pubkey`." - and slot_tx_end = - flag "--slot-tx-end" ~aliases:[ "slot-tx-end" ] - ~doc: - (sprintf - "SLOT Slot after which the node will stop accepting transactions, or\n\ - \ `none` to disable the feature. (default: %s)" - (Option.value_map Mina_compile_config.slot_tx_end ~default:"none" - ~f:Mina_numbers.Global_slot.to_string ) ) - (optional string) - and slot_chain_end = - flag "--slot-network-end" ~aliases:[ "slot-network-end" ] - ~doc: - (sprintf - "SLOT Slot after which the node will stop producing/validating \ - blocks, or `none` to disable the feature. (default: %s)" - (Option.value_map Mina_compile_config.slot_chain_end ~default:"none" - ~f:Mina_numbers.Global_slot.to_string ) ) - (optional string) in let to_pubsub_topic_mode_option = let open Gossip_net.Libp2p in @@ -1288,24 +1270,6 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; "Cannot provide both uptime submitter public key and uptime \ submitter keyfile" in - let slot_tx_end = - match slot_tx_end with - | Some "none" -> - None - | Some slot -> - Some (Mina_numbers.Global_slot.of_string slot) - | None -> - Mina_compile_config.slot_tx_end - in - let slot_chain_end = - match slot_chain_end with - | Some "none" -> - None - | Some slot -> - Some (Mina_numbers.Global_slot.of_string slot) - | None -> - Mina_compile_config.slot_chain_end - in let start_time = Time.now () in let%map coda = Mina_lib.create ~wallets @@ -1336,8 +1300,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ; ~log_block_creation ~precomputed_values ~start_time ?precomputed_blocks_path ~log_precomputed_blocks ~upload_blocks_to_gcloud ~block_reward_threshold ~uptime_url - ~uptime_submitter_keypair ~stop_time ~node_status_url - ~slot_tx_end ~slot_chain_end () ) + ~uptime_submitter_keypair ~stop_time ~node_status_url () ) in { Coda_initialization.coda ; client_trustlist diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 0d2fccb2663..3a0fae54cf9 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -111,8 +111,7 @@ 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 ~consensus_constants - ~slot_tx_end ~slot_chain_end = + ~log_block_creation ~block_reward_threshold ~consensus_constants = let open Interruptible.Let_syntax in let current_global_slot = Consensus.Data.Consensus_time.( @@ -120,9 +119,9 @@ let generate_next_state ~constraint_constants ~previous_protocol_state (of_time_exn ~constants:consensus_constants (Block_time.now time_controller) )) in - match slot_chain_end with - | Some slot_chain_end' - when Mina_numbers.Global_slot.(current_global_slot >= slot_chain_end') -> + match Mina_compile_config.slot_chain_end with + | Some slot_chain_end + when Mina_numbers.Global_slot.(current_global_slot >= slot_chain_end) -> Interruptible.return None | None | Some _ -> ( let previous_protocol_state_body_hash = @@ -160,10 +159,10 @@ let generate_next_state ~constraint_constants ~previous_protocol_state (of_time_exn ~constants:consensus_constants (Block_time.now time_controller) )) in - match slot_tx_end with - | Some slot_tx_end' + match Mina_compile_config.slot_tx_end with + | Some slot_tx_end when Mina_numbers.Global_slot.( - current_global_slot >= slot_tx_end') -> + current_global_slot >= slot_tx_end) -> Ok Staged_ledger_diff.With_valid_signatures_and_proofs .empty_diff @@ -574,7 +573,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~consensus_local_state ~coinbase_receiver ~frontier_reader ~transition_writer ~set_next_producer_timing ~log_block_creation ~(precomputed_values : Precomputed_values.t) ~block_reward_threshold - ~block_produced_bvar ~slot_tx_end ~slot_chain_end = + ~block_produced_bvar = O1trace.sync_thread "produce_blocks" (fun () -> let constraint_constants = precomputed_values.constraint_constants in let consensus_constants = precomputed_values.consensus_constants in @@ -700,7 +699,6 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~staged_ledger:(Breadcrumb.staged_ledger crumb) ~transactions ~get_completed_work ~logger ~log_block_creation ~winner_pk ~block_reward_threshold ~consensus_constants - ~slot_tx_end ~slot_chain_end in match next_state_opt with | None -> diff --git a/src/lib/ledger_catchup/ledger_catchup.ml b/src/lib/ledger_catchup/ledger_catchup.ml index a4b0bac3abb..72ed96457fd 100644 --- a/src/lib/ledger_catchup/ledger_catchup.ml +++ b/src/lib/ledger_catchup/ledger_catchup.ml @@ -3,13 +3,13 @@ module Best_tip_lru = Best_tip_lru let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache ~slot_tx_end : unit = + ~unprocessed_transition_cache : unit = match Transition_frontier.catchup_tree frontier with | Hash _ -> Normal_catchup.run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache ~slot_tx_end + ~unprocessed_transition_cache | Full _ -> Super_catchup.run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache ~slot_tx_end + ~unprocessed_transition_cache diff --git a/src/lib/ledger_catchup/ledger_catchup.mli b/src/lib/ledger_catchup/ledger_catchup.mli index 5914c8cb6aa..2e969057892 100644 --- a/src/lib/ledger_catchup/ledger_catchup.mli +++ b/src/lib/ledger_catchup/ledger_catchup.mli @@ -36,5 +36,4 @@ val run : Strict_pipe.Writer.t -> unprocessed_transition_cache: Transition_handler.Unprocessed_transition_cache.t - -> slot_tx_end:Mina_numbers.Global_slot.t option -> unit diff --git a/src/lib/ledger_catchup/normal_catchup.ml b/src/lib/ledger_catchup/normal_catchup.ml index e5081d903f1..28725c12847 100644 --- a/src/lib/ledger_catchup/normal_catchup.ml +++ b/src/lib/ledger_catchup/normal_catchup.ml @@ -46,7 +46,7 @@ open Network_peer the [Processor] via writing them to catchup_breadcrumbs_writer. *) let verify_transition ~logger ~consensus_constants ~trust_system ~frontier - ~unprocessed_transition_cache ~slot_tx_end enveloped_transition = + ~unprocessed_transition_cache 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 @@ -66,7 +66,7 @@ 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 ~slot_tx_end + ~consensus_constants ~unprocessed_transition_cache enveloped_initially_validated_transition in let open Deferred.Let_syntax in @@ -467,7 +467,7 @@ let download_transitions ~target_hash ~logger ~trust_system ~network let verify_transitions_and_build_breadcrumbs ~logger ~(precomputed_values : Precomputed_values.t) ~trust_system ~verifier ~frontier ~unprocessed_transition_cache ~transitions ~target_hash ~subtrees - ~slot_tx_end = + = let open Deferred.Or_error.Let_syntax in let verification_start_time = Core.Time.now () in let%bind transitions_with_initial_validation, initial_hash = @@ -519,8 +519,7 @@ let verify_transitions_and_build_breadcrumbs ~logger match%bind verify_transition ~logger ~consensus_constants:precomputed_values.consensus_constants - ~trust_system ~frontier ~unprocessed_transition_cache ~slot_tx_end - transition + ~trust_system ~frontier ~unprocessed_transition_cache transition with | Error e -> List.iter acc ~f:(fun (node, vc) -> @@ -622,7 +621,7 @@ let garbage_collect_subtrees ~logger ~subtrees = let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache ~slot_tx_end : unit = + ~unprocessed_transition_cache : unit = let hash_tree = match Transition_frontier.catchup_tree frontier with | Hash t -> @@ -790,7 +789,7 @@ let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier verify_transitions_and_build_breadcrumbs ~logger ~precomputed_values ~trust_system ~verifier ~frontier ~unprocessed_transition_cache ~transitions ~target_hash - ~subtrees ~slot_tx_end + ~subtrees with | Ok trees_of_breadcrumbs -> [%log trace] @@ -904,7 +903,7 @@ let%test_module "Ledger_catchup tests" = Strict_pipe.Reader.t } - let run_catchup ~network ~frontier ~slot_tx_end = + let run_catchup ~network ~frontier = let catchup_job_reader, catchup_job_writer = Strict_pipe.create ~name:(__MODULE__ ^ __LOC__) (Buffered (`Capacity 10, `Overflow Crash)) @@ -918,15 +917,14 @@ let%test_module "Ledger_catchup tests" = in run ~logger ~precomputed_values ~verifier ~trust_system ~network ~frontier ~catchup_breadcrumbs_writer ~catchup_job_reader - ~unprocessed_transition_cache ~slot_tx_end ; + ~unprocessed_transition_cache ; { cache = unprocessed_transition_cache ; job_writer = catchup_job_writer ; breadcrumbs_reader = catchup_breadcrumbs_reader } - let run_catchup_with_target ~network ~frontier ~target_breadcrumb - ~slot_tx_end = - let test = run_catchup ~network ~frontier ~slot_tx_end in + let run_catchup_with_target ~network ~frontier ~target_breadcrumb = + let test = run_catchup ~network ~frontier in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb in @@ -938,12 +936,12 @@ let%test_module "Ledger_catchup tests" = (parent_hash, [ Rose_tree.T ((target_transition, None), []) ]) ; (`Test test, `Cached_transition target_transition) - let test_successful_catchup ~my_net ~target_best_tip_path ~slot_tx_end = + let test_successful_catchup ~my_net ~target_best_tip_path = let open Fake_network in let target_breadcrumb = List.last_exn target_best_tip_path in let `Test { breadcrumbs_reader; _ }, _ = run_catchup_with_target ~network:my_net.network - ~frontier:my_net.state.frontier ~target_breadcrumb ~slot_tx_end + ~frontier:my_net.state.frontier ~target_breadcrumb in (* TODO: expose Strict_pipe.read *) let%map cached_catchup_breadcrumbs = @@ -1003,8 +1001,7 @@ let%test_module "Ledger_catchup tests" = (best_tip peer_net.state.frontier)) in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path - ~slot_tx_end:None ) ) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1020,8 +1017,7 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path - ~slot_tx_end:None ) ) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup fails if one of the parent transitions fail" = Quickcheck.test ~trials:1 @@ -1056,7 +1052,6 @@ let%test_module "Ledger_catchup tests" = let `Test { cache; _ }, `Cached_transition cached_transition = run_catchup_with_target ~network:my_net.network ~frontier:my_net.state.frontier ~target_breadcrumb - ~slot_tx_end:None in let cached_failing_transition = Transition_handler.Unprocessed_transition_cache.register_exn diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index b01ab77d935..cde407fea75 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -120,7 +120,7 @@ let write_graph (_ : t) = () let verify_transition ~logger ~consensus_constants ~trust_system ~frontier - ~unprocessed_transition_cache ~slot_tx_end enveloped_transition = + ~unprocessed_transition_cache 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,7 +139,7 @@ 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 ~slot_tx_end + ~consensus_constants ~unprocessed_transition_cache enveloped_initially_validated_transition in let state_hash = @@ -564,7 +564,7 @@ end let initial_validate ~(precomputed_values : Precomputed_values.t) ~logger ~trust_system ~(batcher : _ Initial_validate_batcher.t) ~frontier - ~unprocessed_transition_cache ~slot_tx_end transition = + ~unprocessed_transition_cache transition = let verification_start_time = Core.Time.now () in let open Deferred.Result.Let_syntax in let state_hash = @@ -614,7 +614,7 @@ let initial_validate ~(precomputed_values : Precomputed_values.t) ~logger "initial_validate: verification of proofs complete" ; verify_transition ~logger ~consensus_constants:precomputed_values.consensus_constants ~trust_system - ~frontier ~unprocessed_transition_cache ~slot_tx_end tv + ~frontier ~unprocessed_transition_cache tv |> Deferred.map ~f:(Result.map_error ~f:(fun e -> `Error e)) open Frontier_base @@ -716,7 +716,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger | `Invalid_staged_ledger_hash of Error.t | `Fatal_error of exn ] ) Result.t - Deferred.t ) ~slot_tx_end = + Deferred.t ) = (* setup_state_machine_runner returns a fully configured lambda function, which is the state machine runner *) let initial_validation_batcher = Initial_validate_batcher.create ~verifier ~precomputed_values @@ -813,7 +813,7 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger step ( initial_validate ~precomputed_values ~logger ~trust_system ~batcher:initial_validation_batcher ~frontier - ~unprocessed_transition_cache ~slot_tx_end + ~unprocessed_transition_cache { external_block with data = { With_hash.data = external_block.data @@ -1004,7 +1004,6 @@ let setup_state_machine_runner ~t ~verifier ~downloader ~logger (* TODO: In the future, this could take over scheduling bootstraps too. *) let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func - ~slot_tx_end ~(catchup_job_reader : ( State_hash.t * ( ( Mina_block.initial_valid_block Envelope.Incoming.t @@ -1125,7 +1124,7 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func let run_state_machine = setup_state_machine_runner ~t ~verifier ~downloader ~logger ~precomputed_values ~trust_system ~frontier ~unprocessed_transition_cache - ~catchup_breadcrumbs_writer ~build_func ~slot_tx_end + ~catchup_breadcrumbs_writer ~build_func in (* TODO: Maybe add everything from transition frontier at the beginning? *) (* TODO: Print out the hashes you're adding *) @@ -1335,11 +1334,11 @@ let run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~build_func let run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache ~slot_tx_end : unit = + ~unprocessed_transition_cache : unit = O1trace.background_thread "perform_super_catchup" (fun () -> run_catchup ~logger ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~precomputed_values ~unprocessed_transition_cache - ~catchup_breadcrumbs_writer ~slot_tx_end + ~catchup_breadcrumbs_writer ~build_func:Transition_frontier.Breadcrumb.build ) (* Unit tests *) @@ -1420,7 +1419,7 @@ let%test_module "Ledger_catchup tests" = Strict_pipe.Reader.t } - let setup_catchup_pipes ~network ~frontier ~slot_tx_end = + let setup_catchup_pipes ~network ~frontier = let catchup_job_reader, catchup_job_writer = Strict_pipe.create ~name:(__MODULE__ ^ __LOC__) (Buffered (`Capacity 10, `Overflow Crash)) @@ -1434,7 +1433,7 @@ let%test_module "Ledger_catchup tests" = in run ~logger ~precomputed_values ~verifier ~trust_system ~network ~frontier ~catchup_breadcrumbs_writer ~catchup_job_reader - ~unprocessed_transition_cache ~slot_tx_end ; + ~unprocessed_transition_cache ; { cache = unprocessed_transition_cache ; job_writer = catchup_job_writer ; breadcrumbs_reader = catchup_breadcrumbs_reader @@ -1460,9 +1459,8 @@ let%test_module "Ledger_catchup tests" = ; breadcrumbs_reader = catchup_breadcrumbs_reader } *) - let setup_catchup_with_target ~network ~frontier ~target_breadcrumb - ~slot_tx_end = - let test = setup_catchup_pipes ~network ~frontier ~slot_tx_end in + let setup_catchup_with_target ~network ~frontier ~target_breadcrumb = + let test = setup_catchup_pipes ~network ~frontier in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb in @@ -1511,12 +1509,12 @@ let%test_module "Ledger_catchup tests" = (n + 1) else Deferred.return b_list - let test_successful_catchup ~my_net ~target_best_tip_path ~slot_tx_end = + let test_successful_catchup ~my_net ~target_best_tip_path = let open Fake_network in let target_breadcrumb = List.last_exn target_best_tip_path in let `Test { breadcrumbs_reader; _ }, _ = setup_catchup_with_target ~network:my_net.network - ~frontier:my_net.state.frontier ~target_breadcrumb ~slot_tx_end + ~frontier:my_net.state.frontier ~target_breadcrumb in let%map breadcrumb_list = call_read ~breadcrumbs_reader ~target_best_tip_path ~my_peer:my_net [] 0 @@ -1567,8 +1565,7 @@ let%test_module "Ledger_catchup tests" = (best_tip peer_net.state.frontier)) in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path - ~slot_tx_end:None ) ) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1584,8 +1581,7 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path - ~slot_tx_end:None ) ) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "catchup succeeds even if the parent transition is already \ in the frontier" = @@ -1601,8 +1597,7 @@ let%test_module "Ledger_catchup tests" = [ Transition_frontier.best_tip peer_net.state.frontier ] in Thread_safe.block_on_async_exn (fun () -> - test_successful_catchup ~my_net ~target_best_tip_path - ~slot_tx_end:None ) ) + test_successful_catchup ~my_net ~target_best_tip_path ) ) let%test_unit "when catchup fails to download state hashes, catchup will \ properly clear the unprocessed_transition_cache of the \ @@ -1625,7 +1620,7 @@ let%test_module "Ledger_catchup tests" = let target_breadcrumb = List.last_exn target_best_tip_path in let test = setup_catchup_pipes ~network:my_net.network - ~frontier:my_net.state.frontier ~slot_tx_end:None + ~frontier:my_net.state.frontier in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb @@ -1723,7 +1718,7 @@ let%test_module "Ledger_catchup tests" = let target_breadcrumb = List.last_exn target_best_tip_path in let test = setup_catchup_pipes ~network:my_net.network - ~frontier:my_net.state.frontier ~slot_tx_end:None + ~frontier:my_net.state.frontier in let parent_hash = Transition_frontier.Breadcrumb.parent_hash target_breadcrumb diff --git a/src/lib/mina_graphql/dune b/src/lib/mina_graphql/dune index a4121fbe22b..3a3c31c2a93 100644 --- a/src/lib/mina_graphql/dune +++ b/src/lib/mina_graphql/dune @@ -78,6 +78,7 @@ o1trace graphql_wrapper either + mina_compile_config ) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_coda ppx_version ppx_jane ppx_deriving_yojson ppx_deriving.make))) diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index 07f0c1e80dd..ec317380981 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -3065,7 +3065,7 @@ module Mutations = struct Some (Mina_commands.reset_trust_status coda ip_address) ) let send_user_command coda user_command_input = - match (Mina_lib.config coda).slot_tx_end with + match Mina_compile_config.slot_tx_end with | _ -> ( match Mina_commands.setup_and_submit_user_command coda user_command_input diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index 44591b28ab6..a269a501071 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -336,7 +336,6 @@ module type Transition_router_intf = sig -> precomputed_values:Precomputed_values.t -> catchup_mode:[ `Normal | `Super ] -> notify_online:(unit -> unit Deferred.t) - -> slot_tx_end:Mina_numbers.Global_slot.t option -> ( [ `Transition of Mina_block.Validated.t ] * [ `Source of [ `Gossip | `Catchup | `Internal ] ] * [ `Valid_cb of Mina_net2.Validation_callback.t option ] ) diff --git a/src/lib/mina_lib/config.ml b/src/lib/mina_lib/config.ml index ae780f98612..4bdf35b6045 100644 --- a/src/lib/mina_lib/config.ml +++ b/src/lib/mina_lib/config.ml @@ -59,7 +59,5 @@ type t = ; uptime_url : Uri.t option [@default None] ; uptime_submitter_keypair : Keypair.t option [@default None] ; stop_time : int - ; slot_tx_end : Mina_numbers.Global_slot.t option [@default None] - ; slot_chain_end : Mina_numbers.Global_slot.t option [@default None] } [@@deriving make] diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 586e6067c25..ddddaa71d44 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1212,8 +1212,7 @@ let start t = ~log_block_creation:t.config.log_block_creation ~precomputed_values:t.config.precomputed_values ~block_reward_threshold:t.config.block_reward_threshold - ~block_produced_bvar:t.components.block_produced_bvar - ~slot_tx_end:t.config.slot_tx_end ~slot_chain_end:t.config.slot_chain_end ; + ~block_produced_bvar:t.components.block_produced_bvar ; perform_compaction t ; let () = match t.config.node_status_url with @@ -1777,7 +1776,6 @@ let create ?wallets (config : Config.t) = ~catchup_mode ~network_transition_reader:block_reader ~producer_transition_reader ~most_recent_valid_block ~precomputed_values:config.precomputed_values ~notify_online - ~slot_tx_end:config.slot_tx_end in let ( valid_transitions_for_network , valid_transitions_for_api diff --git a/src/lib/transition_frontier_controller/transition_frontier_controller.ml b/src/lib/transition_frontier_controller/transition_frontier_controller.ml index e520320a828..15c647b1ab2 100644 --- a/src/lib/transition_frontier_controller/transition_frontier_controller.ml +++ b/src/lib/transition_frontier_controller/transition_frontier_controller.ml @@ -5,7 +5,7 @@ open Mina_block let run ~logger ~trust_system ~verifier ~network ~time_controller ~collected_transitions ~frontier ~network_transition_reader - ~producer_transition_reader ~clear_reader ~precomputed_values ~slot_tx_end = + ~producer_transition_reader ~clear_reader ~precomputed_values = let valid_transition_pipe_capacity = 50 in let start_time = Time.now () in let f_drop_head name head valid_cb = @@ -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 ~slot_tx_end ; + ~unprocessed_transition_cache ; 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) ) @@ -115,7 +115,7 @@ let run ~logger ~trust_system ~verifier ~network ~time_controller ~processed_transition_writer ; Ledger_catchup.run ~logger ~precomputed_values ~trust_system ~verifier ~network ~frontier ~catchup_job_reader ~catchup_breadcrumbs_writer - ~unprocessed_transition_cache ~slot_tx_end ; + ~unprocessed_transition_cache ; Strict_pipe.Reader.iter_without_pushback clear_reader ~f:(fun _ -> let open Strict_pipe.Writer in kill valid_transition_writer ; diff --git a/src/lib/transition_handler/dune b/src/lib/transition_handler/dune index 01c7ce77103..addb68a478b 100644 --- a/src/lib/transition_handler/dune +++ b/src/lib/transition_handler/dune @@ -46,6 +46,7 @@ result mina_numbers staged_ledger_diff + mina_compile_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 e8a27dca95f..c2d4cf27577 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -8,7 +8,7 @@ open Mina_block open Network_peer let validate_transition ~consensus_constants ~logger ~frontier - ~unprocessed_transition_cache ~slot_tx_end enveloped_transition = + ~unprocessed_transition_cache enveloped_transition = let open Result.Let_syntax in let transition = Envelope.Incoming.data enveloped_transition @@ -23,7 +23,7 @@ let validate_transition ~consensus_constants ~logger ~frontier @@ Mina_block.header transition_data in let%bind () = - match slot_tx_end with + match Mina_compile_config.slot_tx_end with | Some slot when Mina_numbers.Global_slot.(block_slot >= slot) -> let staged_ledger_diff = Body.staged_ledger_diff @@ body transition_data @@ -77,7 +77,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 ~slot_tx_end = + Writer.t ) ~unprocessed_transition_cache = let module Lru = Core_extended_cache.Lru in O1trace.background_thread "validate_blocks_against_frontier" (fun () -> Reader.iter transition_reader @@ -90,7 +90,7 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier let sender = Envelope.Incoming.sender transition_env in match validate_transition ~consensus_constants ~logger ~frontier - ~unprocessed_transition_cache ~slot_tx_end transition_env + ~unprocessed_transition_cache transition_env with | Ok cached_transition -> let%map () = diff --git a/src/lib/transition_router/transition_router.ml b/src/lib/transition_router/transition_router.ml index 5e66d8adbd8..6d11d7b7657 100644 --- a/src/lib/transition_router/transition_router.ml +++ b/src/lib/transition_router/transition_router.ml @@ -58,7 +58,7 @@ let start_transition_frontier_controller ~logger ~trust_system ~verifier ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~collected_transitions ~transition_reader_ref ~transition_writer_ref - ~frontier_w ~precomputed_values ~slot_tx_end frontier = + ~frontier_w ~precomputed_values frontier = [%str_log info] Starting_transition_frontier_controller ; let ( transition_frontier_controller_reader , transition_frontier_controller_writer ) = @@ -87,7 +87,7 @@ let start_transition_frontier_controller ~logger ~trust_system ~verifier Transition_frontier_controller.run ~logger ~trust_system ~verifier ~network ~time_controller ~collected_transitions ~frontier ~network_transition_reader:!transition_reader_ref - ~producer_transition_reader ~clear_reader ~precomputed_values ~slot_tx_end + ~producer_transition_reader ~clear_reader ~precomputed_values in Strict_pipe.Reader.iter new_verified_transition_reader ~f: @@ -100,7 +100,7 @@ let start_bootstrap_controller ~logger ~trust_system ~verifier ~network ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~transition_reader_ref ~transition_writer_ref ~consensus_local_state ~frontier_w ~initial_root_transition ~persistent_root ~persistent_frontier - ~best_seen_transition ~precomputed_values ~catchup_mode ~slot_tx_end = + ~best_seen_transition ~precomputed_values ~catchup_mode = [%str_log info] Starting_bootstrap_controller ; [%log info] "Starting Bootstrap Controller phase" ; let bootstrap_controller_reader, bootstrap_controller_writer = @@ -138,8 +138,7 @@ let start_bootstrap_controller ~logger ~trust_system ~verifier ~network ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~collected_transitions ~transition_reader_ref - ~transition_writer_ref ~frontier_w ~precomputed_values ~slot_tx_end - new_frontier ) + ~transition_writer_ref ~frontier_w ~precomputed_values new_frontier ) let download_best_tip ~notify_online ~logger ~network ~verifier ~trust_system ~most_recent_valid_block_writer ~genesis_constants ~precomputed_values = @@ -308,8 +307,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~producer_transition_writer_ref ~clear_reader ~verified_transition_writer ~transition_reader_ref ~transition_writer_ref ~most_recent_valid_block_writer ~persistent_root ~persistent_frontier - ~consensus_local_state ~precomputed_values ~catchup_mode ~notify_online - ~slot_tx_end = + ~consensus_local_state ~precomputed_values ~catchup_mode ~notify_online = let%bind () = if is_demo_mode then return () else wait_for_high_connectivity ~logger ~network ~is_seed @@ -337,7 +335,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~clear_reader ~transition_reader_ref ~consensus_local_state ~transition_writer_ref ~frontier_w ~persistent_root ~persistent_frontier ~initial_root_transition ~catchup_mode ~best_seen_transition:best_tip - ~precomputed_values ~slot_tx_end + ~precomputed_values | best_tip, Some frontier -> ( match best_tip with | Some best_tip @@ -366,7 +364,6 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~transition_writer_ref ~frontier_w ~persistent_root ~persistent_frontier ~initial_root_transition ~catchup_mode ~best_seen_transition:(Some best_tip) ~precomputed_values - ~slot_tx_end | _ -> if Option.is_some best_tip then [%log info] @@ -423,8 +420,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer ~clear_reader ~collected_transitions ~transition_reader_ref - ~transition_writer_ref ~frontier_w ~precomputed_values ~slot_tx_end - frontier ) + ~transition_writer_ref ~frontier_w ~precomputed_values frontier ) let wait_till_genesis ~logger ~time_controller ~(precomputed_values : Precomputed_values.t) = @@ -472,7 +468,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode ~producer_transition_reader ~most_recent_valid_block: (most_recent_valid_block_reader, most_recent_valid_block_writer) - ~precomputed_values ~catchup_mode ~notify_online ~slot_tx_end = + ~precomputed_values ~catchup_mode ~notify_online = let initialization_finish_signal = Ivar.create () in let clear_reader, clear_writer = Strict_pipe.create ~name:"clear" Synchronous @@ -548,7 +544,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode ~producer_transition_writer_ref ~clear_reader ~verified_transition_writer ~transition_reader_ref ~transition_writer_ref ~most_recent_valid_block_writer - ~consensus_local_state ~precomputed_values ~notify_online ~slot_tx_end + ~consensus_local_state ~precomputed_values ~notify_online in Ivar.fill_if_empty initialization_finish_signal () ; let valid_transition_reader1, valid_transition_reader2 = @@ -614,7 +610,7 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode ~consensus_local_state ~frontier_w ~persistent_root ~persistent_frontier ~initial_root_transition ~best_seen_transition:(Some enveloped_transition) - ~precomputed_values ~catchup_mode ~slot_tx_end ) + ~precomputed_values ~catchup_mode ) else Deferred.unit | None -> Deferred.unit From 2560a66c511463ca209d5d8c4d1d507e2b390ce4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Tue, 28 Nov 2023 16:07:35 +0000 Subject: [PATCH 19/36] Adjustments to block production and validation. Add notifications --- src/lib/block_producer/block_producer.ml | 71 +++++++++++++++--------- src/lib/ledger_catchup/normal_catchup.ml | 2 + src/lib/ledger_catchup/super_catchup.ml | 7 ++- src/lib/transition_handler/validator.ml | 30 +++++++++- 4 files changed, 81 insertions(+), 29 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 3a0fae54cf9..4211b23852d 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -113,17 +113,34 @@ let generate_next_state ~constraint_constants ~previous_protocol_state ~(block_data : Consensus.Data.Block_data.t) ~winner_pk ~scheduled_time ~log_block_creation ~block_reward_threshold ~consensus_constants = let open Interruptible.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) )) + let global_slot = + Consensus.Data.Block_data.global_slot_since_genesis block_data in match Mina_compile_config.slot_chain_end with | Some slot_chain_end - when Mina_numbers.Global_slot.(current_global_slot >= 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 current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) + in + let slot_diff slot = + let open Mina_numbers.Global_slot in + Option.map ~f:to_int @@ sub slot current_global_slot + in + Option.iter (Option.bind Mina_compile_config.slot_chain_end ~f:slot_diff) + ~f:(fun slot_diff' -> + if slot_diff' <= 480 && slot_diff' mod 60 = 0 then + [%log info] + "Block producer will stop producing blocks after $slot_diff slots" + ~metadata:[ ("slot_diff", `Int slot_diff') ] ) ; let previous_protocol_state_body_hash = Protocol_state.body previous_protocol_state |> Protocol_state.Body.hash in @@ -138,9 +155,6 @@ let generate_next_state ~constraint_constants ~previous_protocol_state 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 @@ -150,23 +164,28 @@ let generate_next_state ~constraint_constants ~previous_protocol_state let coinbase_receiver = Consensus.Data.Block_data.coinbase_receiver block_data in - let diff = - O1trace.sync_thread "create_staged_ledger_diff" (fun () -> - let current_global_slot = - Consensus.Data.Consensus_time.( - to_global_slot - (of_time_exn ~constants:consensus_constants - (Block_time.now time_controller) )) - in - match Mina_compile_config.slot_tx_end with - | Some slot_tx_end - when Mina_numbers.Global_slot.( - current_global_slot >= slot_tx_end) -> - Ok - Staged_ledger_diff.With_valid_signatures_and_proofs - .empty_diff - | None | Some _ -> ( + match Mina_compile_config.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 -> + Option.iter + (Option.bind Mina_compile_config.slot_tx_end ~f:slot_diff) + ~f:(fun slot_diff' -> + if slot_diff' <= 480 && slot_diff' mod 60 = 0 then + [%log info] + "Block producer will begin producing only empty blocks \ + after $slot_diff slots" + ~metadata:[ ("slot_diff", `Int slot_diff') ] ) ; + O1trace.sync_thread "create_staged_ledger_diff" (fun () -> let diff = Staged_ledger.create_diff ~constraint_constants staged_ledger ~coinbase_receiver ~logger @@ -198,7 +217,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state Staged_ledger_diff.With_valid_signatures_and_proofs .empty_diff ) | _ -> - diff ) ) + diff ) in match%map let%bind.Deferred.Result diff = return diff in diff --git a/src/lib/ledger_catchup/normal_catchup.ml b/src/lib/ledger_catchup/normal_catchup.ml index 28725c12847..b074d363aa0 100644 --- a/src/lib/ledger_catchup/normal_catchup.ml +++ b/src/lib/ledger_catchup/normal_catchup.ml @@ -157,6 +157,8 @@ let verify_transition ~logger ~consensus_constants ~trust_system ~frontier 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 : diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index cde407fea75..26dc34417b9 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -269,8 +269,13 @@ let verify_transition ~logger ~consensus_constants ~trust_system ~frontier [%log warn] ~metadata:[ ("state_hash", state_hash) ] "initial_validate: transition with non empty staged ledger diff after \ - stop slot" ; + 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 diff --git a/src/lib/transition_handler/validator.ml b/src/lib/transition_handler/validator.ml index c2d4cf27577..69600f012a9 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -22,9 +22,20 @@ let validate_transition ~consensus_constants ~logger ~frontier @@ Protocol_state.consensus_state @@ Header.protocol_state @@ Mina_block.header transition_data in + let%bind () = + match Mina_compile_config.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 Mina_compile_config.slot_tx_end with - | Some slot when Mina_numbers.Global_slot.(block_slot >= slot) -> + | 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 @@ -149,7 +160,22 @@ let run ~logger ~consensus_constants ~trust_system ~time_controller ~frontier ~metadata: [ ("state_hash", State_hash.to_yojson transition_hash) ; ( "reason" - , `String "not empty staged ledger diff after stop slot" ) + , `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 From 21ce8360f00ae4c6e9334316bd3bbdc166a5bcd8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 20 Dec 2023 09:28:24 +0000 Subject: [PATCH 20/36] Add slot_chain_end tests and other fixes to integration test --- .../{slot_tx_end_test.ml => slot_end_test.ml} | 78 ++++++++++++------- ...slot_tx_end_test.mli => slot_end_test.mli} | 0 src/app/test_executive/test_executive.ml | 2 +- 3 files changed, 49 insertions(+), 31 deletions(-) rename src/app/test_executive/{slot_tx_end_test.ml => slot_end_test.ml} (70%) rename src/app/test_executive/{slot_tx_end_test.mli => slot_end_test.mli} (100%) diff --git a/src/app/test_executive/slot_tx_end_test.ml b/src/app/test_executive/slot_end_test.ml similarity index 70% rename from src/app/test_executive/slot_tx_end_test.ml rename to src/app/test_executive/slot_end_test.ml index 05f62d42b64..f463a6f5d57 100644 --- a/src/app/test_executive/slot_tx_end_test.ml +++ b/src/app/test_executive/slot_end_test.ml @@ -28,13 +28,13 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct { default with requires_graphql = true ; genesis_ledger = - [ { Test_Account.account_name = "bp-receiver-key" + [ { Test_Account.account_name = "receiver-key" ; balance = "9999999" ; timing = Untimed } - ; { account_name = "bp-sender-key-1"; balance = "0"; timing = Untimed } - ; { account_name = "bp-sender-key-2"; balance = "0"; timing = Untimed } - ; { account_name = "bp-sender-key-3"; balance = "0"; 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 -> @@ -44,10 +44,10 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ; timing = Untimed } ) ; block_producers = - [ { node_name = "bp-receiver"; account_name = "bp-receiver-key" } - ; { node_name = "bp-sender-1"; account_name = "bp-sender-key-1" } - ; { node_name = "bp-sender-2"; account_name = "bp-sender-key-2" } - ; { node_name = "bp-sender-3"; account_name = "bp-sender-key-3" } + [ { 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 @@ -88,11 +88,11 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Mina_numbers.Global_slot.to_int slot + 5 in let receiver = - String.Map.find_exn (Network.block_producers network) "bp-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) "bp-receiver" + String.Map.remove (Network.block_producers network) "receiver" |> String.Map.data in let sender_kps = @@ -153,7 +153,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct >>| const () ) in let%bind () = - section "wait for payments to be processed" + section + (Printf.sprintf "wait until slot %d" num_slots) Async.(at end_t >>= const Malleable_error.ok_unit) in let ok_if_true s = @@ -166,10 +167,22 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct (Network.Node.get_ingress_uri receiver) in let%bind () = - section "check blocks after slot_tx_end" - (Malleable_error.List.iter blocks ~f:(fun block -> - Option.value_map slot_tx_end ~default:Malleable_error.ok_unit - ~f:(fun slot_tx_end -> + section "non-empty blocks produced before slot_tx_end" + (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit + ~f:(fun 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 "only empty blocks produced after slot_tx_end" + (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit + ~f:(fun slot_tx_end -> + Malleable_error.List.iter blocks ~f:(fun block -> let msg = Printf.sprintf "block with transactions after slot_tx_end. block slot \ @@ -182,23 +195,28 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in ok_if_true msg ( Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_tx_end) + of_uint32 block.slot_since_genesis < slot_tx_end ) || block.command_transaction_count = 0 && block.snark_work_count = 0 && block.coinbase = 0 ) ) ) ) in - section "check for blocks after slot_chain_end" - (Malleable_error.List.iter blocks ~f:(fun block -> - Option.value_map slot_chain_end ~default:Malleable_error.ok_unit - ~f:(fun slot_chain_end -> - let msg = - Printf.sprintf - "block produced for slot %s after slot_chain_end (%s)" - (Mina_numbers.Global_slot.to_string - block.slot_since_genesis ) - (Mina_numbers.Global_slot.to_string slot_chain_end) - in - ok_if_true msg - Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_chain_end) ) ) ) + let%bind () = + section "blocks produced before slot_chain_end" + (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit + ~f:(fun 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" + (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit + ~f:(fun 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_tx_end_test.mli b/src/app/test_executive/slot_end_test.mli similarity index 100% rename from src/app/test_executive/slot_tx_end_test.mli rename to src/app/test_executive/slot_end_test.mli diff --git a/src/app/test_executive/test_executive.ml b/src/app/test_executive/test_executive.ml index 05c5cef465c..d06fda861da 100644 --- a/src/app/test_executive/test_executive.ml +++ b/src/app/test_executive/test_executive.ml @@ -61,7 +61,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-tx-end", (module Slot_tx_end_test.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 = From da7097156e26174b7ce6e0a54fbd02c6e094ab3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 20 Dec 2023 10:08:34 +0000 Subject: [PATCH 21/36] Revert uneeded changes --- src/app/cli/src/cli_entrypoint/dune | 1 - src/config/integration_tests_slot_tx_end.mlh | 5 ----- src/lib/mina_intf/dune | 1 - 3 files changed, 7 deletions(-) delete mode 100644 src/config/integration_tests_slot_tx_end.mlh diff --git a/src/app/cli/src/cli_entrypoint/dune b/src/app/cli/src/cli_entrypoint/dune index a0b3a706c33..7315fbe4bf7 100644 --- a/src/app/cli/src/cli_entrypoint/dune +++ b/src/app/cli/src/cli_entrypoint/dune @@ -63,7 +63,6 @@ blockchain_snark snarky.backendless o1trace - mina_numbers ) (preprocessor_deps ../../../../config.mlh) (instrumentation (backend bisect_ppx)) diff --git a/src/config/integration_tests_slot_tx_end.mlh b/src/config/integration_tests_slot_tx_end.mlh deleted file mode 100644 index 433fba72802..00000000000 --- a/src/config/integration_tests_slot_tx_end.mlh +++ /dev/null @@ -1,5 +0,0 @@ -(* same as integration_tests *) -[%%import "/src/config/integration_tests.mlh"] - -[%%define slot_tx_end 10] -[%%define slot_chain_end 15] diff --git a/src/lib/mina_intf/dune b/src/lib/mina_intf/dune index eb8d3399c24..b8e732c984e 100644 --- a/src/lib/mina_intf/dune +++ b/src/lib/mina_intf/dune @@ -25,7 +25,6 @@ block_time verifier rose_tree - mina_numbers ) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_jane ppx_version ppx_deriving.std ppx_deriving_yojson))) From 1f3b8bc03d95cb8283d8afcfa5a2d1a452cd6b26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 20 Dec 2023 16:14:07 +0000 Subject: [PATCH 22/36] Run test even when slot params are not set (validate usual behaviour) --- src/app/test_executive/slot_end_test.ml | 276 ++++++++++++------------ 1 file changed, 133 insertions(+), 143 deletions(-) diff --git a/src/app/test_executive/slot_end_test.ml b/src/app/test_executive/slot_end_test.ml index f463a6f5d57..3cd1e76a2dc 100644 --- a/src/app/test_executive/slot_end_test.ml +++ b/src/app/test_executive/slot_end_test.ml @@ -75,148 +75,138 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let run network t = let open Malleable_error.Let_syntax in let logger = Logger.create () in - if Option.is_none slot_tx_end && Option.is_none slot_chain_end then ( - [%log info] - "slot_tx_end and slot_chain_end are both None. This test doesn't apply." ; - Malleable_error.ok_unit ) - else - let num_slots = - match (slot_tx_end, slot_chain_end) with - | None, None -> - assert false - | Some slot, None | None, Some slot | Some _, Some slot -> - Mina_numbers.Global_slot.to_int slot + 5 - 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_nodes network in - let%bind () = - wait_for t - (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) - in - let%bind () = - section_hard "wait for 3 blocks to be produced (warm-up)" - (wait_for t (Wait_condition.blocks_to_be_produced 3)) - in - let end_t = - Time.add (Time.now ()) - (Time.Span.of_ms @@ float_of_int (num_slots * window_ms)) - 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 "non-empty blocks produced before slot_tx_end" - (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit - ~f:(fun 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 "only empty blocks produced after slot_tx_end" - (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit - ~f:(fun slot_tx_end -> - Malleable_error.List.iter blocks ~f:(fun block -> - let msg = - Printf.sprintf - "block with transactions 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" - (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit - ~f:(fun 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" - (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit - ~f:(fun 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 ) ) ) + let num_slots = + match (slot_tx_end, slot_chain_end) with + | None, None -> + 10 + | Some slot, None | None, Some slot | Some _, Some slot -> + Mina_numbers.Global_slot.to_int slot + 5 + 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_nodes network in + let%bind () = + wait_for t + (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) + in + let%bind () = + section_hard "wait for 3 blocks to be produced (warm-up)" + (wait_for t (Wait_condition.blocks_to_be_produced 3)) + in + let end_t = + Time.add (Time.now ()) + (Time.Span.of_ms @@ float_of_int (num_slots * window_ms)) + 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 -> + Option.value_map slot_tx_end ~default:true ~f:(fun slot_tx_end -> + 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" + (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit + ~f:(fun 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 -> + Option.value_map slot_chain_end ~default:true + ~f:(fun slot_chain_end -> + Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis < slot_chain_end ) ) ) + ) + in + section "no blocks produced after slot_chain_end" + (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit + ~f:(fun 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 From 0b70f8ae71cee09081a3b35934480d0ec43d794b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Thu, 21 Dec 2023 02:58:12 +0000 Subject: [PATCH 23/36] Reformat slot_end_test.ml --- src/app/test_executive/slot_end_test.ml | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/app/test_executive/slot_end_test.ml b/src/app/test_executive/slot_end_test.ml index 3cd1e76a2dc..ad73f3ae86e 100644 --- a/src/app/test_executive/slot_end_test.ml +++ b/src/app/test_executive/slot_end_test.ml @@ -163,7 +163,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct @@ List.exists blocks ~f:(fun block -> Option.value_map slot_tx_end ~default:true ~f:(fun slot_tx_end -> Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_tx_end ) ) + of_uint32 block.slot_since_genesis < slot_tx_end) ) && ( block.command_transaction_count <> 0 || block.snark_work_count <> 0 || block.coinbase <> 0 ) ) ) @@ -185,7 +185,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct in ok_if_true msg ( Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_tx_end ) + of_uint32 block.slot_since_genesis < slot_tx_end) || block.command_transaction_count = 0 && block.snark_work_count = 0 && block.coinbase = 0 ) ) ) ) @@ -197,8 +197,7 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct Option.value_map slot_chain_end ~default:true ~f:(fun slot_chain_end -> Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_chain_end ) ) ) - ) + of_uint32 block.slot_since_genesis < slot_chain_end) ) ) ) in section "no blocks produced after slot_chain_end" (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit @@ -207,6 +206,5 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct @@ not @@ List.exists blocks ~f:(fun block -> Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis >= slot_chain_end ) ) ) - ) + of_uint32 block.slot_since_genesis >= slot_chain_end) ) ) ) end From da03efb75eb798c0de8f9ab04e43b88ba14a93c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 8 Jan 2024 15:55:29 +0000 Subject: [PATCH 24/36] Move log slot_*_end message logic to outer BP run function --- src/lib/block_producer/block_producer.ml | 61 ++++++++++++++---------- 1 file changed, 35 insertions(+), 26 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 4211b23852d..80e82881c23 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -111,7 +111,7 @@ 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 ~consensus_constants = + ~log_block_creation ~block_reward_threshold = let open Interruptible.Let_syntax in let global_slot = Consensus.Data.Block_data.global_slot_since_genesis block_data @@ -125,22 +125,6 @@ let generate_next_state ~constraint_constants ~previous_protocol_state ] ; Interruptible.return None | None | Some _ -> ( - let current_global_slot = - Consensus.Data.Consensus_time.( - to_global_slot - (of_time_exn ~constants:consensus_constants - (Block_time.now time_controller) )) - in - let slot_diff slot = - let open Mina_numbers.Global_slot in - Option.map ~f:to_int @@ sub slot current_global_slot - in - Option.iter (Option.bind Mina_compile_config.slot_chain_end ~f:slot_diff) - ~f:(fun slot_diff' -> - if slot_diff' <= 480 && slot_diff' mod 60 = 0 then - [%log info] - "Block producer will stop producing blocks after $slot_diff slots" - ~metadata:[ ("slot_diff", `Int slot_diff') ] ) ; let previous_protocol_state_body_hash = Protocol_state.body previous_protocol_state |> Protocol_state.Body.hash in @@ -177,14 +161,6 @@ let generate_next_state ~constraint_constants ~previous_protocol_state Result.return Staged_ledger_diff.With_valid_signatures_and_proofs.empty_diff | Some _ | None -> - Option.iter - (Option.bind Mina_compile_config.slot_tx_end ~f:slot_diff) - ~f:(fun slot_diff' -> - if slot_diff' <= 480 && slot_diff' mod 60 = 0 then - [%log info] - "Block producer will begin producing only empty blocks \ - after $slot_diff slots" - ~metadata:[ ("slot_diff", `Int slot_diff') ] ) ; O1trace.sync_thread "create_staged_ledger_diff" (fun () -> let diff = Staged_ledger.create_diff ~constraint_constants @@ -717,7 +693,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 ~consensus_constants + ~winner_pk ~block_reward_threshold in match next_state_opt with | None -> @@ -969,6 +945,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" + Mina_compile_config.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" + Mina_compile_config.slot_tx_end ; let generate_genesis_proof_if_needed () = match Broadcast_pipe.Reader.peek frontier_reader with | Some transition_frontier -> From 58876730a7be3376838d3b3f5adf5d0284de01a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 8 Jan 2024 16:22:24 +0000 Subject: [PATCH 25/36] Don't run test if neither slot_*_end params are set --- src/app/test_executive/slot_end_test.ml | 274 +++++++++++++----------- 1 file changed, 143 insertions(+), 131 deletions(-) diff --git a/src/app/test_executive/slot_end_test.ml b/src/app/test_executive/slot_end_test.ml index ad73f3ae86e..0fc51a563e3 100644 --- a/src/app/test_executive/slot_end_test.ml +++ b/src/app/test_executive/slot_end_test.ml @@ -75,136 +75,148 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let run network t = let open Malleable_error.Let_syntax in let logger = Logger.create () in - let num_slots = - match (slot_tx_end, slot_chain_end) with - | None, None -> - 10 - | Some slot, None | None, Some slot | Some _, Some slot -> - Mina_numbers.Global_slot.to_int slot + 5 - 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_nodes network in - let%bind () = - wait_for t - (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) - in - let%bind () = - section_hard "wait for 3 blocks to be produced (warm-up)" - (wait_for t (Wait_condition.blocks_to_be_produced 3)) - in - let end_t = - Time.add (Time.now ()) - (Time.Span.of_ms @@ float_of_int (num_slots * window_ms)) - 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 -> - Option.value_map slot_tx_end ~default:true ~f:(fun slot_tx_end -> - 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" - (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit - ~f:(fun 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 ) ) ) + if Option.is_none slot_tx_end && Option.is_none slot_chain_end then ( + [%log info] + "slot_tx_end and slot_chain_end are both None. This test doesn't apply." ; + Malleable_error.ok_unit ) + else + let num_slots = + match (slot_tx_end, slot_chain_end) with + | None, None -> + assert false + | Some slot, None | None, Some slot | Some _, Some slot -> + Mina_numbers.Global_slot.to_int slot + 5 + 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_nodes network in + let%bind () = + wait_for t + (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) + in + let%bind () = + section_hard "wait for 3 blocks to be produced (warm-up)" + (wait_for t (Wait_condition.blocks_to_be_produced 3)) + in + let end_t = + Time.add (Time.now ()) + (Time.Span.of_ms @@ float_of_int (num_slots * window_ms)) + 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 -> + Option.value_map slot_tx_end ~default:true + ~f:(fun slot_tx_end -> + 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" + (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit + ~f:(fun 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 -> + Option.value_map slot_chain_end ~default:true + ~f:(fun slot_chain_end -> + Mina_numbers.Global_slot.( + of_uint32 block.slot_since_genesis < slot_chain_end) ) ) + ) + in + section "no blocks produced after slot_chain_end" + (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit + ~f:(fun 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) ) ) ) - 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 -> - Option.value_map slot_chain_end ~default:true - ~f:(fun slot_chain_end -> - Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_chain_end) ) ) ) - in - section "no blocks produced after slot_chain_end" - (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit - ~f:(fun 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 From 7938ca679bb79d2d840a7638bbc2f5da711c43e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 8 Jan 2024 17:10:37 +0000 Subject: [PATCH 26/36] Use genesis timestamp to compute test end timestamp --- src/app/test_executive/dune | 1 + src/app/test_executive/slot_end_test.ml | 8 +++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/app/test_executive/dune b/src/app/test_executive/dune index 70fd4f706f5..2da985050ef 100644 --- a/src/app/test_executive/dune +++ b/src/app/test_executive/dune @@ -42,6 +42,7 @@ graph_algorithms visualization mina_compile_config + 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 index 0fc51a563e3..fd52acb4b77 100644 --- a/src/app/test_executive/slot_end_test.ml +++ b/src/app/test_executive/slot_end_test.ml @@ -126,8 +126,14 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct section_hard "wait for 3 blocks to be produced (warm-up)" (wait_for t (Wait_condition.blocks_to_be_produced 3)) 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 (Time.now ()) + Time.add genesis_timestamp (Time.Span.of_ms @@ float_of_int (num_slots * window_ms)) in let%bind () = From ce59ea46b33c658616c77112bdc0dcd0b1435f8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Tue, 9 Jan 2024 18:02:35 +0000 Subject: [PATCH 27/36] Allow overriding slot_*_end with runtime config --- src/app/test_executive/slot_end_test.ml | 279 ++++++++---------- src/lib/block_producer/block_producer.ml | 19 +- src/lib/block_producer/dune | 1 + .../lib/genesis_ledger_helper_lib.ml | 2 + .../mina_automation.ml | 9 +- src/lib/integration_test_lib/test_config.ml | 4 + src/lib/ledger_catchup/dune | 1 + src/lib/ledger_catchup/normal_catchup.ml | 14 +- src/lib/ledger_catchup/super_catchup.ml | 15 +- .../mina_compile_config.ml | 4 +- src/lib/mina_graphql/dune | 1 - src/lib/mina_graphql/mina_graphql.ml | 5 +- src/lib/runtime_config/dune | 1 + src/lib/runtime_config/runtime_config.ml | 24 +- .../transition_frontier_controller.ml | 2 +- src/lib/transition_handler/dune | 2 +- src/lib/transition_handler/validator.ml | 20 +- 17 files changed, 224 insertions(+), 179 deletions(-) diff --git a/src/app/test_executive/slot_end_test.ml b/src/app/test_executive/slot_end_test.ml index fd52acb4b77..85e2dde1d90 100644 --- a/src/app/test_executive/slot_end_test.ml +++ b/src/app/test_executive/slot_end_test.ml @@ -17,9 +17,9 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let num_extra_keys = 100 - let slot_tx_end = Mina_compile_config.slot_tx_end + let slot_tx_end = 10 - let slot_chain_end = Mina_compile_config.slot_chain_end + let slot_chain_end = 15 let sender_account_prefix = "sender-account-" @@ -64,6 +64,8 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct ; 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 @@ -75,154 +77,127 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct let run network t = let open Malleable_error.Let_syntax in let logger = Logger.create () in - if Option.is_none slot_tx_end && Option.is_none slot_chain_end then ( - [%log info] - "slot_tx_end and slot_chain_end are both None. This test doesn't apply." ; - Malleable_error.ok_unit ) - else - let num_slots = - match (slot_tx_end, slot_chain_end) with - | None, None -> - assert false - | Some slot, None | None, Some slot | Some _, Some slot -> - Mina_numbers.Global_slot.to_int slot + 5 - 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_nodes network in - let%bind () = - wait_for t - (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) - in - let%bind () = - section_hard "wait for 3 blocks to be produced (warm-up)" - (wait_for t (Wait_condition.blocks_to_be_produced 3)) - 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%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 -> - Option.value_map slot_tx_end ~default:true - ~f:(fun slot_tx_end -> - 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" - (Option.value_map slot_tx_end ~default:Malleable_error.ok_unit - ~f:(fun 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 -> - Option.value_map slot_chain_end ~default:true - ~f:(fun slot_chain_end -> - Mina_numbers.Global_slot.( - of_uint32 block.slot_since_genesis < slot_chain_end) ) ) - ) - in - section "no blocks produced after slot_chain_end" - (Option.value_map slot_chain_end ~default:Malleable_error.ok_unit - ~f:(fun 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) ) ) - ) + let num_slots = slot_chain_end + 5 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_nodes network in + let%bind () = + wait_for t + (Wait_condition.nodes_to_initialize (String.Map.data all_nodes)) + in + let%bind () = + section_hard "wait for 3 blocks to be produced (warm-up)" + (wait_for t (Wait_condition.blocks_to_be_produced 3)) + 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/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 80e82881c23..4f10dfe216b 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -111,12 +111,12 @@ 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 global_slot = Consensus.Data.Block_data.global_slot_since_genesis block_data in - match Mina_compile_config.slot_chain_end with + 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" @@ -149,7 +149,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state Consensus.Data.Block_data.coinbase_receiver block_data in let diff = - match Mina_compile_config.slot_tx_end with + match slot_tx_end with | Some slot_tx_end when Mina_numbers.Global_slot.(global_slot >= slot_tx_end) -> [%log info] @@ -610,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 @@ -693,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 -> @@ -972,12 +979,12 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ~message: "Block producer will stop producing blocks after \ $slot_diff slots" - Mina_compile_config.slot_chain_end ; + 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" - Mina_compile_config.slot_tx_end ; + 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/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 b074d363aa0..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 @@ -515,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 26dc34417b9..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 @@ -617,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/mina_compile_config.ml b/src/lib/mina_compile_config/mina_compile_config.ml index 3f57f721c92..b3c1f79027c 100644 --- a/src/lib/mina_compile_config/mina_compile_config.ml +++ b/src/lib/mina_compile_config/mina_compile_config.ml @@ -51,7 +51,7 @@ let rpc_heartbeat_send_every_sec = 10.0 (*same as the default*) [%%ifndef slot_tx_end] -let slot_tx_end = None +let slot_tx_end : Mina_numbers.Global_slot.t option = None [%%else] @@ -63,7 +63,7 @@ let slot_tx_end = Some (Mina_numbers.Global_slot.of_int slot_tx_end) [%%ifndef slot_chain_end] -let slot_chain_end = None +let slot_chain_end : Mina_numbers.Global_slot.t option = None [%%else] diff --git a/src/lib/mina_graphql/dune b/src/lib/mina_graphql/dune index 3a3c31c2a93..a4121fbe22b 100644 --- a/src/lib/mina_graphql/dune +++ b/src/lib/mina_graphql/dune @@ -78,7 +78,6 @@ o1trace graphql_wrapper either - mina_compile_config ) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_coda ppx_version ppx_jane ppx_deriving_yojson ppx_deriving.make))) diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index ec317380981..c177cf45273 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -3065,7 +3065,10 @@ module Mutations = struct Some (Mina_commands.reset_trust_status coda ip_address) ) let send_user_command coda user_command_input = - match Mina_compile_config.slot_tx_end with + let slot_tx_end = + Runtime_config.slot_tx_end_or_default @@ Mina_lib.runtime_config coda + in + match slot_tx_end with | _ -> ( match Mina_commands.setup_and_submit_user_command coda user_command_input diff --git a/src/lib/runtime_config/dune b/src/lib/runtime_config/dune index 1c6747cbcf6..98e210275aa 100644 --- a/src/lib/runtime_config/dune +++ b/src/lib/runtime_config/dune @@ -24,6 +24,7 @@ pickles_types signature_lib with_hash + 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))) diff --git a/src/lib/runtime_config/runtime_config.ml b/src/lib/runtime_config/runtime_config.ml index 96065c4ea5f..cb72677b943 100644 --- a/src/lib/runtime_config/runtime_config.ml +++ b/src/lib/runtime_config/runtime_config.ml @@ -426,10 +426,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 @@ -887,7 +890,11 @@ end module Daemon = struct 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 @@ -904,6 +911,9 @@ 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 } end @@ -1017,6 +1027,16 @@ let combine t1 t2 = ; epoch_data = opt_fallthrough ~default:t1.epoch_data t2.epoch_data } +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/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 addb68a478b..06deaa49115 100644 --- a/src/lib/transition_handler/dune +++ b/src/lib/transition_handler/dune @@ -46,7 +46,7 @@ result mina_numbers staged_ledger_diff - mina_compile_config + 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 69600f012a9..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 @@ -23,7 +24,7 @@ let validate_transition ~consensus_constants ~logger ~frontier @@ Mina_block.header transition_data in let%bind () = - match Mina_compile_config.slot_chain_end with + 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" ; @@ -32,7 +33,7 @@ let validate_transition ~consensus_constants ~logger ~frontier Result.return () in let%bind () = - match Mina_compile_config.slot_tx_end with + 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" ; @@ -88,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 @@ -99,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 () = From 697b9afa3839d0661e924445991ca67e0ff44b89 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 10 Jan 2024 12:02:56 +0000 Subject: [PATCH 28/36] Reject transactions at transaction pool level --- src/lib/mina_graphql/mina_graphql.ml | 33 +- src/lib/mina_lib/mina_lib.ml | 5 + src/lib/network_pool/indexed_pool.ml | 665 ++++++++++-------- src/lib/network_pool/indexed_pool.mli | 2 + src/lib/network_pool/intf.ml | 2 + src/lib/network_pool/transaction_pool.ml | 132 +++- .../transaction_inclusion_status.ml | 10 +- 7 files changed, 504 insertions(+), 345 deletions(-) diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml index c177cf45273..59d633334e6 100644 --- a/src/lib/mina_graphql/mina_graphql.ml +++ b/src/lib/mina_graphql/mina_graphql.ml @@ -3065,25 +3065,20 @@ module Mutations = struct Some (Mina_commands.reset_trust_status coda ip_address) ) let send_user_command coda user_command_input = - let slot_tx_end = - Runtime_config.slot_tx_end_or_default @@ Mina_lib.runtime_config coda - in - match slot_tx_end with - | _ -> ( - match - Mina_commands.setup_and_submit_user_command coda user_command_input - with - | `Active f -> ( - match%map f with - | Ok user_command -> - Ok - { Types.UserCommand.With_status.data = user_command - ; status = Unknown - } - | Error e -> - Error ("Couldn't send user_command: " ^ Error.to_string_hum e) ) - | `Bootstrapping -> - return (Error "Daemon is bootstrapping") ) + match + Mina_commands.setup_and_submit_user_command coda user_command_input + with + | `Active f -> ( + match%map f with + | Ok user_command -> + Ok + { Types.UserCommand.With_status.data = user_command + ; status = Unknown + } + | Error e -> + Error ("Couldn't send user_command: " ^ Error.to_string_hum e) ) + | `Bootstrapping -> + return (Error "Daemon is bootstrapping") let find_identity ~public_key coda = Result.of_option diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index ddddaa71d44..e5166189266 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..d45eaa55f5b 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 @@ -351,6 +355,8 @@ let current_global_slot t = | None -> current_slot +(* let slot_tx_end t = t.slot_tx_end *) + let check_expiry t (cmd : User_command.t) = let current_global_slot = current_global_slot t in let valid_until = User_command.valid_until cmd in @@ -725,114 +731,307 @@ 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 unchecked_cmd = - match cmd0 with - | `Unchecked x -> - x - | `Checked x -> - Transaction_hash.User_command.of_checked x - in - let unchecked = Transaction_hash.User_command.data unchecked_cmd in - let verified () = - match cmd0 with - | `Checked x -> - Ok x - | `Unchecked _ -> - let%map x = - Result.of_option (verify unchecked) ~error:Invalid_transaction - in - Transaction_hash.( - User_command_with_valid_signature.make x - (User_command.hash unchecked_cmd)) - in - let fee = User_command.fee_exn unchecked in - let fee_payer = User_command.fee_payer unchecked in - let nonce = User_command.nonce_exn unchecked in - (* Result errors indicate problems with the command, while assert failures - indicate bugs in Coda. *) - let%bind () = check_expiry t unchecked in - let%bind consumed = currency_consumed' ~constraint_constants unchecked in - let%bind () = - if User_command.check_tokens unchecked then return () else Error Bad_token - in - let%bind () = - (* TODO: Proper exchange rate mechanism. *) - let fee_token = User_command.fee_token unchecked in - if Token_id.(equal default) fee_token then return () - else Error (Unwanted_fee_token fee_token) + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) in - (* C4 *) - match Map.find t.all_by_sender fee_payer with - | None -> - (* nothing queued for this sender *) + match slot_tx_end with + | Some slot_tx_end' when Global_slot.(current_global_slot >= slot_tx_end') -> + Error After_slot_tx_end + | Some _ | None -> ( + let unchecked_cmd = + match cmd0 with + | `Unchecked x -> + x + | `Checked x -> + Transaction_hash.User_command.of_checked x + in + let unchecked = Transaction_hash.User_command.data unchecked_cmd in + let verified () = + match cmd0 with + | `Checked x -> + Ok x + | `Unchecked _ -> + let%map x = + Result.of_option (verify unchecked) ~error:Invalid_transaction + in + Transaction_hash.( + User_command_with_valid_signature.make x + (User_command.hash unchecked_cmd)) + in + let fee = User_command.fee_exn unchecked in + let fee_payer = User_command.fee_payer unchecked in + let nonce = User_command.nonce_exn unchecked in + (* Result errors indicate problems with the command, while assert failures + indicate bugs in Coda. *) + let%bind () = check_expiry t unchecked in + let%bind consumed = currency_consumed' ~constraint_constants unchecked in let%bind () = - Result.ok_if_true - (Account_nonce.equal current_nonce nonce) - ~error:(Invalid_nonce (`Expected current_nonce, nonce)) - (* C1/1a *) + if User_command.check_tokens unchecked then return () + else Error Bad_token in let%bind () = - Result.ok_if_true - Currency.Amount.(consumed <= balance) - ~error:(Insufficient_funds (`Balance balance, consumed)) - (* C2 *) + (* TODO: Proper exchange rate mechanism. *) + let fee_token = User_command.fee_token unchecked in + if Token_id.(equal default) fee_token then return () + else Error (Unwanted_fee_token fee_token) in - let%map cmd = verified () in - ( cmd - , { applicable_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.applicable_by_fee fee cmd - ; all_by_sender = - Map.set t.all_by_sender ~key:fee_payer - ~data:(F_sequence.singleton cmd, consumed) - ; all_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.all_by_fee fee cmd - ; all_by_hash = - Map.set t.all_by_hash - ~key:(Transaction_hash.User_command_with_valid_signature.hash cmd) - ~data:cmd - ; transactions_with_expiration = - add_to_expiration t.transactions_with_expiration cmd - ; size = t.size + 1 - ; constraint_constants - ; consensus_constants - ; time_controller - } - , Sequence.empty ) - | Some (queued_cmds, reserved_currency) -> - (* commands queued for this sender *) - assert (not @@ F_sequence.is_empty queued_cmds) ; - let last_queued_nonce = - F_sequence.last_exn queued_cmds - |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.nonce_exn + (* C4 *) + match Map.find t.all_by_sender fee_payer with + | None -> + (* nothing queued for this sender *) + let%bind () = + Result.ok_if_true + (Account_nonce.equal current_nonce nonce) + ~error:(Invalid_nonce (`Expected current_nonce, nonce)) + (* C1/1a *) + in + let%bind () = + Result.ok_if_true + Currency.Amount.(consumed <= balance) + ~error:(Insufficient_funds (`Balance balance, consumed)) + (* C2 *) + in + let%map cmd = verified () in + ( cmd + , { applicable_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.applicable_by_fee fee cmd + ; all_by_sender = + Map.set t.all_by_sender ~key:fee_payer + ~data:(F_sequence.singleton cmd, consumed) + ; all_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.all_by_fee fee cmd + ; all_by_hash = + Map.set t.all_by_hash + ~key: + (Transaction_hash.User_command_with_valid_signature.hash cmd) + ~data:cmd + ; transactions_with_expiration = + add_to_expiration t.transactions_with_expiration cmd + ; size = t.size + 1 + ; constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + } + , Sequence.empty ) + | Some (queued_cmds, reserved_currency) -> + (* commands queued for this sender *) + assert (not @@ F_sequence.is_empty queued_cmds) ; + let last_queued_nonce = + F_sequence.last_exn queued_cmds + |> Transaction_hash.User_command_with_valid_signature.command + |> User_command.nonce_exn + in + if Account_nonce.equal (Account_nonce.succ last_queued_nonce) nonce + then + (* this command goes on the end *) + let%bind reserved_currency' = + Currency.Amount.(consumed + reserved_currency) + |> Result.of_option ~error:Overflow + (* C4 *) + in + let%bind () = + Result.ok_if_true + Currency.Amount.(balance >= reserved_currency') + ~error: + (Insufficient_funds (`Balance balance, reserved_currency')) + (* C2 *) + in + let%map cmd = verified () in + ( cmd + , { t with + all_by_sender = + Map.set t.all_by_sender ~key:fee_payer + ~data:(F_sequence.snoc queued_cmds cmd, reserved_currency') + ; all_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.all_by_fee fee cmd + ; all_by_hash = + Map.set t.all_by_hash + ~key: + (Transaction_hash.User_command_with_valid_signature.hash + cmd ) + ~data:cmd + ; transactions_with_expiration = + add_to_expiration t.transactions_with_expiration cmd + ; size = t.size + 1 + } + , Sequence.empty ) + else + (* we're replacing a command *) + let first_queued_nonce = + F_sequence.head_exn queued_cmds + |> Transaction_hash.User_command_with_valid_signature.command + |> User_command.nonce_exn + in + assert (Account_nonce.equal first_queued_nonce current_nonce) ; + let%bind () = + Result.ok_if_true + (Account_nonce.between ~low:first_queued_nonce + ~high:last_queued_nonce nonce ) + ~error: + (Invalid_nonce + (`Between (first_queued_nonce, last_queued_nonce), nonce) + ) + (* C1/C1b *) + in + assert ( + F_sequence.length queued_cmds + = Account_nonce.to_int last_queued_nonce + - Account_nonce.to_int first_queued_nonce + + 1 ) ; + let _keep_queue, drop_queue = + F_sequence.split_at queued_cmds + ( Account_nonce.to_int nonce + - Account_nonce.to_int first_queued_nonce ) + in + let to_drop = + F_sequence.head_exn drop_queue + |> Transaction_hash.User_command_with_valid_signature.command + in + assert (Account_nonce.equal (User_command.nonce_exn to_drop) nonce) ; + (* We check the fee increase twice because we need to be sure the + subtraction is safe. *) + let%bind () = + let replace_fee = User_command.fee_exn to_drop in + Result.ok_if_true + Currency.Fee.(fee >= replace_fee) + ~error:(Insufficient_replace_fee (`Replace_fee replace_fee, fee)) + (* C3 *) + in + let dropped, t' = + remove_with_dependents_exn t @@ F_sequence.head_exn drop_queue + in + (* check remove_exn dropped the right things *) + [%test_eq: + Transaction_hash.User_command_with_valid_signature.t Sequence.t] + dropped + (F_sequence.to_seq drop_queue) ; + let%bind cmd = verified () in + (* Add the new transaction *) + let%bind cmd, t'', _ = + match + add_from_gossip_exn t' ~verify (`Checked cmd) current_nonce + balance + with + | Ok (v, t'', dropped') -> + (* We've already removed them, so this should always be empty. *) + assert (Sequence.is_empty dropped') ; + Result.Ok (v, t'', dropped) + | Error err -> + Error err + in + let drop_head, drop_tail = + Option.value_exn (Sequence.next dropped) + in + let increment = + Option.value_exn Currency.Fee.(fee - User_command.fee_exn to_drop) + in + (* Re-add all of the transactions we dropped until there are none left, + or until the fees from dropped transactions exceed the fee increase + over the first transaction. + *) + let%bind t'', increment, dropped' = + let rec go t' increment dropped dropped' current_nonce = + match (Sequence.next dropped, dropped') with + | None, Some dropped' -> + Ok (t', increment, dropped') + | None, None -> + Ok (t', increment, Sequence.empty) + | Some (cmd, dropped), Some _ -> ( + let cmd_unchecked = + Transaction_hash.User_command_with_valid_signature.command + cmd + in + let replace_fee = User_command.fee_exn cmd_unchecked in + match Currency.Fee.(increment - replace_fee) with + | Some increment -> + go t' increment dropped dropped' current_nonce + | None -> + Error + (Insufficient_replace_fee + (`Replace_fee replace_fee, increment) ) ) + | Some (cmd, dropped'), None -> ( + let current_nonce = Account_nonce.succ current_nonce in + match + add_from_gossip_exn t' ~verify (`Checked cmd) + current_nonce balance + with + | Ok (_v, t', dropped_) -> + assert (Sequence.is_empty dropped_) ; + go t' increment dropped' None current_nonce + | Error _err -> + (* Re-evaluate with the same [dropped] to calculate the new + fee increment. + *) + go t' increment dropped (Some dropped') current_nonce ) + in + go t'' increment drop_tail None current_nonce + in + let%map () = + Result.ok_if_true + Currency.Fee.(increment >= replace_fee) + ~error: + (Insufficient_replace_fee (`Replace_fee replace_fee, increment) + ) + (* C3 *) + in + (cmd, t'', Sequence.(append (return drop_head) dropped')) ) + +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 + ; 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 + match slot_tx_end with + | Some slot_tx_end' when Global_slot.(current_global_slot >= slot_tx_end') -> + Error After_slot_tx_end + | Some _ | None -> ( + let unchecked = + Transaction_hash.User_command_with_valid_signature.command cmd in - if Account_nonce.equal (Account_nonce.succ last_queued_nonce) nonce then - (* this command goes on the end *) - let%bind reserved_currency' = - Currency.Amount.(consumed + reserved_currency) - |> Result.of_option ~error:Overflow - (* C4 *) - in - let%bind () = - Result.ok_if_true - Currency.Amount.(balance >= reserved_currency') - ~error:(Insufficient_funds (`Balance balance, reserved_currency')) - (* C2 *) - in - let%map cmd = verified () in - ( cmd - , { t with - all_by_sender = - Map.set t.all_by_sender ~key:fee_payer - ~data:(F_sequence.snoc queued_cmds cmd, reserved_currency') + let%map () = check_expiry t unchecked in + let fee_payer = User_command.fee_payer unchecked in + let fee = User_command.fee_exn unchecked in + let consumed = + Option.value_exn (currency_consumed ~constraint_constants cmd) + in + match Map.find t.all_by_sender fee_payer with + | None -> + { all_by_sender = + (* If the command comes from backtracking, then we know it doesn't + cause overflow, so it's OK to throw here. + *) + Map.add_exn t.all_by_sender ~key:fee_payer + ~data:(F_sequence.singleton cmd, consumed) ; all_by_fee = Map_set.insert (module Transaction_hash.User_command_with_valid_signature) @@ -842,212 +1041,63 @@ let rec add_from_gossip_exn : ~key: (Transaction_hash.User_command_with_valid_signature.hash cmd) ~data:cmd + ; applicable_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.applicable_by_fee fee cmd ; transactions_with_expiration = add_to_expiration t.transactions_with_expiration cmd ; size = t.size + 1 + ; constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end } - , Sequence.empty ) - else - (* we're replacing a command *) - let first_queued_nonce = - F_sequence.head_exn queued_cmds - |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.nonce_exn - in - assert (Account_nonce.equal first_queued_nonce current_nonce) ; - let%bind () = - Result.ok_if_true - (Account_nonce.between ~low:first_queued_nonce - ~high:last_queued_nonce nonce ) - ~error: - (Invalid_nonce - (`Between (first_queued_nonce, last_queued_nonce), nonce) ) - (* C1/C1b *) - in - assert ( - F_sequence.length queued_cmds - = Account_nonce.to_int last_queued_nonce - - Account_nonce.to_int first_queued_nonce - + 1 ) ; - let _keep_queue, drop_queue = - F_sequence.split_at queued_cmds - ( Account_nonce.to_int nonce - - Account_nonce.to_int first_queued_nonce ) - in - let to_drop = - F_sequence.head_exn drop_queue - |> Transaction_hash.User_command_with_valid_signature.command - in - assert (Account_nonce.equal (User_command.nonce_exn to_drop) nonce) ; - (* We check the fee increase twice because we need to be sure the - subtraction is safe. *) - let%bind () = - let replace_fee = User_command.fee_exn to_drop in - Result.ok_if_true - Currency.Fee.(fee >= replace_fee) - ~error:(Insufficient_replace_fee (`Replace_fee replace_fee, fee)) - (* C3 *) - in - let dropped, t' = - remove_with_dependents_exn t @@ F_sequence.head_exn drop_queue - in - (* check remove_exn dropped the right things *) - [%test_eq: - Transaction_hash.User_command_with_valid_signature.t Sequence.t] - dropped - (F_sequence.to_seq drop_queue) ; - let%bind cmd = verified () in - (* Add the new transaction *) - let%bind cmd, t'', _ = - match - add_from_gossip_exn t' ~verify (`Checked cmd) current_nonce balance - with - | Ok (v, t'', dropped') -> - (* We've already removed them, so this should always be empty. *) - assert (Sequence.is_empty dropped') ; - Result.Ok (v, t'', dropped) - | Error err -> - Error err - in - let drop_head, drop_tail = Option.value_exn (Sequence.next dropped) in - let increment = - Option.value_exn Currency.Fee.(fee - User_command.fee_exn to_drop) - in - (* Re-add all of the transactions we dropped until there are none left, - or until the fees from dropped transactions exceed the fee increase - over the first transaction. - *) - let%bind t'', increment, dropped' = - let rec go t' increment dropped dropped' current_nonce = - match (Sequence.next dropped, dropped') with - | None, Some dropped' -> - Ok (t', increment, dropped') - | None, None -> - Ok (t', increment, Sequence.empty) - | Some (cmd, dropped), Some _ -> ( - let cmd_unchecked = - Transaction_hash.User_command_with_valid_signature.command cmd - in - let replace_fee = User_command.fee_exn cmd_unchecked in - match Currency.Fee.(increment - replace_fee) with - | Some increment -> - go t' increment dropped dropped' current_nonce - | None -> - Error - (Insufficient_replace_fee - (`Replace_fee replace_fee, increment) ) ) - | Some (cmd, dropped'), None -> ( - let current_nonce = Account_nonce.succ current_nonce in - match - add_from_gossip_exn t' ~verify (`Checked cmd) current_nonce - balance - with - | Ok (_v, t', dropped_) -> - assert (Sequence.is_empty dropped_) ; - go t' increment dropped' None current_nonce - | Error _err -> - (* Re-evaluate with the same [dropped] to calculate the new - fee increment. - *) - go t' increment dropped (Some dropped') current_nonce ) - in - go t'' increment drop_tail None current_nonce - in - let%map () = - Result.ok_if_true - Currency.Fee.(increment >= replace_fee) - ~error: - (Insufficient_replace_fee (`Replace_fee replace_fee, increment)) - (* C3 *) - in - (cmd, t'', Sequence.(append (return drop_head) dropped')) - -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 -> - let open Result.Let_syntax in - let unchecked = - Transaction_hash.User_command_with_valid_signature.command cmd - in - let%map () = check_expiry t unchecked in - let fee_payer = User_command.fee_payer unchecked in - let fee = User_command.fee_exn unchecked in - let consumed = - Option.value_exn (currency_consumed ~constraint_constants cmd) - in - match Map.find t.all_by_sender fee_payer with - | None -> - { all_by_sender = - (* If the command comes from backtracking, then we know it doesn't - cause overflow, so it's OK to throw here. - *) - Map.add_exn t.all_by_sender ~key:fee_payer - ~data:(F_sequence.singleton cmd, consumed) - ; all_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.all_by_fee fee cmd - ; all_by_hash = - Map.set t.all_by_hash - ~key:(Transaction_hash.User_command_with_valid_signature.hash cmd) - ~data:cmd - ; applicable_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.applicable_by_fee fee cmd - ; transactions_with_expiration = - add_to_expiration t.transactions_with_expiration cmd - ; size = t.size + 1 - ; constraint_constants - ; consensus_constants - ; time_controller - } - | Some (queue, currency_reserved) -> - let first_queued = F_sequence.head_exn queue in - if - not - (Account_nonce.equal - (unchecked |> User_command.nonce_exn |> Account_nonce.succ) - ( first_queued - |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.nonce_exn ) ) - then - failwith - @@ sprintf - !"indexed pool nonces inconsistent when adding from backtrack. \ - Trying to add \ - %{sexp:Transaction_hash.User_command_with_valid_signature.t} to \ - %{sexp: t}" - cmd t ; - let t' = remove_applicable_exn t first_queued in - { applicable_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t'.applicable_by_fee fee cmd - ; all_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t'.all_by_fee fee cmd - ; all_by_hash = - Map.set t.all_by_hash - ~key:(Transaction_hash.User_command_with_valid_signature.hash cmd) - ~data:cmd - ; all_by_sender = - Map.set t'.all_by_sender ~key:fee_payer - ~data: - ( F_sequence.cons cmd queue - , Option.value_exn Currency.Amount.(currency_reserved + consumed) - ) - ; transactions_with_expiration = - add_to_expiration t.transactions_with_expiration cmd - ; size = t.size + 1 - ; constraint_constants - ; consensus_constants - ; time_controller - } + | Some (queue, currency_reserved) -> + let first_queued = F_sequence.head_exn queue in + if + not + (Account_nonce.equal + (unchecked |> User_command.nonce_exn |> Account_nonce.succ) + ( first_queued + |> Transaction_hash.User_command_with_valid_signature.command + |> User_command.nonce_exn ) ) + then + failwith + @@ sprintf + !"indexed pool nonces inconsistent when adding from \ + backtrack. Trying to add \ + %{sexp:Transaction_hash.User_command_with_valid_signature.t} \ + to %{sexp: t}" + cmd t ; + let t' = remove_applicable_exn t first_queued in + { applicable_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t'.applicable_by_fee fee cmd + ; all_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t'.all_by_fee fee cmd + ; all_by_hash = + Map.set t.all_by_hash + ~key: + (Transaction_hash.User_command_with_valid_signature.hash cmd) + ~data:cmd + ; all_by_sender = + Map.set t'.all_by_sender ~key:fee_payer + ~data: + ( F_sequence.cons cmd queue + , Option.value_exn + Currency.Amount.(currency_reserved + consumed) ) + ; transactions_with_expiration = + add_to_expiration t.transactions_with_expiration cmd + ; size = t.size + 1 + ; constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + } ) (* Only show stdout for failed inline tests. *) open Inline_test_quiet_logs @@ -1075,8 +1125,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 +1270,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..9a0c335727e 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 @@ -141,7 +189,7 @@ module Diff_versioned = struct [@@@no_toplevel_latest_type] module V1 = struct - type t = (User_command.Stable.V1.t * Diff_error.Stable.V1.t) list + type t = (User_command.Stable.V1.t * Diff_error.Stable.V2.t) list [@@deriving sexp, yojson] let to_latest = Fn.id @@ -224,8 +272,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 +447,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 +755,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 +906,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 +1180,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 +1203,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 +1625,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 +1709,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 +1773,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 +1803,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 +1857,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 +1923,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 +1965,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 +2083,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 +2137,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 +2228,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 +2270,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 +2338,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 +2441,40 @@ 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_unit "transactions added after slot_tx_end are rejected" = + 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:(Some 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 []) (accepted_commands apply_res) ; + assert_pool_txs [] ; + Deferred.unit ) end ) diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml index 06cc0f9d7dc..c43d76a37e5 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml @@ -111,10 +111,10 @@ let%test_module "transaction_status" = Signed_command.Gen.payment ~sign_type:`Real ~max_amount:100 ~fee_range:10 ~key_gen ~nonce:(Account_nonce.of_int 1) () - let create_pool ~frontier_broadcast_pipe = + let create_pool ~frontier_broadcast_pipe ~slot_tx_end = let config = Transaction_pool.Resource_pool.make_config ~trust_system ~pool_max_size - ~verifier + ~verifier ~slot_tx_end in let transaction_pool, _, local_sink = Transaction_pool.create ~config @@ -146,7 +146,7 @@ let%test_module "transaction_status" = Async.Thread_safe.block_on_async_exn (fun () -> let frontier_broadcast_pipe, _ = Broadcast_pipe.create None in let%bind transaction_pool, local_diffs_writer = - create_pool ~frontier_broadcast_pipe + create_pool ~frontier_broadcast_pipe ~slot_tx_end:None in let%bind () = Transaction_pool.Local_sink.push local_diffs_writer @@ -170,7 +170,7 @@ let%test_module "transaction_status" = Broadcast_pipe.create (Some frontier) in let%bind transaction_pool, local_diffs_writer = - create_pool ~frontier_broadcast_pipe + create_pool ~frontier_broadcast_pipe ~slot_tx_end:None in let%bind () = Transaction_pool.Local_sink.push local_diffs_writer @@ -204,7 +204,7 @@ let%test_module "transaction_status" = Broadcast_pipe.create (Some frontier) in let%bind transaction_pool, local_diffs_writer = - create_pool ~frontier_broadcast_pipe + create_pool ~frontier_broadcast_pipe ~slot_tx_end:None in let unknown_user_command, pool_user_commands = Non_empty_list.uncons user_commands From 77fc86fbf8c17baaf473a28c5ab3b54c54c43704 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 10 Jan 2024 14:25:46 +0000 Subject: [PATCH 29/36] Fix missing versioned type update --- src/lib/network_pool/transaction_pool.ml | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 9a0c335727e..7ebb1245a2a 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -188,12 +188,21 @@ module Diff_versioned = struct module Stable = struct [@@@no_toplevel_latest_type] - module V1 = struct + 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 = + List.map ~f:(fun (cmd, error) -> + (cmd, Diff_error.Stable.V1.to_latest error) ) + end end] type t = Stable.Latest.t [@@deriving sexp, yojson] From dc8ca49d02ae728f0b71f3ff860b0fc29853aa46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 10 Jan 2024 15:01:24 +0000 Subject: [PATCH 30/36] Remove unnecessary changes --- src/app/test_executive/dune | 1 - .../transaction_inclusion_status.ml | 10 +++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/app/test_executive/dune b/src/app/test_executive/dune index 2da985050ef..f17f533150c 100644 --- a/src/app/test_executive/dune +++ b/src/app/test_executive/dune @@ -41,7 +41,6 @@ participating_state graph_algorithms visualization - mina_compile_config block_time ) (instrumentation (backend bisect_ppx)) diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml index c43d76a37e5..07cfc79a521 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml @@ -111,10 +111,10 @@ let%test_module "transaction_status" = Signed_command.Gen.payment ~sign_type:`Real ~max_amount:100 ~fee_range:10 ~key_gen ~nonce:(Account_nonce.of_int 1) () - let create_pool ~frontier_broadcast_pipe ~slot_tx_end = + let create_pool ~frontier_broadcast_pipe = let config = Transaction_pool.Resource_pool.make_config ~trust_system ~pool_max_size - ~verifier ~slot_tx_end + ~verifier ~slot_tx_end:None in let transaction_pool, _, local_sink = Transaction_pool.create ~config @@ -146,7 +146,7 @@ let%test_module "transaction_status" = Async.Thread_safe.block_on_async_exn (fun () -> let frontier_broadcast_pipe, _ = Broadcast_pipe.create None in let%bind transaction_pool, local_diffs_writer = - create_pool ~frontier_broadcast_pipe ~slot_tx_end:None + create_pool ~frontier_broadcast_pipe in let%bind () = Transaction_pool.Local_sink.push local_diffs_writer @@ -170,7 +170,7 @@ let%test_module "transaction_status" = Broadcast_pipe.create (Some frontier) in let%bind transaction_pool, local_diffs_writer = - create_pool ~frontier_broadcast_pipe ~slot_tx_end:None + create_pool ~frontier_broadcast_pipe in let%bind () = Transaction_pool.Local_sink.push local_diffs_writer @@ -204,7 +204,7 @@ let%test_module "transaction_status" = Broadcast_pipe.create (Some frontier) in let%bind transaction_pool, local_diffs_writer = - create_pool ~frontier_broadcast_pipe ~slot_tx_end:None + create_pool ~frontier_broadcast_pipe in let unknown_user_command, pool_user_commands = Non_empty_list.uncons user_commands From 8897d8b792e482a0bdd357b3adc99be75ec05abb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Mon, 22 Jan 2024 12:03:56 +0000 Subject: [PATCH 31/36] Add new txn pool test case --- src/lib/network_pool/transaction_pool.ml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 7ebb1245a2a..2fc992c8bb7 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -2471,11 +2471,10 @@ let%test_module _ = assert_pool_txs independent_cmds' ; Deferred.unit ) - let%test_unit "transactions added after slot_tx_end are rejected" = + let test_txns_rejects slot_tx_end = 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:(Some curr_slot) () + setup_test ~slot_tx_end:(Some slot_tx_end) () in assert_pool_txs [] ; let%bind apply_res = @@ -2486,4 +2485,14 @@ let%test_module _ = [%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 ) From e1d516848c1a3999cdd57afc0621945bb16a8f62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Mon, 22 Jan 2024 12:04:41 +0000 Subject: [PATCH 32/36] Flatten logic --- src/lib/network_pool/indexed_pool.ml | 651 +++++++++++++-------------- 1 file changed, 319 insertions(+), 332 deletions(-) diff --git a/src/lib/network_pool/indexed_pool.ml b/src/lib/network_pool/indexed_pool.ml index d45eaa55f5b..40ed92f83a3 100644 --- a/src/lib/network_pool/indexed_pool.ml +++ b/src/lib/network_pool/indexed_pool.ml @@ -355,8 +355,6 @@ let current_global_slot t = | None -> current_slot -(* let slot_tx_end t = t.slot_tx_end *) - let check_expiry t (cmd : User_command.t) = let current_global_slot = current_global_slot t in let valid_until = User_command.valid_until cmd in @@ -745,254 +743,244 @@ let rec add_from_gossip_exn : (of_time_exn ~constants:consensus_constants (Block_time.now time_controller) )) in - match slot_tx_end with - | Some slot_tx_end' when Global_slot.(current_global_slot >= slot_tx_end') -> - Error After_slot_tx_end - | Some _ | None -> ( - let unchecked_cmd = - match cmd0 with - | `Unchecked x -> - x - | `Checked x -> - Transaction_hash.User_command.of_checked x - in - let unchecked = Transaction_hash.User_command.data unchecked_cmd in - let verified () = - match cmd0 with - | `Checked x -> - Ok x - | `Unchecked _ -> - let%map x = - Result.of_option (verify unchecked) ~error:Invalid_transaction - in - Transaction_hash.( - User_command_with_valid_signature.make x - (User_command.hash unchecked_cmd)) - in - let fee = User_command.fee_exn unchecked in - let fee_payer = User_command.fee_payer unchecked in - let nonce = User_command.nonce_exn unchecked in - (* Result errors indicate problems with the command, while assert failures - indicate bugs in Coda. *) - let%bind () = check_expiry t unchecked in - let%bind consumed = currency_consumed' ~constraint_constants unchecked 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 -> + x + | `Checked x -> + Transaction_hash.User_command.of_checked x + in + let unchecked = Transaction_hash.User_command.data unchecked_cmd in + let verified () = + match cmd0 with + | `Checked x -> + Ok x + | `Unchecked _ -> + let%map x = + Result.of_option (verify unchecked) ~error:Invalid_transaction + in + Transaction_hash.( + User_command_with_valid_signature.make x + (User_command.hash unchecked_cmd)) + in + let fee = User_command.fee_exn unchecked in + let fee_payer = User_command.fee_payer unchecked in + let nonce = User_command.nonce_exn unchecked in + (* Result errors indicate problems with the command, while assert failures + indicate bugs in Coda. *) + let%bind () = check_expiry t unchecked in + let%bind consumed = currency_consumed' ~constraint_constants unchecked in + let%bind () = + if User_command.check_tokens unchecked then return () else Error Bad_token + in + let%bind () = + (* TODO: Proper exchange rate mechanism. *) + let fee_token = User_command.fee_token unchecked in + if Token_id.(equal default) fee_token then return () + else Error (Unwanted_fee_token fee_token) + in + (* C4 *) + match Map.find t.all_by_sender fee_payer with + | None -> + (* nothing queued for this sender *) let%bind () = - if User_command.check_tokens unchecked then return () - else Error Bad_token + Result.ok_if_true + (Account_nonce.equal current_nonce nonce) + ~error:(Invalid_nonce (`Expected current_nonce, nonce)) + (* C1/1a *) in let%bind () = - (* TODO: Proper exchange rate mechanism. *) - let fee_token = User_command.fee_token unchecked in - if Token_id.(equal default) fee_token then return () - else Error (Unwanted_fee_token fee_token) + Result.ok_if_true + Currency.Amount.(consumed <= balance) + ~error:(Insufficient_funds (`Balance balance, consumed)) + (* C2 *) in - (* C4 *) - match Map.find t.all_by_sender fee_payer with - | None -> - (* nothing queued for this sender *) - let%bind () = - Result.ok_if_true - (Account_nonce.equal current_nonce nonce) - ~error:(Invalid_nonce (`Expected current_nonce, nonce)) - (* C1/1a *) - in - let%bind () = - Result.ok_if_true - Currency.Amount.(consumed <= balance) - ~error:(Insufficient_funds (`Balance balance, consumed)) - (* C2 *) - in - let%map cmd = verified () in - ( cmd - , { applicable_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.applicable_by_fee fee cmd - ; all_by_sender = - Map.set t.all_by_sender ~key:fee_payer - ~data:(F_sequence.singleton cmd, consumed) - ; all_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.all_by_fee fee cmd - ; all_by_hash = - Map.set t.all_by_hash - ~key: - (Transaction_hash.User_command_with_valid_signature.hash cmd) - ~data:cmd - ; transactions_with_expiration = - add_to_expiration t.transactions_with_expiration cmd - ; size = t.size + 1 - ; constraint_constants - ; consensus_constants - ; time_controller - ; slot_tx_end - } - , Sequence.empty ) - | Some (queued_cmds, reserved_currency) -> - (* commands queued for this sender *) - assert (not @@ F_sequence.is_empty queued_cmds) ; - let last_queued_nonce = - F_sequence.last_exn queued_cmds - |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.nonce_exn + let%map cmd = verified () in + ( cmd + , { applicable_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.applicable_by_fee fee cmd + ; all_by_sender = + Map.set t.all_by_sender ~key:fee_payer + ~data:(F_sequence.singleton cmd, consumed) + ; all_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.all_by_fee fee cmd + ; all_by_hash = + Map.set t.all_by_hash + ~key:(Transaction_hash.User_command_with_valid_signature.hash cmd) + ~data:cmd + ; transactions_with_expiration = + add_to_expiration t.transactions_with_expiration cmd + ; size = t.size + 1 + ; constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + } + , Sequence.empty ) + | Some (queued_cmds, reserved_currency) -> + (* commands queued for this sender *) + assert (not @@ F_sequence.is_empty queued_cmds) ; + let last_queued_nonce = + F_sequence.last_exn queued_cmds + |> Transaction_hash.User_command_with_valid_signature.command + |> User_command.nonce_exn + in + if Account_nonce.equal (Account_nonce.succ last_queued_nonce) nonce then + (* this command goes on the end *) + let%bind reserved_currency' = + Currency.Amount.(consumed + reserved_currency) + |> Result.of_option ~error:Overflow + (* C4 *) + in + let%bind () = + Result.ok_if_true + Currency.Amount.(balance >= reserved_currency') + ~error:(Insufficient_funds (`Balance balance, reserved_currency')) + (* C2 *) + in + let%map cmd = verified () in + ( cmd + , { t with + all_by_sender = + Map.set t.all_by_sender ~key:fee_payer + ~data:(F_sequence.snoc queued_cmds cmd, reserved_currency') + ; all_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.all_by_fee fee cmd + ; all_by_hash = + Map.set t.all_by_hash + ~key: + (Transaction_hash.User_command_with_valid_signature.hash cmd) + ~data:cmd + ; transactions_with_expiration = + add_to_expiration t.transactions_with_expiration cmd + ; size = t.size + 1 + } + , Sequence.empty ) + else + (* we're replacing a command *) + let first_queued_nonce = + F_sequence.head_exn queued_cmds + |> Transaction_hash.User_command_with_valid_signature.command + |> User_command.nonce_exn + in + assert (Account_nonce.equal first_queued_nonce current_nonce) ; + let%bind () = + Result.ok_if_true + (Account_nonce.between ~low:first_queued_nonce + ~high:last_queued_nonce nonce ) + ~error: + (Invalid_nonce + (`Between (first_queued_nonce, last_queued_nonce), nonce) ) + (* C1/C1b *) + in + assert ( + F_sequence.length queued_cmds + = Account_nonce.to_int last_queued_nonce + - Account_nonce.to_int first_queued_nonce + + 1 ) ; + let _keep_queue, drop_queue = + F_sequence.split_at queued_cmds + ( Account_nonce.to_int nonce + - Account_nonce.to_int first_queued_nonce ) + in + let to_drop = + F_sequence.head_exn drop_queue + |> Transaction_hash.User_command_with_valid_signature.command + in + assert (Account_nonce.equal (User_command.nonce_exn to_drop) nonce) ; + (* We check the fee increase twice because we need to be sure the + subtraction is safe. *) + let%bind () = + let replace_fee = User_command.fee_exn to_drop in + Result.ok_if_true + Currency.Fee.(fee >= replace_fee) + ~error:(Insufficient_replace_fee (`Replace_fee replace_fee, fee)) + (* C3 *) + in + let dropped, t' = + remove_with_dependents_exn t @@ F_sequence.head_exn drop_queue + in + (* check remove_exn dropped the right things *) + [%test_eq: + Transaction_hash.User_command_with_valid_signature.t Sequence.t] + dropped + (F_sequence.to_seq drop_queue) ; + let%bind cmd = verified () in + (* Add the new transaction *) + let%bind cmd, t'', _ = + match + add_from_gossip_exn t' ~verify (`Checked cmd) current_nonce balance + with + | Ok (v, t'', dropped') -> + (* We've already removed them, so this should always be empty. *) + assert (Sequence.is_empty dropped') ; + Result.Ok (v, t'', dropped) + | Error err -> + Error err + in + let drop_head, drop_tail = Option.value_exn (Sequence.next dropped) in + let increment = + Option.value_exn Currency.Fee.(fee - User_command.fee_exn to_drop) + in + (* Re-add all of the transactions we dropped until there are none left, + or until the fees from dropped transactions exceed the fee increase + over the first transaction. + *) + let%bind t'', increment, dropped' = + let rec go t' increment dropped dropped' current_nonce = + match (Sequence.next dropped, dropped') with + | None, Some dropped' -> + Ok (t', increment, dropped') + | None, None -> + Ok (t', increment, Sequence.empty) + | Some (cmd, dropped), Some _ -> ( + let cmd_unchecked = + Transaction_hash.User_command_with_valid_signature.command cmd + in + let replace_fee = User_command.fee_exn cmd_unchecked in + match Currency.Fee.(increment - replace_fee) with + | Some increment -> + go t' increment dropped dropped' current_nonce + | None -> + Error + (Insufficient_replace_fee + (`Replace_fee replace_fee, increment) ) ) + | Some (cmd, dropped'), None -> ( + let current_nonce = Account_nonce.succ current_nonce in + match + add_from_gossip_exn t' ~verify (`Checked cmd) current_nonce + balance + with + | Ok (_v, t', dropped_) -> + assert (Sequence.is_empty dropped_) ; + go t' increment dropped' None current_nonce + | Error _err -> + (* Re-evaluate with the same [dropped] to calculate the new + fee increment. + *) + go t' increment dropped (Some dropped') current_nonce ) in - if Account_nonce.equal (Account_nonce.succ last_queued_nonce) nonce - then - (* this command goes on the end *) - let%bind reserved_currency' = - Currency.Amount.(consumed + reserved_currency) - |> Result.of_option ~error:Overflow - (* C4 *) - in - let%bind () = - Result.ok_if_true - Currency.Amount.(balance >= reserved_currency') - ~error: - (Insufficient_funds (`Balance balance, reserved_currency')) - (* C2 *) - in - let%map cmd = verified () in - ( cmd - , { t with - all_by_sender = - Map.set t.all_by_sender ~key:fee_payer - ~data:(F_sequence.snoc queued_cmds cmd, reserved_currency') - ; all_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.all_by_fee fee cmd - ; all_by_hash = - Map.set t.all_by_hash - ~key: - (Transaction_hash.User_command_with_valid_signature.hash - cmd ) - ~data:cmd - ; transactions_with_expiration = - add_to_expiration t.transactions_with_expiration cmd - ; size = t.size + 1 - } - , Sequence.empty ) - else - (* we're replacing a command *) - let first_queued_nonce = - F_sequence.head_exn queued_cmds - |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.nonce_exn - in - assert (Account_nonce.equal first_queued_nonce current_nonce) ; - let%bind () = - Result.ok_if_true - (Account_nonce.between ~low:first_queued_nonce - ~high:last_queued_nonce nonce ) - ~error: - (Invalid_nonce - (`Between (first_queued_nonce, last_queued_nonce), nonce) - ) - (* C1/C1b *) - in - assert ( - F_sequence.length queued_cmds - = Account_nonce.to_int last_queued_nonce - - Account_nonce.to_int first_queued_nonce - + 1 ) ; - let _keep_queue, drop_queue = - F_sequence.split_at queued_cmds - ( Account_nonce.to_int nonce - - Account_nonce.to_int first_queued_nonce ) - in - let to_drop = - F_sequence.head_exn drop_queue - |> Transaction_hash.User_command_with_valid_signature.command - in - assert (Account_nonce.equal (User_command.nonce_exn to_drop) nonce) ; - (* We check the fee increase twice because we need to be sure the - subtraction is safe. *) - let%bind () = - let replace_fee = User_command.fee_exn to_drop in - Result.ok_if_true - Currency.Fee.(fee >= replace_fee) - ~error:(Insufficient_replace_fee (`Replace_fee replace_fee, fee)) - (* C3 *) - in - let dropped, t' = - remove_with_dependents_exn t @@ F_sequence.head_exn drop_queue - in - (* check remove_exn dropped the right things *) - [%test_eq: - Transaction_hash.User_command_with_valid_signature.t Sequence.t] - dropped - (F_sequence.to_seq drop_queue) ; - let%bind cmd = verified () in - (* Add the new transaction *) - let%bind cmd, t'', _ = - match - add_from_gossip_exn t' ~verify (`Checked cmd) current_nonce - balance - with - | Ok (v, t'', dropped') -> - (* We've already removed them, so this should always be empty. *) - assert (Sequence.is_empty dropped') ; - Result.Ok (v, t'', dropped) - | Error err -> - Error err - in - let drop_head, drop_tail = - Option.value_exn (Sequence.next dropped) - in - let increment = - Option.value_exn Currency.Fee.(fee - User_command.fee_exn to_drop) - in - (* Re-add all of the transactions we dropped until there are none left, - or until the fees from dropped transactions exceed the fee increase - over the first transaction. - *) - let%bind t'', increment, dropped' = - let rec go t' increment dropped dropped' current_nonce = - match (Sequence.next dropped, dropped') with - | None, Some dropped' -> - Ok (t', increment, dropped') - | None, None -> - Ok (t', increment, Sequence.empty) - | Some (cmd, dropped), Some _ -> ( - let cmd_unchecked = - Transaction_hash.User_command_with_valid_signature.command - cmd - in - let replace_fee = User_command.fee_exn cmd_unchecked in - match Currency.Fee.(increment - replace_fee) with - | Some increment -> - go t' increment dropped dropped' current_nonce - | None -> - Error - (Insufficient_replace_fee - (`Replace_fee replace_fee, increment) ) ) - | Some (cmd, dropped'), None -> ( - let current_nonce = Account_nonce.succ current_nonce in - match - add_from_gossip_exn t' ~verify (`Checked cmd) - current_nonce balance - with - | Ok (_v, t', dropped_) -> - assert (Sequence.is_empty dropped_) ; - go t' increment dropped' None current_nonce - | Error _err -> - (* Re-evaluate with the same [dropped] to calculate the new - fee increment. - *) - go t' increment dropped (Some dropped') current_nonce ) - in - go t'' increment drop_tail None current_nonce - in - let%map () = - Result.ok_if_true - Currency.Fee.(increment >= replace_fee) - ~error: - (Insufficient_replace_fee (`Replace_fee replace_fee, increment) - ) - (* C3 *) - in - (cmd, t'', Sequence.(append (return drop_head) dropped')) ) + go t'' increment drop_tail None current_nonce + in + let%map () = + Result.ok_if_true + Currency.Fee.(increment >= replace_fee) + ~error: + (Insufficient_replace_fee (`Replace_fee replace_fee, increment)) + (* C3 *) + in + (cmd, t'', Sequence.(append (return drop_head) dropped')) let add_from_backtrack : t @@ -1011,93 +999,92 @@ let add_from_backtrack : (of_time_exn ~constants:consensus_constants (Block_time.now time_controller) )) in - match slot_tx_end with - | Some slot_tx_end' when Global_slot.(current_global_slot >= slot_tx_end') -> - Error After_slot_tx_end - | Some _ | None -> ( - let unchecked = - Transaction_hash.User_command_with_valid_signature.command cmd - in - let%map () = check_expiry t unchecked in - let fee_payer = User_command.fee_payer unchecked in - let fee = User_command.fee_exn unchecked in - let consumed = - Option.value_exn (currency_consumed ~constraint_constants cmd) - in - match Map.find t.all_by_sender fee_payer with - | None -> - { all_by_sender = - (* If the command comes from backtracking, then we know it doesn't - cause overflow, so it's OK to throw here. - *) - Map.add_exn t.all_by_sender ~key:fee_payer - ~data:(F_sequence.singleton cmd, consumed) - ; all_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.all_by_fee fee cmd - ; all_by_hash = - Map.set t.all_by_hash - ~key: - (Transaction_hash.User_command_with_valid_signature.hash cmd) - ~data:cmd - ; applicable_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t.applicable_by_fee fee cmd - ; transactions_with_expiration = - add_to_expiration t.transactions_with_expiration cmd - ; size = t.size + 1 - ; constraint_constants - ; consensus_constants - ; time_controller - ; slot_tx_end - } - | Some (queue, currency_reserved) -> - let first_queued = F_sequence.head_exn queue in - if - not - (Account_nonce.equal - (unchecked |> User_command.nonce_exn |> Account_nonce.succ) - ( first_queued - |> Transaction_hash.User_command_with_valid_signature.command - |> User_command.nonce_exn ) ) - then - failwith - @@ sprintf - !"indexed pool nonces inconsistent when adding from \ - backtrack. Trying to add \ - %{sexp:Transaction_hash.User_command_with_valid_signature.t} \ - to %{sexp: t}" - cmd t ; - let t' = remove_applicable_exn t first_queued in - { applicable_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t'.applicable_by_fee fee cmd - ; all_by_fee = - Map_set.insert - (module Transaction_hash.User_command_with_valid_signature) - t'.all_by_fee fee cmd - ; all_by_hash = - Map.set t.all_by_hash - ~key: - (Transaction_hash.User_command_with_valid_signature.hash cmd) - ~data:cmd - ; all_by_sender = - Map.set t'.all_by_sender ~key:fee_payer - ~data: - ( F_sequence.cons cmd queue - , Option.value_exn - Currency.Amount.(currency_reserved + consumed) ) - ; transactions_with_expiration = - add_to_expiration t.transactions_with_expiration cmd - ; size = t.size + 1 - ; constraint_constants - ; consensus_constants - ; time_controller - ; slot_tx_end - } ) + 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 + let%map () = check_expiry t unchecked in + let fee_payer = User_command.fee_payer unchecked in + let fee = User_command.fee_exn unchecked in + let consumed = + Option.value_exn (currency_consumed ~constraint_constants cmd) + in + match Map.find t.all_by_sender fee_payer with + | None -> + { all_by_sender = + (* If the command comes from backtracking, then we know it doesn't + cause overflow, so it's OK to throw here. + *) + Map.add_exn t.all_by_sender ~key:fee_payer + ~data:(F_sequence.singleton cmd, consumed) + ; all_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.all_by_fee fee cmd + ; all_by_hash = + Map.set t.all_by_hash + ~key:(Transaction_hash.User_command_with_valid_signature.hash cmd) + ~data:cmd + ; applicable_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t.applicable_by_fee fee cmd + ; transactions_with_expiration = + add_to_expiration t.transactions_with_expiration cmd + ; size = t.size + 1 + ; constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + } + | Some (queue, currency_reserved) -> + let first_queued = F_sequence.head_exn queue in + if + not + (Account_nonce.equal + (unchecked |> User_command.nonce_exn |> Account_nonce.succ) + ( first_queued + |> Transaction_hash.User_command_with_valid_signature.command + |> User_command.nonce_exn ) ) + then + failwith + @@ sprintf + !"indexed pool nonces inconsistent when adding from backtrack. \ + Trying to add \ + %{sexp:Transaction_hash.User_command_with_valid_signature.t} to \ + %{sexp: t}" + cmd t ; + let t' = remove_applicable_exn t first_queued in + { applicable_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t'.applicable_by_fee fee cmd + ; all_by_fee = + Map_set.insert + (module Transaction_hash.User_command_with_valid_signature) + t'.all_by_fee fee cmd + ; all_by_hash = + Map.set t.all_by_hash + ~key:(Transaction_hash.User_command_with_valid_signature.hash cmd) + ~data:cmd + ; all_by_sender = + Map.set t'.all_by_sender ~key:fee_payer + ~data: + ( F_sequence.cons cmd queue + , Option.value_exn Currency.Amount.(currency_reserved + consumed) + ) + ; transactions_with_expiration = + add_to_expiration t.transactions_with_expiration cmd + ; size = t.size + 1 + ; constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + } (* Only show stdout for failed inline tests. *) open Inline_test_quiet_logs From 8f196508c737b3b0870bec730bd384f7faeca69e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Tue, 23 Jan 2024 15:33:57 +0000 Subject: [PATCH 33/36] Revert format changes --- src/lib/runtime_config/dune | 72 ++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 38 deletions(-) diff --git a/src/lib/runtime_config/dune b/src/lib/runtime_config/dune index 3f8780c6163..c4fd7cc1992 100644 --- a/src/lib/runtime_config/dune +++ b/src/lib/runtime_config/dune @@ -2,42 +2,38 @@ (name runtime_config) (public_name coda_runtime_config) (libraries - ;; opam libraries - async - async_kernel - core_kernel - bin_prot.shape - base.caml - base - base64 - integers - result - sexplib0 - ;; local libraries - currency - data_hash_lib - merkle_ledger - mina_base - mina_numbers - ppx_dhall_type - snark_params - unsigned_extended - pasta - pickles - pickles.backend - pickles_types - 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 + ;; opam libraries + async + async_kernel + async_unix + core_kernel + bin_prot.shape + base.caml + base + base64 + integers + result + sexplib0 + ;; local libraries + block_time + currency + genesis_constants + data_hash_lib + merkle_ledger + mina_base + mina_numbers ppx_dhall_type - ppx_version - ppx_compare))) + mina_state + snark_params + unsigned_extended + pasta + pickles + pickles.backend + pickles_types + 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))) \ No newline at end of file From dd4d162dccd31fe1f8ffcf65327c185445aea3f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Tue, 30 Jan 2024 13:53:21 +0000 Subject: [PATCH 34/36] Revert slot_end_test changes --- src/app/test_executive/slot_end_test.ml | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/app/test_executive/slot_end_test.ml b/src/app/test_executive/slot_end_test.ml index 4d846a7d48a..ebd5cfcf7fa 100644 --- a/src/app/test_executive/slot_end_test.ml +++ b/src/app/test_executive/slot_end_test.ml @@ -28,17 +28,21 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct { default with requires_graphql = true ; genesis_ledger = - (let open Test_account in - [ create ~account_name:"receiver-key" ~balance:"9999999" () - ; create ~account_name:"sender-1-key" ~balance:"0" () - ; create ~account_name:"sender-2-key" ~balance:"0" () - ; create ~account_name:"sender-3-key" ~balance:"0" () - ; create ~account_name:"snark-node-key" ~balance:"0" () + [ { 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 -> - create - ~account_name:(sprintf "%s-%d" sender_account_prefix i) - ~balance:"1000" () )) + { 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" } From 8fa750efa33c78ebf0d0aa17f2040836a065656b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Tue, 30 Jan 2024 13:58:40 +0000 Subject: [PATCH 35/36] Reformat --- src/lib/block_producer/block_producer.ml | 6 +++--- src/lib/integration_test_cloud_engine/mina_automation.ml | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 337b35e97bc..0d0df328645 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -165,7 +165,8 @@ let report_transaction_inclusion_failures ~logger failed_txns = let generate_next_state ~zkapp_cmd_limit ~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 ~slot_tx_end ~slot_chain_end = + ~winner_pk ~scheduled_time ~log_block_creation ~block_reward_threshold + ~slot_tx_end ~slot_chain_end = let open Interruptible.Let_syntax in let global_slot_since_hard_fork = Consensus.Data.Block_data.global_slot block_data @@ -802,8 +803,7 @@ let run ~context:(module Context : CONTEXT) ~vrf_evaluator ~prover ~verifier ~staged_ledger:(Breadcrumb.staged_ledger crumb) ~transactions ~get_completed_work ~logger ~log_block_creation ~winner_pk:winner_pubkey ~block_reward_threshold - ~zkapp_cmd_limit:!zkapp_cmd_limit - ~slot_tx_end ~slot_chain_end + ~zkapp_cmd_limit:!zkapp_cmd_limit ~slot_tx_end ~slot_chain_end in [%log internal] "Generate_next_state_done" ; match next_state_opt with diff --git a/src/lib/integration_test_cloud_engine/mina_automation.ml b/src/lib/integration_test_cloud_engine/mina_automation.ml index 6d11f06af49..541db603801 100644 --- a/src/lib/integration_test_cloud_engine/mina_automation.ml +++ b/src/lib/integration_test_cloud_engine/mina_automation.ml @@ -124,8 +124,8 @@ module Network_config = struct ; slots_per_epoch ; slots_per_sub_window ; txpool_max_size - ; slot_tx_end - ; slot_chain_end + ; slot_tx_end + ; slot_chain_end } = test_config in From e8988236abe94fae0998b7c46c59ad54b19d5b57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Tue, 30 Jan 2024 14:14:11 +0000 Subject: [PATCH 36/36] Call unnamed parameter last --- src/lib/ledger_catchup/normal_catchup.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/ledger_catchup/normal_catchup.ml b/src/lib/ledger_catchup/normal_catchup.ml index b7df181abad..d23c2dc8ae3 100644 --- a/src/lib/ledger_catchup/normal_catchup.ml +++ b/src/lib/ledger_catchup/normal_catchup.ml @@ -79,8 +79,8 @@ let verify_transition ~context:(module Context : CONTEXT) ~trust_system in Transition_handler.Validator.validate_transition ~context:(module Context) - ~frontier ~unprocessed_transition_cache - enveloped_initially_validated_transition ~slot_tx_end ~slot_chain_end + ~frontier ~unprocessed_transition_cache ~slot_tx_end ~slot_chain_end + enveloped_initially_validated_transition in let open Deferred.Let_syntax in match cached_initially_validated_transition_result with