Source file zk_rollup_apply.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
open Alpha_context
type error += Zk_rollup_feature_disabled | Zk_rollup_negative_nb_ops
let () =
  let description = "ZK rollups will be enabled in a future proposal." in
  register_error_kind
    `Permanent
    ~id:"operation.zk_rollup_disabled"
    ~title:"ZK rollups are disabled"
    ~description
    ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
    Data_encoding.unit
    (function Zk_rollup_feature_disabled -> Some () | _ -> None)
    (fun () -> Zk_rollup_feature_disabled) ;
  let description = "The value of [nb_ops] should never be negative." in
  register_error_kind
    `Permanent
    ~id:"operation.zk_rollup_negative_nb_ops"
    ~title:"ZK rollups negative number of operations"
    ~description
    ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
    Data_encoding.unit
    (function Zk_rollup_negative_nb_ops -> Some () | _ -> None)
    (fun () -> Zk_rollup_negative_nb_ops)
let assert_feature_enabled ctxt =
  error_unless (Constants.zk_rollup_enable ctxt) Zk_rollup_feature_disabled
let originate ~ctxt_before_op ~ctxt ~public_parameters ~circuits_info
    ~init_state ~nb_ops =
  let open Lwt_result_syntax in
  let*? () = assert_feature_enabled ctxt in
  let*? () = error_when Compare.Int.(nb_ops < 0) Zk_rollup_negative_nb_ops in
  let+ ctxt, originated_zk_rollup, storage_size =
    Zk_rollup.originate
      ctxt
      {
        public_parameters;
        state_length = Array.length init_state;
        circuits_info;
        nb_ops;
      }
      ~init_state
  in
  let consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt in
  let result =
    Apply_results.Zk_rollup_origination_result
      {
        balance_updates = [];
        originated_zk_rollup;
        
        consumed_gas;
        storage_size;
      }
  in
  (ctxt, result, [])
(** [parse_ticket ~ticketer ~contents ~ty ctxt] reconstructs a ticket from
    individual parts submitted as part of a Zk_rollup_publish operation. *)
let parse_ticket ~ticketer ~contents ~ty ctxt =
  Script_ir_translator.parse_comparable_ty ctxt (Micheline.root ty)
  >>?= fun (Ex_comparable_ty contents_type, ctxt) ->
  Script_ir_translator.parse_comparable_data
    ctxt
    contents_type
    (Micheline.root contents)
  >>=? fun (contents, ctxt) ->
  return @@ (ctxt, Ticket_token.Ex_token {ticketer; contents_type; contents})
let publish ~ctxt_before_op ~ctxt ~zk_rollup ~l2_ops =
  let open Lwt_result_syntax in
  let*? () = assert_feature_enabled ctxt in
  let open Zk_rollup.Operation in
  
  let*? () =
    error_unless
      (List.for_all
         (fun (l2_op, _ticket_opt) -> Compare.Z.(l2_op.price.amount <= Z.zero))
         l2_ops)
      Zk_rollup.Errors.Deposit_as_external
  in
  
  let* ctxt, l2_ops_with_ticket_hashes =
    List.fold_left_map_es
      (fun ctxt (l2_op, ticket_opt) ->
        match ticket_opt with
        | None ->
            let*? () =
              error_unless
                Compare.Z.(l2_op.price.amount = Z.zero)
                Zk_rollup.Errors.Invalid_deposit_amount
            in
            return (ctxt, (l2_op, None))
        | Some Zk_rollup.Ticket.{ticketer; ty; contents} ->
            let*? () =
              error_when
                Compare.Z.(l2_op.price.amount = Z.zero)
                Zk_rollup.Errors.Invalid_deposit_amount
            in
            let* ctxt, ticket_token =
              parse_ticket ~ticketer ~contents ~ty ctxt
            in
            
            let* receiver_ticket_hash, ctxt =
              Ticket_balance_key.of_ex_token
                ctxt
                ~owner:(Contract (Implicit l2_op.l1_dst))
                ticket_token
            in
            
            let* source_ticket_hash, ctxt =
              Ticket_balance_key.of_ex_token
                ctxt
                ~owner:(Zk_rollup zk_rollup)
                ticket_token
            in
            let*? () =
              error_unless
                Ticket_hash.(equal l2_op.price.id source_ticket_hash)
                Zk_rollup.Errors.Invalid_deposit_ticket
            in
            return (ctxt, (l2_op, Some receiver_ticket_hash)))
      ctxt
      l2_ops
  in
  let+ ctxt, paid_storage_size_diff =
    Zk_rollup.add_to_pending ctxt zk_rollup l2_ops_with_ticket_hashes
  in
  
  let consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt in
  let result =
    Apply_results.Zk_rollup_publish_result
      {balance_updates = []; consumed_gas; paid_storage_size_diff}
  in
  (ctxt, result, [])
