[Tokens] Simplify transaction pool (#5252)

* Do not evict commands based on source balance

This is inherently racy, and the logic no longer applies when the
account differs from the fee_payer account. These failures are captured
in the snark, where the fee_payer is still charged but no other part of
the transaction is processed.

* Remove receiver checks in the transaction pool

These failures are checked in the snark and transaction logic. When they
appear, the fee is still charged to compensate the network, but the
transaction itself fails.

* Store constraint_constants in the indexed pool

This is used by tokens commands to calculate the account creation fee
(which is charged to the fee-payer).

src/lib/network_pool/indexed_pool.ml

@@ -37,7 +37,8 @@ type t =
             Ordered by nonce inside the accounts. *)
   ; all_by_fee: User_command.With_valid_signature.Set.t Currency.Fee.Map.t
         (** All transactions in the pool indexed by fee. *)
-  ; size: int }
+  ; size: int
+  ; constraint_constants: Genesis_constants.Constraint_constants.t }
 [@@deriving sexp_of]
 
 (* Compute the total currency required from the sender to execute a command.
@@ -73,7 +74,11 @@ module For_tests = struct
   (* Check the invariants of the pool structure as listed in the comment above.
   *)
   let assert_invariants : t -> unit =
-   fun {applicable_by_fee; all_by_sender; all_by_fee; size} ->
+   fun { applicable_by_fee
+       ; all_by_sender
+       ; all_by_fee
+       ; size
+       ; constraint_constants= _ } ->
     let assert_all_by_fee tx =
       if
         Set.mem
@@ -167,11 +172,12 @@ module For_tests = struct
       size
 end
 
-let empty : t =
+let empty ~constraint_constants : t =
   { applicable_by_fee= Currency.Fee.Map.empty
   ; all_by_sender= Account_id.Map.empty
   ; all_by_fee= Currency.Fee.Map.empty
-  ; size= 0 }
+  ; size= 0
+  ; constraint_constants }
 
 let size : t -> int = fun t -> t.size
 
@@ -353,15 +359,13 @@ let handle_committed_txn :
        t
     -> User_command.With_valid_signature.t
     -> fee_payer_balance:Currency.Amount.t
