• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

MinaProtocol / mina / 2903

15 Nov 2024 01:59PM UTC coverage: 36.723% (-25.0%) from 61.682%
2903

Pull #16342

buildkite

dkijania
Merge branch 'dkijania/remove_publish_job_from_pr_comp' into dkijania/remove_publish_job_from_pr_dev
Pull Request #16342: [DEV] Publish debians only on nightly and stable

15 of 40 new or added lines in 14 files covered. (37.5%)

15175 existing lines in 340 files now uncovered.

24554 of 66863 relevant lines covered (36.72%)

20704.91 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

29.73
/src/lib/mina_base/zkapp_command.ml
1
open Core_kernel
21✔
2
open Signature_lib
3

4
module Graphql_repr = struct
5
  [%%versioned
6
  module Stable = struct
7
    module V1 = struct
8
      type t =
42✔
9
        { fee_payer : Account_update.Fee_payer.Stable.V1.t
×
10
        ; account_updates : Account_update.Graphql_repr.Stable.V1.t list
×
11
        ; memo : Signed_command_memo.Stable.V1.t
×
12
        }
13
      [@@deriving sexp, compare, equal, hash, yojson]
105✔
14

15
      let to_latest = Fn.id
16
    end
17
  end]
18
end
19

20
module Simple = struct
21
  (* For easily constructing values *)
22
  [%%versioned
23
  module Stable = struct
24
    module V1 = struct
25
      type t =
42✔
26
        { fee_payer : Account_update.Fee_payer.Stable.V1.t
×
27
        ; account_updates : Account_update.Simple.Stable.V1.t list
×
28
        ; memo : Signed_command_memo.Stable.V1.t
×
29
        }
30
      [@@deriving sexp, compare, equal, hash, yojson]
105✔
31

32
      let to_latest = Fn.id
33
    end
34
  end]
35
end
36

37
module Call_forest = Zkapp_call_forest_base
38
module Digest = Call_forest.Digest
39

40
module T = struct
41
  [%%versioned_binable
42
  module Stable = struct
×
43
    [@@@with_top_version_tag]
44

45
    (* DO NOT DELETE VERSIONS!
46
       so we can always get transaction hashes from old transaction ids
47
       the version linter should be checking this
48

49
       IF YOU CREATE A NEW VERSION:
50
       update Transaction_hash.hash_of_transaction_id to handle it
51
       add hash_zkapp_command_vn for that version
52
    *)
53

54
    module V1 = struct
55
      type t = Mina_wire_types.Mina_base.Zkapp_command.V1.t =
172✔
56
        { fee_payer : Account_update.Fee_payer.Stable.V1.t
×
57
        ; account_updates :
×
UNCOV
58
            ( Account_update.Stable.V1.t
×
UNCOV
59
            , Digest.Account_update.Stable.V1.t
×
UNCOV
60
            , Digest.Forest.Stable.V1.t )
×
UNCOV
61
            Call_forest.Stable.V1.t
×
62
        ; memo : Signed_command_memo.Stable.V1.t
×
63
        }
64
      [@@deriving annot, sexp, compare, equal, hash, yojson, fields]
252✔
65

66
      let to_latest = Fn.id
67

68
      module Wire = struct
69
        [%%versioned
70
        module Stable = struct
71
          module V1 = struct
72
            type t =
42✔
73
              { fee_payer : Account_update.Fee_payer.Stable.V1.t
×
74
              ; account_updates :
×
75
                  ( Account_update.Stable.V1.t
×
UNCOV
76
                  , unit
×
UNCOV
77
                  , unit )
×
78
                  Call_forest.Stable.V1.t
×
79
              ; memo : Signed_command_memo.Stable.V1.t
×
80
              }
81
            [@@deriving sexp, compare, equal, hash, yojson]
105✔
82

83
            let to_latest = Fn.id
84
          end
85
        end]
86

87
        let of_graphql_repr (t : Graphql_repr.t) : t =
UNCOV
88
          { fee_payer = t.fee_payer
×
89
          ; memo = t.memo
90
          ; account_updates =
UNCOV
91
              Call_forest.of_account_updates_map t.account_updates
×
92
                ~f:Account_update.of_graphql_repr
93
                ~account_update_depth:(fun (p : Account_update.Graphql_repr.t)
UNCOV
94
                                      -> p.body.call_depth )
×
95
          }
96

97
        let to_graphql_repr (t : t) : Graphql_repr.t =
UNCOV
98
          { fee_payer = t.fee_payer
×
99
          ; memo = t.memo
100
          ; account_updates =
101
              t.account_updates
UNCOV
102
              |> Call_forest.to_account_updates_map
×
103
                   ~f:(fun ~depth account_update ->
UNCOV
104
                     Account_update.to_graphql_repr account_update
×
105
                       ~call_depth:depth )
106
          }
107

108
        let gen =
109
          let open Quickcheck.Generator in
110
          let open Let_syntax in
111
          let gen_call_forest =
112
            fixed_point (fun self ->
113
                let%bind calls_length = small_non_negative_int in
UNCOV
114
                list_with_length calls_length
×
115
                  (let%map account_update = Account_update.gen
116
                   and calls = self in
UNCOV
117
                   { With_stack_hash.stack_hash = ()
×
118
                   ; elt =
119
                       { Call_forest.Tree.account_update
120
                       ; account_update_digest = ()
121
                       ; calls
122
                       }
123
                   } ) )
124
          in
125
          let open Quickcheck.Let_syntax in
21✔
126
          let%map fee_payer = Account_update.Fee_payer.gen
127
          and account_updates = gen_call_forest
128
          and memo = Signed_command_memo.gen in
UNCOV
129
          { fee_payer; account_updates; memo }
×
130

131
        let shrinker : t Quickcheck.Shrinker.t =
132
          Quickcheck.Shrinker.create (fun t ->
21✔
133
              let shape = Call_forest.shape t.account_updates in
×
134
              Sequence.map
×
135
                (Quickcheck.Shrinker.shrink
×
136
                   Call_forest.Shape.quickcheck_shrinker shape )
137
                ~f:(fun shape' ->
138
                  { t with
×
139
                    account_updates = Call_forest.mask t.account_updates shape'
×
140
                  } ) )
141
      end
142

143
      let of_wire (w : Wire.t) : t =
UNCOV
144
        { fee_payer = w.fee_payer
×
145
        ; memo = w.memo
146
        ; account_updates =
147
            w.account_updates
UNCOV
148
            |> Call_forest.accumulate_hashes
×
149
                 ~hash_account_update:(fun (p : Account_update.t) ->
UNCOV
150
                   Digest.Account_update.create p )
×
151
        }
152

153
      let to_wire (t : t) : Wire.t =
154
        let rec forget_hashes = List.map ~f:forget_hash
1,176✔
155
        and forget_hash = function
156
          | { With_stack_hash.stack_hash = _
2,128✔
157
            ; elt =
158
                { Call_forest.Tree.account_update
159
                ; account_update_digest = _
160
                ; calls
161
                }
162
            } ->
163
              { With_stack_hash.stack_hash = ()
164
              ; elt =
165
                  { Call_forest.Tree.account_update
166
                  ; account_update_digest = ()
167
                  ; calls = forget_hashes calls
2,128✔
168
                  }
169
              }
170
        in
171
        { fee_payer = t.fee_payer
172
        ; memo = t.memo
173
        ; account_updates = forget_hashes t.account_updates
1,176✔
174
        }
175

176
      include
177
        Binable.Of_binable_without_uuid
178
          (Wire.Stable.V1)
179
          (struct
180
            type nonrec t = t
181

UNCOV
182
            let of_binable t = of_wire t
×
183

184
            let to_binable = to_wire
185
          end)
186
    end
187
  end]
×
188
end
189

190
include T
191

192
[%%define_locally Stable.Latest.(of_wire, to_wire)]
193

194
[%%define_locally Stable.Latest.Wire.(gen)]
195