let transaction_to_zk_rollup ~ctxt ~parameters_ty ~parameters ~dst_rollup ~since
    =
  let open Lwt_result_syntax in
  let*? () = assert_feature_enabled ctxt in
  let*? {ex_ticket; zkru_operation} =
    Zk_rollup_parameters.get_deposit_parameters parameters_ty parameters
  in
  let* ticket_size, ctxt = Ticket_scanner.ex_ticket_size ctxt ex_ticket in
  let limit = Constants.tx_rollup_max_ticket_payload_size ctxt in
  let*? () =
    error_when
      Saturation_repr.(ticket_size >! limit)
      (Zk_rollup.Errors.Ticket_payload_size_limit_exceeded
         {payload_size = ticket_size; limit})
  in
  let ex_token, ticket_amount =
    Ticket_scanner.ex_token_and_amount_of_ex_ticket ex_ticket
  in
  
  let* ticket_hash, ctxt =
    Ticket_balance_key.of_ex_token ctxt ~owner:(Zk_rollup dst_rollup) ex_token
  in
  let ticket_amount = Script_int.(to_zint (ticket_amount :> n num)) in
  
  let*? () =
    error_unless
      Compare.Z.(ticket_amount = zkru_operation.price.amount)
      Zk_rollup.Errors.Invalid_deposit_amount
  in
  let*? () =
    error_unless
      Ticket_hash.(equal ticket_hash zkru_operation.price.id)
      Zk_rollup.Errors.Invalid_deposit_ticket
  in
  
  let* receiver_ticket_hash, ctxt =
    Ticket_balance_key.of_ex_token
      ctxt
      ~owner:(Contract (Implicit zkru_operation.l1_dst))
      ex_token
  in
  
  let+ ctxt, paid_storage_size_diff =
    Zk_rollup.add_to_pending
      ctxt
      Zk_rollup.Operation.(zkru_operation.rollup_id)
      [(zkru_operation, Some receiver_ticket_hash)]
  in
  
  let result =
    Apply_internal_results.(
      ITransaction_result
        (Transaction_to_zk_rollup_result
           {
             balance_updates = [];
             consumed_gas = Gas.consumed ~since ~until:ctxt;
             ticket_hash;
             paid_storage_size_diff;
           }))
  in
  (ctxt, result, [])
module SMap = Map.Make (String)
let insert s x =
  SMap.update s (function None -> Some [x] | Some l -> Some (x :: l))
let collect_pending_ops_inputs ~zk_rollup ~account ~rev_pi_map
    ~pending_ops_and_pis =
  let open Lwt_result_syntax in
  let open Zk_rollup.Update in
  let open Zk_rollup.Account in
  let* rev_pi_map, new_state, fees, rev_exit_validites =
    List.fold_left_es
      (fun (rev_pi_map, old_state, fees, rev_exit_validites)
           ((l2_op, _ticket_hash_opt), (name, (sent_pi : op_pi))) ->
        let new_state = sent_pi.new_state in
        let*? () =
          error_unless
            Compare.Int.(Array.length new_state = account.static.state_length)
            Zk_rollup.Errors.Inconsistent_state_update
        in
        let pi =
          Zk_rollup.Circuit_public_inputs.(
            Pending_op
              {
                old_state;
                new_state;
                fee = sent_pi.fee;
                exit_validity = sent_pi.exit_validity;
                zk_rollup;
                l2_op;
              })
        in
        let rev_pi_map =
          insert
            name
            (Zk_rollup.Circuit_public_inputs.to_scalar_array pi)
            rev_pi_map
        in
        return
          ( rev_pi_map,
            new_state,
            Bls.Primitive.Fr.add fees sent_pi.fee,
            sent_pi.exit_validity :: rev_exit_validites ))
      (rev_pi_map, account.dynamic.state, Bls.Primitive.Fr.zero, [])
      pending_ops_and_pis
  in
  return (rev_pi_map, new_state, fees, List.rev rev_exit_validites)
let collect_pivate_batch_inputs ~zk_rollup ~account ~rev_pi_map ~update
    ~prev_state ~fees =
  let open Lwt_result_syntax in
  let open Zk_rollup.Update in
  let open Zk_rollup.Account in
  let is_private = function Some `Private -> true | _ -> false in
  List.fold_left_es
    (fun (rev_pi_map, old_state, fees) (name, (sent_pi : private_inner_pi)) ->
      let*? () =
        error_unless
          (is_private
             (Zk_rollup.Account.SMap.find name account.static.circuits_info))
          Zk_rollup.Errors.Invalid_circuit
      in
      let new_state = sent_pi.new_state in
      let*? () =
        error_unless
          Compare.Int.(Array.length new_state = account.static.state_length)
          Zk_rollup.Errors.Inconsistent_state_update
      in
      let pi =
        Zk_rollup.Circuit_public_inputs.(
          Private_batch {old_state; new_state; fees = sent_pi.fees; zk_rollup})
      in
      let rev_pi_map =
        insert
          name
          (Zk_rollup.Circuit_public_inputs.to_scalar_array pi)
          rev_pi_map
      in
      return (rev_pi_map, new_state, Bls.Primitive.Fr.add fees sent_pi.fees))
    (rev_pi_map, prev_state, fees)
    update.private_pis
let collect_fee_inputs ~prev_state ~update ~fees ~rev_pi_map =
  let open Zk_rollup.Update in
  let old_state = prev_state in
  let new_state = update.fee_pi.new_state in
  let pi = Zk_rollup.Circuit_public_inputs.(Fee {old_state; new_state; fees}) in
  let rev_pi_map =
    insert "fee" (Zk_rollup.Circuit_public_inputs.to_scalar_array pi) rev_pi_map
  in
  (rev_pi_map, new_state)
let collect_inputs ~zk_rollup ~account ~rev_pi_map ~pending_ops_and_pis ~update
    =
  let open Lwt_result_syntax in
  
  let* rev_pi_map, new_state, fees, exit_validities =
    collect_pending_ops_inputs
      ~zk_rollup
      ~account
      ~rev_pi_map
      ~pending_ops_and_pis
  in
  
  let* rev_pi_map, new_state, fees =
    collect_pivate_batch_inputs
      ~zk_rollup
      ~account
      ~rev_pi_map
      ~update
      ~prev_state:new_state
      ~fees
  in
  
  let rev_pi_map, new_state =
    collect_fee_inputs ~prev_state:new_state ~update ~fees ~rev_pi_map
  in
  let pi_map = SMap.map List.rev rev_pi_map in
  return (pi_map, exit_validities, new_state)
let perform_exits ctxt exits =
  let open Lwt_result_syntax in
  List.fold_left_es
    (fun (ctxt, storage_diff) ((op, ticket_hash_opt), exit_validity) ->
      let open Zk_rollup.Operation in
      match ticket_hash_opt with
      | None ->
          let*? () =
            error_unless
              Compare.Z.(Z.zero = op.price.amount)
              Zk_rollup.Errors.Invalid_deposit_amount
          in
          return (ctxt, storage_diff)
      | Some receiver_ticket_hash ->
          if exit_validity then
            let*? amount =
              Option.value_e
                ~error:
                  (Error_monad.trace_of_error
                     Zk_rollup.Errors.Invalid_deposit_amount)
                (Ticket_amount.of_zint (Z.abs @@ op.price.amount))
            in
            let* ctxt, diff =
              Ticket_transfer.transfer_ticket_with_hashes
                ctxt
                ~src_hash:op.price.id
                ~dst_hash:receiver_ticket_hash
                amount
            in
            return (ctxt, Z.add diff storage_diff)
          else return (ctxt, storage_diff))
    (ctxt, Z.zero)
    exits
let update ~ctxt_before_op ~ctxt ~zk_rollup ~update =
  let open Lwt_result_syntax in
  let open Zk_rollup.Update in
  let*? () = assert_feature_enabled ctxt in
  let rev_pi_map = SMap.empty in
  let* ctxt, account = Zk_rollup.account ctxt zk_rollup in
  let update_public_length = List.length update.pending_pis in
  let* ctxt, pending_list_length =
    Zk_rollup.get_pending_length ctxt zk_rollup
  in
  let min_pending_to_process =
    Constants.zk_rollup_min_pending_to_process ctxt
  in
  
  let*? () =
    error_when
      Compare.Int.(
        update_public_length < pending_list_length
        && update_public_length < min_pending_to_process)
      Zk_rollup.Errors.Pending_bound
  in
  let* ctxt, pending_ops =
    Zk_rollup.get_prefix ctxt zk_rollup update_public_length
  in
  
  let pending_ops_and_pis = List.combine_drop pending_ops update.pending_pis in
  
  let* pi_map, exit_validities, new_state =
    collect_inputs ~zk_rollup ~account ~rev_pi_map ~pending_ops_and_pis ~update
  in
  
  let verified =
    Plonk.verify
      account.static.public_parameters
      (SMap.bindings pi_map)
      update.proof
  in
  let*? () = error_unless verified Zk_rollup.Errors.Invalid_verification in
  
  let* ctxt =
    Zk_rollup.update
      ctxt
      zk_rollup
      ~pending_to_drop:update_public_length
      ~new_account:
        {account with dynamic = {account.dynamic with state = new_state}}
  in
  
  let exits = List.combine_drop pending_ops exit_validities in
  let* ctxt, exits_paid_storage_size_diff = perform_exits ctxt exits in
  
  let consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt in
  let result =
    Apply_results.Zk_rollup_update_result
      {
        balance_updates = [];
        consumed_gas;
        paid_storage_size_diff = exits_paid_storage_size_diff;
      }
  in
  return (ctxt, result, [])