From 983c8dbb1afa9ec20079eb0eab7091bbcae3a172 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Tue, 11 Jul 2023 14:09:00 +0000 Subject: [PATCH 01/10] Add slot-tx-end param to CLI --- src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml | 9 ++++++++- src/lib/mina_lib/config.ml | 1 + 2 files changed, 9 insertions(+), 1 deletion(-) 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 d28d7ced863..e046c1eabe8 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,12 @@ 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: + "Slot after which the node will stop accepting transactions. (default: \ + disabled)" + (optional int) in let to_pubsub_topic_mode_option = let open Gossip_net.Libp2p in @@ -1301,7 +1307,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..6f93d1b8639 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 : int option [@default None] } [@@deriving make] From 2226840b5723a23988902ca5abeb5157f7904750 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Fri, 28 Jul 2023 15:52:33 +0100 Subject: [PATCH 02/10] Reject user commands after slot --- src/lib/mina_commands/mina_commands.ml | 110 ++++++++++++++++--------- 1 file changed, 69 insertions(+), 41 deletions(-) diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index 80f3fc676bc..84d6f98a347 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -67,51 +67,79 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) = let open Participating_state.Let_syntax in (* hack to get types to work out *) - let%map () = return () in + let%bind () = return () in + let%map best_tip = Mina_lib.best_tip t in + let consensus_state = + Transition_frontier.Breadcrumb.consensus_state best_tip + in + let global_slot_since_genesis = + Mina_numbers.Global_slot.to_int + @@ Consensus.Data.Consensus_state.global_slot_since_genesis consensus_state + 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)] - ~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 + match (Mina_lib.config t).slot_tx_end with + | Some slot_tx_end when global_slot_since_genesis >= slot_tx_end -> + [%log' warn (Mina_lib.top_level_logger t)] "can't produce" ; + Deferred.return (Error (Error.of_string "can't produce")) + | Some _ | None -> ( + 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%bind _is_active = Mina_lib.active_or_bootstrapping t in + let%map best_tip = Mina_lib.best_tip t in + let consensus_state = + Transition_frontier.Breadcrumb.consensus_state best_tip + in + let global_slot_since_genesis = + Mina_numbers.Global_slot.to_int + @@ Consensus.Data.Consensus_state.global_slot_since_genesis consensus_state + in + match (Mina_lib.config t).slot_tx_end with + | Some slot_tx_end when global_slot_since_genesis >= slot_tx_end -> + [%log' warn (Mina_lib.top_level_logger t)] "can't produce" ; + Deferred.return (Error (Error.of_string "can't produce")) + | Some _ | None -> + [%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 5fcd89f1182e786d4c6581de9e54f461014579c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Tue, 1 Aug 2023 10:36:22 +0000 Subject: [PATCH 03/10] Fix get curr slot --- src/lib/mina_commands/mina_commands.ml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index 84d6f98a347..e97b76ceaa2 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -67,18 +67,18 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) = let open Participating_state.Let_syntax in (* hack to get types to work out *) - let%bind () = return () in - let%map best_tip = Mina_lib.best_tip t in - let consensus_state = - Transition_frontier.Breadcrumb.consensus_state best_tip - in - let global_slot_since_genesis = - Mina_numbers.Global_slot.to_int - @@ Consensus.Data.Consensus_state.global_slot_since_genesis consensus_state + let%map () = return () in + let slot = + Account_nonce.to_int + @@ Consensus.Data.Consensus_time.to_global_slot + (Consensus.Data.Consensus_time.of_time_exn + ~constants: + (Mina_lib.config t).precomputed_values.consensus_constants + (Block_time.now (Mina_lib.config t).time_controller) ) in let open Deferred.Let_syntax in match (Mina_lib.config t).slot_tx_end with - | Some slot_tx_end when global_slot_since_genesis >= slot_tx_end -> + | Some slot_tx_end when slot >= slot_tx_end -> [%log' warn (Mina_lib.top_level_logger t)] "can't produce" ; Deferred.return (Error (Error.of_string "can't produce")) | Some _ | None -> ( From 364b66448ea44267e0c569e69cc6d646bc73152b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Tue, 1 Aug 2023 11:52:38 +0100 Subject: [PATCH 04/10] Improve error messaging --- src/lib/mina_commands/mina_commands.ml | 30 +++++++++++++++----------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index e97b76ceaa2..bbb90aea155 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -79,8 +79,10 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) let open Deferred.Let_syntax in match (Mina_lib.config t).slot_tx_end with | Some slot_tx_end when slot >= slot_tx_end -> - [%log' warn (Mina_lib.top_level_logger t)] "can't produce" ; - Deferred.return (Error (Error.of_string "can't produce")) + [%log' warn (Mina_lib.top_level_logger t)] + "can't produce transaction in slot $slot, tx production ends at $end" + ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> ( let%map result = Mina_lib.add_transactions t [ user_command_input ] in txn_count := !txn_count + 1 ; @@ -120,19 +122,21 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) let setup_and_submit_user_commands t user_command_list = let open Participating_state.Let_syntax in - let%bind _is_active = Mina_lib.active_or_bootstrapping t in - let%map best_tip = Mina_lib.best_tip t in - let consensus_state = - Transition_frontier.Breadcrumb.consensus_state best_tip - in - let global_slot_since_genesis = - Mina_numbers.Global_slot.to_int - @@ Consensus.Data.Consensus_state.global_slot_since_genesis consensus_state + let%map _is_active = Mina_lib.active_or_bootstrapping t in + let slot = + Account_nonce.to_int + @@ Consensus.Data.Consensus_time.to_global_slot + (Consensus.Data.Consensus_time.of_time_exn + ~constants: + (Mina_lib.config t).precomputed_values.consensus_constants + (Block_time.now (Mina_lib.config t).time_controller) ) in match (Mina_lib.config t).slot_tx_end with - | Some slot_tx_end when global_slot_since_genesis >= slot_tx_end -> - [%log' warn (Mina_lib.top_level_logger t)] "can't produce" ; - Deferred.return (Error (Error.of_string "can't produce")) + | Some slot_tx_end when slot >= slot_tx_end -> + [%log' warn (Mina_lib.top_level_logger t)] + "can't produce transactions in slot $slot, tx production ends at $end" + ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> [%log' warn (Mina_lib.top_level_logger t)] "batch-send-payments does not yet report errors" From b5ed8c5d7e0154594db41e13ae213e54f92b0ce0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Wed, 2 Aug 2023 17:16:21 +0100 Subject: [PATCH 05/10] [BP] empty transaction sequence when slot after end --- src/lib/block_producer/block_producer.ml | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 4c36430d179..036f1a15af9 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -542,7 +542,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 @@ -653,11 +653,23 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ( Header.protocol_state_proof @@ Mina_block.header (With_hash.data previous_transition) ) in + let slot = + Mina_numbers.Account_nonce.to_int + @@ Consensus.Data.Consensus_time.to_global_slot + (Consensus.Data.Consensus_time.of_time_exn + ~constants:consensus_constants + (Block_time.now time_controller) ) + in let transactions = - Network_pool.Transaction_pool.Resource_pool.transactions ~logger - transaction_resource_pool - |> Sequence.map - ~f:Transaction_hash.User_command_with_valid_signature.data + match slot_tx_end with + | Some slot_tx_end' when slot >= slot_tx_end' -> + Sequence.empty + | Some _ | None -> + Network_pool.Transaction_pool.Resource_pool.transactions + ~logger transaction_resource_pool + |> Sequence.map + ~f: + Transaction_hash.User_command_with_valid_signature.data in let%bind () = Interruptible.lift (Deferred.return ()) (Ivar.read ivar) From 1ad0e22beee016c695057c1e8c67eccb615f602a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joa=CC=83o=20Santos=20Reis?= Date: Thu, 3 Aug 2023 09:20:06 +0100 Subject: [PATCH 06/10] Add slot check in mina_lib --- src/lib/mina_lib/mina_lib.ml | 51 ++++++++++++++++++++++++++++-------- 1 file changed, 40 insertions(+), 11 deletions(-) diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index de37ac8694a..389d3958132 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -893,18 +893,46 @@ let get_current_nonce t aid = Ok (`Min ledger_nonce, nonce) let add_transactions t (uc_inputs : User_command_input.t list) = - let result_ivar = Ivar.create () in - Strict_pipe.Writer.write t.pipes.user_command_input_writer - (uc_inputs, Ivar.fill result_ivar, get_current_nonce t, get_account t) - |> Deferred.don't_wait_for ; - Ivar.read result_ivar + let slot = + Mina_numbers.Account_nonce.to_int + @@ Consensus.Data.Consensus_time.to_global_slot + (Consensus.Data.Consensus_time.of_time_exn + ~constants:(config t).precomputed_values.consensus_constants + (Block_time.now (config t).time_controller) ) + in + match (config t).slot_tx_end with + | Some slot_tx_end when slot >= slot_tx_end -> + [%log' warn (top_level_logger t)] + "can't add transactions at slot $slot, tx production ends at $end" + ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + Deferred.return (Error (Error.of_string "tx production has ended")) + | Some _ | None -> + let result_ivar = Ivar.create () in + Strict_pipe.Writer.write t.pipes.user_command_input_writer + (uc_inputs, Ivar.fill result_ivar, get_current_nonce t, get_account t) + |> Deferred.don't_wait_for ; + Ivar.read result_ivar let add_full_transactions t user_command = - let result_ivar = Ivar.create () in - Network_pool.Transaction_pool.Local_sink.push t.pipes.tx_local_sink - (user_command, Ivar.fill result_ivar) - |> Deferred.don't_wait_for ; - Ivar.read result_ivar + let slot = + Mina_numbers.Account_nonce.to_int + @@ Consensus.Data.Consensus_time.to_global_slot + (Consensus.Data.Consensus_time.of_time_exn + ~constants:(config t).precomputed_values.consensus_constants + (Block_time.now (config t).time_controller) ) + in + match (config t).slot_tx_end with + | Some slot_tx_end when slot >= slot_tx_end -> + [%log' warn (top_level_logger t)] + "can't add transactions at slot $slot, tx production ends at $end" + ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + Deferred.return (Error (Error.of_string "tx production has ended")) + | Some _ | None -> + let result_ivar = Ivar.create () in + Network_pool.Transaction_pool.Local_sink.push t.pipes.tx_local_sink + (user_command, Ivar.fill result_ivar) + |> Deferred.don't_wait_for ; + Ivar.read result_ivar let next_producer_timing t = t.next_producer_timing @@ -1212,7 +1240,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 dab1a702d562c1f21511b2a1eea9604a5de52565 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Mon, 28 Aug 2023 21:18:14 +0000 Subject: [PATCH 07/10] Txn pool cleaned after slot_tx_end --- src/app/cli/src/cli_entrypoint/dune | 1 + .../src/cli_entrypoint/mina_cli_entrypoint.ml | 1 + src/lib/block_producer/block_producer.ml | 5 +- src/lib/mina_commands/mina_commands.ml | 14 +- src/lib/mina_lib/config.ml | 2 +- src/lib/mina_lib/mina_lib.ml | 19 +- src/lib/network_pool/indexed_pool.ml | 518 ++++++++++-------- src/lib/network_pool/indexed_pool.mli | 8 + src/lib/network_pool/intf.ml | 3 + src/lib/network_pool/network_pool_base.ml | 7 +- src/lib/network_pool/snark_pool.ml | 17 +- src/lib/network_pool/snark_pool.mli | 1 + src/lib/network_pool/test.ml | 6 +- src/lib/network_pool/transaction_pool.ml | 42 +- .../transaction_inclusion_status.ml | 4 +- 15 files changed, 376 insertions(+), 272 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/dune b/src/app/cli/src/cli_entrypoint/dune index ce3b756c4fb..b68a5d45f3a 100644 --- a/src/app/cli/src/cli_entrypoint/dune +++ b/src/app/cli/src/cli_entrypoint/dune @@ -64,6 +64,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 e046c1eabe8..2b004174ac6 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -1277,6 +1277,7 @@ 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.map ~f:Mina_numbers.Account_nonce.of_int slot_tx_end in let start_time = Time.now () in let%map coda = Mina_lib.create ~wallets diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 036f1a15af9..13b1b1779c6 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -654,15 +654,14 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system @@ Mina_block.header (With_hash.data previous_transition) ) in let slot = - Mina_numbers.Account_nonce.to_int - @@ Consensus.Data.Consensus_time.to_global_slot + Consensus.Data.Consensus_time.to_global_slot (Consensus.Data.Consensus_time.of_time_exn ~constants:consensus_constants (Block_time.now time_controller) ) in let transactions = match slot_tx_end with - | Some slot_tx_end' when slot >= slot_tx_end' -> + | Some slot_tx_end' when Mina_numbers.Account_nonce.(slot >= slot_tx_end') -> Sequence.empty | Some _ | None -> Network_pool.Transaction_pool.Resource_pool.transactions diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index bbb90aea155..85496f75b6c 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -69,8 +69,7 @@ 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 slot = - Account_nonce.to_int - @@ Consensus.Data.Consensus_time.to_global_slot + Consensus.Data.Consensus_time.to_global_slot (Consensus.Data.Consensus_time.of_time_exn ~constants: (Mina_lib.config t).precomputed_values.consensus_constants @@ -78,10 +77,10 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) in let open Deferred.Let_syntax in match (Mina_lib.config t).slot_tx_end with - | Some slot_tx_end when slot >= slot_tx_end -> + | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> [%log' warn (Mina_lib.top_level_logger t)] "can't produce transaction in slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> ( let%map result = Mina_lib.add_transactions t [ user_command_input ] in @@ -124,18 +123,17 @@ 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 let slot = - Account_nonce.to_int - @@ Consensus.Data.Consensus_time.to_global_slot + Consensus.Data.Consensus_time.to_global_slot (Consensus.Data.Consensus_time.of_time_exn ~constants: (Mina_lib.config t).precomputed_values.consensus_constants (Block_time.now (Mina_lib.config t).time_controller) ) in match (Mina_lib.config t).slot_tx_end with - | Some slot_tx_end when slot >= slot_tx_end -> + | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> [%log' warn (Mina_lib.top_level_logger t)] "can't produce transactions in slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> [%log' warn (Mina_lib.top_level_logger t)] diff --git a/src/lib/mina_lib/config.ml b/src/lib/mina_lib/config.ml index 6f93d1b8639..31c26c01096 100644 --- a/src/lib/mina_lib/config.ml +++ b/src/lib/mina_lib/config.ml @@ -59,6 +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 : int option [@default None] + ; slot_tx_end : Mina_numbers.Account_nonce.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 389d3958132..f403cd9a9b9 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -6,6 +6,7 @@ open Pipe_lib open Strict_pipe open Signature_lib open Network_peer +open Mina_numbers module Archive_client = Archive_client module Config = Config module Conf_dir = Conf_dir @@ -894,17 +895,16 @@ let get_current_nonce t aid = let add_transactions t (uc_inputs : User_command_input.t list) = let slot = - Mina_numbers.Account_nonce.to_int - @@ Consensus.Data.Consensus_time.to_global_slot + Consensus.Data.Consensus_time.to_global_slot (Consensus.Data.Consensus_time.of_time_exn ~constants:(config t).precomputed_values.consensus_constants (Block_time.now (config t).time_controller) ) in match (config t).slot_tx_end with - | Some slot_tx_end when slot >= slot_tx_end -> + | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> [%log' warn (top_level_logger t)] "can't add transactions at slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> let result_ivar = Ivar.create () in @@ -915,17 +915,16 @@ let add_transactions t (uc_inputs : User_command_input.t list) = let add_full_transactions t user_command = let slot = - Mina_numbers.Account_nonce.to_int - @@ Consensus.Data.Consensus_time.to_global_slot + Consensus.Data.Consensus_time.to_global_slot (Consensus.Data.Consensus_time.of_time_exn ~constants:(config t).precomputed_values.consensus_constants (Block_time.now (config t).time_controller) ) in match (config t).slot_tx_end with - | Some slot_tx_end when slot >= slot_tx_end -> + | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> [%log' warn (top_level_logger t)] "can't add transactions at slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int slot); ("end", `Int slot_tx_end) ] ; + ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> let result_ivar = Ivar.create () in @@ -1618,7 +1617,7 @@ let create ?wallets (config : Config.t) = (* make transaction pool return writer for local and incoming diffs *) Network_pool.Transaction_pool.create ~config:txn_pool_config ~constraint_constants ~consensus_constants - ~time_controller:config.time_controller ~logger:config.logger + ~time_controller:config.time_controller ~slot_tx_end:config.slot_tx_end ~logger:config.logger ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~on_remote_push:notify_online ~log_gossip_heard: @@ -1632,7 +1631,7 @@ let create ?wallets (config : Config.t) = let%bind snark_pool, snark_remote_sink, snark_local_sink = Network_pool.Snark_pool.load ~config:snark_pool_config ~constraint_constants ~consensus_constants - ~time_controller:config.time_controller ~logger:config.logger + ~time_controller:config.time_controller ~slot_tx_end:config.slot_tx_end ~logger:config.logger ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~on_remote_push:notify_online ~log_gossip_heard: diff --git a/src/lib/network_pool/indexed_pool.ml b/src/lib/network_pool/indexed_pool.ml index d1d43def107..812dc8f9219 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 : Account_nonce.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 @@ -506,6 +512,16 @@ let drop_until_sufficient_balance : in go queue currency_reserved Sequence.empty +let drop_all t = + { t with + applicable_by_fee = Currency.Fee.Map.empty + ; all_by_sender = Account_id.Map.empty + ; all_by_fee = Currency.Fee.Map.empty + ; all_by_hash = Transaction_hash.Map.empty + ; transactions_with_expiration = Global_slot.Map.empty + ; size = 0 + } + (* Iterate over all commands in the pool, removing them if they require too much currency or have too low of a nonce. *) @@ -725,249 +741,278 @@ 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)) + let slot = + Consensus.Data.Consensus_time.to_global_slot + (Consensus.Data.Consensus_time.of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) ) 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 () = - Result.ok_if_true - (Account_nonce.equal current_nonce nonce) - ~error:(Invalid_nonce (`Expected current_nonce, nonce)) - (* C1/1a *) + match slot_tx_end with + | Some slot_tx_end' when Account_nonce.(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 - Currency.Amount.(consumed <= balance) - ~error:(Insufficient_funds (`Balance balance, consumed)) - (* C2 *) + if User_command.check_tokens unchecked then return () + else Error Bad_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 + 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 - 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 ) + (* 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 - 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%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; _ } as t) - cmd -> + fun ( { constraint_constants + ; consensus_constants + ; time_controller + ; slot_tx_end + ; _ + } as t ) cmd -> let open Result.Let_syntax in let unchecked = Transaction_hash.User_command_with_valid_signature.command cmd @@ -1004,6 +1049,7 @@ let add_from_backtrack : ; constraint_constants ; consensus_constants ; time_controller + ; slot_tx_end } | Some (queue, currency_reserved) -> let first_queued = F_sequence.head_exn queue in @@ -1047,6 +1093,7 @@ let add_from_backtrack : ; constraint_constants ; consensus_constants ; time_controller + ; slot_tx_end } (* Only show stdout for failed inline tests. *) @@ -1075,8 +1122,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 +1267,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 th 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..bd9816670a3 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:Account_nonce.t option -> t (** How many transactions are currently in the pool *) @@ -138,6 +140,12 @@ val revalidate : (** Get the current global slot according to the pool's time controller. *) val current_global_slot : t -> Mina_numbers.Global_slot.t +(** Get the slot at which transactions are no longer accepted. *) +val slot_tx_end : t -> Account_nonce.t option + +(** Empties the pool *) +val drop_all : t -> t + module For_tests : sig (** Checks the invariants of the data structure. If this throws an exception there is a bug. *) diff --git a/src/lib/network_pool/intf.ml b/src/lib/network_pool/intf.ml index b93cea139f2..55f861869c6 100644 --- a/src/lib/network_pool/intf.ml +++ b/src/lib/network_pool/intf.ml @@ -29,6 +29,7 @@ module type Resource_pool_base_intf = sig constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t + -> slot_tx_end:Mina_numbers.Account_nonce.t option -> frontier_broadcast_pipe: transition_frontier Option.t Broadcast_pipe.Reader.t -> config:Config.t @@ -179,6 +180,7 @@ module type Network_pool_base_intf = sig -> constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t + -> slot_tx_end:Mina_numbers.Account_nonce.t option -> frontier_broadcast_pipe: transition_frontier Option.t Broadcast_pipe.Reader.t -> logger:Logger.t @@ -309,6 +311,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 diff --git a/src/lib/network_pool/network_pool_base.ml b/src/lib/network_pool/network_pool_base.ml index b9ede2a3c16..f0ffc7e19c3 100644 --- a/src/lib/network_pool/network_pool_base.ml +++ b/src/lib/network_pool/network_pool_base.ml @@ -253,7 +253,8 @@ end) go () let create ~config ~constraint_constants ~consensus_constants ~time_controller - ~frontier_broadcast_pipe ~logger ~log_gossip_heard ~on_remote_push = + ~slot_tx_end ~frontier_broadcast_pipe ~logger ~log_gossip_heard + ~on_remote_push = (*Diffs from tansition frontier extensions*) let tf_diff_reader, tf_diff_writer = Strict_pipe.( @@ -262,8 +263,8 @@ end) let t, locals, remotes = of_resource_pool_and_diffs (Resource_pool.create ~constraint_constants ~consensus_constants - ~time_controller ~config ~logger ~frontier_broadcast_pipe - ~tf_diff_writer ) + ~time_controller ~slot_tx_end ~config ~logger + ~frontier_broadcast_pipe ~tf_diff_writer ) ~constraint_constants ~logger ~tf_diffs:tf_diff_reader ~log_gossip_heard ~on_remote_push in diff --git a/src/lib/network_pool/snark_pool.ml b/src/lib/network_pool/snark_pool.ml index e1b3cbabfdb..844a4f4991a 100644 --- a/src/lib/network_pool/snark_pool.ml +++ b/src/lib/network_pool/snark_pool.ml @@ -103,6 +103,7 @@ module type S = sig -> constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t + -> slot_tx_end:Mina_numbers.Account_nonce.t option -> frontier_broadcast_pipe: transition_frontier option Broadcast_pipe.Reader.t -> log_gossip_heard:bool @@ -381,7 +382,7 @@ struct in Deferred.don't_wait_for tf_deferred - let create ~constraint_constants ~consensus_constants:_ ~time_controller:_ + let create ~constraint_constants ~consensus_constants:_ ~time_controller:_ ~slot_tx_end:_ ~frontier_broadcast_pipe ~config ~logger ~tf_diff_writer = let t = { snark_tables = @@ -645,7 +646,7 @@ struct let loaded = ref false let load ~config ~logger ~constraint_constants ~consensus_constants - ~time_controller ~frontier_broadcast_pipe ~log_gossip_heard + ~time_controller ~slot_tx_end ~frontier_broadcast_pipe ~log_gossip_heard ~on_remote_push = if !loaded then failwith @@ -674,7 +675,7 @@ struct res | Error _e -> create ~config ~logger ~constraint_constants ~consensus_constants - ~time_controller ~frontier_broadcast_pipe ~log_gossip_heard + ~time_controller ~slot_tx_end ~frontier_broadcast_pipe ~log_gossip_heard ~on_remote_push in store_periodically (resource_pool pool) ; @@ -749,6 +750,8 @@ let%test_module "random set test" = let time_controller = Block_time.Controller.basic ~logger + let slot_tx_end = None + let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants @@ -798,7 +801,7 @@ let%test_module "random set test" = let open Deferred.Let_syntax in let mock_pool, _r_sink, _l_sink = Mock_snark_pool.create ~config ~logger ~constraint_constants - ~consensus_constants ~time_controller + ~consensus_constants ~time_controller ~slot_tx_end ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) (* |> *) @@ -975,7 +978,7 @@ let%test_module "random set test" = in let network_pool, _, _ = Mock_snark_pool.create ~config ~constraint_constants - ~consensus_constants ~time_controller ~logger + ~consensus_constants ~time_controller ~slot_tx_end ~logger ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in @@ -1046,7 +1049,7 @@ let%test_module "random set test" = in let network_pool, remote_sink, local_sink = Mock_snark_pool.create ~logger ~config ~constraint_constants - ~consensus_constants ~time_controller + ~consensus_constants ~time_controller ~slot_tx_end ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in @@ -1130,7 +1133,7 @@ let%test_module "random set test" = let open Deferred.Let_syntax in let network_pool, _, _ = Mock_snark_pool.create ~logger:(Logger.null ()) ~config - ~constraint_constants ~consensus_constants ~time_controller + ~constraint_constants ~consensus_constants ~time_controller ~slot_tx_end ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in diff --git a/src/lib/network_pool/snark_pool.mli b/src/lib/network_pool/snark_pool.mli index 3a8660df969..6ba603bff59 100644 --- a/src/lib/network_pool/snark_pool.mli +++ b/src/lib/network_pool/snark_pool.mli @@ -44,6 +44,7 @@ module type S = sig -> constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t + -> slot_tx_end:Mina_numbers.Account_nonce.t option -> frontier_broadcast_pipe: transition_frontier option Broadcast_pipe.Reader.t -> log_gossip_heard:bool diff --git a/src/lib/network_pool/test.ml b/src/lib/network_pool/test.ml index 9e43e21d20d..df6b7890d8f 100644 --- a/src/lib/network_pool/test.ml +++ b/src/lib/network_pool/test.ml @@ -22,6 +22,8 @@ let%test_module "network pool test" = let time_controller = Block_time.Controller.basic ~logger + let slot_tx_end = None + let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants @@ -57,7 +59,7 @@ let%test_module "network pool test" = Async.Thread_safe.block_on_async_exn (fun () -> let network_pool, _, _ = Mock_snark_pool.create ~config ~logger ~constraint_constants - ~consensus_constants ~time_controller + ~consensus_constants ~time_controller ~slot_tx_end ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in @@ -112,7 +114,7 @@ let%test_module "network pool test" = let frontier_broadcast_pipe_r, _ = Broadcast_pipe.create (Some tf) in let network_pool, remote_sink, local_sink = Mock_snark_pool.create ~config ~logger ~constraint_constants - ~consensus_constants ~time_controller + ~consensus_constants ~time_controller ~slot_tx_end ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 646d4476f22..846e7bc9256 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -79,6 +79,7 @@ module Diff_versioned = struct | Unwanted_fee_token | Expired | Overloaded + | After_slot_tx_end [@@deriving sexp, yojson] let to_latest = Fn.id @@ -101,6 +102,7 @@ module Diff_versioned = struct | Unwanted_fee_token | Expired | Overloaded + | After_slot_tx_end [@@deriving sexp, yojson] let to_string_hum = function @@ -133,6 +135,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 @@ -393,6 +398,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 @@ -688,6 +695,24 @@ struct ignore ( Hashtbl.find_and_remove t.locally_generated_uncommitted cmd : (Time.t * [ `Batch of int ]) option ) ) ; + let pool = + match Indexed_pool.slot_tx_end t.pool with + | Some slot_tx_end + when Mina_numbers.Account_nonce.(global_slot >= slot_tx_end) -> + (* discard all transactions *) + [%log' debug t.logger] + "Discarding all transactions because the current global slot \ + $slot is past slot_tx_end $slot_tx_end" + ~metadata: + [ ("slot", Mina_numbers.Global_slot.to_yojson global_slot) + ; ("slot_tx_end", Mina_numbers.Global_slot.to_yojson slot_tx_end) + ] ; + Hashtbl.clear t.locally_generated_uncommitted ; + Hashtbl.clear t.locally_generated_committed ; + Indexed_pool.drop_all t.pool + | None | Some _ -> + pool + in Mina_metrics.( Gauge.set Transaction_pool.pool_size (Float.of_int (Indexed_pool.size pool))) ; @@ -695,11 +720,11 @@ struct Deferred.unit let create ~constraint_constants ~consensus_constants ~time_controller - ~frontier_broadcast_pipe ~config ~logger ~tf_diff_writer = + ~slot_tx_end ~frontier_broadcast_pipe ~config ~logger ~tf_diff_writer = let t = { pool = Indexed_pool.empty ~constraint_constants ~consensus_constants - ~time_controller + ~time_controller ~slot_tx_end ; locally_generated_uncommitted = Hashtbl.create ( module Transaction_hash.User_command_with_valid_signature.Stable @@ -850,6 +875,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 +1149,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 +1172,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) -> @@ -1484,6 +1514,8 @@ let%test_module _ = let time_controller = Block_time.Controller.basic ~logger + let slot_tx_end = None + let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants @@ -1573,7 +1605,7 @@ let%test_module _ = in let pool_, _, _ = Test.create ~config ~logger ~constraint_constants ~consensus_constants - ~time_controller ~frontier_broadcast_pipe:tf_pipe_r + ~time_controller ~slot_tx_end ~frontier_broadcast_pipe:tf_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in let pool = Test.resource_pool pool_ in @@ -2025,7 +2057,7 @@ let%test_module _ = in let pool_, _, _ = Test.create ~config ~logger ~constraint_constants - ~consensus_constants ~time_controller + ~consensus_constants ~time_controller ~slot_tx_end ~frontier_broadcast_pipe:frontier_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in diff --git a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml index 06cc0f9d7dc..47f77835f18 100644 --- a/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml +++ b/src/lib/transaction_inclusion_status/transaction_inclusion_status.ml @@ -76,6 +76,8 @@ let%test_module "transaction_status" = let time_controller = Block_time.Controller.basic ~logger + let slot_tx_end = None + let precomputed_values = Lazy.force Precomputed_values.for_unit_tests let proof_level = precomputed_values.proof_level @@ -120,7 +122,7 @@ let%test_module "transaction_status" = Transaction_pool.create ~config ~constraint_constants:precomputed_values.constraint_constants ~consensus_constants:precomputed_values.consensus_constants - ~time_controller ~logger ~frontier_broadcast_pipe + ~time_controller ~slot_tx_end ~logger ~frontier_broadcast_pipe ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in don't_wait_for From 2030ba76794d5267a962d85d1877d83e2d9a6183 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Wed, 30 Aug 2023 16:48:17 +0000 Subject: [PATCH 08/10] Refactorings --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 4 +- src/lib/block_producer/block_producer.ml | 14 +++--- src/lib/mina_commands/mina_commands.ml | 40 ++++++++++------- src/lib/mina_lib/config.ml | 2 +- src/lib/mina_lib/mina_lib.ml | 44 ++++++++++++------- src/lib/network_pool/indexed_pool.ml | 17 +++---- src/lib/network_pool/indexed_pool.mli | 4 +- src/lib/network_pool/intf.ml | 4 +- src/lib/network_pool/snark_pool.ml | 15 ++++--- 9 files changed, 83 insertions(+), 61 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 2b004174ac6..f58e240b072 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -1277,7 +1277,9 @@ 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.map ~f:Mina_numbers.Account_nonce.of_int slot_tx_end in + let slot_tx_end = + Option.map ~f:Mina_numbers.Global_slot.of_int slot_tx_end + in let start_time = Time.now () in let%map coda = Mina_lib.create ~wallets diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 13b1b1779c6..b9c0b664101 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -653,15 +653,17 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system ( Header.protocol_state_proof @@ Mina_block.header (With_hash.data previous_transition) ) in - let slot = - Consensus.Data.Consensus_time.to_global_slot - (Consensus.Data.Consensus_time.of_time_exn - ~constants:consensus_constants - (Block_time.now time_controller) ) + let current_global_slot = + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:consensus_constants + (Block_time.now time_controller) )) in let transactions = match slot_tx_end with - | Some slot_tx_end' when Mina_numbers.Account_nonce.(slot >= slot_tx_end') -> + | Some slot_tx_end' + when Mina_numbers.Global_slot.( + current_global_slot >= slot_tx_end') -> Sequence.empty | Some _ | None -> Network_pool.Transaction_pool.Resource_pool.transactions diff --git a/src/lib/mina_commands/mina_commands.ml b/src/lib/mina_commands/mina_commands.ml index 85496f75b6c..e3c5dd190ba 100644 --- a/src/lib/mina_commands/mina_commands.ml +++ b/src/lib/mina_commands/mina_commands.ml @@ -68,19 +68,22 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) let open Participating_state.Let_syntax in (* hack to get types to work out *) let%map () = return () in - let slot = - Consensus.Data.Consensus_time.to_global_slot - (Consensus.Data.Consensus_time.of_time_exn - ~constants: - (Mina_lib.config t).precomputed_values.consensus_constants - (Block_time.now (Mina_lib.config t).time_controller) ) + let current_global_slot = + let config = Mina_lib.config t in + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:config.precomputed_values.consensus_constants + (Block_time.now config.time_controller) )) in let open Deferred.Let_syntax in match (Mina_lib.config t).slot_tx_end with - | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> + | Some slot_tx_end when Global_slot.(current_global_slot >= slot_tx_end) -> [%log' warn (Mina_lib.top_level_logger t)] "can't produce transaction in slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; + ~metadata: + [ ("slot", `Int (Global_slot.to_int current_global_slot)) + ; ("end", `Int (Global_slot.to_int slot_tx_end)) + ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> ( let%map result = Mina_lib.add_transactions t [ user_command_input ] in @@ -122,18 +125,21 @@ let setup_and_submit_user_command t (user_command_input : User_command_input.t) 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 - let slot = - Consensus.Data.Consensus_time.to_global_slot - (Consensus.Data.Consensus_time.of_time_exn - ~constants: - (Mina_lib.config t).precomputed_values.consensus_constants - (Block_time.now (Mina_lib.config t).time_controller) ) + 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 config.time_controller) )) in - match (Mina_lib.config t).slot_tx_end with - | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> + match config.slot_tx_end with + | Some slot_tx_end when Global_slot.(current_global_slot >= slot_tx_end) -> [%log' warn (Mina_lib.top_level_logger t)] "can't produce transactions in slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; + ~metadata: + [ ("slot", `Int (Global_slot.to_int current_global_slot)) + ; ("end", `Int (Global_slot.to_int slot_tx_end)) + ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> [%log' warn (Mina_lib.top_level_logger t)] diff --git a/src/lib/mina_lib/config.ml b/src/lib/mina_lib/config.ml index 31c26c01096..32cfeeb29e4 100644 --- a/src/lib/mina_lib/config.ml +++ b/src/lib/mina_lib/config.ml @@ -59,6 +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.Account_nonce.t option [@default None] + ; 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 f403cd9a9b9..4552a20cde1 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -894,17 +894,21 @@ let get_current_nonce t aid = Ok (`Min ledger_nonce, nonce) let add_transactions t (uc_inputs : User_command_input.t list) = - let slot = - Consensus.Data.Consensus_time.to_global_slot - (Consensus.Data.Consensus_time.of_time_exn - ~constants:(config t).precomputed_values.consensus_constants - (Block_time.now (config t).time_controller) ) + let config = 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 config.time_controller) )) in - match (config t).slot_tx_end with - | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> + match config.slot_tx_end with + | Some slot_tx_end when Global_slot.(current_global_slot >= slot_tx_end) -> [%log' warn (top_level_logger t)] "can't add transactions at slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; + ~metadata: + [ ("slot", `Int (Global_slot.to_int current_global_slot)) + ; ("end", `Int (Global_slot.to_int slot_tx_end)) + ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> let result_ivar = Ivar.create () in @@ -914,17 +918,21 @@ let add_transactions t (uc_inputs : User_command_input.t list) = Ivar.read result_ivar let add_full_transactions t user_command = + let config = config t in let slot = - Consensus.Data.Consensus_time.to_global_slot - (Consensus.Data.Consensus_time.of_time_exn - ~constants:(config t).precomputed_values.consensus_constants - (Block_time.now (config t).time_controller) ) + Consensus.Data.Consensus_time.( + to_global_slot + (of_time_exn ~constants:config.precomputed_values.consensus_constants + (Block_time.now config.time_controller) )) in - match (config t).slot_tx_end with - | Some slot_tx_end when Account_nonce.(slot >= slot_tx_end) -> + match config.slot_tx_end with + | Some slot_tx_end when Global_slot.(slot >= slot_tx_end) -> [%log' warn (top_level_logger t)] "can't add transactions at slot $slot, tx production ends at $end" - ~metadata:[ ("slot", `Int (Account_nonce.to_int slot)); ("end", `Int (Account_nonce.to_int slot_tx_end)) ] ; + ~metadata: + [ ("slot", `Int (Global_slot.to_int slot)) + ; ("end", `Int (Global_slot.to_int slot_tx_end)) + ] ; Deferred.return (Error (Error.of_string "tx production has ended")) | Some _ | None -> let result_ivar = Ivar.create () in @@ -1617,7 +1625,8 @@ let create ?wallets (config : Config.t) = (* make transaction pool return writer for local and incoming diffs *) Network_pool.Transaction_pool.create ~config:txn_pool_config ~constraint_constants ~consensus_constants - ~time_controller:config.time_controller ~slot_tx_end:config.slot_tx_end ~logger:config.logger + ~time_controller:config.time_controller + ~slot_tx_end:config.slot_tx_end ~logger:config.logger ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~on_remote_push:notify_online ~log_gossip_heard: @@ -1631,7 +1640,8 @@ let create ?wallets (config : Config.t) = let%bind snark_pool, snark_remote_sink, snark_local_sink = Network_pool.Snark_pool.load ~config:snark_pool_config ~constraint_constants ~consensus_constants - ~time_controller:config.time_controller ~slot_tx_end:config.slot_tx_end ~logger:config.logger + ~time_controller:config.time_controller + ~slot_tx_end:config.slot_tx_end ~logger:config.logger ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~on_remote_push:notify_online ~log_gossip_heard: diff --git a/src/lib/network_pool/indexed_pool.ml b/src/lib/network_pool/indexed_pool.ml index 812dc8f9219..e9c08d86ce2 100644 --- a/src/lib/network_pool/indexed_pool.ml +++ b/src/lib/network_pool/indexed_pool.ml @@ -47,7 +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 : Account_nonce.t option + ; slot_tx_end : Global_slot.t option } [@@deriving sexp_of, equal, compare] @@ -749,13 +749,14 @@ let rec add_from_gossip_exn : } as t ) ~verify cmd0 current_nonce balance -> let open Command_error in let open Result.Let_syntax in - let slot = - Consensus.Data.Consensus_time.to_global_slot - (Consensus.Data.Consensus_time.of_time_exn ~constants:consensus_constants - (Block_time.now time_controller) ) + 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 Account_nonce.(slot >= slot_tx_end') -> + | Some slot_tx_end' when Global_slot.(current_global_slot >= slot_tx_end') -> Error After_slot_tx_end | Some _ | None -> ( let unchecked_cmd = @@ -1270,8 +1271,8 @@ let%test_module _ = current_global_slot valid_until () | Error After_slot_tx_end -> failwith - "Transaction was submitted after th slot defined to stop \ - accepting transactions" ) + "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 bd9816670a3..10b129e0aeb 100644 --- a/src/lib/network_pool/indexed_pool.mli +++ b/src/lib/network_pool/indexed_pool.mli @@ -43,7 +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:Account_nonce.t option + -> slot_tx_end:Global_slot.t option -> t (** How many transactions are currently in the pool *) @@ -141,7 +141,7 @@ val revalidate : val current_global_slot : t -> Mina_numbers.Global_slot.t (** Get the slot at which transactions are no longer accepted. *) -val slot_tx_end : t -> Account_nonce.t option +val slot_tx_end : t -> Global_slot.t option (** Empties the pool *) val drop_all : t -> t diff --git a/src/lib/network_pool/intf.ml b/src/lib/network_pool/intf.ml index 55f861869c6..032ca2efa71 100644 --- a/src/lib/network_pool/intf.ml +++ b/src/lib/network_pool/intf.ml @@ -29,7 +29,7 @@ module type Resource_pool_base_intf = sig constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t - -> slot_tx_end:Mina_numbers.Account_nonce.t option + -> slot_tx_end:Mina_numbers.Global_slot.t option -> frontier_broadcast_pipe: transition_frontier Option.t Broadcast_pipe.Reader.t -> config:Config.t @@ -180,7 +180,7 @@ module type Network_pool_base_intf = sig -> constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t - -> slot_tx_end:Mina_numbers.Account_nonce.t option + -> slot_tx_end:Mina_numbers.Global_slot.t option -> frontier_broadcast_pipe: transition_frontier Option.t Broadcast_pipe.Reader.t -> logger:Logger.t diff --git a/src/lib/network_pool/snark_pool.ml b/src/lib/network_pool/snark_pool.ml index 844a4f4991a..ecb491ea7b2 100644 --- a/src/lib/network_pool/snark_pool.ml +++ b/src/lib/network_pool/snark_pool.ml @@ -103,7 +103,7 @@ module type S = sig -> constraint_constants:Genesis_constants.Constraint_constants.t -> consensus_constants:Consensus.Constants.t -> time_controller:Block_time.Controller.t - -> slot_tx_end:Mina_numbers.Account_nonce.t option + -> slot_tx_end:Mina_numbers.Global_slot.t option -> frontier_broadcast_pipe: transition_frontier option Broadcast_pipe.Reader.t -> log_gossip_heard:bool @@ -382,8 +382,9 @@ struct in Deferred.don't_wait_for tf_deferred - let create ~constraint_constants ~consensus_constants:_ ~time_controller:_ ~slot_tx_end:_ - ~frontier_broadcast_pipe ~config ~logger ~tf_diff_writer = + let create ~constraint_constants ~consensus_constants:_ ~time_controller:_ + ~slot_tx_end:_ ~frontier_broadcast_pipe ~config ~logger + ~tf_diff_writer = let t = { snark_tables = { all = Statement_table.create () @@ -675,8 +676,8 @@ struct res | Error _e -> create ~config ~logger ~constraint_constants ~consensus_constants - ~time_controller ~slot_tx_end ~frontier_broadcast_pipe ~log_gossip_heard - ~on_remote_push + ~time_controller ~slot_tx_end ~frontier_broadcast_pipe + ~log_gossip_heard ~on_remote_push in store_periodically (resource_pool pool) ; (pool, r_sink, l_sink) @@ -1133,8 +1134,8 @@ let%test_module "random set test" = let open Deferred.Let_syntax in let network_pool, _, _ = Mock_snark_pool.create ~logger:(Logger.null ()) ~config - ~constraint_constants ~consensus_constants ~time_controller ~slot_tx_end - ~frontier_broadcast_pipe:frontier_broadcast_pipe_r + ~constraint_constants ~consensus_constants ~time_controller + ~slot_tx_end ~frontier_broadcast_pipe:frontier_broadcast_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in let resource_pool = Mock_snark_pool.resource_pool network_pool in From 0361568d482a3ba2bd9e8840b381ac84ae928744 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Thu, 31 Aug 2023 14:49:22 +0000 Subject: [PATCH 09/10] Add tests --- src/lib/network_pool/transaction_pool.ml | 613 +++++++++++++---------- 1 file changed, 360 insertions(+), 253 deletions(-) diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 846e7bc9256..206a9beabbb 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -446,255 +446,6 @@ struct versa so those hashtables remain in sync with reality. *) let global_slot = Indexed_pool.current_global_slot t.pool in - t.best_tip_ledger <- Some best_tip_ledger ; - let pool_max_size = t.config.pool_max_size in - let log_indexed_pool_error error_str ~metadata cmd = - [%log' debug t.logger] - "Couldn't re-add locally generated command $cmd, not valid against \ - new ledger. Error: $error" - ~metadata: - ( [ ( "cmd" - , Transaction_hash.User_command_with_valid_signature.to_yojson - cmd ) - ; ("error", `String error_str) - ] - @ metadata ) - in - [%log' trace t.logger] - ~metadata: - [ ( "removed" - , `List - (List.map removed_commands - ~f:(With_status.to_yojson User_command.Valid.to_yojson) ) ) - ; ( "added" - , `List - (List.map new_commands - ~f:(With_status.to_yojson User_command.Valid.to_yojson) ) ) - ] - "Diff: removed: $removed added: $added from best tip" ; - let pool', dropped_backtrack = - Sequence.fold - ( removed_commands |> List.rev |> Sequence.of_list - |> Sequence.map ~f:(fun unchecked -> - unchecked.data - |> Transaction_hash.User_command_with_valid_signature.create ) - ) - ~init:(t.pool, Sequence.empty) - ~f:(fun (pool, dropped_so_far) cmd -> - ( match - Hashtbl.find_and_remove t.locally_generated_committed cmd - with - | None -> - () - | Some time_added -> - Hashtbl.add_exn t.locally_generated_uncommitted ~key:cmd - ~data:time_added ) ; - let pool', dropped_seq = - match cmd |> Indexed_pool.add_from_backtrack pool with - | Error e -> - let error_str, metadata = of_indexed_pool_error e in - log_indexed_pool_error error_str ~metadata cmd ; - (pool, Sequence.empty) - | Ok indexed_pool -> - drop_until_below_max_size ~pool_max_size indexed_pool - in - (pool', Sequence.append dropped_so_far dropped_seq) ) - in - (* Track what locally generated commands were removed from the pool - during backtracking due to the max size constraint. *) - let locally_generated_dropped = - Sequence.filter dropped_backtrack - ~f:(Hashtbl.mem t.locally_generated_uncommitted) - |> Sequence.to_list_rev - in - if not (List.is_empty locally_generated_dropped) then - [%log' debug t.logger] - "Dropped locally generated commands $cmds during backtracking to \ - maintain max size. Will attempt to re-add after forwardtracking." - ~metadata: - [ ( "cmds" - , `List - (List.map - ~f: - Transaction_hash.User_command_with_valid_signature - .to_yojson locally_generated_dropped ) ) - ] ; - let pool'', dropped_commit_conflicts = - List.fold new_commands ~init:(pool', Sequence.empty) - ~f:(fun (p, dropped_so_far) cmd -> - let balance account_id = - match - Base_ledger.location_of_account best_tip_ledger account_id - with - | None -> - (Currency.Amount.zero, Mina_base.Account.Nonce.zero) - | Some loc -> - let acc = - Option.value_exn - ~message:"public key has location but no account" - (Base_ledger.get best_tip_ledger loc) - in - ( Currency.Balance.to_amount - (balance_of_account ~global_slot acc) - , acc.nonce ) - in - let fee_payer = User_command.(fee_payer (forget_check cmd.data)) in - let fee_payer_balance, fee_payer_nonce = balance fee_payer in - let cmd' = - Transaction_hash.User_command_with_valid_signature.create cmd.data - in - ( match - Hashtbl.find_and_remove t.locally_generated_uncommitted cmd' - with - | None -> - () - | Some time_added -> - [%log' info t.logger] - "Locally generated command $cmd committed in a block!" - ~metadata: - [ ( "cmd" - , With_status.to_yojson User_command.Valid.to_yojson cmd - ) - ] ; - Hashtbl.add_exn t.locally_generated_committed ~key:cmd' - ~data:time_added ) ; - let p', dropped = - match - Indexed_pool.handle_committed_txn p cmd' ~fee_payer_balance - ~fee_payer_nonce - with - | Ok res -> - res - | Error (`Queued_txns_by_sender (error_str, queued_cmds)) -> - [%log' error t.logger] - "Error handling committed transaction $cmd: $error " - ~metadata: - [ ( "cmd" - , With_status.to_yojson User_command.Valid.to_yojson cmd - ) - ; ("error", `String error_str) - ; ( "queue" - , `List - (List.map (Sequence.to_list queued_cmds) - ~f:(fun c -> - Transaction_hash - .User_command_with_valid_signature - .to_yojson c ) ) ) - ] ; - failwith error_str - in - (p', Sequence.append dropped_so_far dropped) ) - in - let commit_conflicts_locally_generated = - Sequence.filter dropped_commit_conflicts ~f:(fun cmd -> - Hashtbl.find_and_remove t.locally_generated_uncommitted cmd - |> Option.is_some ) - in - if not @@ Sequence.is_empty commit_conflicts_locally_generated then - [%log' info t.logger] - "Locally generated commands $cmds dropped because they conflicted \ - with a committed command." - ~metadata: - [ ( "cmds" - , `List - (Sequence.to_list - (Sequence.map commit_conflicts_locally_generated - ~f: - Transaction_hash.User_command_with_valid_signature - .to_yojson ) ) ) - ] ; - [%log' debug t.logger] - !"Finished handling diff. Old pool size %i, new pool size %i. Dropped \ - %i commands during backtracking to maintain max size." - (Indexed_pool.size t.pool) (Indexed_pool.size pool'') - (Sequence.length dropped_backtrack) ; - Mina_metrics.( - Gauge.set Transaction_pool.pool_size - (Float.of_int (Indexed_pool.size pool''))) ; - t.pool <- pool'' ; - List.iter locally_generated_dropped ~f:(fun cmd -> - (* If the dropped transaction was included in the winning chain, it'll - be in locally_generated_committed. If it wasn't, try re-adding to - the pool. *) - let remove_cmd () = - assert ( - Option.is_some - @@ Hashtbl.find_and_remove t.locally_generated_uncommitted cmd ) - in - let log_and_remove ?(metadata = []) error_str = - log_indexed_pool_error error_str ~metadata cmd ; - remove_cmd () - in - if not (Hashtbl.mem t.locally_generated_committed cmd) then - if - not - (has_sufficient_fee t.pool - (Transaction_hash.User_command_with_valid_signature.command - cmd ) - ~pool_max_size ) - then ( - [%log' info t.logger] - "Not re-adding locally generated command $cmd to pool, \ - insufficient fee" - ~metadata: - [ ( "cmd" - , Transaction_hash.User_command_with_valid_signature - .to_yojson cmd ) - ] ; - remove_cmd () ) - else - let unchecked = - Transaction_hash.User_command_with_valid_signature.command cmd - in - match - Option.bind - (Base_ledger.location_of_account best_tip_ledger - (User_command.fee_payer unchecked) ) - ~f:(Base_ledger.get best_tip_ledger) - with - | Some acct -> ( - match - Indexed_pool.add_from_gossip_exn t.pool (`Checked cmd) - acct.nonce ~verify:check_command - ( balance_of_account ~global_slot acct - |> Currency.Balance.to_amount ) - with - | Error e -> - let error_str, metadata = of_indexed_pool_error e in - log_and_remove error_str - ~metadata: - ( ("user_command", User_command.to_yojson unchecked) - :: metadata ) - | Ok (_, pool''', _) -> - [%log' debug t.logger] - "re-added locally generated command $cmd to \ - transaction pool after reorg" - ~metadata: - [ ( "cmd" - , Transaction_hash.User_command_with_valid_signature - .to_yojson cmd ) - ] ; - Mina_metrics.( - Gauge.set Transaction_pool.pool_size - (Float.of_int (Indexed_pool.size pool'''))) ; - t.pool <- pool''' ) - | None -> - log_and_remove "Fee_payer_account not found" - ~metadata: - [ ("user_command", User_command.to_yojson unchecked) ] ) ; - (*Remove any expired user commands*) - let expired_commands, pool = Indexed_pool.remove_expired t.pool in - Sequence.iter expired_commands ~f:(fun cmd -> - [%log' debug t.logger] - "Dropping expired user command from the pool $cmd" - ~metadata: - [ ( "cmd" - , Transaction_hash.User_command_with_valid_signature.to_yojson - cmd ) - ] ; - ignore - ( Hashtbl.find_and_remove t.locally_generated_uncommitted cmd - : (Time.t * [ `Batch of int ]) option ) ) ; let pool = match Indexed_pool.slot_tx_end t.pool with | Some slot_tx_end @@ -711,6 +462,268 @@ struct Hashtbl.clear t.locally_generated_committed ; Indexed_pool.drop_all t.pool | None | Some _ -> + t.best_tip_ledger <- Some best_tip_ledger ; + let pool_max_size = t.config.pool_max_size in + let log_indexed_pool_error error_str ~metadata cmd = + [%log' debug t.logger] + "Couldn't re-add locally generated command $cmd, not valid \ + against new ledger. Error: $error" + ~metadata: + ( [ ( "cmd" + , Transaction_hash.User_command_with_valid_signature + .to_yojson cmd ) + ; ("error", `String error_str) + ] + @ metadata ) + in + [%log' trace t.logger] + ~metadata: + [ ( "removed" + , `List + (List.map removed_commands + ~f:(With_status.to_yojson User_command.Valid.to_yojson) ) + ) + ; ( "added" + , `List + (List.map new_commands + ~f:(With_status.to_yojson User_command.Valid.to_yojson) ) + ) + ] + "Diff: removed: $removed added: $added from best tip" ; + let pool', dropped_backtrack = + Sequence.fold + ( removed_commands |> List.rev |> Sequence.of_list + |> Sequence.map ~f:(fun unchecked -> + unchecked.data + |> Transaction_hash.User_command_with_valid_signature + .create ) ) + ~init:(t.pool, Sequence.empty) + ~f:(fun (pool, dropped_so_far) cmd -> + ( match + Hashtbl.find_and_remove t.locally_generated_committed cmd + with + | None -> + () + | Some time_added -> + Hashtbl.add_exn t.locally_generated_uncommitted ~key:cmd + ~data:time_added ) ; + let pool', dropped_seq = + match cmd |> Indexed_pool.add_from_backtrack pool with + | Error e -> + let error_str, metadata = of_indexed_pool_error e in + log_indexed_pool_error error_str ~metadata cmd ; + (pool, Sequence.empty) + | Ok indexed_pool -> + drop_until_below_max_size ~pool_max_size indexed_pool + in + (pool', Sequence.append dropped_so_far dropped_seq) ) + in + (* Track what locally generated commands were removed from the pool + during backtracking due to the max size constraint. *) + let locally_generated_dropped = + Sequence.filter dropped_backtrack + ~f:(Hashtbl.mem t.locally_generated_uncommitted) + |> Sequence.to_list_rev + in + if not (List.is_empty locally_generated_dropped) then + [%log' debug t.logger] + "Dropped locally generated commands $cmds during backtracking \ + to maintain max size. Will attempt to re-add after \ + forwardtracking." + ~metadata: + [ ( "cmds" + , `List + (List.map + ~f: + Transaction_hash.User_command_with_valid_signature + .to_yojson locally_generated_dropped ) ) + ] ; + let pool'', dropped_commit_conflicts = + List.fold new_commands ~init:(pool', Sequence.empty) + ~f:(fun (p, dropped_so_far) cmd -> + let balance account_id = + match + Base_ledger.location_of_account best_tip_ledger account_id + with + | None -> + (Currency.Amount.zero, Mina_base.Account.Nonce.zero) + | Some loc -> + let acc = + Option.value_exn + ~message:"public key has location but no account" + (Base_ledger.get best_tip_ledger loc) + in + ( Currency.Balance.to_amount + (balance_of_account ~global_slot acc) + , acc.nonce ) + in + let fee_payer = + User_command.(fee_payer (forget_check cmd.data)) + in + let fee_payer_balance, fee_payer_nonce = balance fee_payer in + let cmd' = + Transaction_hash.User_command_with_valid_signature.create + cmd.data + in + ( match + Hashtbl.find_and_remove t.locally_generated_uncommitted + cmd' + with + | None -> + () + | Some time_added -> + [%log' info t.logger] + "Locally generated command $cmd committed in a block!" + ~metadata: + [ ( "cmd" + , With_status.to_yojson User_command.Valid.to_yojson + cmd ) + ] ; + Hashtbl.add_exn t.locally_generated_committed ~key:cmd' + ~data:time_added ) ; + let p', dropped = + match + Indexed_pool.handle_committed_txn p cmd' + ~fee_payer_balance ~fee_payer_nonce + with + | Ok res -> + res + | Error (`Queued_txns_by_sender (error_str, queued_cmds)) -> + [%log' error t.logger] + "Error handling committed transaction $cmd: $error " + ~metadata: + [ ( "cmd" + , With_status.to_yojson + User_command.Valid.to_yojson cmd ) + ; ("error", `String error_str) + ; ( "queue" + , `List + (List.map (Sequence.to_list queued_cmds) + ~f:(fun c -> + Transaction_hash + .User_command_with_valid_signature + .to_yojson c ) ) ) + ] ; + failwith error_str + in + (p', Sequence.append dropped_so_far dropped) ) + in + let commit_conflicts_locally_generated = + Sequence.filter dropped_commit_conflicts ~f:(fun cmd -> + Hashtbl.find_and_remove t.locally_generated_uncommitted cmd + |> Option.is_some ) + in + if not @@ Sequence.is_empty commit_conflicts_locally_generated then + [%log' info t.logger] + "Locally generated commands $cmds dropped because they \ + conflicted with a committed command." + ~metadata: + [ ( "cmds" + , `List + (Sequence.to_list + (Sequence.map commit_conflicts_locally_generated + ~f: + Transaction_hash + .User_command_with_valid_signature + .to_yojson ) ) ) + ] ; + [%log' debug t.logger] + !"Finished handling diff. Old pool size %i, new pool size %i. \ + Dropped %i commands during backtracking to maintain max size." + (Indexed_pool.size t.pool) (Indexed_pool.size pool'') + (Sequence.length dropped_backtrack) ; + Mina_metrics.( + Gauge.set Transaction_pool.pool_size + (Float.of_int (Indexed_pool.size pool''))) ; + t.pool <- pool'' ; + List.iter locally_generated_dropped ~f:(fun cmd -> + (* If the dropped transaction was included in the winning chain, it'll + be in locally_generated_committed. If it wasn't, try re-adding to + the pool. *) + let remove_cmd () = + assert ( + Option.is_some + @@ Hashtbl.find_and_remove t.locally_generated_uncommitted + cmd ) + in + let log_and_remove ?(metadata = []) error_str = + log_indexed_pool_error error_str ~metadata cmd ; + remove_cmd () + in + if not (Hashtbl.mem t.locally_generated_committed cmd) then + if + not + (has_sufficient_fee t.pool + (Transaction_hash.User_command_with_valid_signature + .command cmd ) + ~pool_max_size ) + then ( + [%log' info t.logger] + "Not re-adding locally generated command $cmd to pool, \ + insufficient fee" + ~metadata: + [ ( "cmd" + , Transaction_hash.User_command_with_valid_signature + .to_yojson cmd ) + ] ; + remove_cmd () ) + else + let unchecked = + Transaction_hash.User_command_with_valid_signature.command + cmd + in + match + Option.bind + (Base_ledger.location_of_account best_tip_ledger + (User_command.fee_payer unchecked) ) + ~f:(Base_ledger.get best_tip_ledger) + with + | Some acct -> ( + match + Indexed_pool.add_from_gossip_exn t.pool (`Checked cmd) + acct.nonce ~verify:check_command + ( balance_of_account ~global_slot acct + |> Currency.Balance.to_amount ) + with + | Error e -> + let error_str, metadata = of_indexed_pool_error e in + log_and_remove error_str + ~metadata: + ( ( "user_command" + , User_command.to_yojson unchecked ) + :: metadata ) + | Ok (_, pool''', _) -> + [%log' debug t.logger] + "re-added locally generated command $cmd to \ + transaction pool after reorg" + ~metadata: + [ ( "cmd" + , Transaction_hash + .User_command_with_valid_signature + .to_yojson cmd ) + ] ; + Mina_metrics.( + Gauge.set Transaction_pool.pool_size + (Float.of_int (Indexed_pool.size pool'''))) ; + t.pool <- pool''' ) + | None -> + log_and_remove "Fee_payer_account not found" + ~metadata: + [ ("user_command", User_command.to_yojson unchecked) + ] ) ; + (*Remove any expired user commands*) + let expired_commands, pool = Indexed_pool.remove_expired t.pool in + Sequence.iter expired_commands ~f:(fun cmd -> + [%log' debug t.logger] + "Dropping expired user command from the pool $cmd" + ~metadata: + [ ( "cmd" + , Transaction_hash.User_command_with_valid_signature + .to_yojson cmd ) + ] ; + ignore + ( Hashtbl.find_and_remove t.locally_generated_uncommitted cmd + : (Time.t * [ `Batch of int ]) option ) ) ; pool in Mina_metrics.( @@ -1514,8 +1527,6 @@ let%test_module _ = let time_controller = Block_time.Controller.basic ~logger - let slot_tx_end = None - let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants @@ -1596,7 +1607,7 @@ 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 @@ -2057,7 +2068,7 @@ let%test_module _ = in let pool_, _, _ = Test.create ~config ~logger ~constraint_constants - ~consensus_constants ~time_controller ~slot_tx_end + ~consensus_constants ~time_controller ~slot_tx_end:None ~frontier_broadcast_pipe:frontier_pipe_r ~log_gossip_heard:false ~on_remote_push:(Fn.const Deferred.unit) in @@ -2103,6 +2114,102 @@ let%test_module _ = assert_pool_txs @@ List.drop independent_cmds' 3 ; 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.(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: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 ) + + let%test_unit "transactions from the pool are removed when the transition \ + frontier is recreated and current slot is after slot_tx_end" + = + Thread_safe.block_on_async_exn (fun () -> + (* Set up initial frontier *) + let frontier_pipe_r, frontier_pipe_w = Broadcast_pipe.create None in + let trust_system = Trust_system.null () in + let config = + Test.Resource_pool.make_config ~trust_system ~pool_max_size + ~verifier + in + let current_global_slot = current_global_slot () in + let pool_, _, _ = + Test.create ~config ~logger ~constraint_constants + ~consensus_constants ~time_controller + ~slot_tx_end: + (Some Mina_numbers.Global_slot.(succ current_global_slot)) + ~frontier_broadcast_pipe:frontier_pipe_r ~log_gossip_heard:false + ~on_remote_push:(Fn.const Deferred.unit) + in + let pool = Test.resource_pool pool_ in + let assert_pool_txs txs = + [%test_eq: User_command.t List.t] + ( Test.Resource_pool.transactions ~logger pool + |> Sequence.map + ~f:Transaction_hash.User_command_with_valid_signature.command + |> Sequence.to_list + |> List.sort ~compare:User_command.compare ) + @@ List.sort ~compare:User_command.compare txs + in + assert_pool_txs [] ; + let frontier1, best_tip_diff_w1 = + Mock_transition_frontier.create () + in + let%bind _ = + Broadcast_pipe.Writer.write frontier_pipe_w (Some frontier1) + in + let%bind _ = + Test.Resource_pool.Diff.unsafe_apply pool + (Envelope.Incoming.local + (extract_signed_commands independent_cmds) ) + in + assert_pool_txs independent_cmds' ; + (* Destroy initial frontier *) + Broadcast_pipe.Writer.close best_tip_diff_w1 ; + let%bind _ = Broadcast_pipe.Writer.write frontier_pipe_w None in + (* wait until next slot *) + let%bind () = + after + (Block_time.Span.to_time_span + consensus_constants.block_window_duration_ms ) + in + (* Set up second frontier *) + let frontier2, _best_tip_diff_w2 = + Mock_transition_frontier.create () + in + let%bind _ = + Broadcast_pipe.Writer.write frontier_pipe_w (Some frontier2) + in + assert_pool_txs [] ; Deferred.unit ) + let%test_unit "transaction replacement works" = Thread_safe.block_on_async_exn @@ fun () -> From 61d773cf51cf8c88dc8211e640d8f591be5fbedb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Santos=20Reis?= Date: Thu, 7 Sep 2023 09:00:45 +0000 Subject: [PATCH 10/10] Fix transaction pool types versioning --- src/lib/network_pool/transaction_pool.ml | 56 +++++++++++++++++++++++- 1 file changed, 54 insertions(+), 2 deletions(-) diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 206a9beabbb..5fe1ad9c3ec 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 @@ -84,6 +84,49 @@ module Diff_versioned = struct 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 @@ -145,11 +188,20 @@ module Diff_versioned = struct module Stable = struct [@@@no_toplevel_latest_type] + module V2 = struct + type t = (User_command.Stable.V1.t * Diff_error.Stable.V2.t) list + [@@deriving sexp, yojson] + + let to_latest = Fn.id + end + module V1 = struct type t = (User_command.Stable.V1.t * Diff_error.Stable.V1.t) list [@@deriving sexp, yojson] - let to_latest = Fn.id + let to_latest = + List.map ~f:(fun (cmds, diff) -> + (cmds, Diff_error.Stable.V1.to_latest diff) ) end end]