-    -> source_balance:Currency.Amount.t
     -> ( t * User_command.With_valid_signature.t Sequence.t
        , [ `Queued_txns_by_sender of
            string * User_command.With_valid_signature.t Sequence.t ] )
        Result.t =
- fun t committed ~fee_payer_balance ~source_balance ->
+ fun t committed ~fee_payer_balance ->
   let committed' = User_command.forget_check committed in
   let fee_payer = User_command.fee_payer committed' in
-  let source = User_command.source committed' in
   let nonce_to_remove = User_command.nonce committed' in
   match Map.find t.all_by_sender fee_payer with
   | None ->
@@ -420,47 +424,13 @@ let handle_committed_txn :
         let t3 =
           set_all_by_sender fee_payer new_queued_cmds currency_reserved'' t2
         in
-        let t4, source_dropped_cmds =
-          if Account_id.equal source fee_payer then (t3, Sequence.empty)
-          else
-            match Map.find t.all_by_sender source with
-            | None ->
-                (t3, Sequence.empty)
-            | Some (source_cmds, currency_reserved) ->
-                (* The command may have decreased the balance of the source
-                   account, drop any commands that no longer have sufficient
-                   balance to execute.
-                *)
-                let new_queued_cmds, currency_reserved, dropped_cmds =
-                  drop_until_sufficient_balance
-                    (source_cmds, currency_reserved)
-                    source_balance
-                in
-                let t3' =
-                  if F_sequence.is_empty new_queued_cmds then t3
-                  else
-                    let first_cmd = F_sequence.head_exn source_cmds in
-                    t3
-                    |> Fn.flip remove_applicable_exn first_cmd
-                    |> Fn.flip remove_all_by_fee_exn first_cmd
-                in
-                let t3'' =
-                  Sequence.fold dropped_cmds ~init:t3' ~f:remove_all_by_fee_exn
-                in
-                ( set_all_by_sender source new_queued_cmds currency_reserved
-                    t3''
-                , dropped_cmds )
-        in
         Ok
-          ( t4
+          ( t3
           , Sequence.append
-              (Sequence.append
-                 ( if
-                   User_command.With_valid_signature.equal committed first_cmd
-                 then Sequence.empty
-                 else Sequence.singleton first_cmd )
-                 dropped_cmds)
-              source_dropped_cmds )
+              ( if User_command.With_valid_signature.equal committed first_cmd
+              then Sequence.empty
+              else Sequence.singleton first_cmd )
+              dropped_cmds )
 
 let remove_lowest_fee : t -> User_command.With_valid_signature.t Sequence.t * t
     =
@@ -508,7 +478,7 @@ let rec add_from_gossip_exn :
            [`Replace_fee of Currency.Fee.t] * Currency.Fee.t
          | `Overflow ] )
        Result.t =
- fun t cmd current_nonce balance ->
+ fun ({constraint_constants; _} as t) cmd current_nonce balance ->
   let unchecked = User_command.forget_check cmd in
   let fee = User_command.fee unchecked in
   let fee_payer = User_command.fee_payer unchecked in
@@ -545,7 +515,8 @@ let rec add_from_gossip_exn :
               Map_set.insert
                 (module User_command.With_valid_signature)
                 t.all_by_fee fee cmd
-          ; size= t.size + 1 }
+          ; size= t.size + 1
+          ; constraint_constants }
         , Sequence.empty )
   | Some (queued_cmds, reserved_currency) -> (
       (* commands queued for this sender *)
@@ -648,7 +619,7 @@ let rec add_from_gossip_exn :
             failwith "recursive add_exn failed" )
 
 let add_from_backtrack : t -> User_command.With_valid_signature.t -> t =
- fun t cmd ->
+ fun ({constraint_constants; _} as t) cmd ->
   let unchecked = User_command.forget_check cmd in
   let fee_payer = User_command.fee_payer unchecked in
   let fee = User_command.fee unchecked in
@@ -669,7 +640,8 @@ let add_from_backtrack : t -> User_command.With_valid_signature.t -> t =
           Map_set.insert
             (module User_command.With_valid_signature)
             t.applicable_by_fee fee cmd
-      ; size= t.size + 1 }
+      ; size= t.size + 1
+      ; constraint_constants }
   | Some (queue, currency_reserved) ->
       let first_queued = F_sequence.head_exn queue in
       if
@@ -699,7 +671,8 @@ let add_from_backtrack : t -> User_command.With_valid_signature.t -> t =
               ( F_sequence.cons cmd queue
               , Option.value_exn Currency.Amount.(currency_reserved + consumed)
               )
-      ; size= t.size + 1 }
+      ; size= t.size + 1
+      ; constraint_constants }
 
 let%test_module _ =
   ( module struct
@@ -711,6 +684,12 @@ let%test_module _ =
       User_command.With_valid_signature.Gen.payment_with_random_participants
         ~keys:test_keys ~max_amount:1000 ~max_fee:10
 
+    let precomputed_values = Lazy.force Precomputed_values.for_unit_tests
+
+    let constraint_constants = precomputed_values.constraint_constants
+
+    let empty = empty ~constraint_constants
+
     let%test_unit "empty invariants" = assert_invariants empty
 
     let%test_unit "singleton properties" =

src/lib/network_pool/indexed_pool.mli

@@ -16,7 +16,7 @@ type t [@@deriving sexp_of]
 (* TODO sexp is debug only, remove *)
 
 (** Empty pool *)
-val empty : t
+val empty : constraint_constants:Genesis_constants.Constraint_constants.t -> t
 
 (** How many transactions are currently in the pool *)
 val size : t -> int
@@ -43,7 +43,6 @@ val handle_committed_txn :
      t
   -> User_command.With_valid_signature.t
   -> fee_payer_balance:Currency.Amount.t
-  -> source_balance:Currency.Amount.t
   -> ( t * User_command.With_valid_signature.t Sequence.t
      , [ `Queued_txns_by_sender of
          string * User_command.With_valid_signature.t Sequence.t ] )

src/lib/network_pool/intf.ml

@@ -24,7 +24,8 @@ module type Resource_pool_base_intf = sig
     transition_frontier_diff -> t -> unit Deferred.t
 
   val create :
-       frontier_broadcast_pipe:transition_frontier Option.t
+       constraint_constants:Genesis_constants.Constraint_constants.t
+    -> frontier_broadcast_pipe:transition_frontier Option.t
                                Broadcast_pipe.Reader.t
     -> config:Config.t
     -> logger:Logger.t
@@ -53,8 +54,7 @@ module type Resource_pool_diff_intf = sig
   conincides with applying locally generated diffs or diffs from the network
   or diffs from transition frontier extensions.*)
   val unsafe_apply :
-       constraint_constants:Genesis_constants.Constraint_constants.t
-    -> pool
+       pool
     -> t Envelope.Incoming.t
     -> ( t * rejected
        , [`Locally_generated of t * rejected | `Other of Error.t] )
@@ -228,8 +228,6 @@ module type Transaction_pool_diff_intf = sig
       | Invalid_signature
       | Duplicate
       | Sender_account_does_not_exist
-      | Insufficient_amount_for_account_creation
-      | Delegate_not_found
       | Invalid_nonce
       | Insufficient_funds
       | Insufficient_fee

src/lib/network_pool/network_pool_base.ml

@@ -41,10 +41,7 @@ end)
         valid_cb true ;
         Linear_pipe.write t.write_broadcasts diff' )
     in
-    match%bind
-      Resource_pool.Diff.unsafe_apply
-        ~constraint_constants:t.constraint_constants t.resource_pool pool_diff
-    with
+    match%bind Resource_pool.Diff.unsafe_apply t.resource_pool pool_diff with
     | Ok res ->
         rebroadcast res
     | Error (`Locally_generated res) ->
@@ -141,8 +138,8 @@ end)
     in
     let t =
       of_resource_pool_and_diffs
-        (Resource_pool.create ~config ~logger ~frontier_broadcast_pipe
-           ~tf_diff_writer)
+        (Resource_pool.create ~constraint_constants ~config ~logger
+           ~frontier_broadcast_pipe ~tf_diff_writer)
         ~constraint_constants ~incoming_diffs ~local_diffs ~logger
         ~tf_diffs:tf_diff_reader
     in

src/lib/network_pool/snark_pool.ml

@@ -276,7 +276,8 @@ module Make (Transition_frontier : Transition_frontier_intf) :
         in
         Deferred.don't_wait_for tf_deferred
 
-      let create ~frontier_broadcast_pipe ~config ~logger ~tf_diff_writer =
+      let create ~constraint_constants:_ ~frontier_broadcast_pipe ~config
+          ~logger ~tf_diff_writer =
         let t =
           { snark_tables=
               { all= Statement_table.create ()
@@ -516,8 +517,7 @@ let%test_module "random set test" =
         Mock_snark_pool.Resource_pool.Diff.Add_solved_work
           (work, {Priced_proof.Stable.Latest.proof= proof work; fee})
       in
-      Mock_snark_pool.Resource_pool.Diff.unsafe_apply ~constraint_constants
-        resource_pool
+      Mock_snark_pool.Resource_pool.Diff.unsafe_apply resource_pool
         {Envelope.Incoming.data= diff; sender}
 
     let config verifier =

src/lib/network_pool/snark_pool_diff.ml

@@ -61,8 +61,7 @@ module Make
           ~f:Snark_work_lib.Work.Single.Spec.statement
       , {proof= res.proofs; fee= {fee= res.spec.fee; prover= res.prover}} )
 
-  let unsafe_apply ~constraint_constants:_ (pool : Pool.t)
-      (t : t Envelope.Incoming.t) =
+  let unsafe_apply (pool : Pool.t) (t : t Envelope.Incoming.t) =
     let {Envelope.Incoming.data= diff; sender} = t in
     let is_local = match sender with Local -> true | _ -> false in
     let to_or_error = function