196
let of_simple (w : Simple.t) : t =
197
  { fee_payer = w.fee_payer
1,504✔
198
  ; memo = w.memo
199
  ; account_updates =
200
      Call_forest.of_account_updates w.account_updates
1,504✔
201
        ~account_update_depth:(fun (p : Account_update.Simple.t) ->
202
          p.body.call_depth )
3,016✔
203
      |> Call_forest.map ~f:Account_update.of_simple
1,504✔
204
      |> Call_forest.accumulate_hashes
1,504✔
205
           ~hash_account_update:(fun (p : Account_update.t) ->
206
             Digest.Account_update.create p )
2,260✔
207
  }
208

209
let to_simple (t : t) : Simple.t =
210
  { fee_payer = t.fee_payer
568✔
211
  ; memo = t.memo
212
  ; account_updates =
213
      t.account_updates
214
      |> Call_forest.to_account_updates_map
568✔
215
           ~f:(fun ~depth { Account_update.body = b; authorization } ->
216
             { Account_update.Simple.authorization
944✔
217
             ; body =
218
                 { public_key = b.public_key
219
                 ; token_id = b.token_id
220
                 ; update = b.update
221
                 ; balance_change = b.balance_change
222
                 ; increment_nonce = b.increment_nonce
223
                 ; events = b.events
224
                 ; actions = b.actions
225
                 ; call_data = b.call_data
226
                 ; preconditions = b.preconditions
227
                 ; use_full_commitment = b.use_full_commitment
228
                 ; implicit_account_creation_fee =
229
                     b.implicit_account_creation_fee
230
                 ; may_use_token = b.may_use_token
231
                 ; call_depth = depth
232
                 ; authorization_kind = b.authorization_kind
233
                 }
234
             } )
235
  }
236

237
let all_account_updates (t : t) : _ Call_forest.t =
238
  let p = t.fee_payer in
956✔
239
  let body = Account_update.Body.of_fee_payer p.body in
240
  let fee_payer : Account_update.t =
956✔
241
    let p = t.fee_payer in
242
    { authorization = Control.Signature p.authorization; body }
243
  in
244
  Call_forest.cons fee_payer t.account_updates
245

UNCOV
246
let fee (t : t) : Currency.Fee.t = t.fee_payer.body.fee
×
247

UNCOV
248
let fee_payer_account_update ({ fee_payer; _ } : t) = fee_payer
×
249

250
let applicable_at_nonce (t : t) : Account.Nonce.t =
UNCOV
251
  (fee_payer_account_update t).body.nonce
×
252

253
let target_nonce_on_success (t : t) : Account.Nonce.t =
254
  let base_nonce = Account.Nonce.succ (applicable_at_nonce t) in
×
255
  let fee_payer_pubkey = t.fee_payer.body.public_key in
×
256
  let fee_payer_account_update_increments =
257
    List.count (Call_forest.to_list t.account_updates) ~f:(fun p ->
×
258
        Public_key.Compressed.equal p.body.public_key fee_payer_pubkey
×
259
        && p.body.increment_nonce )
×
260
  in
261
  Account.Nonce.add base_nonce
×
262
    (Account.Nonce.of_int fee_payer_account_update_increments)
×
263

264
let nonce_increments (t : t) : int Public_key.Compressed.Map.t =
265
  let base_increments =
×
266
    Public_key.Compressed.Map.of_alist_exn [ (t.fee_payer.body.public_key, 1) ]
267
  in
268
  List.fold_left (Call_forest.to_list t.account_updates) ~init:base_increments
×
269
    ~f:(fun incr_map account_update ->
270
      if account_update.body.increment_nonce then
×
271
        Map.update incr_map account_update.body.public_key
×
272
          ~f:(Option.value_map ~default:1 ~f:(( + ) 1))
273
      else incr_map )
×
274

275
let fee_token (_t : t) = Token_id.default
2,868✔
276

277
let fee_payer (t : t) =
278
  Account_id.create t.fee_payer.body.public_key (fee_token t)
2,868✔
279

280
let extract_vks (t : t) : (Account_id.t * Verification_key_wire.t) List.t =
UNCOV
281
  account_updates t
×
282
  |> Call_forest.fold ~init:[] ~f:(fun acc (p : Account_update.t) ->
UNCOV
283
         match Account_update.verification_key_update_to_option p with
×
UNCOV
284
         | Zkapp_basic.Set_or_keep.Set (Some vk) ->
×
UNCOV
285
             (Account_update.account_id p, vk) :: acc
×
UNCOV
286
         | _ ->
×
287
             acc )
288

289
let account_updates_list (t : t) : Account_update.t list =
UNCOV
290
  Call_forest.fold t.account_updates ~init:[] ~f:(Fn.flip List.cons) |> List.rev
×
291

292
let all_account_updates_list (t : t) : Account_update.t list =
UNCOV
293
  Call_forest.fold t.account_updates
×
UNCOV
294
    ~init:[ Account_update.of_fee_payer (fee_payer_account_update t) ]
×
UNCOV
295
    ~f:(Fn.flip List.cons)
×
296
  |> List.rev
297

298
let fee_excess (t : t) =
UNCOV
299
  Fee_excess.of_single (fee_token t, Currency.Fee.Signed.of_unsigned (fee t))
×
300

