Merge branch 'dkijania/transaction_pool_tests' into mrmr1993/transaction_pool_tests

Author: dkijania

src/lib/crypto/kimchi_backend/kimchi_backend.mli

@@ -164,6 +164,7 @@ module Pasta : sig
 
     val field_size : Pasta_bindings.BigInt256.t
 
+    module Cvar = Kimchi_pasta.Pallas_based_plonk.Cvar
     module Verification_key = Kimchi_pasta.Pallas_based_plonk.Verification_key
 
     module R1CS_constraint_system =
@@ -197,6 +198,7 @@ module Pasta : sig
 
     val field_size : Pasta_bindings.BigInt256.t
 
+    module Cvar = Kimchi_pasta.Vesta_based_plonk.Cvar
     module Verification_key = Kimchi_pasta.Vesta_based_plonk.Verification_key
     module R1CS_constraint_system =
       Kimchi_pasta.Vesta_based_plonk.R1CS_constraint_system

src/lib/crypto/kimchi_backend/pasta/kimchi_pasta.ml

@@ -7,6 +7,7 @@ module Pallas_based_plonk = struct
 
   let field_size = Pallas_based_plonk.field_size
 
+  module Cvar = Pallas_based_plonk.Cvar
   module Verification_key = Pallas_based_plonk.Verification_key
   module R1CS_constraint_system = Pallas_based_plonk.R1CS_constraint_system
   module Constraint = R1CS_constraint_system.Constraint
@@ -26,6 +27,7 @@ module Vesta_based_plonk = struct
 
   let field_size = Vesta_based_plonk.field_size
 
+  module Cvar = Vesta_based_plonk.Cvar
   module Verification_key = Vesta_based_plonk.Verification_key
   module R1CS_constraint_system = Vesta_based_plonk.R1CS_constraint_system
   module Constraint = R1CS_constraint_system.Constraint

src/lib/crypto/kimchi_backend/pasta/kimchi_pasta.mli

@@ -7,6 +7,7 @@ module Pallas_based_plonk : sig
 
   val field_size : Pasta_bindings.BigInt256.t
 
+  module Cvar = Pallas_based_plonk.Cvar
   module Verification_key = Pallas_based_plonk.Verification_key
   module R1CS_constraint_system = Pallas_based_plonk.R1CS_constraint_system
   module Constraint = R1CS_constraint_system.Constraint
@@ -26,6 +27,7 @@ module Vesta_based_plonk : sig
 
   val field_size : Pasta_bindings.BigInt256.t
 
+  module Cvar = Vesta_based_plonk.Cvar
   module Verification_key = Vesta_based_plonk.Verification_key
   module R1CS_constraint_system = Vesta_based_plonk.R1CS_constraint_system
   module Constraint = R1CS_constraint_system.Constraint

src/lib/crypto/kimchi_backend/pasta/pallas_based_plonk.ml

@@ -181,4 +181,6 @@ module Oracles = Plonk_dlog_oracles.Make (struct
   end
 end)
 
+module Cvar = Kimchi_pasta_snarky_backend.Pallas_based_plonk.Cvar
+
 module Run_state = Kimchi_pasta_snarky_backend.Pallas_based_plonk.Run_state

src/lib/crypto/kimchi_backend/pasta/vesta_based_plonk.ml

@@ -179,4 +179,6 @@ module Oracles = Plonk_dlog_oracles.Make (struct
   end
 end)
 
+module Cvar = Kimchi_pasta_snarky_backend.Vesta_based_plonk.Cvar
+
 module Run_state = Kimchi_pasta_snarky_backend.Vesta_based_plonk.Run_state

src/lib/crypto/kimchi_pasta_snarky_backend/kimchi_pasta_snarky_backend.ml

@@ -35,6 +35,8 @@ module Vesta_based_plonk = struct
 
   let field_size = Field.size
 
+  module Cvar = Snarky_backendless.Cvar.Make (Field)
+
   module R1CS_constraint_system =
     Plonk_constraint_system.Make
       (Field)
@@ -73,6 +75,8 @@ module Pallas_based_plonk = struct
 
   let field_size = Field.size
 
+  module Cvar = Snarky_backendless.Cvar.Make (Field)
+
   module R1CS_constraint_system =
     Plonk_constraint_system.Make
       (Field)

src/lib/crypto/kimchi_pasta_snarky_backend/plonk_constraint_system.ml

@@ -748,6 +748,7 @@ module type Snark_intf = sig
   include
     Snarky_backendless.Snark_intf.Run
       with type field := field
+       and type field_var = field Snarky_backendless.Cvar.t
        and type Constraint.t =
         (field Snarky_backendless.Cvar.t, field) Plonk_constraint.basic
 end

src/lib/network_pool/indexed_pool.ml

@@ -678,27 +678,27 @@ let revalidate :
     -> [ `Entire_pool | `Subset of Account_id.Set.t ]
     -> (Account_id.t -> Account.t)
     -> t * Transaction_hash.User_command_with_valid_signature.t Sequence.t =
- fun t ~logger scope f ->
+ fun t_initial ~logger scope f ->
   let requires_revalidation =
     match scope with
     | `Entire_pool ->
         Fn.const true
     | `Subset subset ->
         Set.mem subset
   in
-  Map.fold t.all_by_sender ~init:(t, Sequence.empty)
+  Map.fold t_initial.all_by_sender ~init:(t_initial, Sequence.empty)
     ~f:(fun
          ~key:sender
          ~data:(queue, currency_reserved)
-         ((t', dropped_acc) as acc)
+         ((t, dropped_acc) as acc)
        ->
       if not (requires_revalidation sender) then acc
       else
         let account : Account.t = f sender in
         let current_balance =
           Currency.Balance.to_amount
             (Account.liquid_balance_at_slot
-               ~global_slot:(global_slot_since_genesis t.config)
+               ~global_slot:(global_slot_since_genesis t_initial.config)
                account )
         in
         [%log debug]
@@ -724,14 +724,14 @@ let revalidate :
         then (
           [%log debug]
             "Account no longer has permission to send; dropping queue" ;
-          let dropped, t'' = remove_with_dependents_exn' t first_cmd in
-          (t'', Sequence.append dropped_acc dropped) )
+          let dropped, t_updated = remove_with_dependents_exn' t first_cmd in
+          (t_updated, Sequence.append dropped_acc dropped) )
         else if Account_nonce.(account.nonce < first_nonce) then (
           [%log debug]
             "Current account nonce precedes first nonce in queue; dropping \
              queue" ;
-          let dropped, t'' = remove_with_dependents_exn' t first_cmd in
-          (t'', Sequence.append dropped_acc dropped) )
+          let dropped, t_updated = remove_with_dependents_exn' t first_cmd in
+          (t_updated, Sequence.append dropped_acc dropped) )
         else
           (* current_nonce >= first_nonce *)
           let first_applicable_nonce_index =
@@ -748,62 +748,73 @@ let revalidate :
             "Current account nonce succeeds first nonce in queue; splitting \
              queue at $index"
             ~metadata:[ ("index", `Int first_applicable_nonce_index) ] ;
-          let drop_queue, keep_queue =
+          let dropped_for_nonce, retained_for_nonce =
             F_sequence.split_at queue first_applicable_nonce_index
           in
-          let currency_reserved' =
+          let currency_reserved_partially_updated =
             F_sequence.foldl
               (fun c cmd ->
                 Option.value_exn
                   Currency.Amount.(c - Option.value_exn (currency_consumed cmd))
                 )
-              currency_reserved drop_queue
+              currency_reserved dropped_for_nonce
           in
-          let keep_queue', currency_reserved'', dropped_for_balance =
+          let keep_queue, currency_reserved_updated, dropped_for_balance =
             drop_until_sufficient_balance
-              (keep_queue, currency_reserved')
+              (retained_for_nonce, currency_reserved_partially_updated)
               current_balance
           in
           let to_drop =
-            Sequence.append (F_sequence.to_seq drop_queue) dropped_for_balance
+            Sequence.append
+              (F_sequence.to_seq dropped_for_nonce)
+              dropped_for_balance
           in
-          match Sequence.next to_drop with
-          | None ->
-              acc
-          | Some (head, tail) ->
-              let t'' =
-                Sequence.fold tail
-                  ~init:
-                    (remove_all_by_fee_and_hash_and_expiration_exn
-                       (remove_applicable_exn t' head)
-                       head )
-                  ~f:remove_all_by_fee_and_hash_and_expiration_exn
-              in
-              let t''' =
-                match F_sequence.uncons keep_queue' with
-                | None ->
-                    { t'' with
-                      all_by_sender = Map.remove t''.all_by_sender sender
-                    }
-                | Some (first_kept, _) ->
-                    let first_kept_unchecked =
-                      Transaction_hash.User_command_with_valid_signature.command
-                        first_kept
-                    in
-                    { t'' with
-                      all_by_sender =
-                        Map.set t''.all_by_sender ~key:sender
-                          ~data:(keep_queue', currency_reserved'')
-                    ; applicable_by_fee =
-                        Map_set.insert
-                          ( module Transaction_hash
-                                   .User_command_with_valid_signature )
-                          t''.applicable_by_fee
-                          (User_command.fee_per_wu first_kept_unchecked)
-                          first_kept
-                    }
-              in
-              (t''', Sequence.append dropped_acc to_drop) )
+          let keeping_prefix = F_sequence.is_empty dropped_for_nonce in
+          let keeping_suffix = Sequence.is_empty dropped_for_balance in
+          (* t with all_by_sender and applicable_by_fee fields updated *)
+          let t_partially_updated =
+            match F_sequence.uncons keep_queue with
+            | _ when keeping_prefix && keeping_suffix ->
+                (* Nothing dropped, nothing needs to be updated *)
+                t
+            | None ->
+                (* We drop the entire queue, first element needs to be removed from
+                   applicable_by_fee *)
+                let t' = remove_applicable_exn t first_cmd in
+                { t' with all_by_sender = Map.remove t'.all_by_sender sender }
+            | Some _ when keeping_prefix ->
+                (* We drop only transactions from the end of queue, keeping
+                   the head untouched, no need to update applicable_by_fee *)
+                { t with
+                  all_by_sender =
+                    Map.set t.all_by_sender ~key:sender
+                      ~data:(keep_queue, currency_reserved_updated)
+                }
+            | Some (first_kept, _) ->
+                (* We need to replace old queue head with the new queue head
+                   in applicable_by_fee *)
+                let first_kept_unchecked =
+                  Transaction_hash.User_command_with_valid_signature.command
+                    first_kept
+                in
+                let t' = remove_applicable_exn t first_cmd in
+                { t' with
+                  all_by_sender =
+                    Map.set t'.all_by_sender ~key:sender
+                      ~data:(keep_queue, currency_reserved_updated)
+                ; applicable_by_fee =
+                    Map_set.insert
+                      (module Transaction_hash.User_command_with_valid_signature)
+                      t'.applicable_by_fee
+                      (User_command.fee_per_wu first_kept_unchecked)
+                      first_kept
+                }
+          in
+          let t_updated =
+            Sequence.fold ~init:t_partially_updated
+              ~f:remove_all_by_fee_and_hash_and_expiration_exn to_drop
+          in
+          (t_updated, Sequence.append dropped_acc to_drop) )
 
 let expired_by_global_slot (t : t) :
     Transaction_hash.User_command_with_valid_signature.t Sequence.t =

src/lib/pickles/common.ml

@@ -250,9 +250,11 @@ let ft_comm ~add:( + ) ~scale ~negate
   f_comm + chunked_t_comm
   + negate (scale chunked_t_comm plonk.zeta_to_domain_size)
 
-let combined_evaluation (type f)
-    (module Impl : Snarky_backendless.Snark_intf.Run with type field = f)
-    ~(xi : Impl.Field.t) (without_degree_bound : _ list) =
+let combined_evaluation (type f v)
+    (module Impl : Snarky_backendless.Snark_intf.Run
+      with type field = f
+       and type field_var = v ) ~(xi : Impl.Field.t)
+    (without_degree_bound : _ list) =
   let open Impl in
   let open Field in
   let mul_and_add ~(acc : Field.t) ~(xi : Field.t)

src/lib/pickles/common.mli

@@ -57,14 +57,12 @@ val dlog_pcs_batch :
   -> ('a, 'total, Pickles_types.Nat.z) Pickles_types.Pcs_batch.t
 
 val combined_evaluation :
-     (module Snarky_backendless.Snark_intf.Run with type field = 'f)
-  -> xi:'f Snarky_backendless.Cvar.t
-  -> ( 'f Snarky_backendless.Cvar.t
-     , 'f Snarky_backendless.Cvar.t Snarky_backendless.Snark_intf.Boolean0.t )
-     Pickles_types.Opt.t
-     array
-     list
-  -> 'f Snarky_backendless.Cvar.t
+     (module Snarky_backendless.Snark_intf.Run
+        with type field = 'f
+         and type field_var = 'v )
+  -> xi:'v
+  -> ('v, 'v Snarky_backendless.Boolean.t) Pickles_types.Opt.t array list
+  -> 'v
 
 module Max_degree : sig
   val wrap_log2 : int

src/lib/pickles/composition_types/composition_types.mli

@@ -814,7 +814,7 @@ module Wrap : sig
       (** A layout of the raw data in a statement, which is needed for
           representing it inside the circuit. *)
       val spec :
-           'a Spec.impl
+           ('f, 'v) Spec.impl
         -> ('challenge1, 'challenge2, 'field1, 'field2) Lookup_parameters.t
         -> Opt.Flag.t Plonk_types.Features.t
         -> ( ( 'field1
@@ -1190,13 +1190,10 @@ module Step : sig
       val typ :
            ('b, 'c) Step_impl.Typ.t
         -> assert_16_bits:(Step_impl.Field.t -> unit)
-        -> ( ( Step_impl.Field.Constant.t Limb_vector.Challenge.t
-             , Step_impl.Field.Constant.t Limb_vector.Challenge.t
-               Scalar_challenge.t
+        -> ( ( Step_impl.Field.t
+             , Step_impl.Field.t Scalar_challenge.t
              , 'b
-             , ( Step_impl.Field.Constant.t Limb_vector.Challenge.t
-                 Scalar_challenge.t
-                 Bulletproof_challenge.t
+             , ( Step_impl.Field.t Scalar_challenge.t Bulletproof_challenge.t
                , Backend.Tock.Rounds.n )
                Vector.t
              , Step_impl.Field.t
@@ -1237,13 +1234,10 @@ module Step : sig
          assert_16_bits:(Wrap_impl.Field.t -> unit)
       -> (Opt.Flag.t Plonk_types.Features.t, 'n) Vector.t
       -> ('b, 'a) Wrap_impl.Typ.t
-      -> ( ( ( ( Wrap_impl.Field.Constant.t Limb_vector.Challenge.t
-               , Wrap_impl.Field.Constant.t Limb_vector.Challenge.t
-                 Scalar_challenge.t
+      -> ( ( ( ( Wrap_impl.Field.t
+               , Wrap_impl.Field.t Scalar_challenge.t
                , 'b
-               , ( Wrap_impl.Field.Constant.t Limb_vector.Challenge.t
-                   Scalar_challenge.t
-                   Bulletproof_challenge.t
+               , ( Wrap_impl.Field.t Scalar_challenge.t Bulletproof_challenge.t
                  , Backend.Tock.Rounds.n )
                  Vector.t
                , Wrap_impl.Field.t

src/lib/pickles/composition_types/spec.ml

@@ -4,7 +4,10 @@ open Pickles_types
 open Hlist
 module Sc = Kimchi_backend_common.Scalar_challenge
 
-type 'f impl = (module Snarky_backendless.Snark_intf.Run with type field = 'f)
+type ('f, 'v) impl =
+  (module Snarky_backendless.Snark_intf.Run
+     with type field = 'f
+      and type field_var = 'v )
 
 module type Branch_data_checked = sig
   type field_var
@@ -199,8 +202,9 @@ struct
   end
 end
 
-let pack_basic (type field other_field other_field_var branch_data_var)
-    ((module Impl) : field impl)
+let pack_basic
+    (type field field_var other_field other_field_var branch_data_var)
+    ((module Impl) : (field, field_var) impl)
     ((module Branch_data_checked) : (branch_data_var, Impl.Field.t) branch_data)
     =
   let open Impl in
@@ -235,7 +239,7 @@ let pack_basic (type field other_field other_field_var branch_data_var)
   in
   { pack }
 
-let pack (type f) ((module Impl) as impl : f impl) branch_data t =
+let pack (type f v) ((module Impl) as impl : (f, v) impl) branch_data t =
   let open Impl in
   pack
     (pack_basic impl branch_data)
@@ -381,10 +385,7 @@ struct
             let (Typ typ) = typ t is_boolean spec in
             let constant_var =
               let fields, aux = typ.value_to_fields x in
-              let fields =
-                Array.map fields ~f:(fun x ->
-                    Snarky_backendless.Cvar.Constant x )
-              in
+              let fields = Array.map ~f:Impl.Field.constant fields in
               typ.var_of_fields (fields, aux)
             in
             let open Impl.Typ in
@@ -477,10 +478,7 @@ struct
             let (T (Typ typ, f, f')) = etyp e is_boolean spec in
             let constant_var =
               let fields, aux = typ.value_to_fields x in
-              let fields =
-                Array.map fields ~f:(fun x ->
-                    Snarky_backendless.Cvar.Constant x )
-              in
+              let fields = Array.map ~f:Impl.Field.constant fields in
               typ.var_of_fields (fields, aux)
             in
             (* We skip any constraints that would be added here, but we *do* use