Fix for recursion when max_proofs_verified = 1

src/app/test_executive/dune

@@ -48,6 +48,7 @@
    sgn
    zkapp_command_builder
    network_pool
+   transaction_snark_work
  )
  (instrumentation (backend bisect_ppx))
  (preprocess (pps ppx_mina ppx_jane ppx_deriving_yojson ppx_mina ppx_version)))

src/app/test_executive/zkapps.ml

@@ -619,8 +619,16 @@ module Make (Inputs : Intf.Test.Inputs_intf) = struct
         ~f:Fn.id
     in
     let snark_work_event_subscription =
-      Event_router.on (event_router t) Snark_work_gossip ~f:(fun _ _ ->
-          [%log info] "Received new snark work" ;
+      Event_router.on (event_router t) Snark_work_gossip
+        ~f:(fun node ({ work = { prover; fee; work } }, dir) ->
+          let j f x = Yojson.Safe.to_string (f x) in
+          [%log info]
+            "%s %s new snark work.\nStatement: %s\nProver: %s\nFee: %s\n"
+            (Network.Node.id node)
+            (match dir with Sent -> "sent" | Received -> "received")
+            (j Transaction_snark_work.Statement.to_yojson work)
+            (j Account.key_to_yojson prover)
+            (j Currency.Fee.to_yojson fee) ;
           Deferred.return `Continue )
     in
     let snark_work_failure_subscription =

src/lib/integration_test_lib/event_type.ml

@@ -345,7 +345,7 @@ end
 module Snark_work_failed = struct
   type t = unit [@@deriving yojson]
 
-  let name = "Transactions_gossip"
+  let name = "Snark_work_failed"
 
   let id = Snark_worker.generating_snark_work_failed_structured_events_id
 

src/lib/pickles/pickles.ml

@@ -162,7 +162,7 @@ module Make_str (_ : Wire_types.Concrete) = struct
                let (T (_proofs_verified, pi)) = HI.length xs in
                let module V = H2_1.To_vector (Int) in
                let v = V.f pi xs in
-               Vector.extend_exn v max_proofs_verified 0
+               Vector.extend_front_exn v max_proofs_verified 0
            end)
     in
     let module V = H2_1.To_vector (Vec) in
@@ -194,6 +194,14 @@ module Make_str (_ : Wire_types.Concrete) = struct
         local_max_proofs_verifieds
         H1.T(Proof_.Messages_for_next_proof_over_same_field.Wrap).t ) =
     let dummy_chals = Dummy.Ipa.Wrap.challenges in
+    let rev_magic :
+        type ms.
+           (* This type is wrong actually, the "ms" type-level list should be
+              reversed but there's no way to do that. *)
+           ms H1.T(Proof_.Messages_for_next_proof_over_same_field.Wrap).t
+        -> ms H1.T(Proof_.Messages_for_next_proof_over_same_field.Wrap).t =
+     fun xs -> Obj.magic (List.rev (Obj.magic xs))
+    in
     let rec go :
         type len ms ns.
            ms H1.T(Nat).t
@@ -215,14 +223,17 @@ module Make_str (_ : Wire_types.Concrete) = struct
           let messages_for_next_wrap_proof =
             { messages_for_next_wrap_proof with
               old_bulletproof_challenges =
-                Vector.extend_exn
+                Vector.extend_front_exn
                   messages_for_next_wrap_proof.old_bulletproof_challenges m
                   dummy_chals
             }
           in
           messages_for_next_wrap_proof :: go maxes messages_for_next_wrap_proofs
     in
-    go M.maxes messages_for_next_wrap_proofs
+    rev_magic
+      (go
+         (Obj.magic (List.rev (Obj.magic M.maxes)))
+         (rev_magic messages_for_next_wrap_proofs) )
 
   module Verification_key = struct
     include Verification_key
@@ -333,7 +344,9 @@ module Make_str (_ : Wire_types.Concrete) = struct
                 =
              fun rule ->
               let (T (_, l)) = HT.length rule.prevs in
-              Vector.extend_exn (V.f l (M.f rule.prevs)) Max_proofs_verified.n 0
+              Vector.extend_front_exn
+                (V.f l (M.f rule.prevs))
+                Max_proofs_verified.n 0
           end)
       in
       let module V = H4.To_vector (Local_max_proofs_verifieds) in
@@ -1961,7 +1974,7 @@ module Make_str (_ : Wire_types.Concrete) = struct
                     (a, b, c, d) IR.t -> Local_max_proofs_verifieds.t =
                  fun rule ->
                   let (T (_, l)) = HT.length rule.prevs in
-                  Vector.extend_exn
+                  Vector.extend_front_exn
                     (V.f l (M.f rule.prevs))
                     Max_proofs_verified.n 0
               end)
@@ -2352,7 +2365,7 @@ module Make_str (_ : Wire_types.Concrete) = struct
                       in
                       O.create pairing_vk
                         Vector.(
-                          map2 (Vector.trim sgs lte) prev_challenges
+                          map2 (Vector.trim_front sgs lte) prev_challenges
                             ~f:(fun commitment cs ->
                               { Tick.Proof.Challenge_polynomial.commitment
                               ; challenges = Vector.to_array cs
@@ -2597,7 +2610,7 @@ module Make_str (_ : Wire_types.Concrete) = struct
                                 ~auxiliary:auxiliary_inputs pk
                                 ~message:
                                   ( Vector.map2
-                                      (Vector.extend_exn
+                                      (Vector.extend_front_exn
                                          prev_statement.proof_state
                                            .messages_for_next_step_proof
                                            .challenge_polynomial_commitments
@@ -2886,7 +2899,7 @@ module Make_str (_ : Wire_types.Concrete) = struct
                     (a, b, c, d) IR.t -> Local_max_proofs_verifieds.t =
                  fun rule ->
                   let (T (_, l)) = HT.length rule.prevs in
-                  Vector.extend_exn
+                  Vector.extend_front_exn
                     (V.f l (M.f rule.prevs))
                     Max_proofs_verified.n 0
               end)
@@ -3277,7 +3290,7 @@ module Make_str (_ : Wire_types.Concrete) = struct
                       in
                       O.create pairing_vk
                         Vector.(
-                          map2 (Vector.trim sgs lte) prev_challenges
+                          map2 (Vector.trim_front sgs lte) prev_challenges
                             ~f:(fun commitment cs ->
                               { Tick.Proof.Challenge_polynomial.commitment
                               ; challenges = Vector.to_array cs
@@ -3488,7 +3501,7 @@ module Make_str (_ : Wire_types.Concrete) = struct
                                 ~auxiliary:auxiliary_inputs pk
                                 ~message:
                                   ( Vector.map2
-                                      (Vector.extend_exn
+                                      (Vector.extend_front_exn
                                          prev_statement.proof_state
                                            .messages_for_next_step_proof
                                            .challenge_polynomial_commitments

src/lib/pickles/requests.ml

@@ -118,6 +118,8 @@ module Step = struct
 
     type prev_values
 
+    type proofs_verified
+
     (* TODO: As an optimization this can be the local proofs-verified size *)
     type max_proofs_verified
 
@@ -144,13 +146,13 @@ module Step = struct
       | Return_value : return_value -> unit t
       | Auxiliary_value : auxiliary_value -> unit t
       | Unfinalized_proofs :
-          (Unfinalized.Constant.t, max_proofs_verified) Vector.t t
+          (Unfinalized.Constant.t, proofs_verified) Vector.t t
       | Messages_for_next_wrap_proof :
           (Digest.Constant.t, max_proofs_verified) Vector.t t
   end
 
   let create :
-      type local_signature local_branches statement return_value auxiliary_value prev_values prev_ret_values max_proofs_verified.
+      type proofs_verified local_signature local_branches statement return_value auxiliary_value prev_values prev_ret_values max_proofs_verified.
          unit
       -> (module S
             with type local_signature = local_signature
@@ -159,11 +161,14 @@ module Step = struct
              and type return_value = return_value
              and type auxiliary_value = auxiliary_value
              and type prev_values = prev_values
+             and type proofs_verified = proofs_verified
              and type max_proofs_verified = max_proofs_verified ) =
    fun () ->
     let module R = struct
       type nonrec max_proofs_verified = max_proofs_verified
 
+      type nonrec proofs_verified = proofs_verified
+
       type nonrec statement = statement
 
       type nonrec return_value = return_value
@@ -193,7 +198,7 @@ module Step = struct
         | Return_value : return_value -> unit t
         | Auxiliary_value : auxiliary_value -> unit t
         | Unfinalized_proofs :
-            (Unfinalized.Constant.t, max_proofs_verified) Vector.t t
+            (Unfinalized.Constant.t, proofs_verified) Vector.t t
         | Messages_for_next_wrap_proof :
             (Digest.Constant.t, max_proofs_verified) Vector.t t
     end in

src/lib/pickles/step.ml

@@ -265,7 +265,7 @@ struct
         in
         O.create dlog_vk
           ( Vector.map2
-              (Vector.extend_exn
+              (Vector.extend_front_exn
                  statement.messages_for_next_step_proof
                    .challenge_polynomial_commitments Local_max_proofs_verified.n
                  (Lazy.force Dummy.Ipa.Wrap.sg) )
@@ -352,13 +352,13 @@ struct
             }
         ; prev_proof_evals = t.prev_evals
         ; prev_challenge_polynomial_commitments =
-            Vector.extend_exn
+            Vector.extend_front_exn
               t.statement.messages_for_next_step_proof
                 .challenge_polynomial_commitments Local_max_proofs_verified.n
               (Lazy.force Dummy.Ipa.Wrap.sg)
             (* TODO: This computation is also redone elsewhere. *)
         ; prev_challenges =
-            Vector.extend_exn
+            Vector.extend_front_exn
               (Vector.map
                  t.statement.messages_for_next_step_proof
                    .old_bulletproof_challenges ~f:Ipa.Step.compute_challenges )
@@ -550,10 +550,11 @@ struct
       prev_proofs := Some prev_proofs' ;
       actual_wrap_domains := Some actual_wrap_domains'
     in
+    let unfinalized_proofs = lazy (Option.value_exn !unfinalized_proofs) in
     let unfinalized_proofs_extended =
       lazy
-        (Vector.extend
-           (Option.value_exn !unfinalized_proofs)
+        (Vector.extend_front
+           (Lazy.force unfinalized_proofs)
            lte Max_proofs_verified.n
            (Lazy.force Unfinalized.Constant.dummy) )
     in
@@ -647,10 +648,12 @@ struct
             :: pad [] ms n
       in
       lazy
-        (pad
-           (Vector.map (Option.value_exn !statements_with_hashes) ~f:(fun s ->
-                s.proof_state.messages_for_next_wrap_proof ) )
-           Maxes.maxes Maxes.length )
+        (Vector.rev
+           (pad
+              (Vector.map
+                 (Vector.rev (Option.value_exn !statements_with_hashes))
+                 ~f:(fun s -> s.proof_state.messages_for_next_wrap_proof) )
+              Maxes.maxes Maxes.length ) )
     in
     let handler (Snarky_backendless.Request.With { request; respond } as r) =
       let k x = respond (Provide x) in
@@ -671,7 +674,7 @@ struct
           auxiliary_value := Some res ;
           k ()
       | Req.Unfinalized_proofs ->
-          k (Lazy.force unfinalized_proofs_extended)
+          k (Lazy.force unfinalized_proofs)
       | Req.Messages_for_next_wrap_proof ->
           k (Lazy.force messages_for_next_wrap_proof_padded)
       | _ -> (
@@ -766,7 +769,7 @@ struct
       ; statement = next_statement
       ; index = branch_data.index
       ; prev_evals =
-          Vector.extend
+          Vector.extend_front
             (Vector.map2 prev_evals (Option.value_exn !x_hats)
                ~f:(fun (es, ft_eval1) x_hat ->
                  Plonk_types.All_evals.

src/lib/pickles/step_branch_data.ml

@@ -47,6 +47,7 @@ type ( 'a_var
           (module Requests.Step.S
              with type statement = 'a_value
               and type max_proofs_verified = 'max_proofs_verified
+              and type proofs_verified = 'proofs_verified
               and type prev_values = 'prev_values
               and type local_signature = 'local_widths
               and type local_branches = 'local_heights

src/lib/pickles/step_main.ml

@@ -67,7 +67,7 @@ let verify_one
           hash_messages_for_next_step_proof ~widths:d.proofs_verifieds
             ~max_width:(Nat.Add.n d.max_proofs_verified)
             ~proofs_verified_mask:
-              (Vector.trim branch_data.proofs_verified_mask
+              (Vector.trim_front branch_data.proofs_verified_mask
                  (Nat.lte_exn
                     (Vector.length prev_challenge_polynomial_commitments)
                     Nat.N2.n ) )
@@ -130,6 +130,7 @@ let step_main :
            and type statement = a_value
            and type prev_values = prev_values
            and type max_proofs_verified = max_proofs_verified
+           and type proofs_verified = proofs_verified
            and type return_value = ret_value
            and type auxiliary_value = auxiliary_value )
     -> (module Nat.Add.Intf with type n = max_proofs_verified)
@@ -345,14 +346,15 @@ let step_main :
         and prevs =
           exists (Prev_typ.f prev_proof_typs) ~request:(fun () ->
               Req.Proof_with_datas )
-        and unfinalized_proofs =
+        and unfinalized_proofs_unextended =
           exists
             (Vector.typ'
                (Vector.map
                   ~f:(fun uses_lookup ->
                     Unfinalized.typ ~wrap_rounds:Backend.Tock.Rounds.n
                       ~uses_lookup )
-                  (Vector.extend lookup_usage lte Max_proofs_verified.n No) ) )
+                  lookup_usage
+                  (* Vector.extend lookup_usage lte Max_proofs_verified.n No *) ) )
             ~request:(fun () -> Req.Unfinalized_proofs)
         and messages_for_next_wrap_proof =
           exists (Vector.typ Digest.typ Max_proofs_verified.n)
@@ -419,10 +421,10 @@ let step_main :
                   with_label "messages_for_next_wrap_proofs" (fun () ->
                       let module V = H1.Of_vector (Digest) in
                       V.f proofs_verified
-                        (Vector.trim messages_for_next_wrap_proof lte) )
+                        (Vector.trim_front messages_for_next_wrap_proof lte) )
                 and unfinalized_proofs =
                   let module H = H1.Of_vector (Unfinalized) in
-                  H.f proofs_verified (Vector.trim unfinalized_proofs lte)
+                  H.f proofs_verified unfinalized_proofs_unextended
                 and datas =
                   let self_data :
                       ( var
@@ -513,6 +515,10 @@ let step_main :
                     bulletproof_challenges
                 } )
         in
+        let unfinalized_proofs =
+          Vector.extend_front unfinalized_proofs_unextended lte
+            Max_proofs_verified.n (Unfinalized.dummy ())
+        in
         ( { Types.Step.Statement.proof_state =
               { unfinalized_proofs; messages_for_next_step_proof }
           ; messages_for_next_wrap_proof

src/lib/pickles/step_verifier.ml

@@ -915,7 +915,7 @@ struct
       let sg_evals pt =
         Vector.map2
           ~f:(fun keep f -> (keep, f pt))
-          (Vector.trim actual_width_mask
+          (Vector.trim_front actual_width_mask
              (Nat.lte_exn Proofs_verified.n Nat.N2.n) )
           sg_olds
       in
@@ -925,7 +925,7 @@ struct
       let challenge_digest =
         let opt_sponge = Opt_sponge.create sponge_params in
         Vector.iter2
-          (Vector.trim actual_width_mask
+          (Vector.trim_front actual_width_mask
              (Nat.lte_exn Proofs_verified.n Nat.N2.n) )
           prev_challenges
           ~f:(fun keep chals ->
@@ -1111,6 +1111,7 @@ struct
     let after_index = sponge_after_index index in
     ( after_index
     , stage (fun t ~widths ~max_width ~proofs_verified_mask ->
+          (* TODO: Just get rid of the proofs verified mask and always absorb in full *)
           let sponge = Sponge.copy after_index in
           let t =
             { t with

src/lib/pickles/unfinalized.ml

@@ -106,3 +106,10 @@ let typ ~wrap_rounds ~uses_lookup : (t, Constant.t) Typ.t =
     (Shifted_value.typ Other_field.typ)
     ~assert_16_bits:(Step_verifier.assert_n_bits ~n:16)
     ~zero:Common.Lookup_parameters.tick_zero ~uses_lookup
+
+let dummy () : t =
+  let (Typ { var_of_fields; value_to_fields; _ }) =
+    typ ~wrap_rounds:Backend.Tock.Rounds.n ~uses_lookup:No
+  in
+  let xs, aux = value_to_fields (Lazy.force Constant.dummy) in
+  var_of_fields (Array.map ~f:Field.constant xs, aux)

src/lib/pickles/util.ml

@@ -39,6 +39,9 @@ let rec absorb :
       let t1, t2 = t in
       absorb ty1 t1 ; absorb ty2 t2
 
+(** [ones_vector (module I) ~first_zero n] returns a vector of booleans of
+   length n which is all ones until position [first_zero], at which it is zero,
+   and zero thereafter. *)
 let ones_vector :
     type f n.
        first_zero:f Snarky_backendless.Cvar.t

src/lib/pickles/verify.ml

@@ -311,7 +311,7 @@ let verify_heterogenous (ts : Instance.t list) =
                            Vector.to_array (Ipa.Wrap.compute_challenges cs)
                        ; commitment = g
                        } )
-                     (Vector.extend_exn
+                     (Vector.extend_front_exn
                         t.statement.messages_for_next_step_proof
                           .challenge_polynomial_commitments
                         Max_proofs_verified.n