From 6ac18d13ee7c9bf807449b79e072a5c3c18644c1 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Wed, 7 May 2025 16:27:45 +0200 Subject: [PATCH 1/2] Proto/test: generalize test_consensus_operation helpers for all operations --- .../test/helpers/consensus_helpers.ml | 195 ++++++++---------- .../lib_protocol/test/helpers/op.ml | 67 ++++++ .../lib_protocol/test/helpers/op.mli | 52 +++++ 3 files changed, 206 insertions(+), 108 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml index dd3323ad19ec..e4c9820d26a2 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml @@ -26,130 +26,109 @@ open Protocol open Alpha_context -type mode = Application | Construction | Mempool +type kind = Preattestation | Attestation | Aggregate -let show_mode = function - | Application -> "Application" - | Construction -> "Construction" - | Mempool -> "Mempool" +(** Crafts a consensus operation. -type kind = Preattestation | Attestation | Aggregate + By default, a (pre)attestation is for the first slot, whereas an + attestations aggregate is for all the level's attesters that are + using a BLS consensus key. -(** Craft an attestation or preattestation, and bake a block - containing it (in application or construction modes) or inject it - into a mempool. When [error] is [None], check that it succeeds, - otherwise check that it fails as specified by [error]. + Moreover, the operation points to the given [attested_block]: in + other words, it has that block's level, round, payload hash, and + its branch is the predecessor of that block. - By default, the (pre)attestation is for the first slot and is - signed by the delegate that owns this slot. Moreover, the operation - points to the given [attested_block]: in other words, it has that - block's level, round, payload hash, and its branch is the - predecessor of that block. Optional arguments allow to override - these default parameters. + Optional arguments allow to override these default parameters. *) +let craft_consensus_operation ?delegate ?slot ?level ?round ?block_payload_hash + ?branch ~attested_block kind = + match kind with + | Preattestation -> + Op.preattestation + ?delegate + ?slot + ?level + ?round + ?block_payload_hash + ?branch + attested_block + | Attestation -> + Op.attestation + ?delegate + ?slot + ?level + ?round + ?block_payload_hash + ?branch + attested_block + | Aggregate -> + Op.attestations_aggregate + ?level + ?round + ?block_payload_hash + ?branch + attested_block - The [predecessor] is used as the predecessor of the baked block or - the head of the mempool. When it is not provided, we use the - [attested_block] for this. *) let test_consensus_operation ?delegate ?slot ?level ?round ?block_payload_hash ?branch ~attested_block ?(predecessor = attested_block) ?error ~loc kind mode = let open Lwt_result_syntax in let* operation = - match kind with - | Preattestation -> - Op.preattestation - ?delegate - ?slot - ?level - ?round - ?block_payload_hash - ?branch - attested_block - | Attestation -> - Op.attestation - ?delegate - ?slot - ?level - ?round - ?block_payload_hash - ?branch - attested_block - | Aggregate -> - Op.attestations_aggregate - ?level - ?round - ?block_payload_hash - ?branch - attested_block + craft_consensus_operation + ?delegate + ?slot + ?level + ?round + ?block_payload_hash + ?branch + ~attested_block + kind in - let check_error res = - match error with - | Some error -> Assert.proto_error ~loc res error - | None -> - let*? _ = res in - return_unit - in - match mode with - | Application -> - let*! result = - Block.bake ~baking_mode:Application ~operation predecessor - in - check_error result - | Construction -> - let*! result = Block.bake ~baking_mode:Baking ~operation predecessor in - check_error result - | Mempool -> - let*! res = - let* inc = - Incremental.begin_construction ~mempool_mode:true predecessor - in - let* inc = Incremental.add_operation inc operation in - (* Finalization doesn't do much in mempool mode, but some RPCs - still call it, so we check that it doesn't fail unexpectedly. *) - Incremental.finalize_block inc - in - check_error res + Op.check_validation_and_application ~loc ?error ~predecessor mode operation let test_consensus_operation_all_modes_different_outcomes ?delegate ?slot ?level - ?round ?block_payload_hash ?branch ~attested_block ?predecessor ~loc - ?application_error ?construction_error ?mempool_error kind = - List.iter_es - (fun (mode, error) -> - test_consensus_operation - ?delegate - ?slot - ?level - ?round - ?block_payload_hash - ?branch - ~attested_block - ?predecessor - ?error - ~loc:(Format.sprintf "%s (%s mode)" loc (show_mode mode)) - kind - mode) - [ - (Application, application_error); - (Construction, construction_error); - (Mempool, mempool_error); - ] + ?round ?block_payload_hash ?branch ~attested_block + ?(predecessor = attested_block) ~loc ?application_error ?construction_error + ?mempool_error kind = + let open Lwt_result_syntax in + let* operation = + craft_consensus_operation + ?delegate + ?slot + ?level + ?round + ?block_payload_hash + ?branch + ~attested_block + kind + in + Op.check_validation_and_application_all_modes_different_outcomes + ~loc + ?application_error + ?construction_error + ?mempool_error + ~predecessor + operation let test_consensus_operation_all_modes ?delegate ?slot ?level ?round - ?block_payload_hash ?branch ~attested_block ?predecessor ?error ~loc kind = - test_consensus_operation_all_modes_different_outcomes - ?delegate - ?slot - ?level - ?round - ?block_payload_hash - ?branch - ~attested_block - ?predecessor + ?block_payload_hash ?branch ~attested_block ?(predecessor = attested_block) + ?error ~loc kind = + let open Lwt_result_syntax in + let* operation = + craft_consensus_operation + ?delegate + ?slot + ?level + ?round + ?block_payload_hash + ?branch + ~attested_block + kind + in + Op.check_validation_and_application_all_modes ~loc - ?application_error:error - ?construction_error:error - ?mempool_error:error - kind + ?error + ~predecessor + operation let delegate_of_first_slot b = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml index 6117bf472d83..14fb92592829 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml @@ -27,6 +27,8 @@ open Protocol open Alpha_context +type t = packed_operation + let pack_operation ctxt signature contents = let branch = Context.branch ctxt in Operation.pack @@ -1281,3 +1283,68 @@ let zk_rollup_update ?force_reveal ?counter ?fee ?gas_limit ?storage_limit ctxt sign ctxt account.sk (Context.branch ctxt) to_sign_op module Micheline = Micheline + +type tested_mode = Application | Construction | Mempool + +let show_mode = function + | Application -> "Application" + | Construction -> "Construction" + | Mempool -> "Mempool" + +let check_validation_and_application ~loc ?error ~predecessor mode operation = + let open Lwt_result_syntax in + let check_error res = + match error with + | Some error -> Assert.proto_error ~loc res error + | None -> + (* assert success *) + let*? (_ : Block.t) = res in + return_unit + in + match mode with + | Application -> + let*! result = + Block.bake ~baking_mode:Application ~operation predecessor + in + check_error result + | Construction -> + let*! result = Block.bake ~baking_mode:Baking ~operation predecessor in + check_error result + | Mempool -> + let*! res = + let* inc = + Incremental.begin_construction ~mempool_mode:true predecessor + in + let* inc = Incremental.add_operation inc operation in + (* Finalization doesn't do much in mempool mode, but some RPCs + still call it, so we check that it doesn't fail unexpectedly. *) + Incremental.finalize_block inc + in + check_error res + +let check_validation_and_application_all_modes_different_outcomes ~loc + ?application_error ?construction_error ?mempool_error ~predecessor operation + = + List.iter_es + (fun (mode, error) -> + check_validation_and_application + ~loc:(Format.sprintf "%s (%s mode)" loc (show_mode mode)) + ?error + ~predecessor + mode + operation) + [ + (Application, application_error); + (Construction, construction_error); + (Mempool, mempool_error); + ] + +let check_validation_and_application_all_modes ~loc ?error ~predecessor + operation = + check_validation_and_application_all_modes_different_outcomes + ~loc + ?application_error:error + ?construction_error:error + ?mempool_error:error + ~predecessor + operation diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.mli b/src/proto_alpha/lib_protocol/test/helpers/op.mli index 2af3f847af52..c56747e6b398 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/op.mli @@ -27,6 +27,9 @@ open Protocol open Alpha_context +(** The operation representation handled most often in test helpers. *) +type t = Alpha_context.packed_operation + (* TODO: https://gitlab.com/tezos/tezos/-/issues/3181 Improve documentation of the operation helpers *) @@ -736,3 +739,52 @@ val zk_rollup_update : Operation.packed tzresult Lwt.t module Micheline = Micheline + +(** {!Protocol.type-mode}-related helpers *) + +(** Which {!Protocol.type-mode} to test. *) +type tested_mode = Application | Construction | Mempool + +(** [check_validation_and_application ~loc ?error ~predecessor + tested_mode operation] tests the validation and application of + [operation] in [tested_mode]. + + - When [tested_mode] is [Application] or [Construction], a block + containing [operation] is baked on top of [predecessor] in the + specified mode. + + - When [tested_mode] is [Mempool], a mempool is initialized using + [predecessor] as head, then {!Incremental.add_operation} is called + on [operation]. + + When [error] is [None], we check that everything succeeds, + otherwise we check that the error identified by [error] is + returned. +*) +val check_validation_and_application : + loc:string -> + ?error:(Environment.Error_monad.error -> bool) -> + predecessor:Block.t -> + tested_mode -> + t -> + unit tzresult Lwt.t + +(** Calls {!check_validation_and_application} on all {!tested_mode}s + successively, with respective errors. *) +val check_validation_and_application_all_modes_different_outcomes : + loc:string -> + ?application_error:(Environment.Error_monad.error -> bool) -> + ?construction_error:(Environment.Error_monad.error -> bool) -> + ?mempool_error:(Environment.Error_monad.error -> bool) -> + predecessor:Block.t -> + t -> + unit tzresult Lwt.t + +(** Calls {!check_validation_and_application} on all {!tested_mode}s + successively, with the same [error] provided for each mode. *) +val check_validation_and_application_all_modes : + loc:string -> + ?error:(Environment.Error_monad.error -> bool) -> + predecessor:Block.t -> + t -> + unit tzresult Lwt.t -- GitLab From 5381d421adc5efa1117c32ecc674567d4c7d96ad Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 12 May 2025 14:51:36 +0200 Subject: [PATCH 2/2] Proto/test: test non bls aggregate with DAL content is still invalid --- .../lib_protocol/alpha_context.mli | 5 ++ .../lib_protocol/dal_attestation_repr.ml | 4 ++ .../lib_protocol/dal_attestation_repr.mli | 8 +++ .../lib_protocol/test/helpers/dal_helpers.ml | 8 +++ .../lib_protocol/test/helpers/dal_helpers.mli | 7 +++ .../integration/consensus/test_aggregate.ml | 63 +++++++++++-------- 6 files changed, 70 insertions(+), 25 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 230b0fc3c056..54d4a5832329 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2910,6 +2910,11 @@ module Dal : sig t -> Bls.t option end + + module Internal_for_tests : sig + (** See {!Dal_attestation_repr.Internal_for_tests.of_z}. *) + val of_z : Z.t -> t tzresult + end end type slot_id = {published_level : Raw_level.t; index : Slot_index.t} diff --git a/src/proto_alpha/lib_protocol/dal_attestation_repr.ml b/src/proto_alpha/lib_protocol/dal_attestation_repr.ml index 1e151b0a47d9..1397d3c7a94c 100644 --- a/src/proto_alpha/lib_protocol/dal_attestation_repr.ml +++ b/src/proto_alpha/lib_protocol/dal_attestation_repr.ml @@ -248,3 +248,7 @@ module Dal_dependent_signing = struct ~op t end + +module Internal_for_tests = struct + let of_z = Bitset.from_z +end diff --git a/src/proto_alpha/lib_protocol/dal_attestation_repr.mli b/src/proto_alpha/lib_protocol/dal_attestation_repr.mli index 3a4e1f4969e3..52205443ae30 100644 --- a/src/proto_alpha/lib_protocol/dal_attestation_repr.mli +++ b/src/proto_alpha/lib_protocol/dal_attestation_repr.mli @@ -177,3 +177,11 @@ module Dal_dependent_signing : sig t -> Bls.t option end + +module Internal_for_tests : sig + (** Builds a {!type-t} from its integer representation, that is, the + sum of powers of two of the indexes of attested slots. + + Returns an error when the given argument is negative. *) + val of_z : Z.t -> t tzresult +end diff --git a/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.ml index 729beef48034..57001c72c674 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.ml @@ -294,3 +294,11 @@ struct "Skip_list.search returned Nearest', while all given levels to \ produce proofs are supposed to be in the skip list.") end + +let dal_content_of_int ~loc n = + let attestation = + WithExceptions.Result.get_ok + ~loc + (Alpha_context.Dal.Attestation.Internal_for_tests.of_z (Z.of_int n)) + in + Alpha_context.{attestation} diff --git a/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.mli b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.mli index 940b8b25ac5a..35b38232af4b 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/dal_helpers.mli @@ -186,3 +186,10 @@ end) : sig val bad_history_cache : __LOC__:string -> 'a tzresult -> 'b -> unit tzresult Lwt.t end + +(** Builds a {!Alpha_context.type-dal_content} from its integer + representation, that is, the sum of powers of two of the indexes + of attested slots. + + Raises an exception when the given argument is negative. *) +val dal_content_of_int : loc:string -> int -> Alpha_context.dal_content diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml index ee096b5ffbb8..e29278b5eca6 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml @@ -450,7 +450,7 @@ let test_preattestations_aggregate_non_bls_delegate () = ~loc:__LOC__ (find_attester_with_non_bls_key attesters) in - (* Craft a preattestation for this attester to retreive a signature and a + (* Craft a preattestation for this attester to retrieve a signature and a triplet {level, round, block_payload_hash} *) let* {shell; protocol_data = {contents; signature}} = Op.raw_preattestation @@ -499,34 +499,47 @@ let test_attestations_aggregate_non_bls_delegate () = ~loc:__LOC__ (find_attester_with_non_bls_key attesters) in - (* Craft an attestation for this attester to retreive a signature and a + (* Craft an attestation for this attester to retrieve a signature and a triplet {level, round, block_payload_hash} *) let* {shell; protocol_data = {contents; signature}} = Op.raw_attestation ~delegate:attester.RPC.Validators.delegate ~slot block in - match contents with - | Single (Attestation {consensus_content; _}) -> - let {level; round; block_payload_hash; _} : - Alpha_context.consensus_content = - consensus_content - in - (* Craft an aggregate including the attester slot and signature *) - let consensus_content : Alpha_context.consensus_aggregate_content = - {level; round; block_payload_hash} - in - (* TODO: https://gitlab.com/tezos/tezos/-/issues/7935 - Add tests with dal_content = Some _. *) - let contents : _ Alpha_context.contents_list = - Single - (Attestations_aggregate - {consensus_content; committee = [(slot, None)]}) - in - let aggregate : operation = - {shell; protocol_data = Operation_data {contents; signature}} - in - (* Bake a block containing this aggregate and expect an error *) - let*! res = Block.bake ~operation:aggregate block in - Assert.proto_error ~loc:__LOC__ res non_bls_in_aggregate + let (Single + (Attestation + {consensus_content = {level; round; block_payload_hash; _}; _})) = + contents + in + (* Craft an aggregate including the attester slot and signature and + various dal_contents *) + let consensus_content : Alpha_context.consensus_aggregate_content = + {level; round; block_payload_hash} + in + let check_non_bls_aggregate_refused dal_content = + let contents : _ Alpha_context.contents_list = + Single + (Attestations_aggregate + {consensus_content; committee = [(slot, dal_content)]}) + in + let operation : operation = + {shell; protocol_data = Operation_data {contents; signature}} + in + Op.check_validation_and_application_all_modes_different_outcomes + ~loc:__LOC__ + ~application_error:non_bls_in_aggregate + ~construction_error:non_bls_in_aggregate + ~mempool_error:aggregate_in_mempool_error + ~predecessor:block + operation + in + let dal_contents_to_test = + [ + None; + Some Alpha_context.{attestation = Dal.Attestation.empty}; + Some (Dal_helpers.dal_content_of_int ~loc:__LOC__ 1); + Some (Dal_helpers.dal_content_of_int ~loc:__LOC__ 255); + ] + in + List.iter_es check_non_bls_aggregate_refused dal_contents_to_test let test_multiple_aggregates_per_block_forbidden () = let open Lwt_result_syntax in -- GitLab