301
(* always `Accessed` for fee payer *)
302
let account_access_statuses (t : t) (status : Transaction_status.t) =
303
  let init = [ (fee_payer t, `Accessed) ] in
1,912✔
304
  let status_sym =
305
    match status with Applied -> `Accessed | Failed _ -> `Not_accessed
×
306
  in
307
  Call_forest.fold t.account_updates ~init ~f:(fun acc p ->
1,912✔
308
      (Account_update.account_id p, status_sym) :: acc )
2,872✔
309
  |> List.rev |> List.stable_dedup
1,912✔
310

311
let accounts_referenced (t : t) =
312
  List.map (account_access_statuses t Applied) ~f:(fun (acct_id, _status) ->
1,912✔
313
      acct_id )
4,784✔
314

UNCOV
315
let fee_payer_pk (t : t) = t.fee_payer.body.public_key
×
316

317
let value_if b ~then_ ~else_ = if b then then_ else else_
3,348✔
318

319
module Virtual = struct
320
  module Bool = struct
321
    type t = bool
322

323
    let true_ = true
324

325
    let assert_ _ = ()
×
326

327
    let equal = Bool.equal
328

329
    let not = not
330

331
    let ( || ) = ( || )
332

333
    let ( && ) = ( && )
334
  end
335

336
  module Unit = struct
337
    type t = unit
338

339
    let if_ = value_if
340
  end
341

342
  module Ledger = Unit
343
  module Account = Unit
344

345
  module Amount = struct
346
    open Currency.Amount
347

348
    type nonrec t = t
349

350
    let if_ = value_if
351

352
    module Signed = Signed
353

354
    let zero = zero
355

356
    let ( - ) (x1 : t) (x2 : t) : Signed.t =
357
      Option.value_exn Signed.(of_unsigned x1 + negate (of_unsigned x2))
×
358

359
    let ( + ) (x1 : t) (x2 : t) : t = Option.value_exn (add x1 x2)
×
360

361
    let add_signed (x1 : t) (x2 : Signed.t) : t =
362
      let y = Option.value_exn Signed.(of_unsigned x1 + x2) in
×
363
      match y.sgn with Pos -> y.magnitude | Neg -> failwith "add_signed"
×
364
  end
365

366
  module Token_id = struct
367
    include Token_id
368

369
    let if_ = value_if
370
  end
371

372
  module Zkapp_command = struct
373
    type t = Account_update.t list
374

375
    let if_ = value_if
376

377
    type account_update = Account_update.t
378

379
    let empty = []
380

381
    let is_empty = List.is_empty
382

383
    let pop (t : t) = match t with [] -> failwith "pop" | p :: t -> (p, t)
×
384
  end
385
end
386

387
let check_authorization (p : Account_update.t) : unit Or_error.t =
388
  match (p.authorization, p.body.authorization_kind) with
134✔
389
  | None_given, None_given | Proof _, Proof _ | Signature _, Signature ->
5✔
390
      Ok ()
391
  | _ ->
×
392
      let err =
393
        let expected =
394
          Account_update.Authorization_kind.to_control_tag
395
            p.body.authorization_kind
396
        in
397
        let got = Control.tag p.authorization in
×
398
        Error.create "Authorization kind does not match the authorization"
×
399
          [ ("expected", expected); ("got", got) ]
400
          [%sexp_of: (string * Control.Tag.t) list]
401
      in
402
      Error err
403

404
module Verifiable : sig
405
  [%%versioned:
406
  module Stable : sig
407
    module V1 : sig
408
      type t = private
409
        { fee_payer : Account_update.Fee_payer.Stable.V1.t
410
        ; account_updates :
411
            ( Side_loaded_verification_key.Stable.V2.t
412
            , Zkapp_basic.F.Stable.V1.t )
413
            With_hash.Stable.V1.t
414
            option
415
            Call_forest.With_hashes_and_data.Stable.V1.t
416
        ; memo : Signed_command_memo.Stable.V1.t
417
        }
418
      [@@deriving sexp, compare, equal, hash, yojson]
419

420
      val to_latest : t -> t
421
    end
422
  end]
423

424
  val load_vk_from_ledger :
425
       location_of_account:(Account_id.t -> 'loc option)
426
    -> get:('loc -> Account.t option)
427
    -> Zkapp_basic.F.t
428
    -> Account_id.t
429
    -> Verification_key_wire.t Or_error.t
430

431
  val load_vks_from_ledger :
432
       location_of_account_batch:
433
         (Account_id.t list -> (Account_id.t * 'loc option) list)
434
    -> get_batch:('loc list -> ('loc * Account.t option) list)
435
    -> Account_id.t list
436
    -> Verification_key_wire.t Account_id.Map.t
437

438
  val create :
439
       T.t
440
    -> failed:bool
441
    -> find_vk:
442
         (Zkapp_basic.F.t -> Account_id.t -> Verification_key_wire.t Or_error.t)
443
    -> t Or_error.t
444

445
  module type Command_wrapper_intf = sig
446
    type 'a t
447

448
    val unwrap : 'a t -> 'a
449

450
    val map : 'a t -> f:('a -> 'b) -> 'b t
451

452
    val is_failed : 'a t -> bool
453
  end
454

455
  module type Create_all_intf = sig
456
    type cache
457

458
    module Command_wrapper : Command_wrapper_intf
459

460
    val create_all :
461
      T.t Command_wrapper.t list -> cache -> t Command_wrapper.t list Or_error.t
462
  end
463

464
  module From_unapplied_sequence :
465
    Create_all_intf
466
      with type 'a Command_wrapper.t = 'a
467
       and type cache =
468
        Verification_key_wire.t Zkapp_basic.F_map.Map.t Account_id.Map.t
469

470
  module From_applied_sequence :
471
    Create_all_intf
472
      with type 'a Command_wrapper.t = 'a With_status.t
473
       and type cache = Verification_key_wire.t Account_id.Map.t
474
end = struct
475
  [%%versioned
476
  module Stable = struct
477
    module V1 = struct
478
      type t =
42✔
479
        { fee_payer : Account_update.Fee_payer.Stable.V1.t
×
480
        ; account_updates :
×
481
            ( Side_loaded_verification_key.Stable.V2.t
×
482
            , Zkapp_basic.F.Stable.V1.t )
×
483
            With_hash.Stable.V1.t
×
484
            option
×
485
            Call_forest.With_hashes_and_data.Stable.V1.t
×
486
        ; memo : Signed_command_memo.Stable.V1.t
×
487
        }
488
      [@@deriving sexp, compare, equal, hash, yojson]
105✔
489

490
      let to_latest = Fn.id
491
    end
492
  end]
493

494
  let ok_if_vk_hash_expected ~got ~expected =
495
    if not @@ Zkapp_basic.F.equal (With_hash.hash got) expected then
5✔
496
      Error
×
497
        (Error.create "Expected vk hash doesn't match hash in vk we received"
×
498
           [ ("expected_vk_hash", expected)
499
           ; ("got_vk_hash", With_hash.hash got)
×
500
           ]
501
           [%sexp_of: (string * Zkapp_basic.F.t) list] )
502
    else Ok got
5✔
503

504
  let load_vk_from_ledger ~location_of_account ~get expected_vk_hash account_id
505
      =
506
    match
3✔
507
      let open Option.Let_syntax in
508
      let%bind location = location_of_account account_id in
3✔
509
      let%bind (account : Account.t) = get location in
3✔
510
      let%bind zkapp = account.zkapp in
511
      zkapp.verification_key
3✔
512
    with
513
    | Some vk ->
3✔
514
        ok_if_vk_hash_expected ~got:vk ~expected:expected_vk_hash
515
    | None ->
×
516
        let err =
517
          Error.create "No verification key found for proved account update"
518
            ("account_id", account_id) [%sexp_of: string * Account_id.t]
519
        in
520
        Error err
×
521

522
  let load_vks_from_ledger ~location_of_account_batch ~get_batch account_ids =
523
    let locations =
200✔
524
      location_of_account_batch account_ids |> List.filter_map ~f:snd
200✔
525
    in
526
    get_batch locations
200✔
527
    |> List.filter_map ~f:(fun ((_, account) : _ * Account.t option) ->
200✔
UNCOV
528
           let open Option.Let_syntax in
×
529
           let account = Option.value_exn account in
530
           let%bind zkapp = account.zkapp in
531
           let%map verification_key = zkapp.verification_key in
UNCOV
532
           (Account.identifier account, verification_key) )
×
533
    |> Account_id.Map.of_alist_exn
534

535
  (* Ensures that there's a verification_key available for all account_updates
536
   * and creates a valid command associating the correct keys with each
537
   * account_id.
538
   *
539
   * If an account_update replaces the verification_key (or deletes it),
540
   * subsequent account_updates use the replaced key instead of looking in the
541
   * ledger for the key (ie set by a previous transaction).
542
   *)
543
  let create ({ fee_payer; account_updates; memo } : T.t) ~failed ~find_vk :
544
      t Or_error.t =
545
    With_return.with_return (fun { return } ->
20✔
546
        let tbl = Account_id.Table.create () in
20✔
547
        let vks_overridden =
20✔
548
          (* Keep track of the verification keys that have been set so far
549
             during this transaction.
550
          *)
551
          ref Account_id.Map.empty
552
        in
553
        let account_updates =
554
          Call_forest.map account_updates ~f:(fun p ->
555
              let account_id = Account_update.account_id p in
134✔
556
              let vks_overriden' =
134✔
557
                match Account_update.verification_key_update_to_option p with
558
                | Zkapp_basic.Set_or_keep.Set vk_next ->
42✔
559
                    Account_id.Map.set !vks_overridden ~key:account_id
42✔
560
                      ~data:vk_next
561
                | Zkapp_basic.Set_or_keep.Keep ->
92✔
562
                    !vks_overridden
563
              in
564
              let () =
565
                match check_authorization p with
566
                | Ok () ->
134✔
567
                    ()
568
                | Error _ as err ->
×
569
                    return err
×
570
              in
571
              match (p.body.authorization_kind, failed) with
572
              | Proof vk_hash, false -> (
5✔
573
                  let prioritized_vk =
574
                    (* only lookup _past_ vk setting, ie exclude the new one we
575
                     * potentially set in this account_update (use the non-'
576
                     * vks_overrided) . *)
577
                    match Account_id.Map.find !vks_overridden account_id with
578
                    | Some (Some vk) -> (
2✔
579
                        match
580
                          ok_if_vk_hash_expected ~got:vk ~expected:vk_hash
581
                        with
582
                        | Ok vk ->
2✔
583
                            Some vk
584
                        | Error err ->
×
585
                            return (Error err) )
×
586
                    | Some None ->
×
587
                        (* we explicitly have erased the key *)
588
                        let err =
589
                          Error.create
590
                            "No verification key found for proved account \
591
                             update: the verification key was removed by a \
592
                             previous account update"
593
                            ("account_id", account_id)
594
                            [%sexp_of: string * Account_id.t]
595
                        in
596
                        return (Error err)
×
597
                    | None -> (
3✔
598
                        (* we haven't set anything; lookup the vk in the fallback *)
599
                        match find_vk vk_hash account_id with
600
                        | Error e ->
×
601
                            return (Error e)
×
602
                        | Ok vk ->
3✔
603
                            Some vk )
604
                  in
605
                  match prioritized_vk with
606
                  | Some prioritized_vk ->
5✔
607
                      Account_id.Table.update tbl account_id ~f:(fun _ ->
608
                          With_hash.hash prioritized_vk ) ;
5✔
609
                      (* return the updated overrides *)
610
                      vks_overridden := vks_overriden' ;
5✔
611
                      (p, Some prioritized_vk)
612
                  | None ->
×
613
                      (* The transaction failed, so we allow the vk to be missing. *)
614
                      (p, None) )
615
              | _ ->
129✔
616
                  vks_overridden := vks_overriden' ;
617
                  (p, None) )
618
        in
619
        Ok { fee_payer; account_updates; memo } )
20✔
620

621
  module type Cache_intf = sig
622
    type t
623

624
    val find :
625
         t
626
      -> account_id:Account_id.t
627
      -> vk_hash:Zkapp_basic.F.t
628
      -> Verification_key_wire.t option
629

630
    val add : t -> account_id:Account_id.t -> vk:Verification_key_wire.t -> t
631
  end
632

633
  module type Command_wrapper_intf = sig
634
    type 'a t
635

636
    val unwrap : 'a t -> 'a
637

638
    val map : 'a t -> f:('a -> 'b) -> 'b t
639

640
    val is_failed : 'a t -> bool
641
  end
642

643
  module type Create_all_intf = sig
644
    type cache
645

646
    module Command_wrapper : Command_wrapper_intf
647

648
    val create_all :
649
      T.t Command_wrapper.t list -> cache -> t Command_wrapper.t list Or_error.t
650
  end
651

652
  module Make_create_all
653
      (Cache : Cache_intf)
654
      (Command_wrapper : Command_wrapper_intf) :
655
    Create_all_intf
656
      with module Command_wrapper := Command_wrapper
657
       and type cache = Cache.t = struct
658
    type cache = Cache.t
659

660
    let create_all (wrapped_cmds : T.t Command_wrapper.t list)
661
        (init_cache : Cache.t) : t Command_wrapper.t list Or_error.t =
662
      Or_error.try_with (fun () ->
200✔
663
          snd (* remove the helper cache we folded with *)
200✔
664
            (List.fold_map wrapped_cmds ~init:init_cache
200✔
665
               ~f:(fun running_cache wrapped_cmd ->
UNCOV
666
                 let cmd = Command_wrapper.unwrap wrapped_cmd in
×
UNCOV
667
                 let cmd_failed = Command_wrapper.is_failed wrapped_cmd in
×
UNCOV
668
                 let verified_cmd : t =
×
UNCOV
669
                   create cmd ~failed:cmd_failed
×
670
                     ~find_vk:(fun vk_hash account_id ->
671
                       (* first we check if there's anything in the running
672
                          cache within this chunk so far *)
UNCOV
673
                       match Cache.find running_cache ~account_id ~vk_hash with
×
674
                       | None ->
×
675
                           Error
676
                             (Error.of_string
×
677
                                "verification key not found in cache" )
UNCOV
678
                       | Some vk ->
×
679
                           Ok vk )
UNCOV
680
                   |> Or_error.ok_exn
×
681
                 in
682
                 let running_cache' =
683
                   (* update the cache if the command is not failed *)
684
                   if not cmd_failed then
UNCOV
685
                     List.fold (extract_vks cmd) ~init:running_cache
×
686
                       ~f:(fun acc (account_id, vk) ->
UNCOV
687
                         Cache.add acc ~account_id ~vk )
×
UNCOV
688
                   else running_cache
×
689
                 in
690
                 ( running_cache'
UNCOV
691
                 , Command_wrapper.map wrapped_cmd ~f:(Fn.const verified_cmd) ) )
×
692
            ) )
693
  end
694

695
  (* There are 2 situations in which we are converting commands to their verifiable format:
696
       - we are reasoning about the validity of commands when the sequence is not yet known
697
       - we are reasoning about the validity of commands when the sequence (and by extension, status) is known
698
  *)
699

700
  module From_unapplied_sequence = struct
701
    module Cache = struct
702
      type t = Verification_key_wire.t Zkapp_basic.F_map.Map.t Account_id.Map.t
703

704
      let find (t : t) ~account_id ~vk_hash =
UNCOV
705
        let%bind.Option vks = Map.find t account_id in
×
UNCOV
706
        Map.find vks vk_hash
×
707

708
      let add (t : t) ~account_id ~(vk : Verification_key_wire.t) =
UNCOV
709
        Map.update t account_id ~f:(fun vks_opt ->
×
UNCOV
710
            let vks =
×
711
              Option.value vks_opt ~default:Zkapp_basic.F_map.Map.empty
712
            in
UNCOV
713
            Map.set vks ~key:vk.hash ~data:vk )
×
714
    end
715

716
    module Command_wrapper : Command_wrapper_intf with type 'a t = 'a = struct
717
      type 'a t = 'a
718

UNCOV
719
      let unwrap t = t
×
720

UNCOV
721
      let map t ~f = f t
×
722

UNCOV
723
      let is_failed _ = false
×
724
    end
725

726
    include Make_create_all (Cache) (Command_wrapper)
727
  end
728

729
  module From_applied_sequence = struct
730
    module Cache = struct
731
      type t = Verification_key_wire.t Account_id.Map.t
732

733
      let find (t : t) ~account_id ~vk_hash =
UNCOV
734
        let%bind.Option vk = Map.find t account_id in
×
UNCOV
735
        Option.some_if (Zkapp_basic.F.equal vk_hash vk.hash) vk
×
736

UNCOV
737
      let add (t : t) ~account_id ~vk = Map.set t ~key:account_id ~data:vk
×
738
    end
739

740
    module Command_wrapper :
741
      Command_wrapper_intf with type 'a t = 'a With_status.t = struct
742
      type 'a t = 'a With_status.t
743

744
      let unwrap = With_status.data
745

746
      let map { With_status.status; data } ~f =
747
        { With_status.status; data = f data }
960✔
748

749
      let is_failed { With_status.status; _ } =
UNCOV
750
        match status with Applied -> false | Failed _ -> true
×
751
    end
752

753
    include Make_create_all (Cache) (Command_wrapper)
754
  end
755
end
756

757
let of_verifiable (t : Verifiable.t) : t =
758
  { fee_payer = t.fee_payer
20✔
759
  ; account_updates = Call_forest.map t.account_updates ~f:fst
20✔
760
  ; memo = t.memo
761
  }
762

763
module Transaction_commitment = struct
764
  module Stable = Kimchi_backend.Pasta.Basic.Fp.Stable
765

766
  type t = (Stable.Latest.t[@deriving sexp])
767

768
  let sexp_of_t = Stable.Latest.sexp_of_t
769

770
  let t_of_sexp = Stable.Latest.t_of_sexp
771

772
  let empty = Outside_hash_image.t
773

774
  let typ = Snark_params.Tick.Field.typ
775

776
  let create ~(account_updates_hash : Digest.Forest.t) : t =
777
    (account_updates_hash :> t)
996✔
778

779
  let create_complete (t : t) ~memo_hash
780
      ~(fee_payer_hash : Digest.Account_update.t) =
781
    Random_oracle.hash ~init:Hash_prefix.account_update_cons
996✔
782
      [| memo_hash; (fee_payer_hash :> t); t |]
783

784
  module Checked = struct
785
    type t = Pickles.Impls.Step.Field.t
786

787
    let create ~(account_updates_hash : Digest.Forest.Checked.t) =
788
      (account_updates_hash :> t)
60✔
789

790
    let create_complete (t : t) ~memo_hash
791
        ~(fee_payer_hash : Digest.Account_update.Checked.t) =
792
      Random_oracle.Checked.hash ~init:Hash_prefix.account_update_cons
60✔
793
        [| memo_hash; (fee_payer_hash :> t); t |]
794
  end
795
end
796

797
let account_updates_hash (t : t) = Call_forest.hash t.account_updates
40✔
798

799
let commitment (t : t) : Transaction_commitment.t =
UNCOV
800
  Transaction_commitment.create ~account_updates_hash:(account_updates_hash t)
×
801

802
(** This module defines weights for each component of a `Zkapp_command.t` element. *)
803
module Weight = struct
UNCOV
804
  let account_update : Account_update.t -> int = fun _ -> 1
×
805

UNCOV
806
  let fee_payer (_fp : Account_update.Fee_payer.t) : int = 1
×
807

808
  let account_updates : (Account_update.t, _, _) Call_forest.t -> int =
UNCOV
809
    Call_forest.fold ~init:0 ~f:(fun acc p -> acc + account_update p)
×
810

UNCOV
811
  let memo : Signed_command_memo.t -> int = fun _ -> 0
×
812
end
813

814
let weight (zkapp_command : t) : int =
UNCOV
815
  let { fee_payer; account_updates; memo } = zkapp_command in
×
816
  List.sum
817
    (module Int)
818
    ~f:Fn.id
UNCOV
819
    [ Weight.fee_payer fee_payer
×
UNCOV
820
    ; Weight.account_updates account_updates
×
UNCOV
821
    ; Weight.memo memo
×
822
    ]
823

824
module type Valid_intf = sig
825
  [%%versioned:
826
  module Stable : sig
827
    module V1 : sig
828
      type t = private { zkapp_command : T.Stable.V1.t }
829
      [@@deriving sexp, compare, equal, hash, yojson]
830
    end
831
  end]
832

833
  val to_valid_unsafe :
834
    T.t -> [> `If_this_is_used_it_should_have_a_comment_justifying_it of t ]
835

836
  val to_valid :
837
       T.t
838
    -> failed:bool
839
    -> find_vk:
840
         (   Zkapp_basic.F.t
841
          -> Account_id.t
842
          -> (Verification_key_wire.t, Error.t) Result.t )
843
    -> t Or_error.t
844

845
  val of_verifiable : Verifiable.t -> t
846

847
  val forget : t -> T.t
848
end
849

850
module Valid :
851
  Valid_intf
852
    with type Stable.V1.t = Mina_wire_types.Mina_base.Zkapp_command.Valid.V1.t =
853
struct
854
  module S = Stable
855

856
  module Verification_key_hash = struct
857
    [%%versioned
858
    module Stable = struct
859
      module V1 = struct
860
        type t = Zkapp_basic.F.Stable.V1.t
×
861
        [@@deriving sexp, compare, equal, hash, yojson]
105✔
862

863
        let to_latest = Fn.id
864
      end
865
    end]
866
  end
867

868
  [%%versioned
869
  module Stable = struct
870
    module V1 = struct
871
      type t = Mina_wire_types.Mina_base.Zkapp_command.Valid.V1.t =
42✔
872
        { zkapp_command : S.V1.t }
×
873
      [@@deriving sexp, compare, equal, hash, yojson]
105✔
874

875
      let to_latest = Fn.id
876
    end
877
  end]
878

UNCOV
879
  let create zkapp_command : t = { zkapp_command }
×
880

881
  let of_verifiable (t : Verifiable.t) : t = { zkapp_command = of_verifiable t }
20✔
882

883
  let to_valid_unsafe (t : T.t) :
884
      [> `If_this_is_used_it_should_have_a_comment_justifying_it of t ] =
UNCOV
885
    `If_this_is_used_it_should_have_a_comment_justifying_it (create t)
×
886

887
  let forget (t : t) : T.t = t.zkapp_command
20✔
888

889
  let to_valid (t : T.t) ~failed ~find_vk : t Or_error.t =
890
    Verifiable.create t ~failed ~find_vk |> Or_error.map ~f:of_verifiable
20✔
891
end
892

893
[%%define_locally Stable.Latest.(of_yojson, to_yojson)]
894

895
(* so transaction ids have a version tag *)
896
include Codable.Make_base64 (Stable.Latest.With_top_version_tag)
897

898
type account_updates =
899
  (Account_update.t, Digest.Account_update.t, Digest.Forest.t) Call_forest.t
900

901
let account_updates_deriver obj =
902
  let of_zkapp_command_with_depth (ps : Account_update.Graphql_repr.t list) :
23✔
903
      account_updates =
904
    Call_forest.of_account_updates ps
20✔
905
      ~account_update_depth:(fun (p : Account_update.Graphql_repr.t) ->
906
        p.body.call_depth )
248✔
907
    |> Call_forest.map ~f:Account_update.of_graphql_repr
20✔
908
    |> Call_forest.accumulate_hashes'
909
  and to_zkapp_command_with_depth (ps : account_updates) :
910
      Account_update.Graphql_repr.t list =
911
    ps
20✔
912
    |> Call_forest.to_account_updates_map ~f:(fun ~depth p ->
913
           Account_update.to_graphql_repr ~call_depth:depth p )
134✔
914
  in
915
  let open Fields_derivers_zkapps.Derivers in
916
  let inner = (list @@ Account_update.Graphql_repr.deriver @@ o ()) @@ o () in
23✔
917
  iso ~map:of_zkapp_command_with_depth ~contramap:to_zkapp_command_with_depth
23✔
918
    inner obj
919

920
let deriver obj =
921
  let open Fields_derivers_zkapps.Derivers in
23✔
922
  let ( !. ) = ( !. ) ~t_fields_annots in
923
  Fields.make_creator obj
23✔
924
    ~fee_payer:!.Account_update.Fee_payer.deriver
23✔
925
    ~account_updates:!.account_updates_deriver
23✔
926
    ~memo:!.Signed_command_memo.deriver
23✔
927
  |> finish "ZkappCommand" ~t_toplevel_annots
928

929
let arg_typ () = Fields_derivers_zkapps.(arg_typ (deriver @@ Derivers.o ()))
1✔
930

931
let typ () = Fields_derivers_zkapps.(typ (deriver @@ Derivers.o ()))
×
932

933
let to_json x = Fields_derivers_zkapps.(to_json (deriver @@ Derivers.o ())) x
20✔
934

935
let of_json x = Fields_derivers_zkapps.(of_json (deriver @@ Derivers.o ())) x
×
936

937
let account_updates_of_json x =
938
  Fields_derivers_zkapps.(
×
939
    of_json
×
940
      ((list @@ Account_update.Graphql_repr.deriver @@ o ()) @@ derivers ()))
×
941
    x
942

943
let zkapp_command_to_json x =
944
  Fields_derivers_zkapps.(to_json (deriver @@ derivers ())) x
×
945

946
let arg_query_string x =
947
  Fields_derivers_zkapps.Test.Loop.json_to_string_gql @@ to_json x
20✔
948

949
let dummy =
950
  lazy
UNCOV
951
    (let account_update : Account_update.t =
×
952
       { body = Account_update.Body.dummy
UNCOV
953
       ; authorization = Control.dummy_of_tag Signature
×
954
       }
955
     in
956
     let fee_payer : Account_update.Fee_payer.t =
957
       { body = Account_update.Body.Fee_payer.dummy
958
       ; authorization = Signature.dummy
959
       }
960
     in
961
     { fee_payer
UNCOV
962
     ; account_updates = Call_forest.cons account_update []
×
963
     ; memo = Signed_command_memo.empty
964
     } )
965

966
module Make_update_group (Input : sig
967
  type global_state
968

969
  type local_state
970

971
  type spec
972

973
  type connecting_ledger_hash
974

975
  val zkapp_segment_of_controls : Control.t list -> spec
976
end) : sig
977
  module Zkapp_command_intermediate_state : sig
978
    type state = { global : Input.global_state; local : Input.local_state }
979

980
    type t =
981
      { kind : [ `Same | `New | `Two_new ]
982
      ; spec : Input.spec
983
      ; state_before : state
984
      ; state_after : state
985
      ; connecting_ledger : Input.connecting_ledger_hash
986
      }
987
  end
988

989
  val group_by_zkapp_command_rev :
990
       t list
991
    -> (Input.global_state * Input.local_state * Input.connecting_ledger_hash)
992
       list
993
       list
994
    -> Zkapp_command_intermediate_state.t list
995
end = struct
996
  open Input
997

998
  module Zkapp_command_intermediate_state = struct
999
    type state = { global : global_state; local : local_state }
1000

1001
    type t =
1002
      { kind : [ `Same | `New | `Two_new ]
1003
      ; spec : spec
1004
      ; state_before : state
1005
      ; state_after : state
1006
      ; connecting_ledger : connecting_ledger_hash
1007
      }
1008
  end
1009

1010
  (** [group_by_zkapp_command_rev zkapp_commands stmtss] identifies before/after pairs of
1011
      statements, corresponding to account updates for each zkapp_command in [zkapp_commands] which minimize the
1012
      number of snark proofs needed to prove all of the zkapp_command.
1013

1014
      This function is intended to take multiple zkapp transactions as
1015
      its input, which is then converted to a [Account_update.t list list] using
1016
      [List.map ~f:Zkapp_command.zkapp_command]. The [stmtss] argument should
1017
      be a list of the same length, with 1 more state than the number of
1018
      zkapp_command for each transaction.
1019

1020
      For example, two transactions made up of zkapp_command [[p1; p2; p3]] and
1021
      [[p4; p5]] should have the statements [[[s0; s1; s2; s3]; [s3; s4; s5]]],
1022
      where each [s_n] is the state after applying [p_n] on top of [s_{n-1}], and
1023
      where [s0] is the initial state before any of the transactions have been
1024
      applied.
1025

1026
      Each pair is also identified with one of [`Same], [`New], or [`Two_new],
1027
      indicating that the next one ([`New]) or next two ([`Two_new]) [Zkapp_command.t]s
1028
      will need to be passed as part of the snark witness while applying that
1029
      pair.
1030
  *)
1031
  let group_by_zkapp_command_rev (zkapp_commands : t list)
1032
      (stmtss : (global_state * local_state * connecting_ledger_hash) list list)
1033
      : Zkapp_command_intermediate_state.t list =
UNCOV
1034
    let intermediate_state ~kind ~spec ~before ~after =
×
UNCOV
1035
      let global_before, local_before, _ = before in
×
1036
      let global_after, local_after, connecting_ledger = after in
1037
      { Zkapp_command_intermediate_state.kind
1038
      ; spec
1039
      ; state_before = { global = global_before; local = local_before }
1040
      ; state_after = { global = global_after; local = local_after }
1041
      ; connecting_ledger
1042
      }
1043
    in
1044
    let zkapp_account_updatess =
1045
      []
UNCOV
1046
      :: List.map zkapp_commands ~f:(fun (zkapp_command : t) ->
×
UNCOV
1047
             all_account_updates_list zkapp_command )
×
1048
    in
1049
    let rec group_by_zkapp_command_rev
1050
        (zkapp_commands : Account_update.t list list) stmtss acc =
UNCOV
1051
      match (zkapp_commands, stmtss) with
×
1052
      | ([] | [ [] ]), [ _ ] ->
×
1053
          (* We've associated statements with all given zkapp_command. *)
1054
          acc
UNCOV
1055
      | [ [ { authorization = a1; _ } ] ], [ [ before; after ] ] ->
×
1056
          (* There are no later zkapp_command to pair this one with. Prove it on its
1057
             own.
1058
          *)
1059
          intermediate_state ~kind:`Same
UNCOV
1060
            ~spec:(zkapp_segment_of_controls [ a1 ])
×
1061
            ~before ~after
1062
          :: acc
UNCOV
1063
      | [ []; [ { authorization = a1; _ } ] ], [ [ _ ]; [ before; after ] ] ->
×
1064
          (* This account_update is part of a new transaction, and there are no later
1065
             zkapp_command to pair it with. Prove it on its own.
1066
          *)
1067
          intermediate_state ~kind:`New
UNCOV
1068
            ~spec:(zkapp_segment_of_controls [ a1 ])
×
1069
            ~before ~after
1070
          :: acc
UNCOV
1071
      | ( ({ authorization = Proof _ as a1; _ } :: zkapp_command)
×
1072
          :: zkapp_commands
1073
        , (before :: (after :: _ as stmts)) :: stmtss ) ->
1074
          (* This account_update contains a proof, don't pair it with other account updates. *)
1075
          group_by_zkapp_command_rev
1076
            (zkapp_command :: zkapp_commands)
1077
            (stmts :: stmtss)
1078
            ( intermediate_state ~kind:`Same
UNCOV
1079
                ~spec:(zkapp_segment_of_controls [ a1 ])
×
1080
                ~before ~after
1081
            :: acc )
1082
      | ( []
×
1083
          :: ({ authorization = Proof _ as a1; _ } :: zkapp_command)
1084
             :: zkapp_commands
1085
        , [ _ ] :: (before :: (after :: _ as stmts)) :: stmtss ) ->
1086
          (* This account_update is part of a new transaction, and contains a proof, don't
1087
             pair it with other account updates.
1088
          *)
1089
          group_by_zkapp_command_rev
1090
            (zkapp_command :: zkapp_commands)
1091
            (stmts :: stmtss)
1092
            ( intermediate_state ~kind:`New
1093
                ~spec:(zkapp_segment_of_controls [ a1 ])
×
1094
                ~before ~after
1095
            :: acc )
1096
      | ( ({ authorization = a1; _ }
×
1097
          :: ({ authorization = Proof _; _ } :: _ as zkapp_command) )
1098
          :: zkapp_commands
1099
        , (before :: (after :: _ as stmts)) :: stmtss ) ->
1100
          (* The next account_update contains a proof, don't pair it with this account_update. *)
1101
          group_by_zkapp_command_rev
1102
            (zkapp_command :: zkapp_commands)
1103
            (stmts :: stmtss)
1104
            ( intermediate_state ~kind:`Same
1105
                ~spec:(zkapp_segment_of_controls [ a1 ])
×
1106
                ~before ~after
1107
            :: acc )
1108
      | ( ({ authorization = a1; _ } :: ([] as zkapp_command))
×
1109
          :: (({ authorization = Proof _; _ } :: _) :: _ as zkapp_commands)
1110
        , (before :: (after :: _ as stmts)) :: stmtss ) ->
1111
          (* The next account_update is in the next transaction and contains a proof,
1112
             don't pair it with this account_update.
1113
          *)
1114
          group_by_zkapp_command_rev
1115
            (zkapp_command :: zkapp_commands)
1116
            (stmts :: stmtss)
1117
            ( intermediate_state ~kind:`Same
1118
                ~spec:(zkapp_segment_of_controls [ a1 ])
×
1119
                ~before ~after
1120
            :: acc )
UNCOV
1121
      | ( ({ authorization = (Signature _ | None_given) as a1; _ }
×
UNCOV
1122
          :: { authorization = (Signature _ | None_given) as a2; _ }
×
1123
             :: zkapp_command )
1124
          :: zkapp_commands
1125
        , (before :: _ :: (after :: _ as stmts)) :: stmtss ) ->
1126
          (* The next two zkapp_command do not contain proofs, and are within the same
1127
             transaction. Pair them.
1128
             Ok to get "use_full_commitment" of [a1] because neither of them
1129
             contain a proof.
1130
          *)
1131
          group_by_zkapp_command_rev
1132
            (zkapp_command :: zkapp_commands)
1133
            (stmts :: stmtss)
1134
            ( intermediate_state ~kind:`Same
UNCOV
1135
                ~spec:(zkapp_segment_of_controls [ a1; a2 ])
×
1136
                ~before ~after
1137
            :: acc )
UNCOV
1138
      | ( []
×
1139
          :: ({ authorization = a1; _ }
1140
             :: ({ authorization = Proof _; _ } :: _ as zkapp_command) )
1141
             :: zkapp_commands
1142
        , [ _ ] :: (before :: (after :: _ as stmts)) :: stmtss ) ->
1143
          (* This account_update is in the next transaction, and the next account_update contains a
1144
             proof, don't pair it with this account_update.
1145
          *)
1146
          group_by_zkapp_command_rev
1147
            (zkapp_command :: zkapp_commands)
1148
            (stmts :: stmtss)
1149
            ( intermediate_state ~kind:`New
UNCOV
1150
                ~spec:(zkapp_segment_of_controls [ a1 ])
×
1151
                ~before ~after
1152
            :: acc )
UNCOV
1153
      | ( []
×
1154
          :: ({ authorization = (Signature _ | None_given) as a1; _ }
×
UNCOV
1155
             :: { authorization = (Signature _ | None_given) as a2; _ }
×
1156
                :: zkapp_command )
1157
             :: zkapp_commands
1158
        , [ _ ] :: (before :: _ :: (after :: _ as stmts)) :: stmtss ) ->
1159
          (* The next two zkapp_command do not contain proofs, and are within the same
1160
             new transaction. Pair them.
1161
             Ok to get "use_full_commitment" of [a1] because neither of them
1162
             contain a proof.
1163
          *)
1164
          group_by_zkapp_command_rev
1165
            (zkapp_command :: zkapp_commands)
1166
            (stmts :: stmtss)
1167
            ( intermediate_state ~kind:`New
UNCOV
1168
                ~spec:(zkapp_segment_of_controls [ a1; a2 ])
×
1169
                ~before ~after
1170
            :: acc )
1171
      | ( [ { authorization = (Signature _ | None_given) as a1; _ } ]
×
1172
          :: ({ authorization = (Signature _ | None_given) as a2; _ }
×
1173
             :: zkapp_command )
1174
             :: zkapp_commands
1175
        , (before :: _after1) :: (_before2 :: (after :: _ as stmts)) :: stmtss )
1176
        ->
1177
          (* The next two zkapp_command do not contain proofs, and the second is within
1178
             a new transaction. Pair them.
1179
             Ok to get "use_full_commitment" of [a1] because neither of them
1180
             contain a proof.
1181
          *)
1182
          group_by_zkapp_command_rev
1183
            (zkapp_command :: zkapp_commands)
1184
            (stmts :: stmtss)
1185
            ( intermediate_state ~kind:`New
1186
                ~spec:(zkapp_segment_of_controls [ a1; a2 ])
×
1187
                ~before ~after
1188
            :: acc )
1189
      | ( []
×
1190
          :: ({ authorization = a1; _ } :: zkapp_command)
1191
             :: (({ authorization = Proof _; _ } :: _) :: _ as zkapp_commands)
1192
        , [ _ ] :: (before :: ([ after ] as stmts)) :: (_ :: _ as stmtss) ) ->
1193
          (* The next transaction contains a proof, and this account_update is in a new
1194
             transaction, don't pair it with the next account_update.
1195
          *)
1196
          group_by_zkapp_command_rev
1197
            (zkapp_command :: zkapp_commands)
1198
            (stmts :: stmtss)
1199
            ( intermediate_state ~kind:`New
1200
                ~spec:(zkapp_segment_of_controls [ a1 ])
×
1201
                ~before ~after
1202
            :: acc )
1203
      | ( []
×
1204
          :: [ { authorization = (Signature _ | None_given) as a1; _ } ]
×
1205
             :: ({ authorization = (Signature _ | None_given) as a2; _ }
×
1206
                :: zkapp_command )
1207
                :: zkapp_commands
1208
        , [ _ ]
1209
          :: [ before; _after1 ]
1210
             :: (_before2 :: (after :: _ as stmts)) :: stmtss ) ->
1211
          (* The next two zkapp_command do not contain proofs, the first is within a
1212
             new transaction, and the second is within another new transaction.
1213
             Pair them.
1214
             Ok to get "use_full_commitment" of [a1] because neither of them
1215
             contain a proof.
1216
          *)
1217
          group_by_zkapp_command_rev
1218
            (zkapp_command :: zkapp_commands)
1219
            (stmts :: stmtss)
1220
            ( intermediate_state ~kind:`Two_new
1221
                ~spec:(zkapp_segment_of_controls [ a1; a2 ])
×
1222
                ~before ~after
1223
            :: acc )
1224
      | [ [ { authorization = a1; _ } ] ], (before :: after :: _) :: _ ->
×
1225
          (* This account_update is the final account_update given. Prove it on its own. *)
1226
          intermediate_state ~kind:`Same
1227
            ~spec:(zkapp_segment_of_controls [ a1 ])
×
1228
            ~before ~after
1229
          :: acc
1230
      | ( [] :: [ { authorization = a1; _ } ] :: [] :: _
×
1231
        , [ _ ] :: (before :: after :: _) :: _ ) ->
1232
          (* This account_update is the final account_update given, in a new transaction. Prove it
1233
             on its own.
1234
          *)
1235
          intermediate_state ~kind:`New
1236
            ~spec:(zkapp_segment_of_controls [ a1 ])
×
1237
            ~before ~after
1238
          :: acc
1239
      | _, [] ->
×
1240
          failwith "group_by_zkapp_command_rev: No statements remaining"
1241
      | ([] | [ [] ]), _ ->
×
1242
          failwith "group_by_zkapp_command_rev: Unmatched statements remaining"
1243
      | [] :: _, [] :: _ ->
×
1244
          failwith
1245
            "group_by_zkapp_command_rev: No final statement for current \
1246
             transaction"
1247
      | [] :: _, (_ :: _ :: _) :: _ ->
×
1248
          failwith
1249
            "group_by_zkapp_command_rev: Unmatched statements for current \
1250
             transaction"
1251
      | [] :: [ _ ] :: _, [ _ ] :: (_ :: _ :: _ :: _) :: _ ->
×
1252
          failwith
1253
            "group_by_zkapp_command_rev: Unmatched statements for next \
1254
             transaction"
1255
      | [ []; [ _ ] ], [ _ ] :: [ _; _ ] :: _ :: _ ->
×
1256
          failwith
1257
            "group_by_zkapp_command_rev: Unmatched statements after next \
1258
             transaction"
1259
      | (_ :: _) :: _, ([] | [ _ ]) :: _ | (_ :: _ :: _) :: _, [ _; _ ] :: _ ->
×
1260
          failwith
1261
            "group_by_zkapp_command_rev: Too few statements remaining for the \
1262
             current transaction"
1263
      | ([] | [ _ ]) :: [] :: _, _ ->
×
1264
          failwith
1265
            "group_by_zkapp_command_rev: The next transaction has no \
1266
             zkapp_command"
1267
      | [] :: (_ :: _) :: _, _ :: ([] | [ _ ]) :: _
×
1268
      | [] :: (_ :: _ :: _) :: _, _ :: [ _; _ ] :: _ ->
×
1269
          failwith
1270
            "group_by_zkapp_command_rev: Too few statements remaining for the \
1271
             next transaction"
1272
      | [ _ ] :: (_ :: _) :: _, _ :: ([] | [ _ ]) :: _ ->
×
1273
          failwith
1274
            "group_by_zkapp_command_rev: Too few statements remaining for the \
1275
             next transaction"
1276
      | [] :: [ _ ] :: (_ :: _) :: _, _ :: _ :: ([] | [ _ ]) :: _ ->
×
1277
          failwith
1278
            "group_by_zkapp_command_rev: Too few statements remaining for the \
1279
             transaction after next"
1280
      | ([] | [ _ ]) :: (_ :: _) :: _, [ _ ] ->
×
1281
          failwith
1282
            "group_by_zkapp_command_rev: No statements given for the next \
1283
             transaction"
1284
      | [] :: [ _ ] :: (_ :: _) :: _, [ _; _ :: _ :: _ ] ->
×
1285
          failwith
1286
            "group_by_zkapp_command_rev: No statements given for transaction \
1287
             after next"
1288
    in
1289
    group_by_zkapp_command_rev zkapp_account_updatess stmtss []
1290
end
1291

1292
(*Transaction_snark.Zkapp_command_segment.Basic.t*)
1293
type possible_segments = Proved | Signed_single | Signed_pair
1294

1295
module Update_group = Make_update_group (struct
1296
  type local_state = unit
1297

1298
  type global_state = unit
1299

1300
  type connecting_ledger_hash = unit
1301

1302
  type spec = possible_segments
1303

1304
  let zkapp_segment_of_controls controls : spec =
UNCOV
1305
    match controls with
×
UNCOV
1306
    | [ Control.Proof _ ] ->
×
1307
        Proved
UNCOV
1308
    | [ (Control.Signature _ | Control.None_given) ] ->
×
1309
        Signed_single
1310
    | [ Control.(Signature _ | None_given); Control.(Signature _ | None_given) ]
×
1311
      ->
1312
        Signed_pair
1313
    | _ ->
×
1314
        failwith "zkapp_segment_of_controls: Unsupported combination"
1315
end)
1316

1317
let zkapp_cost ~proof_segments ~signed_single_segments ~signed_pair_segments
1318
    ~(genesis_constants : Genesis_constants.t) () =
1319
  (*10.26*np + 10.08*n2 + 9.14*n1 < 69.45*)
UNCOV
1320
  let proof_cost = genesis_constants.zkapp_proof_update_cost in
×
1321
  let signed_pair_cost = genesis_constants.zkapp_signed_pair_update_cost in
1322
  let signed_single_cost = genesis_constants.zkapp_signed_single_update_cost in
1323
  Float.(
UNCOV
1324
    (proof_cost * of_int proof_segments)
×
UNCOV
1325
    + (signed_pair_cost * of_int signed_pair_segments)
×
UNCOV
1326
    + (signed_single_cost * of_int signed_single_segments))
×
1327

1328
(* Zkapp_command transactions are filtered using this predicate
1329
   - when adding to the transaction pool
1330
   - in incoming blocks
1331
*)
1332
let valid_size ~(genesis_constants : Genesis_constants.t) (t : t) :
1333
    unit Or_error.t =
UNCOV
1334
  let events_elements events =
×
UNCOV
1335
    List.fold events ~init:0 ~f:(fun acc event -> acc + Array.length event)
×
1336
  in
1337
  let all_updates, num_event_elements, num_action_elements =
UNCOV
1338
    Call_forest.fold t.account_updates
×
UNCOV
1339
      ~init:([ Account_update.of_fee_payer (fee_payer_account_update t) ], 0, 0)
×
1340
      ~f:(fun (acc, num_event_elements, num_action_elements)
1341
              (account_update : Account_update.t) ->
UNCOV
1342
        let account_update_evs_elements =
×
1343
          events_elements account_update.body.events
1344
        in
UNCOV
1345
        let account_update_seq_evs_elements =
×
1346
          events_elements account_update.body.actions
1347
        in
UNCOV
1348
        ( account_update :: acc
×
1349
        , num_event_elements + account_update_evs_elements
1350
        , num_action_elements + account_update_seq_evs_elements ) )
UNCOV
1351
    |> fun (updates, ev, sev) -> (List.rev updates, ev, sev)
×
1352
  in
UNCOV
1353
  let groups =
×
1354
    Update_group.group_by_zkapp_command_rev [ t ]
1355
      ( [ ((), (), ()) ]
UNCOV
1356
      :: [ ((), (), ()) :: List.map all_updates ~f:(fun _ -> ((), (), ())) ] )
×
1357
  in
UNCOV
1358
  let proof_segments, signed_single_segments, signed_pair_segments =
×
1359
    List.fold ~init:(0, 0, 0) groups
1360
      ~f:(fun (proof_segments, signed_singles, signed_pairs) { spec; _ } ->
UNCOV
1361
        match spec with
×
UNCOV
1362
        | Proved ->
×
1363
            (proof_segments + 1, signed_singles, signed_pairs)
UNCOV
1364
        | Signed_single ->
×
1365
            (proof_segments, signed_singles + 1, signed_pairs)
UNCOV
1366
        | Signed_pair ->
×
1367
            (proof_segments, signed_singles, signed_pairs + 1) )
1368
  in
UNCOV
1369
  let cost_limit = genesis_constants.zkapp_transaction_cost_limit in
×
1370
  let max_event_elements = genesis_constants.max_event_elements in
1371
  let max_action_elements = genesis_constants.max_action_elements in
1372
  let zkapp_cost_within_limit =
1373
    Float.(
UNCOV
1374
      zkapp_cost ~proof_segments ~signed_single_segments ~signed_pair_segments
×
1375
        ~genesis_constants ()
1376
      < cost_limit)
1377
  in
1378
  let valid_event_elements = num_event_elements <= max_event_elements in
1379
  let valid_action_elements = num_action_elements <= max_action_elements in
UNCOV
1380
  if zkapp_cost_within_limit && valid_event_elements && valid_action_elements
×
UNCOV
1381
  then Ok ()
×
1382
  else
1383
    let proof_zkapp_command_err =
×
1384
      if zkapp_cost_within_limit then None
×
1385
      else Some (sprintf "zkapp transaction too expensive")
×
1386
    in
1387
    let events_err =
1388
      if valid_event_elements then None
×
1389
      else
1390
        Some
×
1391
          (sprintf "too many event elements (%d, max allowed is %d)"
×
1392
             num_event_elements max_event_elements )
1393
    in
1394
    let actions_err =
1395
      if valid_action_elements then None
×
1396
      else
1397
        Some
×
1398
          (sprintf "too many sequence event elements (%d, max allowed is %d)"
×
1399
             num_action_elements max_action_elements )
1400
    in
1401
    let err_msg =
1402
      List.filter
×
1403
        [ proof_zkapp_command_err; events_err; actions_err ]
1404
        ~f:Option.is_some
1405
      |> List.map ~f:(fun opt -> Option.value_exn opt)
×
1406
      |> String.concat ~sep:"; "
1407
    in
1408
    Error (Error.of_string err_msg)
×
1409

1410
let has_zero_vesting_period t =
UNCOV
1411
  Call_forest.exists t.account_updates ~f:(fun p ->
×
UNCOV
1412
      match p.body.update.timing with
×
UNCOV
1413
      | Keep ->
×
1414
          false
UNCOV
1415
      | Set { vesting_period; _ } ->
×
UNCOV
1416
          Mina_numbers.Global_slot_span.(equal zero) vesting_period )
×
1417

1418
let is_incompatible_version t =
UNCOV
1419
  Call_forest.exists t.account_updates ~f:(fun p ->
×
UNCOV
1420
      match p.body.update.permissions with
×
UNCOV
1421
      | Keep ->
×
1422
          false
UNCOV
1423
      | Set { set_verification_key = _auth, txn_version; _ } ->
×
UNCOV
1424
          not Mina_numbers.Txn_version.(equal_to_current txn_version) )
×
1425

1426
let get_transaction_commitments (zkapp_command : t) =
1427
  let memo_hash = Signed_command_memo.hash zkapp_command.memo in
40✔
1428
  let fee_payer_hash =
40✔
1429
    Account_update.of_fee_payer zkapp_command.fee_payer
40✔
1430
    |> Digest.Account_update.create
1431
  in
1432
  let account_updates_hash = account_updates_hash zkapp_command in
40✔
1433
  let txn_commitment = Transaction_commitment.create ~account_updates_hash in
40✔
1434
  let full_txn_commitment =
1435
    Transaction_commitment.create_complete txn_commitment ~memo_hash
1436
      ~fee_payer_hash
1437
  in
1438
  (txn_commitment, full_txn_commitment)
40✔
1439

1440
let inner_query =
1441
  lazy
1442
    (Option.value_exn ~message:"Invariant: All projectable derivers are Some"
2✔
1443
       Fields_derivers_zkapps.(inner_query (deriver @@ Derivers.o ())) )
2✔
1444

1445
module For_tests = struct
1446
  let replace_vk vk (p : Account_update.t) =
NEW
1447
    { p with
×
1448
      body =
1449
        { p.body with
1450
          update =
1451
            { p.body.update with
1452
              verification_key =
1453
                (* replace dummy vks in vk Setting *)
1454
                ( match p.body.update.verification_key with
NEW
1455
                | Set _vk ->
×
1456
                    Set vk
NEW
1457
                | Keep ->
×
1458
                    Keep )
1459
            }
1460
        ; authorization_kind =
1461
            (* replace dummy vk hashes in authorization kind *)
1462
            ( match p.body.authorization_kind with
NEW
1463
            | Proof _vk_hash ->
×
NEW
1464
                Proof (With_hash.hash vk)
×
NEW
1465
            | ak ->
×
1466
                ak )
1467
        }
1468
    }
1469

1470
  let replace_vks (t : t) vk =
UNCOV
1471
    { t with
×
NEW
1472
      account_updates = Call_forest.map t.account_updates ~f:(replace_vk vk)
×
1473
    }
1474
end
1475

1476
let%test "latest zkApp version" =
1477
  (* if this test fails, update `Transaction_hash.hash_of_transaction_id`
1478
     for latest version, then update this test
1479
  *)
UNCOV
1480
  Stable.Latest.version = 1
×
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc