diff --git a/manifest/main.ml b/manifest/main.ml index 0d5956dc7735b9b45f67c5636968464014467cbf..b18edd1fc270321702a9f0dbaa59628514568455 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -3594,6 +3594,7 @@ end = struct (3, "test_refutation_game", N.(number >= 014)); (3, "test_carbonated_map", N.(number >= 013)); (3, "test_zk_rollup_encoding", N.(number >= 015)); + (3, "test_dal_slot_proof", N.(number >= 016)); ] |> List.filter_map (fun (i, n, b) -> if b then Some (i, n) else None) in @@ -3634,6 +3635,8 @@ end = struct benchmark |> if_some |> open_; benchmark_type_inference |> if_some |> open_; sc_rollup |> if_some |> if_ N.(number >= 015) |> open_; + octez_crypto_dal |> if_ N.(number >= 016) |> open_; + octez_base_test_helpers |> if_ N.(number >= 016) |> open_; ] ~dune in @@ -3658,6 +3661,7 @@ end = struct test_helpers |> if_some |> open_; alcotest_lwt; octez_stdlib |> if_ N.(number >= 013) |> open_; + octez_crypto_dal |> if_ N.(number >= 016) |> open_; ] ~dune: Dune. @@ -4193,6 +4197,7 @@ module Protocol = Protocol plugin |> if_some |> open_; octez_shell_services |> open_; plompiler |> if_ N.(number >= 015); + octez_crypto_dal |> if_ N.(number >= 016) |> open_; ] in let _plugin_tests = diff --git a/opam/tezos-alpha-test-helpers.opam b/opam/tezos-alpha-test-helpers.opam index 524c3b558b80b29accfe766c5f26e45d04cf5e0a..27fdb9af22eff6a061fcdbf703e5d5bfd1195b17 100644 --- a/opam/tezos-alpha-test-helpers.opam +++ b/opam/tezos-alpha-test-helpers.opam @@ -21,6 +21,7 @@ depends: [ "tezos-protocol-plugin-alpha" "tezos-shell-services" "tezos-plompiler" { >= "0.1.2" } + "tezos-crypto-dal" ] build: [ ["rm" "-r" "vendors"] diff --git a/opam/tezos-protocol-alpha-tests.opam b/opam/tezos-protocol-alpha-tests.opam index 23930c85fbb2aaf45df8369b2b8edd27b608d18a..0b2d0e29dcbedb95068f3565d557c917062530c5 100644 --- a/opam/tezos-protocol-alpha-tests.opam +++ b/opam/tezos-protocol-alpha-tests.opam @@ -26,6 +26,7 @@ depends: [ "tezos-test-helpers" {with-test} "alcotest" { with-test & >= "1.5.0" } "tezos-sc-rollup-alpha" {with-test} + "tezos-crypto-dal" {with-test} "tezos-client-base" {with-test} "tezos-protocol-environment" {with-test} "tezos-stdlib-unix" {with-test} diff --git a/src/lib_crypto_dal/cryptobox.ml b/src/lib_crypto_dal/cryptobox.ml index 559e503a16df166511151c7a64ff467bca7d4da0..617f88c95ad102a949e84fe93f1a9cea0231b204 100644 --- a/src/lib_crypto_dal/cryptobox.ml +++ b/src/lib_crypto_dal/cryptobox.ml @@ -856,4 +856,12 @@ module Internal_for_tests = struct {srs_g1; srs_g2} let load_parameters parameters = initialisation_parameters := Some parameters + + let parameters (t : t) = + { + redundancy_factor = t.redundancy_factor; + slot_size = t.slot_size; + page_size = t.page_size; + number_of_shards = t.number_of_shards; + } end diff --git a/src/lib_crypto_dal/cryptobox.mli b/src/lib_crypto_dal/cryptobox.mli index 9be137a21ddf3d1183d2455de7ca7598ac7caf5d..37c8e2b53178c563d3c7de47699256535b005fc0 100644 --- a/src/lib_crypto_dal/cryptobox.mli +++ b/src/lib_crypto_dal/cryptobox.mli @@ -61,14 +61,20 @@ type t type commitment +type page_proof + module Verifier : - VERIFIER with type parameters = parameters and type commitment = commitment + VERIFIER + with type parameters = parameters + and type commitment = commitment + and type page_proof = page_proof include VERIFIER with type t := t and type parameters := parameters and type commitment := commitment + and type page_proof := page_proof (** The primitives exposed in this modules require some preprocessing. This preprocessing generates data from an unknown @@ -212,4 +218,7 @@ module Internal_for_tests : sig from test frameworks where tests with various parameters could be run using the same binary. *) val load_parameters : initialisation_parameters -> unit + + (** [parameters t] returns the parameters with which [t] was initialized. *) + val parameters : t -> parameters end diff --git a/src/lib_protocol_environment/environment_V8.ml b/src/lib_protocol_environment/environment_V8.ml index 0588c8f171a2b5999c89e4ac1a6166cb307aa805..baab9642d3d9a136fedd16a573a2e82d95638826 100644 --- a/src/lib_protocol_environment/environment_V8.ml +++ b/src/lib_protocol_environment/environment_V8.ml @@ -102,6 +102,7 @@ module type T = sig * Tezos_protocol_environment_structs.V8.Plonk.transcript and type Dal.parameters = Tezos_crypto_dal.Cryptobox.Verifier.parameters and type Dal.commitment = Tezos_crypto_dal.Cryptobox.Verifier.commitment + and type Dal.page_proof = Tezos_crypto_dal.Cryptobox.Verifier.page_proof and type Bounded.Non_negative_int32.t = Tezos_base.Bounded.Non_negative_int32.t and type Wasm_2_0_0.input = Tezos_scoru_wasm.Wasm_pvm_sig.input_info diff --git a/src/lib_protocol_environment/environment_V8.mli b/src/lib_protocol_environment/environment_V8.mli index ea70f763dc3acb17476fe81ed588334bf5f2a55b..6421bbf18047a7d446cf0af52c08ec3564a12871 100644 --- a/src/lib_protocol_environment/environment_V8.mli +++ b/src/lib_protocol_environment/environment_V8.mli @@ -102,6 +102,7 @@ module type T = sig * Tezos_protocol_environment_structs.V8.Plonk.transcript and type Dal.parameters = Tezos_crypto_dal.Cryptobox.Verifier.parameters and type Dal.commitment = Tezos_crypto_dal.Cryptobox.Verifier.commitment + and type Dal.page_proof = Tezos_crypto_dal.Cryptobox.Verifier.page_proof and type Bounded.Non_negative_int32.t = Tezos_base.Bounded.Non_negative_int32.t and type Wasm_2_0_0.input = Tezos_scoru_wasm.Wasm_pvm_sig.input_info diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 583e506317391f720ade26876d7619a2e3ca0f53..57ae508c62fe60fcedee8b1ff6469dc69888c1cd 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2818,10 +2818,12 @@ module Dal : sig val equal : int -> int -> bool end - type t = {slot_index : Slot_index.t; page_index : Index.t} + type t val content_encoding : content Data_encoding.t + type proof = Dal.page_proof + val encoding : t Data_encoding.t val pp : Format.formatter -> t -> unit diff --git a/src/proto_alpha/lib_protocol/dal_slot_repr.ml b/src/proto_alpha/lib_protocol/dal_slot_repr.ml index 3e760e61ba26a7340b528f7d2a7317cc68f22f67..dcbfb2cc04b139c07c195310f143dbc5a8eed449 100644 --- a/src/proto_alpha/lib_protocol/dal_slot_repr.ml +++ b/src/proto_alpha/lib_protocol/dal_slot_repr.ml @@ -111,31 +111,44 @@ module Page = struct let equal = Compare.Int.equal end - type t = {slot_index : Slot_index.t; page_index : Index.t} + type t = {slot_id : id; page_index : Index.t} + + type proof = Dal.page_proof let encoding = let open Data_encoding in conv - (fun {slot_index; page_index} -> (slot_index, page_index)) - (fun (slot_index, page_index) -> {slot_index; page_index}) - (obj2 + (fun {slot_id = {published_level; index}; page_index} -> + (published_level, index, page_index)) + (fun (published_level, index, page_index) -> + {slot_id = {published_level; index}; page_index}) + (obj3 + (req "published_level" Raw_level_repr.encoding) (req "slot_index" Slot_index.encoding) (req "page_index" Index.encoding)) - let equal page page' = - Slot_index.equal page.slot_index page'.slot_index - && Index.equal page.page_index page'.page_index + let equal {slot_id; page_index} p = + slot_id_equal slot_id p.slot_id && Index.equal page_index p.page_index + + let proof_encoding = Dal.page_proof_encoding let content_encoding = Data_encoding.bytes - let pp fmt {slot_index; page_index} = + let pp fmt {slot_id = {published_level; index}; page_index} = Format.fprintf fmt - "(slot_index: %a, page_index: %a)" + "(published_level: %a, slot_index: %a, page_index: %a)" + Raw_level_repr.pp + published_level Slot_index.pp - slot_index + index Index.pp page_index + + let pp_proof fmt proof = + Data_encoding.Json.pp + fmt + (Data_encoding.Json.construct proof_encoding proof) end let slot_encoding = @@ -153,7 +166,7 @@ let slot_encoding = let pp_slot fmt {id = {published_level; index}; header} = Format.fprintf fmt - "published_level: %a index: %a header: %a" + "slot:(published_level: %a, index: %a, header: %a)" Raw_level_repr.pp published_level Format.pp_print_int @@ -246,6 +259,22 @@ module Slots_history = struct let basis = 2 end + type error += Add_element_in_slots_skip_list_violates_ordering + + let () = + register_error_kind + `Temporary + ~id:"Dal_slot_repr.add_element_in_slots_skip_list_violates_ordering" + ~title:"Add an element in slots skip list that violates ordering" + ~description: + "Attempting to add an element on top of the Dal confirmed slots skip \ + list that violates the ordering." + Data_encoding.unit + (function + | Add_element_in_slots_skip_list_violates_ordering -> Some () + | _ -> None) + (fun () -> Add_element_in_slots_skip_list_violates_ordering) + module Skip_list = struct include Skip_list_repr.Make (Skip_list_parameters) @@ -271,22 +300,6 @@ module Slots_history = struct let compare_lwt a b = Lwt.return @@ compare a b - type error += Add_element_in_slots_skip_list_violates_ordering - - let () = - register_error_kind - `Temporary - ~id:"Dal_slot_repr.add_element_in_slots_skip_list_violates_ordering" - ~title:"Add an element in slots skip list that violates ordering" - ~description: - "Attempting to add an element on top of the Dal confirmed slots skip \ - list that violates the ordering." - Data_encoding.unit - (function - | Add_element_in_slots_skip_list_violates_ordering -> Some () - | _ -> None) - (fun () -> Add_element_in_slots_skip_list_violates_ordering) - let next ~prev_cell ~prev_cell_ptr elt = let open Tzresult_syntax in let* () = @@ -296,13 +309,8 @@ module Slots_history = struct in return @@ next ~prev_cell ~prev_cell_ptr elt - let search ~deref ~cell ~id_target = - search ~deref ~cell ~compare:(compare_lwt id_target) - - (* FIXME/DAL: search will be used in refutation proof. But we need to - introduce it here to explain why we need an ordering on the skip list's - elements. *) - let _ = ignore search + let search ~deref ~cell ~target_id = + search ~deref ~cell ~compare:(fun slot -> compare_lwt slot.id target_id) end module V1 = struct @@ -379,6 +387,446 @@ module Slots_history = struct let no_cache = History_cache.empty ~capacity:0L in fun t slots -> List.fold_left_e add_confirmed_slot (t, no_cache) slots >|? fst + + (* Dal proofs section *) + + (** An inclusion proof, for a page ID, is a list of the slots' history + skip list's cells that encodes a minimal path: + - from a starting cell, which serves as a reference. It is usually called + 'snapshot' below, + - to a final cell, that is either the exact target cell in case the slot + of the page is confirmed, or a cell whose slot ID is the smallest + that directly follows the page's slot id, in case the target slot + is not confirmed. + + Using the starting cell as a trustable starting point (i.e. maintained + and provided by L1), and combined with the extra information stored in + the {!proof} type below, one can verify if a slot (and then a page of + that slot) is confirmed on L1 or not. *) + type inclusion_proof = history list + + (** (See the documentation in the mli file to understand what we want to + prove in game refutation involving Dal and why.) + + A Dal proof is an algebraic datatype with two cases, where we basically + prove that a Dal page is confirmed on L1 or not. Being 'not confirmed' + here includes the case where the slot's header is not published and the + case where the slot's header is published, but the endorsers didn't + confirm the availability of its data. + + To produce a proof for a page (see function {!produce_proof} below), we + assume given: + + - [page_id], identifies the page; + + - [slots_history], a current/recent cell of the slots history skip list. + Typically, it should be the skip list cell snapshotted when starting the + refutation game; + + - [history_cache], a sufficiently large slots history cache, to navigate + back through the successive cells of the skip list. Typically, + the cache should at least contain the cell whose slot ID is [page_id.slot_id] + in case the page is confirmed, or the cell whose slot ID is immediately + after [page_id.slot_id] in case of an unconfirmed page. Indeed, + inclusion proofs encode paths through skip lists' cells where the head + is the reference/snapshot cell and the last element is the target slot + in or the nearest upper slot (w.r.t [page_id]'s slot id and to + skip list elements ordering) ; + + - [page_info], that provides the page's information (the content and + the slot membership proof) for page_id. In case the page is supposed + to be confirmed, this argument should contain the page's content and + the proof that the page is part of the (confirmed) slot whose ID is + given in [page_id]. In case we want to show that the page is not confirmed, + the value [page_info] should be [None]. + + [dal_parameters] is used when verifying that/if the page is part of + the candidate slot (if any). + + +*) + type proof = + | Page_confirmed of { + target_cell : history; + (** [target_cell] is a cell whose content contains the slot to + which the page belongs to. *) + inc_proof : inclusion_proof; + (** [inc_proof] is a (minimal) path in the skip list that proves + cells inclusion. The head of the list is the [slots_history] + provided to produce the proof. The last cell's content is + the slot containing the page identified by [page_id], + that is: [target_cell]. *) + page_data : Page.content; + (** [page_data] is the content of the page. *) + page_proof : Page.proof; + (** [page_proof] is the proof that the page whose content is + [page_data] is actually the [page_id.page_index]th page of + the slot stored in [target_cell] and identified by + page_id.slot_id. *) + } (** The case where the slot's page is confirmed/attested on L1. *) + | Page_unconfirmed of { + prev_cell : history; + (** [prev_cell] is the cell of the skip list containing a + (confirmed) slot, and whose ID is the biggest (w.r.t. to skip + list elements ordering), but smaller than [page_id.slot_id]. *) + next_cell_opt : history option; + (** [next_cell_opt] is the cell that immediately follows [prev_cell] + in the skip list, if [prev_cell] is not the latest element in + the list. Otherwise, it's set to [None]. *) + next_inc_proof : inclusion_proof; + (** [inc_proof] is a (minimal) path in the skip list that proves + cells inclusion. In case, [next_cell_opt] contains some cell + 'next_cell', the head of the list is the [slots_history] + provided to produce the proof, and the last cell is + 'next_cell'. In case [next_cell_opt] is [None], the list is + empty. + + We maintain the following invariant in case the inclusion + proof is not empty: + ``` + (content next_cell).id > page_id.slot_id > (content prev_cell).id AND + hash prev_cell = back_pointer next_cell 0 AND + Some next_cell = next_cell_opt AND + head next_inc_proof = slots_history + ``` + + Said differently, `next_cell` and `prev_cell` are two consecutive + cells of the skip list whose contents' IDs surround the page's + slot ID. Moreover, the head of the list should be equal to + the initial (snapshotted) slots_history skip list. + + The case of an empty inclusion proof happens when the inputs + are such that: `page_id.slot_id > (content slots_history).id`. + The returned proof statement implies the following property in this case: + + ``` + next_cell_opt = None AND prev_cell = slots_history + ``` + *) + } + (** The case where the slot's page doesn't exist or is not + confirmed on L1. *) + + let proof_encoding = + let open Data_encoding in + let case_page_confirmed = + case + ~title:"confirmed dal page proof" + (Tag 0) + (obj5 + (req "kind" (constant "confirmed")) + (req "target_cell" history_encoding) + (req "inc_proof" (list history_encoding)) + (req "page_data" bytes) + (req "page_proof" Page.proof_encoding)) + (function + | Page_confirmed {target_cell; inc_proof; page_data; page_proof} -> + Some ((), target_cell, inc_proof, page_data, page_proof) + | _ -> None) + (fun ((), target_cell, inc_proof, page_data, page_proof) -> + Page_confirmed {target_cell; inc_proof; page_data; page_proof}) + and case_page_unconfirmed = + case + ~title:"unconfirmed dal page proof" + (Tag 1) + (obj4 + (req "kind" (constant "unconfirmed")) + (req "prev_cell" history_encoding) + (req "next_cell_opt" (option history_encoding)) + (req "next_inc_proof" (list history_encoding))) + (function + | Page_unconfirmed {prev_cell; next_cell_opt; next_inc_proof} -> + Some ((), prev_cell, next_cell_opt, next_inc_proof) + | _ -> None) + (fun ((), prev_cell, next_cell_opt, next_inc_proof) -> + Page_unconfirmed {prev_cell; next_cell_opt; next_inc_proof}) + in + + union [case_page_confirmed; case_page_unconfirmed] + + let pp_inclusion_proof = Format.pp_print_list pp_history + + let pp_history_opt = Format.pp_print_option pp_history + + let pp_proof fmt p = + match p with + | Page_confirmed {target_cell; inc_proof; page_data; page_proof} -> + Format.fprintf + fmt + "Page_confirmed (target_cell=%a, data=%s,@ inc_proof:[size=%d |@ \ + path=%a]@ page_proof:%a)" + pp_history + target_cell + (Bytes.to_string page_data) + (List.length inc_proof) + pp_inclusion_proof + inc_proof + Page.pp_proof + page_proof + | Page_unconfirmed {prev_cell; next_cell_opt; next_inc_proof} -> + Format.fprintf + fmt + "Page_unconfirmed (prev_cell = %a | next_cell = %a | \ + prev_inc_proof:[size=%d@ | path=%a])" + pp_history + prev_cell + pp_history_opt + next_cell_opt + (List.length next_inc_proof) + pp_inclusion_proof + next_inc_proof + + type dal_parameters = Dal.parameters = { + redundancy_factor : int; + page_size : int; + slot_size : int; + number_of_shards : int; + } + + type error += Dal_proof_error of string + + let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"dal_slot_repr.slots_history.dal_proof_error" + ~title:"Dal proof error" + ~description:"Error occurred during Dal proof production or validation" + ~pp:(fun ppf e -> Format.fprintf ppf "Dal proof error: %s" e) + (obj1 (req "error" string)) + (function Dal_proof_error e -> Some e | _ -> None) + (fun e -> Dal_proof_error e) + + let dal_proof_error reason = Dal_proof_error reason + + let proof_error reason = fail @@ dal_proof_error reason + + let check_page_proof dal_params proof data pid slot_header = + let open Lwt_tzresult_syntax in + let* dal = + match Dal.make dal_params with + | Ok dal -> return dal + | Error (`Fail s) -> proof_error s + in + let page = {Dal.content = data; index = pid.Page.page_index} in + let fail_with_error_msg what = + Format.kasprintf + proof_error + "%s (page data=%s, page id=%a, commitment=%a)." + what + (Bytes.to_string data) + Page.pp + pid + Header.pp + slot_header + in + match Dal.verify_page dal slot_header page proof with + | Ok true -> return () + | Ok false -> + fail_with_error_msg + "Wrong page content for the given page index and slot commitment" + | Error `Segment_index_out_of_range -> + fail_with_error_msg "Segment_index_out_of_range" + | Error (`Degree_exceeds_srs_length s) -> + fail_with_error_msg + @@ Format.sprintf "Degree_exceeds_srs_length: %s" s + + let produce_proof dal_params page_id ~page_info slots_hist hist_cache = + let open Lwt_tzresult_syntax in + let Page.{slot_id; page_index = _} = page_id in + let deref ptr = History_cache.find ptr hist_cache in + (* We search for a slot whose ID is equal to target_id. *) + let*! search_result = + Skip_list.search ~deref ~target_id:slot_id ~cell:slots_hist + in + match (page_info, search_result.Skip_list.last_cell) with + | _, Deref_returned_none -> + proof_error + "Skip_list.search returned 'Deref_returned_none': Slots history \ + cache is ill-formed or has too few entries." + | _, No_exact_or_lower_ptr -> + proof_error + "Skip_list.search returned 'No_exact_or_lower_ptr', while it is \ + initialized with a min elt (slot zero)." + | Some (page_data, page_proof), Found target_cell -> + (* The slot to which the page is supposed to belong is found. *) + let {id; header} = Skip_list.content target_cell in + (* We check that the slot is not the dummy slot. *) + let* () = + fail_when + Compare.Int.(compare_slot_id id zero.id = 0) + (dal_proof_error + "Skip_list.search returned 'Found ': No existence \ + proof should be constructed with the slot zero.") + in + let* () = + check_page_proof dal_params page_proof page_data page_id header + in + let inc_proof = List.rev search_result.Skip_list.rev_path in + let* () = + fail_when + (List.is_empty inc_proof) + (dal_proof_error "The inclusion proof cannot be empty") + in + (* All checks succeeded. We return a `Page_confirmed` proof. *) + let status = + Page_confirmed {inc_proof; target_cell; page_data; page_proof} + in + return (status, Some page_data) + | None, Nearest {lower = prev_cell; upper = next_cell_opt} -> + (* There is no previously confirmed slot in the skip list whose ID + corresponds to the {published_level; slot_index} information + given in [page_id]. But, `search` returned a skip list [prev_cell] + (and possibly [next_cell_opt]) such that: + - the ID of [prev_cell]'s slot is the biggest immediately smaller than + the page's information {published_level; slot_index} + - if not equal to [None], the ID of [next_cell_opt]'s slot is the smallest + immediately bigger than the page's slot id `slot_id`. + - if [next_cell_opt] is [None] then, [prev_cell] should be equal to + the given history_proof cell. *) + let* next_inc_proof = + match search_result.Skip_list.rev_path with + | [] -> assert false (* Not reachable *) + | prev :: rev_next_inc_proof -> + let* () = + fail_unless + (equal_history prev prev_cell) + (dal_proof_error + "Internal error: search's Nearest result is \ + inconsistent.") + in + return @@ List.rev rev_next_inc_proof + in + return + (Page_unconfirmed {prev_cell; next_cell_opt; next_inc_proof}, None) + | None, Found _ -> + proof_error + "The page ID's slot is confirmed, but no page content and proof \ + are provided." + | Some _, Nearest _ -> + proof_error + "The page ID's slot is not confirmed, but page content and proof \ + are provided." + + (* Given a starting cell [snapshot] and a (final) [target], this function + checks that the provided [inc_proof] encodes a minimal path from + [snapshot] to [target]. *) + let verify_inclusion_proof inc_proof ~src:snapshot ~dest:target = + let assoc = List.map (fun c -> (hash_skip_list_cell c, c)) inc_proof in + let path = List.split assoc |> fst in + let deref = + let open Map.Make (Pointer_hash) in + let map = of_seq (List.to_seq assoc) in + fun ptr -> find_opt ptr map + in + let snapshot_ptr = hash_skip_list_cell snapshot in + let target_ptr = hash_skip_list_cell target in + fail_unless + (Skip_list.valid_back_path + ~equal_ptr:Pointer_hash.equal + ~deref + ~cell_ptr:snapshot_ptr + ~target_ptr + path) + (dal_proof_error "verify_proof: invalid inclusion Dal proof.") + + let verify_proof dal_params page_id snapshot proof = + let open Lwt_tzresult_syntax in + let Page.{slot_id; page_index = _} = page_id in + match proof with + | Page_confirmed {target_cell; page_data; page_proof; inc_proof} -> + (* If the page is supposed to be confirmed, the last cell in + [inc_proof] should store the slot of the page. *) + let {id; header} = Skip_list.content target_cell in + let* () = + fail_when + Compare.Int.(compare_slot_id id zero.id = 0) + (dal_proof_error + "verify_proof: cannot construct a confirmation page proof \ + with 'zero' as target slot.") + in + let* () = + verify_inclusion_proof inc_proof ~src:snapshot ~dest:target_cell + in + (* We check that the page indeed belongs to the target slot at the + given page index. *) + let* () = + check_page_proof dal_params page_proof page_data page_id header + in + (* If all checks succeed, we return the data/content of the page. *) + return_some page_data + | Page_unconfirmed {prev_cell; next_cell_opt; next_inc_proof} -> + (* The page's slot is supposed to be unconfirmed. *) + let ( < ) a b = Compare.Int.(compare_slot_id a b < 0) in + (* We retrieve the last cell of the inclusion proof to be able to + call {!verify_inclusion_proof}. We also do some well-formedness on + the shape of the inclusion proof (see the case [Page_unconfirmed] + of type {!proof}). *) + let* () = + match next_cell_opt with + | None -> + let* () = + fail_unless + (List.is_empty next_inc_proof) + (dal_proof_error "verify_proof: invalid next_inc_proof") + in + (* In case the inclusion proof has no elements, we check that: + - the prev_cell slot's id is smaller than the unconfirmed slot's ID + - the snapshot is equal to the [prev_cell] skip list. + + This way, and since the skip list is sorted wrt. + {!compare_slot_id}, we are sure that the skip list whose head + is [snapshot] = [prev_cell] cannot contain a slot whose ID is + [slot_id]. *) + fail_unless + ((Skip_list.content prev_cell).id < slot_id + && equal_history snapshot prev_cell) + (dal_proof_error "verify_proof: invalid next_inc_proof") + | Some next_cell -> + (* In case the inclusion proof has at least one element, + we check that: + - the [prev_cell] slot's id is smaller than [slot_id] + - the [next_cell] slot's id is greater than [slot_id] + - the [next_cell] cell is a direct successor of the + [prev_cell] cell. + - the [next_cell] cell is a predecessor of [snapshot] + + Since the skip list is sorted wrt. {!compare_slot_id}, and + if the call to {!verify_inclusion_proof} succeeds, we are + sure that the skip list whose head is [snapshot] cannot + contain a slot whose ID is [slot_id]. *) + let* () = + fail_unless + ((Skip_list.content prev_cell).id < slot_id + && slot_id < (Skip_list.content next_cell).id + && + let prev_cell_pointer = + Skip_list.back_pointer next_cell 0 + in + match prev_cell_pointer with + | None -> false + | Some prev_ptr -> + Pointer_hash.equal + prev_ptr + (hash_skip_list_cell prev_cell)) + (dal_proof_error "verify_proof: invalid next_inc_proof") + in + verify_inclusion_proof + next_inc_proof + ~src:snapshot + ~dest:next_cell + in + return_none + + module Internal_for_tests = struct + let content = Skip_list.content + + let proof_statement_is proof expected = + match (expected, proof) with + | `Confirmed, Page_confirmed _ | `Unconfirmed, Page_unconfirmed _ -> + true + | _ -> false + end end include V1 diff --git a/src/proto_alpha/lib_protocol/dal_slot_repr.mli b/src/proto_alpha/lib_protocol/dal_slot_repr.mli index cf4e0571abf47a35c32280c4686ef759e35a1174..7cf1741eef991d542c24af4ef62016fbe063f074 100644 --- a/src/proto_alpha/lib_protocol/dal_slot_repr.mli +++ b/src/proto_alpha/lib_protocol/dal_slot_repr.mli @@ -97,6 +97,8 @@ type slot = t val equal : t -> t -> bool +val pp_slot : Format.formatter -> t -> unit + type slot_index = Index.t (** A DAL slot is decomposed to a successive list of pages with fixed content @@ -123,14 +125,18 @@ module Page : sig (** Encoding for page contents. *) val content_encoding : content Data_encoding.t - (** A page is identified by its slots index and by its own index in the list + (** A page is identified by its slot id and by its own index in the list of pages of the slot. *) - type t = {slot_index : slot_index; page_index : Index.t} + type t = {slot_id : id; page_index : Index.t} + + type proof = Dal.page_proof val equal : t -> t -> bool val encoding : t Data_encoding.t + val proof_encoding : proof Data_encoding.t + val pp : Format.formatter -> t -> unit end @@ -212,4 +218,89 @@ module Slots_history : sig (** [equal a b] returns true iff a is equal to b. *) val equal : t -> t -> bool + + (** {1 Dal slots/pages proofs} *) + + (** When a SCORU kernel's inputs come from the DAL, they are provided as + pages' content for confirmed slots, or None in case the slot doesn't + exist or is not confirmed. + + In a refutation game involving an import tick of a Dal page input, a + honest user should be able to provide: + + - When the PVM is requesting a page of a confirmed slot: a proof that the + slot is confirmed, in addition to needed information to check that the + page (whose id and content are given) is part of the slot; + + - When the opponent pretends that the PVM is requesting a page of some + unconfirmed slot, but that slot is not published or not confirmed on L1: + a proof that the slot (whose id is given via the page's id) cannot be + confirmed on L1. + + See the documentation in the ml file for more technical details. *) + type proof + + (** Encoding for {!proof}. *) + val proof_encoding : proof Data_encoding.t + + (** Pretty-printer for {!proof}. *) + val pp_proof : Format.formatter -> proof -> unit + + (** To verify the proof of a page membership in its associated slot, the + Cryptobox module needs the following Dal parameters. These are part of the + protocol's parameters. See {!Default_parameters.default_dal}. *) + type dal_parameters = Dal.parameters = { + redundancy_factor : int; + page_size : int; + slot_size : int; + number_of_shards : int; + } + + (** [produce_proof dal_parameters page_id page_info slots_hist hist_cache] + produces a proof that either: + - there exists a confirmed slot in the skip list that contains + the page identified by [page_id] whose data and slot inclusion proof + are given by [page_info], or + - there cannot exist a confirmed slot in the skip list (whose head is + given by [slots_hist]) containing the page identified by [page_id]. + + In the first case above, [page_info] should contain the page's content + and the proof that the page is part of the (confirmed) slot whose + id is given in [page_id]. In the second case, no page content or proof + should be provided, as they are not needed to construct a non-confirmation + proof. + + [dal_parameters] is used when verifying that/if the page is part of + the candidate slot (if any). + *) + val produce_proof : + dal_parameters -> + Page.t -> + page_info:(Page.content * Page.proof) option -> + t -> + History_cache.t -> + (proof * Page.content option) tzresult Lwt.t + + (** [verify_proof dal_params page_id snapshot proof] verifies that the given + [proof] is a valid proof to show that either: + - the page identified by [page_id] belongs to a confirmed slot stored in + the skip list whose head is [snapshot], or + - there is not confirmed slot in the skip list (whose head is) [snapshot] + that could contain the page identified by [page_id]. + + [dal_parameters] is used when verifying that/if the page is part of + the candidate slot (if any). + *) + val verify_proof : + dal_parameters -> Page.t -> t -> proof -> Page.content option tzresult Lwt.t + + type error += Add_element_in_slots_skip_list_violates_ordering + + type error += Dal_proof_error of string + + module Internal_for_tests : sig + val content : t -> slot + + val proof_statement_is : proof -> [`Confirmed | `Unconfirmed] -> bool + end end diff --git a/src/proto_alpha/lib_protocol/test/helpers/assert.ml b/src/proto_alpha/lib_protocol/test/helpers/assert.ml index b0609e6506fe1f76a74f02cffaa49263fe7a68b7..9350839c633a895e8e761edbf01c57d54add19ea 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/assert.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/assert.ml @@ -210,6 +210,11 @@ let is_error ~loc ~pp = function | Ok x -> failwith "Unexpected (Ok %a) (%s)" pp x loc | Error _ -> return_unit +let get_ok ~__LOC__ = function + | Ok r -> return r + | Error err -> + failwith "@[Unexpected error (%s): %a@]" __LOC__ pp_print_trace err + open Context (* Some asserts for account operations *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.ml new file mode 100644 index 0000000000000000000000000000000000000000..ca2efa04ff7e197d36ae7c5e49eb061a6a7c29fe --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.ml @@ -0,0 +1,226 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +module S = Dal_slot_repr +module P = S.Page +module Hist = S.Slots_history +module Ihist = Hist.Internal_for_tests + +(* Some global constants. *) + +let genesis_history = Hist.genesis + +let genesis_history_cache = Hist.History_cache.empty ~capacity:3000L + +let level_one = Raw_level_repr.(succ root) + +let level_ten = Raw_level_repr.(of_int32_exn 10l) + +(* Helper functions. *) + +(** Error used below for functions that don't return their failures in the monad + error. *) +type error += Test_failure of string + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"test_failure" + ~title:"Test failure" + ~description:"Test failure." + ~pp:(fun ppf e -> Format.fprintf ppf "Test failure: %s" e) + (obj1 (req "error" string)) + (function Test_failure e -> Some e | _ -> None) + (fun e -> Test_failure e) + +let dal_mk_env dal_params = + let open Result_syntax in + let parameters = + Cryptobox.Internal_for_tests.initialisation_parameters_from_slot_size + ~slot_size:dal_params.Hist.slot_size + in + let () = Cryptobox.Internal_for_tests.load_parameters parameters in + match Cryptobox.make dal_params with + | Ok dal -> return dal + | Error (`Fail s) -> fail [Test_failure s] + +let dal_mk_polynomial_from_slot dal slot_data = + let open Result_syntax in + match Cryptobox.polynomial_from_slot dal slot_data with + | Ok p -> return p + | Error (`Slot_wrong_size s) -> + fail + [ + Test_failure + (Format.sprintf "polynomial_from_slot: Slot_wrong_size (%s)" s); + ] + +let dal_mk_prove_page dal polynomial page_id = + let open Result_syntax in + match Cryptobox.prove_page dal polynomial page_id.P.page_index with + | Ok p -> return p + | Error `Segment_index_out_of_range -> + fail [Test_failure "compute_proof_segment: Segment_index_out_of_range"] + +let mk_slot ?(level = level_one) ?(index = S.Index.zero) + ?(fill_function = fun _i -> 'x') dal = + let open Result_syntax in + let params = Cryptobox.Internal_for_tests.parameters dal in + let slot_data = Bytes.init params.slot_size fill_function in + let* polynomial = dal_mk_polynomial_from_slot dal slot_data in + let kate_commit = Cryptobox.commit dal polynomial in + return + ( slot_data, + polynomial, + S.{id = S.{published_level = level; index}; header = kate_commit} ) + +let mk_page_id published_level slot_index page_index = + P.{slot_id = {published_level; index = slot_index}; page_index} + +let no_data = Some (fun ~default_char:_ _ -> None) + +let mk_page_info ?(default_char = 'x') ?level ?(page_index = P.Index.zero) + ?(custom_data = None) dal (slot : S.t) polynomial = + let open Result_syntax in + let level = + match level with None -> slot.id.published_level | Some level -> level + in + let params = Cryptobox.Internal_for_tests.parameters dal in + let page_id = mk_page_id level slot.id.index page_index in + let* page_proof = dal_mk_prove_page dal polynomial page_id in + match custom_data with + | None -> + let page_data = Bytes.make params.page_size default_char in + return (Some (page_data, page_proof), page_id) + | Some mk_data -> ( + match mk_data ~default_char params.page_size with + | None -> return (None, page_id) + | Some page_data -> return (Some (page_data, page_proof), page_id)) + +let succ_slot_index index = + Option.value_f + S.Index.(of_int (to_int index + 1)) + ~default:(fun () -> S.Index.zero) + +let next_char c = Char.(chr ((code c + 1) mod 255)) + +(** Auxiliary test function used by both unit and PBT tests: This function + produces a proof from the given information and verifies the produced result, + if any. The result of each step is checked with [check_produce_result] and + [check_verify_result], respectively. *) +let produce_and_verify_proof ~check_produce ?check_verify dal skip_list cache + ~page_info ~page_id = + let open Lwt_result_syntax in + let params = Cryptobox.Internal_for_tests.parameters dal in + let*! res = + Hist.produce_proof params ~page_info page_id skip_list cache + >|= Environment.wrap_tzresult + in + let* () = check_produce res page_info in + match check_verify with + | None -> return_unit + | Some check_verify -> + let*? proof, _input_opt = res in + let*! res = + Hist.verify_proof params page_id skip_list proof + >|= Environment.wrap_tzresult + in + check_verify res page_info + +(* Some check functions. *) + +(** Check that/if the returned content is the expected one. *) +let assert_content_is ~__LOC__ ~expected returned = + Assert.equal + ~loc:__LOC__ + (Option.equal Bytes.equal) + "Returned %s doesn't match the expected one" + (fun fmt opt -> + match opt with + | None -> Format.fprintf fmt "" + | Some bs -> Format.fprintf fmt "" (Bytes.to_string bs)) + returned + expected + +let expected_data page_info proof_status = + match (page_info, proof_status) with + | Some (d, _p), `Confirmed -> Some d + | None, `Confirmed -> assert false + | _ -> None + +let proof_status_to_string = function + | `Confirmed -> "CONFIRMED" + | `Unconfirmed -> "UNCONFIRMED" + +let successful_check_produce_result ~__LOC__ proof_status res page_info = + let open Lwt_result_syntax in + let* proof, input_opt = Assert.get_ok ~__LOC__ res in + let* () = + if Hist.Internal_for_tests.proof_statement_is proof proof_status then + return_unit + else + failwith + "Expected to have a %s page proof. Got %a@." + (proof_status_to_string proof_status) + Hist.pp_proof + proof + in + assert_content_is + ~__LOC__ + input_opt + ~expected:(expected_data page_info proof_status) + +let failing_check_produce_result ~__LOC__ err_string res _page_info = + Assert.proto_error ~loc:__LOC__ res (function + | Hist.Dal_proof_error s -> String.equal s err_string + | _ -> false) + +let successful_check_verify_result ~__LOC__ proof_status res page_info = + let open Lwt_result_syntax in + let* content = Assert.get_ok ~__LOC__ res in + let expected = expected_data page_info proof_status in + assert_content_is ~__LOC__ ~expected content + +(** Checks if the two provided Page.proof are equal. *) +let eq_page_proof = + let bytes_opt_of_proof page_proof = + Data_encoding.Binary.to_bytes_opt P.proof_encoding page_proof + in + fun pp1 pp2 -> + Option.equal Bytes.equal (bytes_opt_of_proof pp1) (bytes_opt_of_proof pp2) + +let slot_confirmed_but_page_data_not_provided ~__LOC__ = + failing_check_produce_result + ~__LOC__ + "The page ID's slot is confirmed, but no page content and proof are \ + provided." + +let slot_not_confirmed_but_page_data_provided ~__LOC__ = + failing_check_produce_result + ~__LOC__ + "The page ID's slot is not confirmed, but page content and proof are \ + provided." diff --git a/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.mli b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.mli new file mode 100644 index 0000000000000000000000000000000000000000..f6a81558236f1243ecb6be43f8c832dfbaeb0423 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.mli @@ -0,0 +1,148 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +(** Some global constants. *) + +val genesis_history : Dal_slot_repr.Slots_history.t + +val genesis_history_cache : Dal_slot_repr.Slots_history.History_cache.t + +val level_one : Raw_level_repr.t + +val level_ten : Raw_level_repr.t + +(** Helper functions. *) + +(** Returns an object of type {!Cryptobox.t} from the given DAL paramters. *) +val dal_mk_env : Cryptobox.parameters -> (Cryptobox.t, error trace) result + +(** Returns the slot's polynomial from the given slot's data. *) +val dal_mk_polynomial_from_slot : + Cryptobox.t -> bytes -> (Cryptobox.polynomial, error trace) result + +(** Using the given slot's polynomial, this function computes the page proof of + the page whose ID is provided. *) +val dal_mk_prove_page : + Cryptobox.t -> + Cryptobox.polynomial -> + Dal_slot_repr.Page.t -> + (Cryptobox.page_proof, error trace) result + +(** Constructs a slot whose ID is defined from the given level and given index, + and whose data are built using the given fill function. The function returns + the slot's data, polynomial, and header (in the sense: ID + kate + commitment). *) +val mk_slot : + ?level:Raw_level_repr.t -> + ?index:Dal_slot_repr.slot_index -> + ?fill_function:(int -> char) -> + Cryptobox.t -> + (bytes * Cryptobox.polynomial * Dal_slot_repr.t, error trace) result + +(** Constructs a record value of type Page.id. *) +val mk_page_id : + Raw_level_repr.t -> Dal_slot_repr.slot_index -> int -> Dal_slot_repr.Page.t + +val no_data : (default_char:char -> int -> bytes option) option + +(** Constructs a page whose level and slot indexes are those of the given slot + (except if level is redefined via [?level]), and whose page index and data + are given by arguments [page_index] and [mk_data]. If [mk_data] is set to [No], + the function returns the pair (None, page_id). Otherwise, the page's [data] + and [proof] is computed, and the function returns [Some (data, proof), + page_id]. *) +val mk_page_info : + ?default_char:char -> + ?level:Raw_level_repr.t -> + ?page_index:int -> + ?custom_data:(default_char:char -> int -> bytes option) option -> + Cryptobox.t -> + Dal_slot_repr.t -> + Cryptobox.polynomial -> + ( (bytes * Cryptobox.page_proof) option * Dal_slot_repr.Page.t, + error trace ) + result + +(** Returns the char after [c]. Restarts from the char whose code is 0 if [c]'s + code is 255. *) +val next_char : char -> char + +(** Increment the given slot index. Returns zero in case of overflow. *) +val succ_slot_index : Dal_slot_repr.slot_index -> Dal_slot_repr.slot_index + +(** Auxiliary test function used by both unit and PBT tests: This function + produces a proof from the given information and verifies the produced result, + if any. The result of each step is checked with [check_produce_result] and + [check_verify_result], respectively. *) +val produce_and_verify_proof : + check_produce: + ((Dal_slot_repr.Slots_history.proof * bytes option) tzresult -> + (bytes * Cryptobox.page_proof) option -> + (unit, tztrace) result Lwt.t) -> + ?check_verify: + (bytes option tzresult -> + (bytes * Cryptobox.page_proof) option -> + (unit, tztrace) result Lwt.t) -> + Cryptobox.t -> + Dal_slot_repr.Slots_history.t -> + Dal_slot_repr.Slots_history.History_cache.t -> + page_info:(bytes * Cryptobox.page_proof) option -> + page_id:Dal_slot_repr.Page.t -> + (unit, tztrace) result Lwt.t + +(** Check if two page proofs are equal. *) +val eq_page_proof : Cryptobox.page_proof -> Cryptobox.page_proof -> bool + +(** Helper for the case where produce_proof is expected to succeed. *) +val successful_check_produce_result : + __LOC__:string -> + [`Confirmed | `Unconfirmed] -> + (Dal_slot_repr.Slots_history.proof * bytes option, tztrace) result -> + (bytes * 'a) option -> + (unit, tztrace) result Lwt.t + +(** Helper for the case where verify_proof is expected to succeed. *) +val successful_check_verify_result : + __LOC__:string -> + [> `Confirmed] -> + (bytes option, tztrace) result -> + (bytes * 'a) option -> + (unit, tztrace) result Lwt.t + +(** Helper for the case where produce_proof is expected to fail because the slot + is confirmed but no page information are provided. *) +val slot_confirmed_but_page_data_not_provided : + __LOC__:string -> ('a, tztrace) result -> 'b -> unit tzresult Lwt.t + +(** Helper for the case where produce_proof is expected to fail because the slot + is not confirmed but page_info are provided. *) +val slot_not_confirmed_but_page_data_provided : + __LOC__:string -> ('a, tztrace) result -> 'b -> unit tzresult Lwt.t + +(** Helper for the case where produce_proof is expected to fail. *) +val failing_check_produce_result : + __LOC__:string -> string -> ('a, tztrace) result -> 'b -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/dune b/src/proto_alpha/lib_protocol/test/helpers/dune index 9fb6dd17a57cd77dec1615b82b8da19f0355397a..65309764c9d27b70a09861e5ab98e1f30b1cb1fc 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/dune +++ b/src/proto_alpha/lib_protocol/test/helpers/dune @@ -18,7 +18,8 @@ tezos-protocol-environment tezos-protocol-plugin-alpha tezos-shell-services - tezos-plompiler) + tezos-plompiler + tezos-crypto-dal) (flags (:standard) -open Tezos_base.TzPervasives @@ -28,4 +29,5 @@ -open Tezos_protocol_alpha -open Tezos_client_alpha -open Tezos_protocol_plugin_alpha - -open Tezos_shell_services)) + -open Tezos_shell_services + -open Tezos_crypto_dal)) diff --git a/src/proto_alpha/lib_protocol/test/pbt/dune b/src/proto_alpha/lib_protocol/test/pbt/dune index 72a2d61953b68db02337e634d1eaa01c48ec36eb..4609fc9901736947e9f4b4ddefff4b4c3075a4d7 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/dune +++ b/src/proto_alpha/lib_protocol/test/pbt/dune @@ -16,7 +16,8 @@ test_sc_rollup_encoding test_refutation_game test_carbonated_map - test_zk_rollup_encoding) + test_zk_rollup_encoding + test_dal_slot_proof) (libraries tezos-base tezos-micheline @@ -30,7 +31,9 @@ tezos-benchmark tezos-benchmark-alpha tezos-benchmark-type-inference-alpha - tezos-sc-rollup-alpha) + tezos-sc-rollup-alpha + tezos-crypto-dal + tezos-base-test-helpers) (flags (:standard) -open Tezos_base.TzPervasives @@ -40,7 +43,9 @@ -open Tezos_alpha_test_helpers -open Tezos_benchmark_alpha -open Tezos_benchmark_type_inference_alpha - -open Tezos_sc_rollup_alpha)) + -open Tezos_sc_rollup_alpha + -open Tezos_crypto_dal + -open Tezos_base_test_helpers)) (rule (alias runtest) @@ -112,6 +117,11 @@ (package tezos-protocol-alpha-tests) (action (run %{dep:./test_zk_rollup_encoding.exe}))) +(rule + (alias runtest) + (package tezos-protocol-alpha-tests) + (action (run %{dep:./test_dal_slot_proof.exe}))) + (rule (alias runtest1) (action (run %{exe:liquidity_baking_pbt.exe}))) (rule (alias runtest1) (action (run %{exe:saturation_fuzzing.exe}))) @@ -139,3 +149,5 @@ (rule (alias runtest3) (action (run %{exe:test_carbonated_map.exe}))) (rule (alias runtest3) (action (run %{exe:test_zk_rollup_encoding.exe}))) + +(rule (alias runtest3) (action (run %{exe:test_dal_slot_proof.exe}))) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_dal_slot_proof.ml b/src/proto_alpha/lib_protocol/test/pbt/test_dal_slot_proof.ml new file mode 100644 index 0000000000000000000000000000000000000000..abeef1f4b020e46acfa41755747d48d8496ca4e6 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/pbt/test_dal_slot_proof.ml @@ -0,0 +1,203 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: PBT for refutation proofs of Dal + Invocation: dune exec \ + src/proto_alpha/lib_protocol/test/pbt/test_dal_slot_proof.exe + Subject: Refutation proof-related functions of Dal +*) + +open Protocol +open Dal_helpers + +(* Introduce some intermediate types *) + +(** The slot is not confirmed (skipped) iff the boolean is [true]. *) +type slot_skipped = bool + +type slots = slot_skipped list + +type levels = slots list + +(** Given a list of {!levels}, where each element is of type {!slots} = {!slot} + list, and where each slot is a boolean, this function populates an + empty slots_history skip list and a corresponding history_cache as follows: + - the function starts from a given [start_level] (default is 1) + - levels are incremented by 2 (to allow having levels without confirmed slots + for test purpose). + - every element in the list of levels represents the slots of a single level. + - each slot of a given level is not confirmed iff the boolean is true. *) +let populate_slots_history dal (levels_data : levels) = + let open Result_syntax in + (* Make and insert a slot. *) + let add_slot level sindex (cell, cache, slots_info) skip_slot = + let index = + Option.value_f (Dal_slot_repr.Index.of_int sindex) ~default:(fun () -> + assert false) + in + let* _data, poly, slot = mk_slot ~level ~index dal in + let* cell, cache = + if skip_slot then return (cell, cache) + else + Dal_slot_repr.Slots_history.add_confirmed_slots cell cache [slot] + |> Environment.wrap_tzresult + in + return (cell, cache, (poly, slot, skip_slot) :: slots_info) + in + (* Insert the slots of a level. *) + let add_slots level accu slots_data = + (* We start at level one, and we skip even levels for test purpose (which + means that no DAL slot is confirmed for them). *) + let curr_level = + Int32.of_int (1 + (2 * level)) |> Raw_level_repr.of_int32_exn + in + List.fold_left_i_e (add_slot curr_level) accu slots_data + in + (* Insert the slots of all the levels. *) + let add_levels = List.fold_left_i_e add_slots in + add_levels (genesis_history, genesis_history_cache, []) levels_data + +(** This function returns the (correct) information of a page to + prove that it is confirmed, or None if the page's slot is skipped. *) +let request_confirmed_page dal (poly, slot, skip_slot) = + let open Result_syntax in + if skip_slot then + (* We cannot check that a page of an unconfirmed slot is confirmed. *) + return None + else + let* page_info, page_id = mk_page_info dal slot poly in + return @@ Some (page_info, page_id) + +(** This function returns information of a page to prove that it is unconfirmed, +if the page's slot is skipped, the information look correct (but the slot is not +confirmed). Otherwise, we increment the publish_level field to simulate a non +confirmed slot (as for even levels, no slot is confirmed. See +{!populate_slots_history}). *) +let request_unconfirmed_page dal (poly, slot, skip_slot) = + let open Result_syntax in + (* If the slot is unconfirmed, we test that a page belonging to it is not + confirmed. If the slot is confirmed, we check that the page of the + slot at the next level is unconfirmed (since we insert levels without + any confirmed slot). *) + let level = + if skip_slot then Dal_slot_repr.(slot.id.published_level) + else Raw_level_repr.succ Dal_slot_repr.(slot.id.published_level) + in + let* _page_info, page_id = mk_page_info ~level dal slot poly in + (* We should not provide the page's info if we want to build an + unconfirmation proof. *) + return @@ Some (None, page_id) + +(** This helper function allows to test DAL's {!produce_proof} and {!verify_proof} + functions, using the data constructed from {!populate_slots_history} above. *) +let helper_check_pbt_pages dal last_cell last_cache slots_info ~page_to_request + ~check_produce ~check_verify = + let open Lwt_result_syntax in + List.iter_es + (fun item -> + let*? mk_test = page_to_request dal item in + match mk_test with + | None -> return_unit + | Some (page_info, page_id) -> + produce_and_verify_proof + dal + last_cell + last_cache + ~page_info + ~page_id + ~check_produce + ~check_verify) + slots_info + +(** Making some confirmation pages tests for slots that are confirmed. *) +let test_confirmed_pages dal (levels_data : levels) = + let open Lwt_result_syntax in + let*? last_cell, last_cache, slots_info = + populate_slots_history dal levels_data + in + helper_check_pbt_pages + dal + last_cell + last_cache + slots_info + ~page_to_request:request_confirmed_page + ~check_produce:(successful_check_produce_result ~__LOC__ `Confirmed) + ~check_verify:(successful_check_verify_result ~__LOC__ `Confirmed) + +(** Making some unconfirmation pages tests for slots that are confirmed. *) +let test_unconfirmed_pages dal (levels_data : levels) = + let open Lwt_result_syntax in + let*? last_cell, last_cache, slots_info = + populate_slots_history dal levels_data + in + helper_check_pbt_pages + dal + last_cell + last_cache + slots_info + ~page_to_request:request_unconfirmed_page + ~check_produce:(successful_check_produce_result ~__LOC__ `Unconfirmed) + ~check_verify:(successful_check_verify_result ~__LOC__ `Unconfirmed) + +let tests = + Result.value_f + (dal_mk_env + { + Dal_slot_repr.Slots_history.redundancy_factor = 16; + page_size = 4096 / 64; + slot_size = 1048576 / 64; + number_of_shards = 2048 / 64; + }) + ~default:(fun () -> + Format.eprintf "failed to initialize Cryptobox.t" ; + assert false) + |> fun dal -> + let gen_dal_config : levels QCheck2.Gen.t = + QCheck2.Gen.( + let nb_slots = pure 20 in + let nb_levels = pure 5 in + (* The slot is confirmed iff the boolean is true *) + let slot = bool in + let slots = list_size nb_slots slot in + list_size nb_levels slots) + in + [ + Tztest.tztest_qcheck2 + ~name:"Pbt tests: confirmed pages" + ~count:10 + gen_dal_config + (test_confirmed_pages dal); + Tztest.tztest_qcheck2 + ~name:"Pbt tests: unconfirmed pages" + ~count:10 + gen_dal_config + (test_unconfirmed_pages dal); + ] + +let () = + let tests = [("Dal slots refutation", tests)] in + Alcotest_lwt.run "Refutation_game" tests |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/unit/dune b/src/proto_alpha/lib_protocol/test/unit/dune index b840f665aa6983504614d10fe9e4224f0562b022..7fabcf75d5e7548659e09da594a43aa14f734190 100644 --- a/src/proto_alpha/lib_protocol/test/unit/dune +++ b/src/proto_alpha/lib_protocol/test/unit/dune @@ -15,7 +15,8 @@ tezos-protocol-alpha tezos-alpha-test-helpers alcotest-lwt - tezos-stdlib) + tezos-stdlib + tezos-crypto-dal) (flags (:standard) -open Tezos_base.TzPervasives @@ -25,7 +26,8 @@ -open Tezos_client_alpha -open Tezos_protocol_alpha -open Tezos_alpha_test_helpers - -open Tezos_stdlib)) + -open Tezos_stdlib + -open Tezos_crypto_dal)) (rule (alias runtest) diff --git a/src/proto_alpha/lib_protocol/test/unit/main.ml b/src/proto_alpha/lib_protocol/test/unit/main.ml index c7964f3314dd0a2aff909727dc2670b5bf86eeb1..9df7b4fa13f78723a4fbcdf7ed23ac01af6554e8 100644 --- a/src/proto_alpha/lib_protocol/test/unit/main.ml +++ b/src/proto_alpha/lib_protocol/test/unit/main.ml @@ -86,5 +86,6 @@ let () = Unit_test.spec "compare operations" Test_compare_operations.tests; Unit_test.spec "Delegate_consensus_key.ml" Test_consensus_key.tests; Unit_test.spec "local_contexts" Test_local_contexts.tests; + Unit_test.spec "dal slot proof" Test_dal_slot_proof.tests; ] |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/unit/test_dal_slot_proof.ml b/src/proto_alpha/lib_protocol/test/unit/test_dal_slot_proof.ml new file mode 100644 index 0000000000000000000000000000000000000000..f695945bdca58c91a42ac24a873b0b207c25f12c --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/unit/test_dal_slot_proof.ml @@ -0,0 +1,396 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Protocol (dal slot proof) + Invocation: dune exec src/proto_alpha/lib_protocol/test/unit/main.exe \ + -- test "^\[Unit\] dal slot proof$" + Subject: These unit tests check proof-related functions of Dal slots. +*) + +open Protocol +module S = Dal_slot_repr +module P = S.Page +module Hist = S.Slots_history +open Dal_helpers + +(* Tests to check insertion of slots in a dal skip list. *) + +(** Check insertion of a new slot in the given skip list. *) +let skip_list_ordering dal skip_list ~mk_level ~mk_slot_index ~check_result = + let open Lwt_result_syntax in + let {S.id; _} = Hist.Internal_for_tests.content skip_list in + let*? _data, _poly, slot = + mk_slot ~level:(mk_level id) ~index:(mk_slot_index id) dal + in + Hist.add_confirmed_slots_no_cache skip_list [slot] + |> Environment.wrap_tzresult |> check_result + +(** This test attempts to add a slot on top of genesis cell zero which would + break the ordering. In fact, confirmed slots' skip list is ordered by slots + ID: the slots' level should increase or the level is equal in which case the + slots' index should increase. In the test below, we attempt to insert a slot + where (published_level, slot_index) doesn't increase (is the same as the + genesis cell). *) +let insertion_breaks_skip_list_ordering dal () = + skip_list_ordering + dal + genesis_history + ~mk_level:(fun id -> id.S.published_level) + ~mk_slot_index:(fun id -> id.S.index) + ~check_result:(fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Hist.Add_element_in_slots_skip_list_violates_ordering -> true + | _ -> false)) + +(** This test attempts to add a slot on top of genesis cell zero which satisfies + the ordering. *) +let correct_insertion_in_skip_list_ordering_1 dal () = + let open Lwt_result_syntax in + skip_list_ordering + dal + genesis_history + ~mk_level:(fun id -> Raw_level_repr.succ id.S.published_level) + ~mk_slot_index:(fun id -> id.S.index) + ~check_result:(fun res -> + let* _skip_list = Assert.get_ok ~__LOC__ res in + return_unit) + +(** This test attempts to add a slot on top of genesis cell zero which satisfies + the ordering. *) +let correct_insertion_in_skip_list_ordering_2 dal () = + let open Lwt_result_syntax in + skip_list_ordering + dal + genesis_history + ~mk_level:(fun id -> id.S.published_level) + ~mk_slot_index:(fun id -> succ_slot_index id.S.index) + ~check_result:(fun res -> + let* _skip_list = Assert.get_ok ~__LOC__ res in + return_unit) + +(** This test attempts to add two slots on top of genesis cell zero which satisfies + the ordering. *) +let correct_insertion_in_skip_list_ordering_3 dal () = + let open Lwt_result_syntax in + skip_list_ordering + dal + genesis_history + ~mk_level:(fun id -> id.S.published_level) + ~mk_slot_index:(fun id -> succ_slot_index id.S.index) + ~check_result:(fun res -> + let* skip_list = Assert.get_ok ~__LOC__ res in + skip_list_ordering + dal + skip_list + ~mk_level:(fun id -> Raw_level_repr.(succ (succ id.S.published_level))) + ~mk_slot_index:(fun id -> id.S.index) + ~check_result:(fun res -> + let* _skip_list = Assert.get_ok ~__LOC__ res in + return_unit)) + +(* Tests of construct/verify proofs that confirm/unconfirm pages on top of + genesis skip list (whose unique cell is slot zero). *) + +(** This test attempts to construct a proof to confirm a slot page from the + genesis skip list. Proof production is expected to fail. *) +let confirmed_page_on_genesis dal () = + let {S.id = {published_level; index}; _} = + Hist.Internal_for_tests.content genesis_history + in + let page_id = mk_page_id published_level index P.Index.zero in + produce_and_verify_proof + dal + genesis_history + genesis_history_cache + (* values of level and slot index are equal to slot zero. We would get a + page confirmation proof. But, no proof that confirms the existence of a page + in slot [zero] is possible. *) + ~page_info:None + ~page_id + ~check_produce:(slot_confirmed_but_page_data_not_provided ~__LOC__) + +(** This test attempts to construct a proof to unconfirm a slot page from the + genesis skip list. Proof production is expected to succeed. *) +let unconfirmed_page_on_genesis dal incr_level = + let {S.id = {published_level; index}; _} = + Hist.Internal_for_tests.content genesis_history + in + let level, sindex = + if incr_level then (Raw_level_repr.succ published_level, index) + else (published_level, succ_slot_index index) + in + let page_id = mk_page_id level sindex P.Index.zero in + produce_and_verify_proof + dal + genesis_history + genesis_history_cache + ~page_info:None + ~page_id + ~check_produce:(successful_check_produce_result ~__LOC__ `Unconfirmed) + ~check_verify:(successful_check_verify_result ~__LOC__ `Unconfirmed) + +(* Tests of construct/verify proofs that attempt to confirm pages on top of a + (confirmed) slot added in genesis_history skip list. *) + +(** Helper function that adds a slot a top of the genesis skip list. *) +let helper_confirmed_slot_on_genesis ~level ~mk_page_info ~check_produce + ?check_verify dal = + let open Lwt_result_syntax in + let*? _slot_data, polynomial, slot = mk_slot ~level dal in + let*? skip_list, cache = + Hist.add_confirmed_slots genesis_history genesis_history_cache [slot] + |> Environment.wrap_tzresult + in + let*? page_info, page_id = mk_page_info dal slot polynomial in + produce_and_verify_proof + dal + skip_list + cache + ~page_info + ~page_id + ?check_verify + ~check_produce + +(** Test where a slot is confirmed, requesting a proof for a confirmed page, + where the correct data and page proof are provided. *) +let confirmed_slot_on_genesis_confirmed_page_good_data dal () = + helper_confirmed_slot_on_genesis + dal + ~level:(Raw_level_repr.succ level_ten) + ~mk_page_info + ~check_produce:(successful_check_produce_result ~__LOC__ `Confirmed) + ~check_verify:(successful_check_verify_result ~__LOC__ `Confirmed) + +(** Test where a slot is confirmed, requesting a proof for a confirmed page, + where the page data and proof are not given. *) +let confirmed_slot_on_genesis_confirmed_page_no_data dal () = + helper_confirmed_slot_on_genesis + dal + ~level:(Raw_level_repr.succ level_ten) + ~mk_page_info:(mk_page_info ~custom_data:no_data) + ~check_produce:(slot_confirmed_but_page_data_not_provided ~__LOC__) + +(** Test where a slot is confirmed, requesting a proof for a confirmed page, + where correct data are provided, but the given page proof is wrong. *) +let confirmed_slot_on_genesis_confirmed_page_bad_page_proof dal () = + let open Result_syntax in + helper_confirmed_slot_on_genesis + dal + ~level:(Raw_level_repr.succ level_ten) + ~mk_page_info:(fun dal slot poly -> + let* page_info1, _page_id1 = mk_page_info ~page_index:1 dal slot poly in + let* page_info2, page_id2 = mk_page_info ~page_index:2 dal slot poly in + assert ( + match (page_info1, page_info2) with + | Some (_d1, p1), Some (_d2, p2) -> not (eq_page_proof p1 p2) + | _ -> false) ; + return (page_info1, page_id2)) + ~check_produce: + (failing_check_produce_result + ~__LOC__ + "Wrong page content for the given page index and slot commitment \ + (page \ + data=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, \ + page id=(published_level: 11, slot_index: 0, page_index: 2), \ + commitment=sh1veuXUPvxu6SWCWtN5v2erwCQVc787gZbFT5LEbixWPLdzb8gemTzAoodnoxJ5HHU2rqu9Ph).") + +(** Test where a slot is confirmed, requesting a proof for a confirmed page, + where correct page proof is provided, but given page data is altered. *) +let confirmed_slot_on_genesis_confirmed_page_bad_data_right_length dal () = + helper_confirmed_slot_on_genesis + dal + ~level:(Raw_level_repr.succ level_ten) + ~mk_page_info: + (mk_page_info + ~custom_data: + (Some + (fun ~default_char page_size -> + Some + (Bytes.init page_size (fun i -> + if i = 0 then next_char default_char else default_char))))) + ~check_produce: + (failing_check_produce_result + ~__LOC__ + "Wrong page content for the given page index and slot commitment \ + (page \ + data=yxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, \ + page id=(published_level: 11, slot_index: 0, page_index: 0), \ + commitment=sh1veuXUPvxu6SWCWtN5v2erwCQVc787gZbFT5LEbixWPLdzb8gemTzAoodnoxJ5HHU2rqu9Ph).") + +(* Variants of the tests above: Construct/verify proofs that attempt to + unconfirm pages on top of a (confirmed) slot added in genesis_history skip + list. + + All the tests are somehow equivalent when building "Unconfirmed page" proof, + because the page's data & page's proof are ignored in this case. +*) + +(** Specialisation of helper {!helper_confirmed_slot_on_genesis}, where some + parameters are fixed. *) +let helper_confirmed_slot_on_genesis_unconfirmed_page ~check_produce + ?check_verify ~page_level ~mk_page_info dal = + helper_confirmed_slot_on_genesis + dal + ~level:(Raw_level_repr.succ page_level) + ~mk_page_info + ~check_produce + ?check_verify + +(** Unconfirmation proof for a page with good data. *) +let confirmed_slot_on_genesis_unconfirmed_page_good_data dal () = + helper_confirmed_slot_on_genesis_unconfirmed_page + dal + ~page_level:level_ten + ~mk_page_info:(mk_page_info ~level:level_ten) + ~check_produce:(slot_not_confirmed_but_page_data_provided ~__LOC__) + +(** Unconfirmation proof for a page with no data. *) +let confirmed_slot_on_genesis_unconfirmed_page_no_data dal () = + helper_confirmed_slot_on_genesis_unconfirmed_page + dal + ~page_level:level_ten + ~mk_page_info:(mk_page_info ~custom_data:no_data ~level:level_ten) + ~check_produce:(successful_check_produce_result ~__LOC__ `Unconfirmed) + +(** Unconfirmation proof for a page with bad page proof. *) +let confirmed_slot_on_genesis_unconfirmed_page_bad_proof dal () = + let open Result_syntax in + let level = level_ten in + helper_confirmed_slot_on_genesis_unconfirmed_page + dal + ~page_level:level + ~mk_page_info:(fun dal slot poly -> + let* page_info1, _page_id1 = + mk_page_info ~level:level_ten ~page_index:1 dal slot poly + in + let* _page_info2, page_id2 = + mk_page_info ~level:level_ten ~page_index:2 dal slot poly + in + assert ( + match (page_info1, _page_info2) with + | Some (_d1, p1), Some (_d2, p2) -> not (eq_page_proof p1 p2) + | _ -> false) ; + return (page_info1, page_id2)) + ~check_produce:(slot_not_confirmed_but_page_data_provided ~__LOC__) + +(** Unconfirmation proof for a page with bad data. *) +let confirmed_slot_on_genesis_unconfirmed_page_bad_data dal () = + let level = level_ten in + helper_confirmed_slot_on_genesis_unconfirmed_page + dal + ~page_level:level + ~mk_page_info: + (mk_page_info + ~level:level_ten + ~custom_data: + (Some + (fun ~default_char page_size -> + Some + (Bytes.init page_size (fun i -> + if i = 0 then next_char default_char else default_char))))) + ~check_produce:(slot_not_confirmed_but_page_data_provided ~__LOC__) + +(* The list of tests. *) +let tests = + Result.value_f + (dal_mk_env + { + Hist.redundancy_factor = 16; + page_size = 4096 / 64; + slot_size = 1048576 / 64; + number_of_shards = 2048 / 64; + }) + ~default:(fun () -> + Format.eprintf "failed to initialize Cryptobox.t" ; + assert false) + |> fun dal -> + let tztest title test_function = + Tztest.tztest title `Quick (test_function dal) + in + let qcheck2 name gen test = + Tztest.tztest_qcheck2 ~name ~count:1 gen (test dal) + in + let bool = QCheck2.Gen.bool in + let ordering_tests = + [ + tztest + "add a slot on top of genesis that breaks ordering" + insertion_breaks_skip_list_ordering; + tztest + "add a slot on top of genesis that satisfies ordering (1/2)" + correct_insertion_in_skip_list_ordering_1; + tztest + "add a slot on top of genesis that satisfies ordering (2/2)" + correct_insertion_in_skip_list_ordering_2; + tztest + "add two slots on top of genesis that satisfy ordering" + correct_insertion_in_skip_list_ordering_3; + ] + in + let proofs_tests_on_genesis = + [ + tztest "Confirmed page on genesis" confirmed_page_on_genesis; + qcheck2 "Unconfirmed page on genesis" bool unconfirmed_page_on_genesis; + ] + in + + let confirmed_slot_on_genesis_confirmed_page_tests = + [ + tztest + "Confirmed slot on top of genesis: confirmed page with good data" + confirmed_slot_on_genesis_confirmed_page_good_data; + tztest + "Confirmed slot on top of genesis: confirmed page with no data" + confirmed_slot_on_genesis_confirmed_page_no_data; + tztest + "Confirmed slot on top of genesis: confirmed page with bad proof" + confirmed_slot_on_genesis_confirmed_page_bad_page_proof; + tztest + "Confirmed slot on top of genesis: confirmed page with bad data " + confirmed_slot_on_genesis_confirmed_page_bad_data_right_length; + ] + in + let confirmed_slot_on_genesis_unconfirmed_page_tests = + [ + tztest + "Confirmed slot on top of genesis: unconfirmed page with good data" + confirmed_slot_on_genesis_unconfirmed_page_good_data; + tztest + "Confirmed slot on top of genesis: unconfirmed page with no data" + confirmed_slot_on_genesis_unconfirmed_page_no_data; + tztest + "Confirmed slot on top of genesis: unconfirmed page with bad proof" + confirmed_slot_on_genesis_unconfirmed_page_bad_proof; + tztest + "Confirmed slot on top of genesis: unconfirmed page with bad data \ + (altered)" + confirmed_slot_on_genesis_unconfirmed_page_bad_data; + ] + in + ordering_tests @ proofs_tests_on_genesis + @ confirmed_slot_on_genesis_confirmed_page_tests + @ confirmed_slot_on_genesis_unconfirmed_page_tests