[compatible] Add parameter to stop the chain after given slot

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))

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
@@ -1271,6 +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.Global_slot.of_int slot_tx_end
+          in
           let start_time = Time.now () in
           let%map coda =
             Mina_lib.create ~wallets
@@ -1301,7 +1310,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

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,24 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system
                   ( Header.protocol_state_proof
                   @@ Mina_block.header (With_hash.data previous_transition) )
             in
+            let current_global_slot =
+              Consensus.Data.Consensus_time.(
+                to_global_slot
+                  (of_time_exn ~constants:consensus_constants
+                     (Block_time.now time_controller) ))
+            in
             let 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 Mina_numbers.Global_slot.(
+                       current_global_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)

src/lib/mina_commands/mina_commands.ml

@@ -68,50 +68,86 @@ 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 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
-  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)]
+  match (Mina_lib.config t).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 transaction in slot $slot, tx production ends at $end"
         ~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
+          [ ("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
+      txn_count := !txn_count + 1 ;
+      match result with
+      | Ok ([], [ failed_txn ]) ->
+          Error
+            (Error.of_string
+               (sprintf !"%s"
+                  ( Network_pool.Transaction_pool.Resource_pool.Diff.Diff_error
+                    .to_yojson (snd failed_txn)
+                  |> Yojson.Safe.to_string ) ) )
+      | Ok ([ Signed_command txn ], []) ->
+          [%log' info (Mina_lib.top_level_logger t)]
+            ~metadata:
+              [ ("command", User_command.to_yojson (Signed_command txn)) ]
+            "Scheduled payment $command" ;
+          Ok txn
+      | Ok (valid_commands, invalid_commands) ->
+          [%log' info (Mina_lib.top_level_logger t)]
+            ~metadata:
+              [ ( "valid_commands"
+                , `List (List.map ~f:User_command.to_yojson valid_commands) )
+              ; ( "invalid_commands"
+                , `List
+                    (List.map
+                       ~f:
+                         (Fn.compose
+                            Network_pool.Transaction_pool.Resource_pool.Diff
+                            .Diff_error
+                            .to_yojson snd )
+                       invalid_commands ) )
+              ]
+            "Invalid result from scheduling a payment" ;
+          Error (Error.of_string "Internal error while scheduling a payment")
+      | Error e ->
+          Error e )
 
 let setup_and_submit_user_commands t user_command_list =
   let open Participating_state.Let_syntax in
   let%map _is_active = Mina_lib.active_or_bootstrapping t in
-  [%log' warn (Mina_lib.top_level_logger t)]
-    "batch-send-payments does not yet report errors"
-    ~metadata:
-      [ ("mina_command", `String "scheduling a batch of user transactions") ] ;
-  Mina_lib.add_transactions t user_command_list
+  let config = Mina_lib.config t in
+  let current_global_slot =
+    Consensus.Data.Consensus_time.(
+      to_global_slot
+        (of_time_exn ~constants:config.precomputed_values.consensus_constants
+           (Block_time.now config.time_controller) ))
+  in
+  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 (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)]
+        "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

src/lib/mina_lib/config.ml

@@ -59,5 +59,6 @@ type t =
   ; uptime_url : Uri.t option [@default None]
   ; uptime_submitter_keypair : Keypair.t option [@default None]
   ; stop_time : int
+  ; slot_tx_end : Mina_numbers.Global_slot.t option [@default None]
   }
 [@@deriving make]

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
@@ -893,18 +894,52 @@ 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 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.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 (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
+      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 config = config t in
+  let 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.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 (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
+      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 +1247,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
@@ -1589,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 ~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:
@@ -1603,7 +1640,8 @@ let create ?wallets (config : Config.t) =
           let snark_pool, snark_remote_sink, snark_local_sink =
             Network_pool.Snark_pool.create ~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: