Source file sc_rollup_inbox_repr.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
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
(**
A Merkelized inbox represents a list of messages. This list
is decomposed into sublists of messages, one for each Tezos level greater
than the level where SCORU is activated.
This module is designed to:
1. provide a space-efficient representation for proofs of inbox
inclusions (only for inboxes obtained at the end of block
validation) ;
2. offer an efficient function to add a new batch of messages in the
inbox at the current level.
To solve (1), we use a proof tree H which is implemented by a merkelized skip
list allowing for compact inclusion proofs (See {!skip_list_repr.ml}).
To solve (2), we maintain a separate proof tree C witnessing the contents of
messages of the current level also implemented by a merkelized skip list for
the same reason.
The protocol maintains the hashes of the head of H and C.
The rollup node needs to maintain a full representation for C and a
partial representation for H back to the level of the LCC.
*)
type error += Inbox_proof_error of string
type error += Tried_to_add_zero_messages
type error += Inbox_level_reached_messages_limit
let () =
let open Data_encoding in
register_error_kind
`Permanent
~id:"internal.smart_rollup_inbox_proof_error"
~title:
"Internal error: error occurred during proof production or validation"
~description:"An inbox proof error."
~pp:(fun ppf e -> Format.fprintf ppf "Inbox proof error: %s" e)
(obj1 (req "error" (string Plain)))
(function Inbox_proof_error e -> Some e | _ -> None)
(fun e -> Inbox_proof_error e) ;
register_error_kind
`Permanent
~id:"internal.smart_rollup_add_zero_messages"
~title:"Internal error: trying to add zero messages"
~description:
"Message adding functions must be called with a positive number of \
messages"
~pp:(fun ppf _ -> Format.fprintf ppf "Tried to add zero messages")
empty
(function Tried_to_add_zero_messages -> Some () | _ -> None)
(fun () -> Tried_to_add_zero_messages) ;
let description =
Format.sprintf
"There can be only %s messages in an inbox level, the limit has been \
reached."
(Z.to_string Constants_repr.sc_rollup_max_number_of_messages_per_level)
in
register_error_kind
`Permanent
~id:"smart_rollup_inbox_level_reached_message_limit"
~title:"Inbox level reached messages limit"
~description
~pp:(fun ppf _ -> Format.pp_print_string ppf description)
empty
(function Inbox_level_reached_messages_limit -> Some () | _ -> None)
(fun () -> Inbox_level_reached_messages_limit)
module Int64_map = Map.Make (Int64)
let hash_prefix = "\003\255\138\145\110"
module Hash = struct
let prefix = "srib1"
let encoded_size = 55
module H =
Blake2B.Make
(Base58)
(struct
let name = "Smart_rollup_inbox_hash"
let title = "The hash of an inbox of a smart rollup"
let b58check_prefix = hash_prefix
let size = None
end)
include H
let () = Base58.check_encoded_prefix b58check_encoding prefix encoded_size
include Path_encoding.Make_hex (H)
end
module Skip_list_parameters = struct
let basis = 4
end
module Skip_list = Skip_list_repr.Make (Skip_list_parameters)
module V1 = struct
type level_proof = {
hash : Sc_rollup_inbox_merkelized_payload_hashes_repr.Hash.t;
level : Raw_level_repr.t;
}
let level_proof_encoding =
let open Data_encoding in
conv
(fun {hash; level} -> (hash, level))
(fun (hash, level) -> {hash; level})
(obj2
(req
"hash"
Sc_rollup_inbox_merkelized_payload_hashes_repr.Hash.encoding)
(req "level" Raw_level_repr.encoding))
let equal_level_proof {hash; level} level_proof_2 =
Sc_rollup_inbox_merkelized_payload_hashes_repr.Hash.equal
hash
level_proof_2.hash
&& Raw_level_repr.equal level level_proof_2.level
type history_proof = (level_proof, Hash.t) Skip_list.cell
let hash_history_proof cell =
let {hash; level} = Skip_list.content cell in
let back_pointers_hashes = Skip_list.back_pointers cell in
Sc_rollup_inbox_merkelized_payload_hashes_repr.Hash.to_bytes hash
:: (Raw_level_repr.to_int32 level |> Int32.to_string |> Bytes.of_string)
:: List.map Hash.to_bytes back_pointers_hashes
|> Hash.hash_bytes
let equal_history_proof = Skip_list.equal Hash.equal equal_level_proof
let history_proof_encoding : history_proof Data_encoding.t =
Skip_list.encoding Hash.encoding level_proof_encoding
let pp_level_proof fmt {hash; level} =
Format.fprintf
fmt
"hash: %a@,level: %a"
Sc_rollup_inbox_merkelized_payload_hashes_repr.Hash.pp
hash
Raw_level_repr.pp
level
let pp_history_proof fmt history_proof =
(Skip_list.pp ~pp_content:pp_level_proof ~pp_ptr:Hash.pp) fmt history_proof
(** Construct an inbox [history] with a given [capacity]. If you
are running a rollup node, [capacity] needs to be large enough to
remember any levels for which you may need to produce proofs. *)
module History =
Bounded_history_repr.Make
(struct
let name = "Smart_rollup_inbox_history"
end)
(Hash)
(struct
type t = history_proof
let pp = pp_history_proof
let equal = equal_history_proof
let encoding = history_proof_encoding
end)
type t = {level : Raw_level_repr.t; old_levels_messages : history_proof}
let equal inbox1 inbox2 =
let {level; old_levels_messages} = inbox1 in
Raw_level_repr.equal level inbox2.level
&& equal_history_proof old_levels_messages inbox2.old_levels_messages
let pp fmt {level; old_levels_messages} =
Format.fprintf
fmt
"@[<hov 2>{ level = %a@;old_levels_messages = %a@;}@]"
Raw_level_repr.pp
level
pp_history_proof
old_levels_messages
let hash inbox = hash_history_proof inbox.old_levels_messages
let inbox_level inbox = inbox.level
let old_levels_messages inbox = inbox.old_levels_messages
let current_witness inbox =
let {hash; _} = Skip_list.content inbox.old_levels_messages in
hash
let encoding =
Data_encoding.(
conv
(fun {level; old_levels_messages} -> (level, old_levels_messages))
(fun (level, old_levels_messages) -> {level; old_levels_messages})
(obj2
(req "level" Raw_level_repr.encoding)
(req "old_levels_messages" history_proof_encoding)))
end
type versioned = V1 of V1.t
let versioned_encoding =
let open Data_encoding in
union
[
case
~title:"V1"
(Tag 0)
V1.encoding
(function V1 inbox -> Some inbox)
(fun inbox -> V1 inbox);
]
include V1
let of_versioned = function V1 inbox -> inbox [@@inline]
let to_versioned inbox = V1 inbox [@@inline]
type serialized_proof = string
let serialized_proof_encoding = Data_encoding.(string Hex)
type payloads_proof = {
proof : Sc_rollup_inbox_merkelized_payload_hashes_repr.proof;
payload : Sc_rollup_inbox_message_repr.serialized option;
}
let payloads_proof_encoding =
let open Data_encoding in
conv
(fun {proof; payload} -> (proof, (payload :> string option)))
(fun (proof, payload) ->
{
proof;
payload =
Option.map Sc_rollup_inbox_message_repr.unsafe_of_string payload;
})
(obj2
(req
"proof"
Sc_rollup_inbox_merkelized_payload_hashes_repr.proof_encoding)
(opt "payload" (string Hex)))
let add_protocol_internal_message payload payloads_history witness =
Sc_rollup_inbox_merkelized_payload_hashes_repr.add_payload
payloads_history
witness
payload
let add_protocol_internal_message_no_history payload witness =
Sc_rollup_inbox_merkelized_payload_hashes_repr.add_payload_no_history
witness
payload
let add_message payload payloads_history witness =
let open Result_syntax in
let message_counter =
Sc_rollup_inbox_merkelized_payload_hashes_repr.get_index witness
in
let* () =
let max_number_of_messages_per_level =
Constants_repr.sc_rollup_max_number_of_messages_per_level
in
error_unless
Compare.Z.(message_counter <= max_number_of_messages_per_level)
Inbox_level_reached_messages_limit
in
Sc_rollup_inbox_merkelized_payload_hashes_repr.add_payload
payloads_history
witness
payload
let take_snapshot inbox = inbox.old_levels_messages
(** [archive history inbox witness] archives the current inbox level depending
on the [history] parameter's [capacity]. Updates the
[inbox.current_level] and [inbox.old_levels_messages]. *)
let archive history inbox witness =
let open Result_syntax in
let form_history_proof history inbox =
let prev_cell = inbox.old_levels_messages in
let prev_cell_ptr = hash_history_proof prev_cell in
let* history = History.remember prev_cell_ptr prev_cell history in
let current_level_proof =
let hash = Sc_rollup_inbox_merkelized_payload_hashes_repr.hash witness in
{hash; level = inbox.level}
in
let cell = Skip_list.next ~prev_cell ~prev_cell_ptr current_level_proof in
return (history, cell)
in
let* history, old_levels_messages = form_history_proof history inbox in
let inbox = {inbox with old_levels_messages} in
return (history, inbox)
(** [archive_no_history inbox witness] archives the current inbox level. Updates
the [inbox.current_level] and [inbox.old_levels_messages]. *)
let archive_no_history inbox witness =
let old_levels_messages =
let prev_cell = inbox.old_levels_messages in
let prev_cell_ptr = hash_history_proof prev_cell in
let current_level_proof =
let hash = Sc_rollup_inbox_merkelized_payload_hashes_repr.hash witness in
{hash; level = inbox.level}
in
Skip_list.next ~prev_cell ~prev_cell_ptr current_level_proof
in
{inbox with old_levels_messages}
let add_messages payloads_history payloads witness =
let open Result_syntax in
let* () =
error_when
(match payloads with [] -> true | _ -> false)
Tried_to_add_zero_messages
in
let* payloads_history, witness =
List.fold_left_e
(fun (payloads_history, witness) payload ->
add_message payload payloads_history witness)
(payloads_history, witness)
payloads
in
return (payloads_history, witness)
let add_messages_no_history payloads witness =
let open Result_syntax in
let+ _, witness =
add_messages
Sc_rollup_inbox_merkelized_payload_hashes_repr.History.no_history
payloads
witness
in
witness
type inclusion_proof = history_proof list
let inclusion_proof_encoding =
let open Data_encoding in
list history_proof_encoding
let pp_inclusion_proof = Format.pp_print_list pp_history_proof
let pp_payloads_proof fmt {proof; payload} =
Format.fprintf
fmt
"payload: %a@,@[<v 2>proof:@,%a@]"
Format.(
pp_print_option
~none:(fun fmt () -> pp_print_string fmt "None")
(fun fmt payload ->
pp_print_string
fmt
(Sc_rollup_inbox_message_repr.unsafe_to_string payload)))
payload
Sc_rollup_inbox_merkelized_payload_hashes_repr.pp_proof
proof
type proof = {inclusion_proof : inclusion_proof; message_proof : payloads_proof}
let pp_proof fmt {inclusion_proof; message_proof} =
Format.fprintf
fmt
"@[<v>@[<v 2>inclusion proof:@,%a@]@,@[<v 2>payloads proof:@,%a@]@]"
pp_inclusion_proof
inclusion_proof
pp_payloads_proof
message_proof
let proof_encoding =
let open Data_encoding in
conv
(fun {inclusion_proof; message_proof} -> (inclusion_proof, message_proof))
(fun (inclusion_proof, message_proof) -> {inclusion_proof; message_proof})
(obj2
(req "inclusion_proof" inclusion_proof_encoding)
(req "message_proof" payloads_proof_encoding))
let of_serialized_proof = Data_encoding.Binary.of_string_opt proof_encoding
let to_serialized_proof = Data_encoding.Binary.to_string_exn proof_encoding
(** [verify_payloads_proof {proof; payload} head_cell_hash n label] handles
all the verification needed for a particular message proof at a particular
level.
First it checks that [proof] is a valid inclusion of [payload_cell] in
[head_cell] and that [head_cell] hash is [head_cell_hash].
Then there is two cases,
- either [n] is superior to the index of [head_cell] then the provided
[payload] must be empty (and [payload_cell = head_cell]);
- or [0 < n < max_index head_cell] then the provided payload must exist and
the payload hash must equal the content of the [payload_cell].
*)
let verify_payloads_proof {proof; payload} head_cell_hash n =
let open Result_syntax in
let* payload_cell, head_cell =
Sc_rollup_inbox_merkelized_payload_hashes_repr.verify_proof proof
in
let* () =
error_unless
(Sc_rollup_inbox_merkelized_payload_hashes_repr.Hash.equal
head_cell_hash
(Sc_rollup_inbox_merkelized_payload_hashes_repr.hash head_cell))
(Inbox_proof_error (Format.sprintf "message_proof does not match history"))
in
let max_index =
Sc_rollup_inbox_merkelized_payload_hashes_repr.get_index head_cell
in
if Compare.Z.(n = Z.succ max_index) then
let* () =
error_unless
(Option.is_none payload)
(Inbox_proof_error "Payload provided but none expected")
in
let* () =
error_unless
(Sc_rollup_inbox_merkelized_payload_hashes_repr.equal
payload_cell
head_cell)
(Inbox_proof_error "Provided proof is about a unexpected payload")
in
return_none
else if Compare.Z.(n <= max_index) then
let* payload =
match payload with
| Some payload -> return payload
| None ->
tzfail
(Inbox_proof_error
"Expected a payload but none provided in the proof")
in
let payload_hash =
Sc_rollup_inbox_message_repr.hash_serialized_message payload
in
let proven_payload_hash =
Sc_rollup_inbox_merkelized_payload_hashes_repr.get_payload_hash
payload_cell
in
let* () =
error_unless
(Sc_rollup_inbox_message_repr.Hash.equal
payload_hash
proven_payload_hash)
(Inbox_proof_error
"the payload provided does not match the payload's hash found in \
the message proof")
in
let payload_index =
Sc_rollup_inbox_merkelized_payload_hashes_repr.get_index payload_cell
in
let* () =
error_unless
(Compare.Z.equal n payload_index)
(Inbox_proof_error
(Format.sprintf "found index in message_proof is incorrect"))
in
return_some payload
else
tzfail
(Inbox_proof_error
"Provided message counter is out of the valid range [0 -- (max_index \
+ 1)]")
(** [produce_payloads_proof get_payloads_history head_cell_hash ~index]
[get_payloads_history cell_hash] is a function that returns an
{!Sc_rollup_inbox_merkelized_payload_hashes_repr.History.t}. The returned
history must contains the cell with hash [cell_hash], all its ancestor cell
and their associated payload.
[head_cell] the latest cell of the [witness] we want to produce a proof on
with hash [head_cell_hash].
This function produce either:
- if [index <= head_cell_max_index], a proof that [payload_cell] with
[index] is an ancestor to [head_cell] where [head_cell] is the cell with
hash [head_cell_hash]. It returns the proof and the payload associated to
[payload_cell];
- else a proof that [index] is out of bound for [head_cell]. It returns the
proof and no payload.
*)
let produce_payloads_proof get_payloads_history head_cell_hash ~index =
let open Lwt_result_syntax in
let*! payloads_history = get_payloads_history head_cell_hash in
let*? head_cell =
match
Sc_rollup_inbox_merkelized_payload_hashes_repr.History.find
head_cell_hash
payloads_history
with
| Some {merkelized = head_cell; payload = _} -> ok head_cell
| None ->
error
(Inbox_proof_error "could not find head_cell in the payloads_history")
in
let head_cell_max_index =
Sc_rollup_inbox_merkelized_payload_hashes_repr.get_index head_cell
in
let target_index = Compare.Z.(min index head_cell_max_index) in
let proof =
Sc_rollup_inbox_merkelized_payload_hashes_repr.produce_proof
payloads_history
head_cell
~index:target_index
in
match proof with
| Some ({payload; merkelized = _}, proof) ->
if Compare.Z.(target_index = index) then
return {proof; payload = Some payload}
else return {proof; payload = None}
| None -> tzfail (Inbox_proof_error "could not produce a valid proof.")
let verify_inclusion_proof inclusion_proof snapshot_history_proof =
let open Result_syntax in
let rec aux (hash_map, ptr_list) = function
| [] -> tzfail (Inbox_proof_error "inclusion proof is empty")
| [target] ->
let target_ptr = hash_history_proof target in
let hash_map = Hash.Map.add target_ptr target hash_map in
let ptr_list = target_ptr :: ptr_list in
ok (hash_map, List.rev ptr_list, target, target_ptr)
| history_proof :: tail ->
let ptr = hash_history_proof history_proof in
aux (Hash.Map.add ptr history_proof hash_map, ptr :: ptr_list) tail
in
let* hash_map, ptr_list, target, target_ptr =
aux (Hash.Map.empty, []) inclusion_proof
in
let deref ptr = Hash.Map.find ptr hash_map in
let cell_ptr = hash_history_proof snapshot_history_proof in
let* () =
error_unless
(Skip_list.valid_back_path
~equal_ptr:Hash.equal
~deref
~cell_ptr
~target_ptr
ptr_list)
(Inbox_proof_error "invalid inclusion proof")
in
return target
let produce_inclusion_proof deref inbox_snapshot l =
let open Lwt_result_syntax in
let compare {hash = _; level} = Raw_level_repr.compare level l in
let*! result = Skip_list.Lwt.search ~deref ~compare ~cell:inbox_snapshot in
match result with
| Skip_list.{rev_path; last_cell = Found history_proof} ->
return (List.rev rev_path, history_proof)
| {last_cell = Nearest _; _}
| {last_cell = No_exact_or_lower_ptr; _}
| {last_cell = Deref_returned_none; _} ->
tzfail
@@ Inbox_proof_error
(Format.asprintf
"Skip_list.search failed to find a valid path: %a"
(Skip_list.pp_search_result ~pp_cell:pp_history_proof)
result)
let verify_proof (l, n) inbox_snapshot {inclusion_proof; message_proof} =
assert (Z.(geq n zero)) ;
let open Result_syntax in
let* history_proof = verify_inclusion_proof inclusion_proof inbox_snapshot in
let level_proof = Skip_list.content history_proof in
let* payload_opt = verify_payloads_proof message_proof level_proof.hash n in
match payload_opt with
| Some payload ->
return_some
Sc_rollup_PVM_sig.{inbox_level = l; message_counter = n; payload}
| None ->
if equal_history_proof inbox_snapshot history_proof then return_none
else
let* payload =
Sc_rollup_inbox_message_repr.(serialize (Internal Start_of_level))
in
let inbox_level = Raw_level_repr.succ l in
let message_counter = Z.zero in
return_some Sc_rollup_PVM_sig.{inbox_level; message_counter; payload}
let produce_proof ~get_payloads_history ~get_history inbox_snapshot (l, n) =
let open Lwt_result_syntax in
let* inclusion_proof, history_proof =
produce_inclusion_proof get_history inbox_snapshot l
in
let level_proof = Skip_list.content history_proof in
let* ({payload; proof = _} as message_proof) =
produce_payloads_proof get_payloads_history level_proof.hash ~index:n
in
let proof = {inclusion_proof; message_proof} in
let*? input =
let open Result_syntax in
match payload with
| Some payload ->
return_some
Sc_rollup_PVM_sig.{inbox_level = l; message_counter = n; payload}
| None ->
if equal_history_proof inbox_snapshot history_proof then
return_none
else
let inbox_level = Raw_level_repr.succ l in
let message_counter = Z.zero in
let* payload =
Sc_rollup_inbox_message_repr.(serialize (Internal Start_of_level))
in
return_some Sc_rollup_PVM_sig.{inbox_level; message_counter; payload}
in
return (proof, input)
let init_witness payloads_history =
let open Result_syntax in
let sol = Sc_rollup_inbox_message_repr.start_of_level_serialized in
let* payloads_history, witness =
Sc_rollup_inbox_merkelized_payload_hashes_repr.genesis payloads_history sol
in
return (payloads_history, witness)
let init_witness_no_history =
let sol = Sc_rollup_inbox_message_repr.start_of_level_serialized in
Sc_rollup_inbox_merkelized_payload_hashes_repr.genesis_no_history sol
let add_info_per_level ~predecessor_timestamp ~predecessor payloads_history
witness =
let info_per_level =
Sc_rollup_inbox_message_repr.info_per_level_serialized
~predecessor_timestamp
~predecessor
in
add_protocol_internal_message info_per_level payloads_history witness
let add_info_per_level_no_history ~predecessor_timestamp ~predecessor witness =
let info_per_level =
Sc_rollup_inbox_message_repr.info_per_level_serialized
~predecessor_timestamp
~predecessor
in
add_protocol_internal_message_no_history info_per_level witness
let finalize_inbox_level payloads_history history inbox witness =
let open Result_syntax in
let inbox = {inbox with level = Raw_level_repr.succ inbox.level} in
let eol = Sc_rollup_inbox_message_repr.end_of_level_serialized in
let* payloads_history, witness =
add_protocol_internal_message eol payloads_history witness
in
let* history, inbox = archive history inbox witness in
return (payloads_history, history, witness, inbox)
let finalize_inbox_level_no_history inbox witness =
let inbox = {inbox with level = Raw_level_repr.succ inbox.level} in
let eol = Sc_rollup_inbox_message_repr.end_of_level_serialized in
let witness = add_protocol_internal_message_no_history eol witness in
archive_no_history inbox witness
let add_all_messages ~protocol_migration_message ~predecessor_timestamp
~predecessor history inbox messages =
let open Result_syntax in
let* payloads = List.map_e Sc_rollup_inbox_message_repr.serialize messages in
let is_first_block = Option.is_some protocol_migration_message in
let payloads_history =
let capacity =
(List.length payloads + 3 + if is_first_block then 1 else 0)
|> Int64.of_int
in
Sc_rollup_inbox_merkelized_payload_hashes_repr.History.empty ~capacity
in
let* payloads_history, witness = init_witness payloads_history in
let* payloads_history, witness =
add_info_per_level
~predecessor_timestamp
~predecessor
payloads_history
witness
in
let* payloads_history, witness =
match protocol_migration_message with
| Some protocol_migration_message ->
let* message =
Sc_rollup_inbox_message_repr.serialize
(Internal protocol_migration_message)
in
add_message message payloads_history witness
| None -> return (payloads_history, witness)
in
let* payloads_history, witness =
match payloads with
| [] -> return (payloads_history, witness)
| payloads -> add_messages payloads_history payloads witness
in
let* payloads_history, history, witness, inbox =
finalize_inbox_level payloads_history history inbox witness
in
let messages =
let open Sc_rollup_inbox_message_repr in
let sol = Internal Start_of_level in
let info_per_level =
Internal (Info_per_level {predecessor_timestamp; predecessor})
in
let migration =
Option.fold
~none:[]
~some:(fun x -> [Internal x])
protocol_migration_message
in
let eol = Internal End_of_level in
[sol] @ [info_per_level] @ migration @ messages @ [eol]
in
return (payloads_history, history, inbox, witness, messages)
let genesis ~protocol_migration_message ~predecessor_timestamp ~predecessor
level =
let witness = init_witness_no_history in
let witness =
add_info_per_level_no_history ~predecessor_timestamp ~predecessor witness
in
let witness =
add_protocol_internal_message_no_history protocol_migration_message witness
in
let eol = Sc_rollup_inbox_message_repr.end_of_level_serialized in
let witness = add_protocol_internal_message_no_history eol witness in
let level_proof =
let hash = Sc_rollup_inbox_merkelized_payload_hashes_repr.hash witness in
{hash; level}
in
{level; old_levels_messages = Skip_list.genesis level_proof}
module Internal_for_tests = struct
type nonrec inclusion_proof = inclusion_proof
let pp_inclusion_proof = pp_inclusion_proof
let produce_inclusion_proof = produce_inclusion_proof
let verify_inclusion_proof = verify_inclusion_proof
let serialized_proof_of_string x = x
let get_level_of_history_proof (history_proof : history_proof) =
let ({level; _} : level_proof) = Skip_list.content history_proof in
level
type nonrec payloads_proof = payloads_proof = {
proof : Sc_rollup_inbox_merkelized_payload_hashes_repr.proof;
payload : Sc_rollup_inbox_message_repr.serialized option;
}
let pp_payloads_proof = pp_payloads_proof
let produce_payloads_proof = produce_payloads_proof
let verify_payloads_proof = verify_payloads_proof
type nonrec level_proof = level_proof = {
hash : Sc_rollup_inbox_merkelized_payload_hashes_repr.Hash.t;
level : Raw_level_repr.t;
}
let level_proof_of_history_proof = Skip_list.content
let expose_proof {inclusion_proof; message_proof} =
(inclusion_proof, message_proof)
let make_proof inclusion_proof message_proof =
{inclusion_proof; message_proof}
end
type inbox = t