diff --git a/manifest/product_octez.ml b/manifest/product_octez.ml index ebeef8c3f70b114c6ee86a0e9920ecb83868bd15..3abf7623fe9b3da5fce8398a406d04b902772450 100644 --- a/manifest/product_octez.ml +++ b/manifest/product_octez.ml @@ -6174,6 +6174,7 @@ end = struct ("test_aggregate", N.(number >= 022)); ("test_dal_entrapment", N.(number >= 022)); ("test_companion_key", N.(number >= 023)); + ("test_scenario_attestation", N.(number >= 023)); ] |> conditional_list in diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/account_helpers.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/account_helpers.ml index b5df3f4b4907f1a98178cbeb23abe416401f7507..4961b7dab5a5f120ad54e2327d253abfd3e82fdb 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/account_helpers.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/account_helpers.ml @@ -560,7 +560,7 @@ let current_total_frozen_deposits_with_limits account_state = account_state.parameters.limit_of_staking_over_baking account_state.frozen_deposits -let update_activity account constants current_cycle = +let update_activity constants current_cycle account = match account.last_seen_activity with | None -> { diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml index c25500bafeea78ac5a4253dde6564990e57e84b5..003c194a07809db20e19d963e54d47df96a0aee6 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml @@ -1317,6 +1317,11 @@ let current_cycle b = let current_level = b.header.shell.level in current_cycle_of_level ~blocks_per_cycle ~current_level +let cycle_of_next_block b = + let blocks_per_cycle = b.constants.blocks_per_cycle in + let current_level = Int32.succ b.header.shell.level in + current_cycle_of_level ~blocks_per_cycle ~current_level + let cycle_position b = let blocks_per_cycle = b.constants.blocks_per_cycle in let level = b.header.shell.level in diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli index 4315ccb8b8f66e441d511362f4785967de88a082..a11f8bd8626a485f79f79efb9175eec23d97e918 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli @@ -368,6 +368,8 @@ val current_level : block -> int32 val current_cycle : block -> Cycle.t +val cycle_of_next_block : block -> Cycle.t + val cycle_position : block -> int32 val first_level_of_cycle : Constants.Parametric.t -> level:int32 -> bool diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario.ml index 38a2e0be669aaa7baeb792bd7dd52d8ce26ca2ca..f5c67b6161898c7420bde67dcee773431adef79f 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario.ml @@ -15,3 +15,4 @@ include Scenario_dsl include Scenario_begin include Scenario_constants include Scenario_bake +include Scenario_attestation diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_attestation.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_attestation.ml new file mode 100644 index 0000000000000000000000000000000000000000..56d2c1ca2500149da0627853f4b948af5202d49e --- /dev/null +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_attestation.ml @@ -0,0 +1,620 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2025 Nomadic Labs, *) +(* *) +(*****************************************************************************) + +open State_account +open State +open Scenario_dsl +open Log_helpers +open Scenario_base +open Protocol + +let update_activity name block state : State.t = + State.update_account_f + name + (Account_helpers.update_activity + state.constants + (Block.cycle_of_next_block block)) + state + +type kind = Preattestation | Attestation + +let string_of_kind = function + | Preattestation -> "preattestation" + | Attestation -> "attestation" + +(** --- Attestations --- *) + +let check_attestation_metadata ?(check_not_found = false) ~kind delegate_pkh + consensus_key_pkh : Block.full_metadata -> t -> unit tzresult Lwt.t = + fun (_block_header_metadata, op_metadata) (_block, _state) -> + let open Lwt_result_syntax in + Log.debug + ~color:low_debug_color + "Check metadata: %s for %a (consensus key : %a)" + (string_of_kind kind) + Signature.Public_key_hash.pp + delegate_pkh + Signature.Public_key_hash.pp + consensus_key_pkh ; + let id_or_not, error_prefix = + if check_not_found then (not, "Not expected but found in metadata") + else (Fun.id, "Expected but not found in metadata") + in + if + id_or_not + @@ List.exists + (fun metadata -> + match (kind, metadata) with + | ( Attestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Attestation_result + { + (* This list is always empty *) + balance_updates = []; + delegate; + consensus_key; + consensus_power = _; + }); + } ) + | ( Preattestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Preattestation_result + { + (* This list is always empty *) + balance_updates = []; + delegate; + consensus_key; + consensus_power = _; + }); + } ) -> + Signature.Public_key_hash.( + equal delegate delegate_pkh + && equal consensus_key consensus_key_pkh) + | _ -> false) + op_metadata + then return_unit + else + failwith + "%s: %s for %a (consensus key : %a)" + error_prefix + (string_of_kind kind) + Signature.Public_key_hash.pp + delegate_pkh + Signature.Public_key_hash.pp + consensus_key_pkh + +let check_attestation_aggregate_metadata ?(check_not_found = false) ~kind + committee_expect : Block.full_metadata -> t -> unit tzresult Lwt.t = + fun (_block_header_metadata, op_metadata) (_block, _state) -> + let open Lwt_result_syntax in + Log.debug ~color:low_debug_color "Check metadata: aggregated attestation" ; + let id_or_not, error_prefix = + if check_not_found then (not, "Not expected but found in metadata") + else (Fun.id, "Expected but not found in metadata") + in + if + id_or_not + @@ List.exists + (fun metadata -> + match (kind, metadata) with + | ( Attestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Attestations_aggregate_result + { + (* This list is always empty *) + balance_updates = []; + committee; + total_consensus_power = _; + }); + } ) + | ( Preattestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Preattestations_aggregate_result + { + (* This list is always empty *) + balance_updates = []; + committee; + total_consensus_power = _; + }); + } ) -> + let committee = + List.map + (fun ((ck : Protocol.Alpha_context.Consensus_key.t), _) -> + ck.delegate) + committee + |> List.sort Signature.Public_key_hash.compare + in + let committee_expect = + List.map fst committee_expect + |> List.sort Signature.Public_key_hash.compare + in + List.equal + Signature.Public_key_hash.equal + committee + committee_expect + | _ -> false) + op_metadata + then return_unit + else + failwith + "%s: %s aggregate for committee@.[%a]" + error_prefix + (string_of_kind kind) + Format.( + pp_print_list + ~pp_sep:(fun fmt () -> fprintf fmt "; ") + Signature.Public_key_hash.pp) + (List.map fst committee_expect) + +let attest_with ?dal_content (delegate_name : string) : (t, t) scenarios = + exec (fun (block, state) -> + let open Lwt_result_wrap_syntax in + let kind = Attestation in + Log.info ~color:action_color "[Attesting with \"%s\"]" delegate_name ; + if state.force_attest_all then + failwith "Cannot manually attest if force_attest_all is true" + else + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let*?@ dal_content = + Option.map_e + Alpha_context.Dal.Attestation.Internal_for_tests.of_z + dal_content + in + let dal_content = + Option.map (fun i -> Alpha_context.{attestation = i}) dal_content + in + (* Fails to produce an attestation if the delegate has no slot for the block *) + let* op = + Op.attestation ?dal_content ~delegate:consensus_key.pkh block + in + (* Update the activity of the delegate *) + let state = update_activity delegate_name block state in + let state = State.add_pending_operations [op] state in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate.pkh consensus_key.pkh) + state + in + return (block, state)) + +(** (tz4 only) Creates an aggregated attestation from the attestations of the given delegates. + Fails if one of the delegates has no slot for the given block, or if one of the + delegates' consensus key is not a tz4 *) +let attest_aggreg_with (delegates : string list) : (t, t) scenarios = + exec (fun (block, state) -> + let open Lwt_result_wrap_syntax in + let kind = Attestation in + Log.info + ~color:action_color + "[Aggregated attesting with \"%a\"]" + Format.( + pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "; ") pp_print_string) + delegates ; + if state.force_attest_all then + failwith "Cannot manually attest if force_attest_all is true" + else + let* state, committee, delegate_and_ck_committee = + List.fold_left_es + (fun (state, committee, delegate_and_ck) delegate_name -> + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key + (B state.grandparent) + delegate.pkh + in + let consensus_key_pkh = + consensus_key_info.active.consensus_key_pkh + in + (* Update the activity of the committee *) + let state = update_activity delegate_name block state in + return + ( state, + consensus_key_pkh :: committee, + (delegate.pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, [], []) + delegates + in + let* () = + if + not + @@ List.for_all + (function + | (Bls _ : Signature.public_key_hash) -> true | _ -> false) + committee + then failwith "Cannot aggregate non-BLS attestation" + else return_unit + in + (* Fails to produce an attestation if one of the delegates has no slot for the block *) + let* op = Op.attestations_aggregate ~committee block in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let state = State.add_pending_operations [op] state in + return (block, state)) + +let attest_with_all_ : t -> t tzresult Lwt.t = + let open Lwt_result_syntax in + fun (block, state) -> + Log.info ~color:action_color "[Attesting with all eligible delegates]" ; + let kind = Attestation in + let* rights = Plugin.RPC.Attestation_rights.get Block.rpc_ctxt block in + let delegates_rights = + match rights with + | [{level = _; delegates_rights; estimated_time = _}] -> delegates_rights + | _ -> + (* Cannot happen: RPC called to return only current level, + so the returned list should only contain one element. *) + assert false + in + let* dlgs = + List.map + (fun { + Plugin.RPC.Attestation_rights.delegate; + consensus_key = _; + first_slot; + attestation_power; + } -> + Tezt.Check.( + (attestation_power > 0) + int + ~__LOC__ + ~error_msg:"Attestation power should be greater than 0, got %L") ; + (delegate, first_slot)) + delegates_rights + |> List.filter_es (fun (delegate, _slot) -> + let* is_forbidden = + Context.Delegate.is_forbidden (B block) delegate + in + return (not is_forbidden)) + in + let* to_aggregate, ops = + List.fold_left_es + (fun (to_aggregate, regular) (delegate, slot) -> + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let* op = + Op.raw_attestation ~delegate:consensus_key.pkh ~slot block + in + match (state.constants.aggregate_attestation, consensus_key.pk) with + | true, Bls _ -> + return ((op, delegate, consensus_key.pkh) :: to_aggregate, regular) + | _ -> + return + ( to_aggregate, + ( Protocol.Alpha_context.Operation.pack op, + delegate, + consensus_key.pkh ) + :: regular )) + ([], []) + dlgs + in + let aggregated = + Op.aggregate (List.map (fun (x, _, _) -> x) to_aggregate) + in + let state = + match aggregated with + | None -> state + | Some op -> + (* Update the activity of the committee *) + let state, delegate_and_ck_committee = + List.fold_left + (fun (state, delegate_and_ck) (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + ( update_activity delegate_name block state, + (delegate_pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, []) + to_aggregate + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let state = State.add_pending_operations [op] state in + state + in + (* Update the activity of the rest of the committee, and check metadata *) + let state = + List.fold_left + (fun state (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + let state = update_activity delegate_name block state in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate_pkh consensus_key_pkh) + state + in + state) + state + ops + in + let state = + State.add_pending_operations (List.map (fun (x, _, _) -> x) ops) state + in + return (block, state) + +let attest_with_all = exec attest_with_all_ + +(** --- Preattestations --- *) + +let make_fake_block ?payload_round incr = + let open Lwt_result_wrap_syntax in + let* int_round, round = + match payload_round with + | Some payload_round -> + let int_round = payload_round in + let*?@ round = Alpha_context.Round.of_int int_round in + return (int_round, round) + | None -> + let round = + (Incremental.header incr).protocol_data.contents.payload_round + in + let*?@ int_round = Alpha_context.Round.to_int round in + return (int_round, round) + in + let operations = + Block.Forge.classify_operations (List.rev @@ Incremental.rev_operations incr) + in + let non_consensus_operations = + List.concat (match List.tl operations with None -> [] | Some l -> l) + in + Block.bake + ~policy:(By_round int_round) + ~payload_round:round + ~operations:non_consensus_operations + (Incremental.predecessor incr) + +let preattest_with ?payload_round (delegate_name : string) : + (t_incr, t_incr) scenarios = + exec (fun (incr, state) -> + let open Lwt_result_wrap_syntax in + Log.info ~color:action_color "[Preattesting with \"%s\"]" delegate_name ; + if state.force_preattest_all then + failwith "Cannot manually preattest if force_preattest_all is true" + else + let kind = Preattestation in + let* fake_block = make_fake_block ?payload_round incr in + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (I incr) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + (* Fails to produce an attestation if the delegate has no slot for the block *) + let* op = Op.preattestation ~delegate:consensus_key.pkh fake_block in + (* Update the activity of the delegate *) + let state = + update_activity delegate_name (Incremental.predecessor incr) state + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate.pkh consensus_key.pkh) + state + in + let* incr = Incremental.add_operation incr op in + return (incr, state)) + +(** (tz4 only) Creates an aggregated preattestation from the preattestations of the given delegates. + Fails if one of the delegates has no slot for the given block, or if one of the + delegates' consensus key is not a tz4 *) +let preattest_aggreg_with ?payload_round (delegates : string list) : + (t_incr, t_incr) scenarios = + exec (fun (incr, state) -> + let open Lwt_result_wrap_syntax in + Log.info + ~color:action_color + "[Aggregated preattesting with \"%a\"]" + Format.( + pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "; ") pp_print_string) + delegates ; + if state.force_preattest_all then + failwith "Cannot manually preattest if force_preattest_all is true" + else + let kind = Preattestation in + let* fake_block = make_fake_block ?payload_round incr in + let* state, committee, delegate_and_ck_committee = + List.fold_left_es + (fun (state, committee, delegate_and_ck) delegate_name -> + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (I incr) delegate.pkh + in + let consensus_key_pkh = + consensus_key_info.active.consensus_key_pkh + in + (* Update the activity of the committee *) + let state = + update_activity + delegate_name + (Incremental.predecessor incr) + state + in + return + ( state, + consensus_key_pkh :: committee, + (delegate.pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, [], []) + delegates + in + let* () = + if + not + @@ List.for_all + (function + | (Bls _ : Signature.public_key_hash) -> true | _ -> false) + committee + then failwith "Cannot aggregate non-BLS preattestation" + else return_unit + in + (* Fails to produce a preattestation if one of the delegates has no slot for the block *) + let* op = Op.preattestations_aggregate ~committee fake_block in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let* incr = Incremental.add_operation incr op in + return (incr, state)) + +let preattest_with_all_ ?payload_round : t_incr -> t_incr tzresult Lwt.t = + let open Lwt_result_syntax in + fun (incr, state) -> + Log.info ~color:action_color "[Preattesting with all eligible delegates]" ; + let kind = Preattestation in + let* fake_block = make_fake_block ?payload_round incr in + let* rights = Plugin.RPC.Attestation_rights.get Block.rpc_ctxt fake_block in + let delegates_rights = + match rights with + | [{level = _; delegates_rights; estimated_time = _}] -> delegates_rights + | _ -> + (* Cannot happen: RPC called to return only current level, + so the returned list should only contain one element. *) + assert false + in + let* dlgs = + List.map + (fun { + Plugin.RPC.Attestation_rights.delegate; + consensus_key = _; + first_slot; + attestation_power; + } -> + Tezt.Check.( + (attestation_power > 0) + int + ~__LOC__ + ~error_msg:"Attestation power should be greater than 0, got %L") ; + (delegate, first_slot)) + delegates_rights + |> List.filter_es (fun (delegate, _slot) -> + let* is_forbidden = + Context.Delegate.is_forbidden (I incr) delegate + in + return (not is_forbidden)) + in + let* to_aggregate, ops = + List.fold_left_es + (fun (to_aggregate, regular) (delegate, slot) -> + let* consensus_key_info = + Context.Delegate.consensus_key (I incr) delegate + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let* op = + Op.raw_preattestation ~delegate:consensus_key.pkh ~slot fake_block + in + match (state.constants.aggregate_attestation, consensus_key.pk) with + | true, Bls _ -> + return ((op, delegate, consensus_key.pkh) :: to_aggregate, regular) + | _ -> + return + ( to_aggregate, + ( Protocol.Alpha_context.Operation.pack op, + delegate, + consensus_key.pkh ) + :: regular )) + ([], []) + dlgs + in + let aggregated = + Op.aggregate_preattestations (List.map (fun (x, _, _) -> x) to_aggregate) + in + let* incr, state = + match aggregated with + | None -> return (incr, state) + | Some op -> + (* Update the activity of the committee *) + let state, delegate_and_ck_committee = + List.fold_left + (fun (state, delegate_and_ck) (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + ( update_activity + delegate_name + (Incremental.predecessor incr) + state, + (delegate_pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, []) + to_aggregate + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let* incr = Incremental.add_operation incr op in + return (incr, state) + in + (* Update the activity of the rest of the committee, and check metadata *) + let state = + List.fold_left + (fun state (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + let state = + update_activity delegate_name (Incremental.predecessor incr) state + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate_pkh consensus_key_pkh) + state + in + state) + state + ops + in + let* incr = + List.fold_left_es + Incremental.add_operation + incr + (List.map (fun (x, _, _) -> x) ops) + in + return (incr, state) diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml index 98ecdaad3f9cfb3932e6e7aa70e5887ff3627442..cd8e793ebf98e5d7582ea2409f6dfc379ea6cde8 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml @@ -10,6 +10,7 @@ open State open Scenario_dsl open Log_helpers open Scenario_base +open Scenario_attestation (** Applies when baking the last block of a cycle *) let apply_end_cycle current_cycle previous_block block state : @@ -215,67 +216,6 @@ let check_issuance_rpc block : unit tzresult Lwt.t = in return_unit -let attest_all_ previous_block = - let open Lwt_result_syntax in - fun (block, state) -> - let* rights = Plugin.RPC.Attestation_rights.get Block.rpc_ctxt block in - let delegates_rights = - match rights with - | [{level = _; delegates_rights; estimated_time = _}] -> delegates_rights - | _ -> - (* Cannot happen: RPC called to return only current level, - so the returned list should only contain one element. *) - assert false - in - let* dlgs = - List.map - (fun { - Plugin.RPC.Attestation_rights.delegate; - consensus_key = _; - first_slot; - attestation_power; - } -> - Tezt.Check.( - (attestation_power > 0) - int - ~__LOC__ - ~error_msg:"Attestation power should be greater than 0, got %L") ; - (delegate, first_slot)) - delegates_rights - |> List.filter_es (fun (delegate, _slot) -> - let* is_forbidden = - Context.Delegate.is_forbidden (B block) delegate - in - return (not is_forbidden)) - in - let* to_aggregate, ops = - List.fold_left_es - (fun (to_aggregate, regular) (delegate, slot) -> - let* consensus_key_info = - Context.Delegate.consensus_key (B previous_block) delegate - in - let consensus_key = consensus_key_info.active in - let* consensus_key = Account.find consensus_key.consensus_key_pkh in - let* op = - Op.raw_attestation ~delegate:consensus_key.pkh ~slot block - in - match (state.constants.aggregate_attestation, consensus_key.pk) with - | true, Bls _ -> return (op :: to_aggregate, regular) - | _ -> - return - ( to_aggregate, - Protocol.Alpha_context.Operation.pack op :: regular )) - ([], []) - dlgs - in - let aggregated = Op.aggregate to_aggregate in - let ops = match aggregated with None -> ops | Some x -> x :: ops in - let state = State.add_pending_operations ops state in - return (block, state) - -(* Does not produce a new block *) -let attest_all previous_block = exec (attest_all_ previous_block) - let check_ai_launch_cycle_is_zero ~loc block = let open Lwt_result_syntax in let* ai_launch_cycle = Context.get_adaptive_issuance_launch_cycle (B block) in @@ -296,8 +236,14 @@ let apply_all_pending_operations_ : t_incr -> t_incr tzresult Lwt.t = (** finalize the payload of the next block. Can start including preattestations. *) let finalize_payload_ ?payload_round ?baker : t -> t_incr tzresult Lwt.t = - fun (block, state) -> + fun ((block, state) as input) -> let open Lwt_result_wrap_syntax in + (* Before going incremental mode, apply the [force_attest_all] *) + let* block, state = + if Int32.(block.header.shell.level <> zero) && state.force_attest_all then + attest_with_all_ input + else Lwt_result.return input + in let policy = match baker with | None -> state.baking_policy @@ -313,6 +259,11 @@ let finalize_payload_ ?payload_round ?baker : t -> t_incr tzresult Lwt.t = in Some (Block.By_account pkh) in + let payload_round = + match payload_round with + | Some _ -> payload_round + | None -> state.payload_round + in let* baker, _, _, _ = Block.get_next_baker ?policy block in let baker_name, {contract = baker_contract; _} = State.find_account_from_pkh baker state @@ -366,57 +317,26 @@ let finalize_payload ?payload_round ?baker () : (t, t_incr) scenarios = exec (finalize_payload_ ?payload_round ?baker) let finalize_block_ : t_incr -> t tzresult Lwt.t = - fun (i, state) -> + fun ((_, state) as input) -> let open Lwt_result_wrap_syntax in assert (List.is_empty state.pending_operations) ; - let* block, block_metadata = Incremental.finalize_block_with_metadata i in - let ((_, op_metadata) as metadata) = - (block_metadata, List.rev (Incremental.rev_tickets i)) + (* Before going finalizing the block, apply the [force_preattest_all] *) + let* i, state = + if state.force_preattest_all then preattest_with_all_ input + else Lwt_result.return input in + let* block, block_metadata = Incremental.finalize_block_with_metadata i in + let metadata = (block_metadata, List.rev (Incremental.rev_tickets i)) in let previous_block = Incremental.predecessor i in let baker = Incremental.delegate i in - let baker_name, baker_acc = State.find_account_from_pkh baker.pkh state in - (* update baker and attesters activity *) - let update_activity delegate_account = - Account_helpers.update_activity - delegate_account - state.constants - (Block.current_cycle block) - in - let* attesters = - List.filter_map_es - (function - | Protocol.Apply_results.No_operation_metadata -> return_none - | Operation_metadata {contents} -> ( - match contents with - | Single_result (Attestation_result {delegate; _}) - | Single_result (Preattestation_result {delegate; _}) -> - return_some [delegate] - | Single_result (Attestations_aggregate_result {committee; _}) - | Single_result (Preattestations_aggregate_result {committee; _}) -> - return_some - (List.map - (fun ((ck : Protocol.Alpha_context.Consensus_key.t), _) -> - ck.delegate) - committee) - | _ -> return_none)) - op_metadata - in - let attesters = List.flatten attesters in + let baker_name, _ = State.find_account_from_pkh baker.pkh state in + (* Update baker activity *) let state = - State.update_map - ~f:(fun acc_map -> - let acc_map = - String.Map.add baker_name (update_activity baker_acc) acc_map - in - List.fold_left - (fun acc_map delegate_pkh -> - let delegate_name, delegate_acc = - State.find_account_from_pkh delegate_pkh state - in - String.Map.add delegate_name (update_activity delegate_acc) acc_map) - acc_map - attesters) + State.update_account_f + baker_name + (Account_helpers.update_activity + state.constants + (Block.current_cycle block)) state in let* () = check_ai_launch_cycle_is_zero ~loc:__LOC__ block in @@ -443,10 +363,6 @@ let finalize_block_ : t_incr -> t tzresult Lwt.t = |> Int32.to_int) ; return @@ apply_new_cycle new_future_current_cycle state) in - let* block, state = - if state.force_attest_all then attest_all_ previous_block (block, state) - else return (block, state) - in let* () = List.iter_es (fun f -> f metadata (block, state)) diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml index 79bbf05b7b734ef40e4ec531fb3ef9ae2b0e0300..142737652ea131b05493f36e64fca3b94f0ce14d 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml @@ -59,10 +59,15 @@ let exclude_bakers bakers : (t, t) scenarios = return {state with State.baking_policy = Some (Block.Excluding bakers_pkh)}) -let set_baked_round (round : int) : (t, t) scenarios = +let set_baked_round ?payload_round (round : int) : (t, t) scenarios = let open Lwt_result_syntax in exec_state (fun (_block, state) -> - return {state with State.baking_policy = Some (Block.By_round round)}) + return + { + state with + State.baking_policy = Some (Block.By_round round); + payload_round; + }) (** Unsets the baking policy, it returns to default ([By_round 0]) *) let unset_baking_policy : (t, t) scenarios = diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml index 06e6d8ed339eb83439f7a759f9d775441cb6f6fc..a424ad1f2c63aea6cbba2c4f7ae961512cddb04f 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml @@ -82,8 +82,8 @@ let init_constants ?(default = Test) ?(reward_per_block = 0L) (** Initialize the test, given some initial parameters *) let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false) - ?(check_finalized_block_perm = []) delegates_name_list : - (constants, t) scenarios = + ?(force_preattest_all = false) ?(check_finalized_block_perm = []) + delegates_name_list : (constants, t) scenarios = exec (fun (constants : constants) -> let open Lwt_result_syntax in let bootstrap = "__bootstrap__" in @@ -142,6 +142,7 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false) param_requests = []; force_ai_vote_yes = true; baking_policy = None; + payload_round = None; last_level_rewards = init_level; snapshot_balances = String.Map.empty; saved_rate = None; @@ -152,6 +153,7 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false) pending_slashes = []; double_signings = []; force_attest_all; + force_preattest_all; check_finalized_block_perm; check_finalized_block_temp = []; previous_metadata = None; diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml index a4610cc125c7541b0384cbefee845c4dabfe13f0..5100c97640d6ffb60cb87500bfc15b5a6150dfdf 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml @@ -166,17 +166,10 @@ let set_delegate src_name delegate_name_opt : (t, t) scenarios = let state = (* if self delegating *) if Option.equal String.equal delegate_name_opt (Some src_name) then - let src = State.find_account src_name state in let activity_cycle = current_cycle in - State.update_map - ~f:(fun acc_map -> - String.Map.add - src_name - (Account_helpers.update_activity - src - state.constants - activity_cycle) - acc_map) + State.update_account_f + src_name + (Account_helpers.update_activity state.constants activity_cycle) state else state in diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml index ec99172479a916c1a6c189be694202ffa02b9fb7..a27ed03b0748677dc7ff2fef677d1bd98762b0f1 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml +++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml @@ -26,6 +26,7 @@ type t = { param_requests : (string * staking_parameters * int) list; force_ai_vote_yes : bool; baking_policy : Block.baker_policy option; + payload_round : int option; last_level_rewards : Protocol.Alpha_context.Raw_level.t; snapshot_balances : (string * balance) list String.Map.t; saved_rate : Q.t option; @@ -37,6 +38,7 @@ type t = { (Signature.Public_key_hash.t * Protocol.Denunciations_repr.item) list; double_signings : double_signing_state list; force_attest_all : bool; + force_preattest_all : bool; check_finalized_block_perm : (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list; check_finalized_block_temp : @@ -200,6 +202,17 @@ let update_account (account_name : string) (value : account_state) (state : t) : let account_map = String.Map.add account_name value state.account_map in {state with account_map} +let update_account_f (account_name : string) + (f : account_state -> account_state) (state : t) : t = + let f = function + | None -> + Log.error "State.update_account_f: account %s not found" account_name ; + assert false + | Some s -> Some (f s) + in + let account_map = String.Map.update account_name f state.account_map in + {state with account_map} + let update_delegate account_name delegate_name_opt state : t = let account = find_account account_name state in update_account account_name {account with delegate = delegate_name_opt} state @@ -249,3 +262,9 @@ let pop_pending_operations state = let add_pending_batch operations state = {state with pending_batch = state.pending_batch @ operations} + +let add_temp_check check state = + { + state with + check_finalized_block_temp = state.check_finalized_block_temp @ [check]; + } diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/dune b/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/dune index df92d667828b9a12a04d9402fb2dfe039fadf2d6..8779420d54f8f96335f4c92545babfaf9e1ba9c0 100644 --- a/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/dune +++ b/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/dune @@ -44,7 +44,8 @@ test_seed test_aggregate test_dal_entrapment - test_companion_key)) + test_companion_key + test_scenario_attestation)) (executable (name main) diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/test_scenario_attestation.ml b/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/test_scenario_attestation.ml new file mode 100644 index 0000000000000000000000000000000000000000..4e403817da7d6e32a5ab2e3dcf4fd96a3941f26c --- /dev/null +++ b/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/test_scenario_attestation.ml @@ -0,0 +1,173 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2025 Nomadic Labs, *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Protocol ((pre)attestations) + Invocation: dune exec src/proto_alpha/lib_protocol/test/integration/consensus/main.exe \ + -- --file test_scenario_attestation.ml + + Subject: Test various scenarios with attestations, preattestations, aggregation, DAL bitset, + consensus and companion keys, forbidden and inactive delegates, and metadata. +*) + +open Scenario + +let check_delegate_attested ~check_not_found ~kind delegate = + let open Lwt_result_syntax in + exec_unit (fun (block, state) -> + let delegate = State.find_account delegate state in + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let metadata = Stdlib.Option.get state.previous_metadata in + check_attestation_metadata + ~check_not_found + ~kind + delegate.pkh + consensus_key.pkh + metadata + (block, state)) + +let check_delegate_didnt_preattest delegate = + check_delegate_attested ~check_not_found:true ~kind:Preattestation delegate + +let check_delegate_didnt_attest delegate = + check_delegate_attested ~check_not_found:true ~kind:Attestation delegate + +let check_delegate_preattested delegate = + check_delegate_attested ~check_not_found:false ~kind:Preattestation delegate + +let check_delegate_attested delegate = + check_delegate_attested ~check_not_found:false ~kind:Attestation delegate + +let check_aggregated_committee ~check_not_found ~kind delegates = + let open Lwt_result_syntax in + exec_unit (fun (block, state) -> + let* delegates = + List.map_es + (fun delegate_name -> + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + return (delegate.pkh, consensus_key.pkh)) + delegates + in + let metadata = Stdlib.Option.get state.previous_metadata in + check_attestation_aggregate_metadata + ~check_not_found + ~kind + delegates + metadata + (block, state)) + +let check_aggregated_wrong_committee = + check_aggregated_committee ~check_not_found:true + +let check_aggregated_committee = + check_aggregated_committee ~check_not_found:false + +let test_attest_simple = + init_constants () + --> begin_test ["delegate"; "dummy"] ~force_attest_all:false + --> next_block --> attest_with "delegate" --> next_block + (* Sanity checks. The positive checks are done every time there is an attestation + or a preattestation. *) + --> check_delegate_attested "delegate" + --> check_delegate_didnt_attest "dummy" + +let test_preattest_simple = + init_constants () + --> begin_test ["delegate"] ~force_preattest_all:false + --> set_baked_round 1 --> next_block + --> finalize_payload ~payload_round:0 () + --> preattest_with "delegate" --> finalize_block + (* Sanity checks *) + --> check_delegate_preattested "delegate" + --> check_delegate_didnt_preattest "dummy" + +let test_preattest_less_simple = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~force_preattest_all:false + --> set_baked_round 1 --> next_block --> start_payload + --> transfer "delegate1" "delegate2" (Amount (Tez_helpers.of_mutez 100L)) + --> transfer "delegate2" "delegate1" (Amount (Tez_helpers.of_mutez 99L)) + --> finalize_payload ~payload_round:0 () + --> preattest_with "delegate1" --> preattest_with "delegate2" + --> finalize_block + (* Sanity checks *) + --> check_delegate_preattested "delegate1" + --> check_delegate_preattested "delegate2" + +let test_attest_all = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~force_attest_all:true + --> next_block (* This block does not contain attestations; check next. *) + --> next_block + (* Sanity checks *) + --> check_delegate_attested "delegate1" + --> check_delegate_attested "delegate2" + --> check_aggregated_wrong_committee + ~kind:Attestation + ["delegate1"; "delegate2"] + +let test_preattest_all = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~force_preattest_all:true + --> set_baked_round ~payload_round:0 1 + --> next_block + (* Sanity checks *) + --> check_delegate_preattested "delegate1" + --> check_delegate_preattested "delegate2" + --> check_aggregated_wrong_committee + ~kind:Preattestation + ["delegate1"; "delegate2"] + +let test_attest_aggreg = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~algo:Bls ~force_attest_all:false + --> next_block + --> attest_aggreg_with ["delegate1"; "delegate2"] + --> next_block + (* Sanity checks. Aggregated committees are always handled separately. *) + --> check_aggregated_committee ~kind:Attestation ["delegate1"; "delegate2"] + (* Check that bls attestations cannot be found alone, i.e. non aggregated. *) + --> check_delegate_didnt_attest "delegate1" + --> check_delegate_didnt_attest "delegate2" + +let test_preattest_aggreg = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~algo:Bls ~force_preattest_all:false + --> set_baked_round 1 --> next_block + --> finalize_payload ~payload_round:0 () + --> preattest_aggreg_with ["delegate1"; "delegate2"] + --> finalize_block + (* Sanity checks *) + --> check_aggregated_committee ~kind:Preattestation ["delegate1"; "delegate2"] + (* Check that bls attestations cannot be found alone, i.e. non aggregated. *) + --> check_delegate_didnt_preattest "delegate1" + --> check_delegate_didnt_preattest "delegate2" + +let tests = + tests_of_scenarios + @@ [ + ("Test simple attestation", test_attest_simple); + ("Test simple preattestation", test_preattest_less_simple); + ("Test less simple preattestation", test_preattest_less_simple); + ("Test attest all", test_attest_all); + ("Test preattest all", test_preattest_all); + ("Test attest aggreg", test_attest_aggreg); + ("Test preattest aggreg", test_preattest_aggreg); + ] + +let () = + register_tests ~__FILE__ ~tags:["protocol"; "scenario"; "consensus"] tests diff --git a/src/proto_alpha/lib_protocol/test/helpers/account_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/account_helpers.ml index b5df3f4b4907f1a98178cbeb23abe416401f7507..4961b7dab5a5f120ad54e2327d253abfd3e82fdb 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/account_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/account_helpers.ml @@ -560,7 +560,7 @@ let current_total_frozen_deposits_with_limits account_state = account_state.parameters.limit_of_staking_over_baking account_state.frozen_deposits -let update_activity account constants current_cycle = +let update_activity constants current_cycle account = match account.last_seen_activity with | None -> { diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index f04560b00faf04c9fb19d6658229c87c674845ef..9bd810d18d18a4e146349d185f32ec7f0826912c 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -1317,6 +1317,11 @@ let current_cycle b = let current_level = b.header.shell.level in current_cycle_of_level ~blocks_per_cycle ~current_level +let cycle_of_next_block b = + let blocks_per_cycle = b.constants.blocks_per_cycle in + let current_level = Int32.succ b.header.shell.level in + current_cycle_of_level ~blocks_per_cycle ~current_level + let cycle_position b = let blocks_per_cycle = b.constants.blocks_per_cycle in let level = b.header.shell.level in diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.mli b/src/proto_alpha/lib_protocol/test/helpers/block.mli index 4315ccb8b8f66e441d511362f4785967de88a082..a11f8bd8626a485f79f79efb9175eec23d97e918 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/block.mli @@ -368,6 +368,8 @@ val current_level : block -> int32 val current_cycle : block -> Cycle.t +val cycle_of_next_block : block -> Cycle.t + val cycle_position : block -> int32 val first_level_of_cycle : Constants.Parametric.t -> level:int32 -> bool diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario.ml index 38a2e0be669aaa7baeb792bd7dd52d8ce26ca2ca..f5c67b6161898c7420bde67dcee773431adef79f 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/scenario.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/scenario.ml @@ -15,3 +15,4 @@ include Scenario_dsl include Scenario_begin include Scenario_constants include Scenario_bake +include Scenario_attestation diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_attestation.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_attestation.ml new file mode 100644 index 0000000000000000000000000000000000000000..56d2c1ca2500149da0627853f4b948af5202d49e --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_attestation.ml @@ -0,0 +1,620 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2025 Nomadic Labs, *) +(* *) +(*****************************************************************************) + +open State_account +open State +open Scenario_dsl +open Log_helpers +open Scenario_base +open Protocol + +let update_activity name block state : State.t = + State.update_account_f + name + (Account_helpers.update_activity + state.constants + (Block.cycle_of_next_block block)) + state + +type kind = Preattestation | Attestation + +let string_of_kind = function + | Preattestation -> "preattestation" + | Attestation -> "attestation" + +(** --- Attestations --- *) + +let check_attestation_metadata ?(check_not_found = false) ~kind delegate_pkh + consensus_key_pkh : Block.full_metadata -> t -> unit tzresult Lwt.t = + fun (_block_header_metadata, op_metadata) (_block, _state) -> + let open Lwt_result_syntax in + Log.debug + ~color:low_debug_color + "Check metadata: %s for %a (consensus key : %a)" + (string_of_kind kind) + Signature.Public_key_hash.pp + delegate_pkh + Signature.Public_key_hash.pp + consensus_key_pkh ; + let id_or_not, error_prefix = + if check_not_found then (not, "Not expected but found in metadata") + else (Fun.id, "Expected but not found in metadata") + in + if + id_or_not + @@ List.exists + (fun metadata -> + match (kind, metadata) with + | ( Attestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Attestation_result + { + (* This list is always empty *) + balance_updates = []; + delegate; + consensus_key; + consensus_power = _; + }); + } ) + | ( Preattestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Preattestation_result + { + (* This list is always empty *) + balance_updates = []; + delegate; + consensus_key; + consensus_power = _; + }); + } ) -> + Signature.Public_key_hash.( + equal delegate delegate_pkh + && equal consensus_key consensus_key_pkh) + | _ -> false) + op_metadata + then return_unit + else + failwith + "%s: %s for %a (consensus key : %a)" + error_prefix + (string_of_kind kind) + Signature.Public_key_hash.pp + delegate_pkh + Signature.Public_key_hash.pp + consensus_key_pkh + +let check_attestation_aggregate_metadata ?(check_not_found = false) ~kind + committee_expect : Block.full_metadata -> t -> unit tzresult Lwt.t = + fun (_block_header_metadata, op_metadata) (_block, _state) -> + let open Lwt_result_syntax in + Log.debug ~color:low_debug_color "Check metadata: aggregated attestation" ; + let id_or_not, error_prefix = + if check_not_found then (not, "Not expected but found in metadata") + else (Fun.id, "Expected but not found in metadata") + in + if + id_or_not + @@ List.exists + (fun metadata -> + match (kind, metadata) with + | ( Attestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Attestations_aggregate_result + { + (* This list is always empty *) + balance_updates = []; + committee; + total_consensus_power = _; + }); + } ) + | ( Preattestation, + Protocol.Apply_results.Operation_metadata + { + contents = + Single_result + (Preattestations_aggregate_result + { + (* This list is always empty *) + balance_updates = []; + committee; + total_consensus_power = _; + }); + } ) -> + let committee = + List.map + (fun ((ck : Protocol.Alpha_context.Consensus_key.t), _) -> + ck.delegate) + committee + |> List.sort Signature.Public_key_hash.compare + in + let committee_expect = + List.map fst committee_expect + |> List.sort Signature.Public_key_hash.compare + in + List.equal + Signature.Public_key_hash.equal + committee + committee_expect + | _ -> false) + op_metadata + then return_unit + else + failwith + "%s: %s aggregate for committee@.[%a]" + error_prefix + (string_of_kind kind) + Format.( + pp_print_list + ~pp_sep:(fun fmt () -> fprintf fmt "; ") + Signature.Public_key_hash.pp) + (List.map fst committee_expect) + +let attest_with ?dal_content (delegate_name : string) : (t, t) scenarios = + exec (fun (block, state) -> + let open Lwt_result_wrap_syntax in + let kind = Attestation in + Log.info ~color:action_color "[Attesting with \"%s\"]" delegate_name ; + if state.force_attest_all then + failwith "Cannot manually attest if force_attest_all is true" + else + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let*?@ dal_content = + Option.map_e + Alpha_context.Dal.Attestation.Internal_for_tests.of_z + dal_content + in + let dal_content = + Option.map (fun i -> Alpha_context.{attestation = i}) dal_content + in + (* Fails to produce an attestation if the delegate has no slot for the block *) + let* op = + Op.attestation ?dal_content ~delegate:consensus_key.pkh block + in + (* Update the activity of the delegate *) + let state = update_activity delegate_name block state in + let state = State.add_pending_operations [op] state in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate.pkh consensus_key.pkh) + state + in + return (block, state)) + +(** (tz4 only) Creates an aggregated attestation from the attestations of the given delegates. + Fails if one of the delegates has no slot for the given block, or if one of the + delegates' consensus key is not a tz4 *) +let attest_aggreg_with (delegates : string list) : (t, t) scenarios = + exec (fun (block, state) -> + let open Lwt_result_wrap_syntax in + let kind = Attestation in + Log.info + ~color:action_color + "[Aggregated attesting with \"%a\"]" + Format.( + pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "; ") pp_print_string) + delegates ; + if state.force_attest_all then + failwith "Cannot manually attest if force_attest_all is true" + else + let* state, committee, delegate_and_ck_committee = + List.fold_left_es + (fun (state, committee, delegate_and_ck) delegate_name -> + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key + (B state.grandparent) + delegate.pkh + in + let consensus_key_pkh = + consensus_key_info.active.consensus_key_pkh + in + (* Update the activity of the committee *) + let state = update_activity delegate_name block state in + return + ( state, + consensus_key_pkh :: committee, + (delegate.pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, [], []) + delegates + in + let* () = + if + not + @@ List.for_all + (function + | (Bls _ : Signature.public_key_hash) -> true | _ -> false) + committee + then failwith "Cannot aggregate non-BLS attestation" + else return_unit + in + (* Fails to produce an attestation if one of the delegates has no slot for the block *) + let* op = Op.attestations_aggregate ~committee block in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let state = State.add_pending_operations [op] state in + return (block, state)) + +let attest_with_all_ : t -> t tzresult Lwt.t = + let open Lwt_result_syntax in + fun (block, state) -> + Log.info ~color:action_color "[Attesting with all eligible delegates]" ; + let kind = Attestation in + let* rights = Plugin.RPC.Attestation_rights.get Block.rpc_ctxt block in + let delegates_rights = + match rights with + | [{level = _; delegates_rights; estimated_time = _}] -> delegates_rights + | _ -> + (* Cannot happen: RPC called to return only current level, + so the returned list should only contain one element. *) + assert false + in + let* dlgs = + List.map + (fun { + Plugin.RPC.Attestation_rights.delegate; + consensus_key = _; + first_slot; + attestation_power; + } -> + Tezt.Check.( + (attestation_power > 0) + int + ~__LOC__ + ~error_msg:"Attestation power should be greater than 0, got %L") ; + (delegate, first_slot)) + delegates_rights + |> List.filter_es (fun (delegate, _slot) -> + let* is_forbidden = + Context.Delegate.is_forbidden (B block) delegate + in + return (not is_forbidden)) + in + let* to_aggregate, ops = + List.fold_left_es + (fun (to_aggregate, regular) (delegate, slot) -> + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let* op = + Op.raw_attestation ~delegate:consensus_key.pkh ~slot block + in + match (state.constants.aggregate_attestation, consensus_key.pk) with + | true, Bls _ -> + return ((op, delegate, consensus_key.pkh) :: to_aggregate, regular) + | _ -> + return + ( to_aggregate, + ( Protocol.Alpha_context.Operation.pack op, + delegate, + consensus_key.pkh ) + :: regular )) + ([], []) + dlgs + in + let aggregated = + Op.aggregate (List.map (fun (x, _, _) -> x) to_aggregate) + in + let state = + match aggregated with + | None -> state + | Some op -> + (* Update the activity of the committee *) + let state, delegate_and_ck_committee = + List.fold_left + (fun (state, delegate_and_ck) (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + ( update_activity delegate_name block state, + (delegate_pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, []) + to_aggregate + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let state = State.add_pending_operations [op] state in + state + in + (* Update the activity of the rest of the committee, and check metadata *) + let state = + List.fold_left + (fun state (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + let state = update_activity delegate_name block state in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate_pkh consensus_key_pkh) + state + in + state) + state + ops + in + let state = + State.add_pending_operations (List.map (fun (x, _, _) -> x) ops) state + in + return (block, state) + +let attest_with_all = exec attest_with_all_ + +(** --- Preattestations --- *) + +let make_fake_block ?payload_round incr = + let open Lwt_result_wrap_syntax in + let* int_round, round = + match payload_round with + | Some payload_round -> + let int_round = payload_round in + let*?@ round = Alpha_context.Round.of_int int_round in + return (int_round, round) + | None -> + let round = + (Incremental.header incr).protocol_data.contents.payload_round + in + let*?@ int_round = Alpha_context.Round.to_int round in + return (int_round, round) + in + let operations = + Block.Forge.classify_operations (List.rev @@ Incremental.rev_operations incr) + in + let non_consensus_operations = + List.concat (match List.tl operations with None -> [] | Some l -> l) + in + Block.bake + ~policy:(By_round int_round) + ~payload_round:round + ~operations:non_consensus_operations + (Incremental.predecessor incr) + +let preattest_with ?payload_round (delegate_name : string) : + (t_incr, t_incr) scenarios = + exec (fun (incr, state) -> + let open Lwt_result_wrap_syntax in + Log.info ~color:action_color "[Preattesting with \"%s\"]" delegate_name ; + if state.force_preattest_all then + failwith "Cannot manually preattest if force_preattest_all is true" + else + let kind = Preattestation in + let* fake_block = make_fake_block ?payload_round incr in + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (I incr) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + (* Fails to produce an attestation if the delegate has no slot for the block *) + let* op = Op.preattestation ~delegate:consensus_key.pkh fake_block in + (* Update the activity of the delegate *) + let state = + update_activity delegate_name (Incremental.predecessor incr) state + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate.pkh consensus_key.pkh) + state + in + let* incr = Incremental.add_operation incr op in + return (incr, state)) + +(** (tz4 only) Creates an aggregated preattestation from the preattestations of the given delegates. + Fails if one of the delegates has no slot for the given block, or if one of the + delegates' consensus key is not a tz4 *) +let preattest_aggreg_with ?payload_round (delegates : string list) : + (t_incr, t_incr) scenarios = + exec (fun (incr, state) -> + let open Lwt_result_wrap_syntax in + Log.info + ~color:action_color + "[Aggregated preattesting with \"%a\"]" + Format.( + pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "; ") pp_print_string) + delegates ; + if state.force_preattest_all then + failwith "Cannot manually preattest if force_preattest_all is true" + else + let kind = Preattestation in + let* fake_block = make_fake_block ?payload_round incr in + let* state, committee, delegate_and_ck_committee = + List.fold_left_es + (fun (state, committee, delegate_and_ck) delegate_name -> + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (I incr) delegate.pkh + in + let consensus_key_pkh = + consensus_key_info.active.consensus_key_pkh + in + (* Update the activity of the committee *) + let state = + update_activity + delegate_name + (Incremental.predecessor incr) + state + in + return + ( state, + consensus_key_pkh :: committee, + (delegate.pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, [], []) + delegates + in + let* () = + if + not + @@ List.for_all + (function + | (Bls _ : Signature.public_key_hash) -> true | _ -> false) + committee + then failwith "Cannot aggregate non-BLS preattestation" + else return_unit + in + (* Fails to produce a preattestation if one of the delegates has no slot for the block *) + let* op = Op.preattestations_aggregate ~committee fake_block in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let* incr = Incremental.add_operation incr op in + return (incr, state)) + +let preattest_with_all_ ?payload_round : t_incr -> t_incr tzresult Lwt.t = + let open Lwt_result_syntax in + fun (incr, state) -> + Log.info ~color:action_color "[Preattesting with all eligible delegates]" ; + let kind = Preattestation in + let* fake_block = make_fake_block ?payload_round incr in + let* rights = Plugin.RPC.Attestation_rights.get Block.rpc_ctxt fake_block in + let delegates_rights = + match rights with + | [{level = _; delegates_rights; estimated_time = _}] -> delegates_rights + | _ -> + (* Cannot happen: RPC called to return only current level, + so the returned list should only contain one element. *) + assert false + in + let* dlgs = + List.map + (fun { + Plugin.RPC.Attestation_rights.delegate; + consensus_key = _; + first_slot; + attestation_power; + } -> + Tezt.Check.( + (attestation_power > 0) + int + ~__LOC__ + ~error_msg:"Attestation power should be greater than 0, got %L") ; + (delegate, first_slot)) + delegates_rights + |> List.filter_es (fun (delegate, _slot) -> + let* is_forbidden = + Context.Delegate.is_forbidden (I incr) delegate + in + return (not is_forbidden)) + in + let* to_aggregate, ops = + List.fold_left_es + (fun (to_aggregate, regular) (delegate, slot) -> + let* consensus_key_info = + Context.Delegate.consensus_key (I incr) delegate + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let* op = + Op.raw_preattestation ~delegate:consensus_key.pkh ~slot fake_block + in + match (state.constants.aggregate_attestation, consensus_key.pk) with + | true, Bls _ -> + return ((op, delegate, consensus_key.pkh) :: to_aggregate, regular) + | _ -> + return + ( to_aggregate, + ( Protocol.Alpha_context.Operation.pack op, + delegate, + consensus_key.pkh ) + :: regular )) + ([], []) + dlgs + in + let aggregated = + Op.aggregate_preattestations (List.map (fun (x, _, _) -> x) to_aggregate) + in + let* incr, state = + match aggregated with + | None -> return (incr, state) + | Some op -> + (* Update the activity of the committee *) + let state, delegate_and_ck_committee = + List.fold_left + (fun (state, delegate_and_ck) (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + ( update_activity + delegate_name + (Incremental.predecessor incr) + state, + (delegate_pkh, consensus_key_pkh) :: delegate_and_ck )) + (state, []) + to_aggregate + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_aggregate_metadata + ~kind + delegate_and_ck_committee) + state + in + let* incr = Incremental.add_operation incr op in + return (incr, state) + in + (* Update the activity of the rest of the committee, and check metadata *) + let state = + List.fold_left + (fun state (_, delegate_pkh, consensus_key_pkh) -> + let delegate_name, _ = + State.find_account_from_pkh delegate_pkh state + in + let state = + update_activity delegate_name (Incremental.predecessor incr) state + in + (* Check metadata *) + let state = + State.add_temp_check + (check_attestation_metadata ~kind delegate_pkh consensus_key_pkh) + state + in + state) + state + ops + in + let* incr = + List.fold_left_es + Incremental.add_operation + incr + (List.map (fun (x, _, _) -> x) ops) + in + return (incr, state) diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml index 98ecdaad3f9cfb3932e6e7aa70e5887ff3627442..cd8e793ebf98e5d7582ea2409f6dfc379ea6cde8 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml @@ -10,6 +10,7 @@ open State open Scenario_dsl open Log_helpers open Scenario_base +open Scenario_attestation (** Applies when baking the last block of a cycle *) let apply_end_cycle current_cycle previous_block block state : @@ -215,67 +216,6 @@ let check_issuance_rpc block : unit tzresult Lwt.t = in return_unit -let attest_all_ previous_block = - let open Lwt_result_syntax in - fun (block, state) -> - let* rights = Plugin.RPC.Attestation_rights.get Block.rpc_ctxt block in - let delegates_rights = - match rights with - | [{level = _; delegates_rights; estimated_time = _}] -> delegates_rights - | _ -> - (* Cannot happen: RPC called to return only current level, - so the returned list should only contain one element. *) - assert false - in - let* dlgs = - List.map - (fun { - Plugin.RPC.Attestation_rights.delegate; - consensus_key = _; - first_slot; - attestation_power; - } -> - Tezt.Check.( - (attestation_power > 0) - int - ~__LOC__ - ~error_msg:"Attestation power should be greater than 0, got %L") ; - (delegate, first_slot)) - delegates_rights - |> List.filter_es (fun (delegate, _slot) -> - let* is_forbidden = - Context.Delegate.is_forbidden (B block) delegate - in - return (not is_forbidden)) - in - let* to_aggregate, ops = - List.fold_left_es - (fun (to_aggregate, regular) (delegate, slot) -> - let* consensus_key_info = - Context.Delegate.consensus_key (B previous_block) delegate - in - let consensus_key = consensus_key_info.active in - let* consensus_key = Account.find consensus_key.consensus_key_pkh in - let* op = - Op.raw_attestation ~delegate:consensus_key.pkh ~slot block - in - match (state.constants.aggregate_attestation, consensus_key.pk) with - | true, Bls _ -> return (op :: to_aggregate, regular) - | _ -> - return - ( to_aggregate, - Protocol.Alpha_context.Operation.pack op :: regular )) - ([], []) - dlgs - in - let aggregated = Op.aggregate to_aggregate in - let ops = match aggregated with None -> ops | Some x -> x :: ops in - let state = State.add_pending_operations ops state in - return (block, state) - -(* Does not produce a new block *) -let attest_all previous_block = exec (attest_all_ previous_block) - let check_ai_launch_cycle_is_zero ~loc block = let open Lwt_result_syntax in let* ai_launch_cycle = Context.get_adaptive_issuance_launch_cycle (B block) in @@ -296,8 +236,14 @@ let apply_all_pending_operations_ : t_incr -> t_incr tzresult Lwt.t = (** finalize the payload of the next block. Can start including preattestations. *) let finalize_payload_ ?payload_round ?baker : t -> t_incr tzresult Lwt.t = - fun (block, state) -> + fun ((block, state) as input) -> let open Lwt_result_wrap_syntax in + (* Before going incremental mode, apply the [force_attest_all] *) + let* block, state = + if Int32.(block.header.shell.level <> zero) && state.force_attest_all then + attest_with_all_ input + else Lwt_result.return input + in let policy = match baker with | None -> state.baking_policy @@ -313,6 +259,11 @@ let finalize_payload_ ?payload_round ?baker : t -> t_incr tzresult Lwt.t = in Some (Block.By_account pkh) in + let payload_round = + match payload_round with + | Some _ -> payload_round + | None -> state.payload_round + in let* baker, _, _, _ = Block.get_next_baker ?policy block in let baker_name, {contract = baker_contract; _} = State.find_account_from_pkh baker state @@ -366,57 +317,26 @@ let finalize_payload ?payload_round ?baker () : (t, t_incr) scenarios = exec (finalize_payload_ ?payload_round ?baker) let finalize_block_ : t_incr -> t tzresult Lwt.t = - fun (i, state) -> + fun ((_, state) as input) -> let open Lwt_result_wrap_syntax in assert (List.is_empty state.pending_operations) ; - let* block, block_metadata = Incremental.finalize_block_with_metadata i in - let ((_, op_metadata) as metadata) = - (block_metadata, List.rev (Incremental.rev_tickets i)) + (* Before going finalizing the block, apply the [force_preattest_all] *) + let* i, state = + if state.force_preattest_all then preattest_with_all_ input + else Lwt_result.return input in + let* block, block_metadata = Incremental.finalize_block_with_metadata i in + let metadata = (block_metadata, List.rev (Incremental.rev_tickets i)) in let previous_block = Incremental.predecessor i in let baker = Incremental.delegate i in - let baker_name, baker_acc = State.find_account_from_pkh baker.pkh state in - (* update baker and attesters activity *) - let update_activity delegate_account = - Account_helpers.update_activity - delegate_account - state.constants - (Block.current_cycle block) - in - let* attesters = - List.filter_map_es - (function - | Protocol.Apply_results.No_operation_metadata -> return_none - | Operation_metadata {contents} -> ( - match contents with - | Single_result (Attestation_result {delegate; _}) - | Single_result (Preattestation_result {delegate; _}) -> - return_some [delegate] - | Single_result (Attestations_aggregate_result {committee; _}) - | Single_result (Preattestations_aggregate_result {committee; _}) -> - return_some - (List.map - (fun ((ck : Protocol.Alpha_context.Consensus_key.t), _) -> - ck.delegate) - committee) - | _ -> return_none)) - op_metadata - in - let attesters = List.flatten attesters in + let baker_name, _ = State.find_account_from_pkh baker.pkh state in + (* Update baker activity *) let state = - State.update_map - ~f:(fun acc_map -> - let acc_map = - String.Map.add baker_name (update_activity baker_acc) acc_map - in - List.fold_left - (fun acc_map delegate_pkh -> - let delegate_name, delegate_acc = - State.find_account_from_pkh delegate_pkh state - in - String.Map.add delegate_name (update_activity delegate_acc) acc_map) - acc_map - attesters) + State.update_account_f + baker_name + (Account_helpers.update_activity + state.constants + (Block.current_cycle block)) state in let* () = check_ai_launch_cycle_is_zero ~loc:__LOC__ block in @@ -443,10 +363,6 @@ let finalize_block_ : t_incr -> t tzresult Lwt.t = |> Int32.to_int) ; return @@ apply_new_cycle new_future_current_cycle state) in - let* block, state = - if state.force_attest_all then attest_all_ previous_block (block, state) - else return (block, state) - in let* () = List.iter_es (fun f -> f metadata (block, state)) diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml index 79bbf05b7b734ef40e4ec531fb3ef9ae2b0e0300..142737652ea131b05493f36e64fca3b94f0ce14d 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml @@ -59,10 +59,15 @@ let exclude_bakers bakers : (t, t) scenarios = return {state with State.baking_policy = Some (Block.Excluding bakers_pkh)}) -let set_baked_round (round : int) : (t, t) scenarios = +let set_baked_round ?payload_round (round : int) : (t, t) scenarios = let open Lwt_result_syntax in exec_state (fun (_block, state) -> - return {state with State.baking_policy = Some (Block.By_round round)}) + return + { + state with + State.baking_policy = Some (Block.By_round round); + payload_round; + }) (** Unsets the baking policy, it returns to default ([By_round 0]) *) let unset_baking_policy : (t, t) scenarios = diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml index 06e6d8ed339eb83439f7a759f9d775441cb6f6fc..a424ad1f2c63aea6cbba2c4f7ae961512cddb04f 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml @@ -82,8 +82,8 @@ let init_constants ?(default = Test) ?(reward_per_block = 0L) (** Initialize the test, given some initial parameters *) let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false) - ?(check_finalized_block_perm = []) delegates_name_list : - (constants, t) scenarios = + ?(force_preattest_all = false) ?(check_finalized_block_perm = []) + delegates_name_list : (constants, t) scenarios = exec (fun (constants : constants) -> let open Lwt_result_syntax in let bootstrap = "__bootstrap__" in @@ -142,6 +142,7 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false) param_requests = []; force_ai_vote_yes = true; baking_policy = None; + payload_round = None; last_level_rewards = init_level; snapshot_balances = String.Map.empty; saved_rate = None; @@ -152,6 +153,7 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false) pending_slashes = []; double_signings = []; force_attest_all; + force_preattest_all; check_finalized_block_perm; check_finalized_block_temp = []; previous_metadata = None; diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml index a4610cc125c7541b0384cbefee845c4dabfe13f0..5100c97640d6ffb60cb87500bfc15b5a6150dfdf 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml @@ -166,17 +166,10 @@ let set_delegate src_name delegate_name_opt : (t, t) scenarios = let state = (* if self delegating *) if Option.equal String.equal delegate_name_opt (Some src_name) then - let src = State.find_account src_name state in let activity_cycle = current_cycle in - State.update_map - ~f:(fun acc_map -> - String.Map.add - src_name - (Account_helpers.update_activity - src - state.constants - activity_cycle) - acc_map) + State.update_account_f + src_name + (Account_helpers.update_activity state.constants activity_cycle) state else state in diff --git a/src/proto_alpha/lib_protocol/test/helpers/state.ml b/src/proto_alpha/lib_protocol/test/helpers/state.ml index ec99172479a916c1a6c189be694202ffa02b9fb7..a27ed03b0748677dc7ff2fef677d1bd98762b0f1 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/state.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/state.ml @@ -26,6 +26,7 @@ type t = { param_requests : (string * staking_parameters * int) list; force_ai_vote_yes : bool; baking_policy : Block.baker_policy option; + payload_round : int option; last_level_rewards : Protocol.Alpha_context.Raw_level.t; snapshot_balances : (string * balance) list String.Map.t; saved_rate : Q.t option; @@ -37,6 +38,7 @@ type t = { (Signature.Public_key_hash.t * Protocol.Denunciations_repr.item) list; double_signings : double_signing_state list; force_attest_all : bool; + force_preattest_all : bool; check_finalized_block_perm : (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list; check_finalized_block_temp : @@ -200,6 +202,17 @@ let update_account (account_name : string) (value : account_state) (state : t) : let account_map = String.Map.add account_name value state.account_map in {state with account_map} +let update_account_f (account_name : string) + (f : account_state -> account_state) (state : t) : t = + let f = function + | None -> + Log.error "State.update_account_f: account %s not found" account_name ; + assert false + | Some s -> Some (f s) + in + let account_map = String.Map.update account_name f state.account_map in + {state with account_map} + let update_delegate account_name delegate_name_opt state : t = let account = find_account account_name state in update_account account_name {account with delegate = delegate_name_opt} state @@ -249,3 +262,9 @@ let pop_pending_operations state = let add_pending_batch operations state = {state with pending_batch = state.pending_batch @ operations} + +let add_temp_check check state = + { + state with + check_finalized_block_temp = state.check_finalized_block_temp @ [check]; + } diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/dune b/src/proto_alpha/lib_protocol/test/integration/consensus/dune index 8b30a3c95e85d8fe8ae74c64a140ed4cf9717e85..5065c6ad07f54da98092de4e008d430bddba84ad 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/dune +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/dune @@ -43,7 +43,8 @@ test_seed test_aggregate test_dal_entrapment - test_companion_key)) + test_companion_key + test_scenario_attestation)) (executable (name main) diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_scenario_attestation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_scenario_attestation.ml new file mode 100644 index 0000000000000000000000000000000000000000..4e403817da7d6e32a5ab2e3dcf4fd96a3941f26c --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_scenario_attestation.ml @@ -0,0 +1,173 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2025 Nomadic Labs, *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Protocol ((pre)attestations) + Invocation: dune exec src/proto_alpha/lib_protocol/test/integration/consensus/main.exe \ + -- --file test_scenario_attestation.ml + + Subject: Test various scenarios with attestations, preattestations, aggregation, DAL bitset, + consensus and companion keys, forbidden and inactive delegates, and metadata. +*) + +open Scenario + +let check_delegate_attested ~check_not_found ~kind delegate = + let open Lwt_result_syntax in + exec_unit (fun (block, state) -> + let delegate = State.find_account delegate state in + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + let metadata = Stdlib.Option.get state.previous_metadata in + check_attestation_metadata + ~check_not_found + ~kind + delegate.pkh + consensus_key.pkh + metadata + (block, state)) + +let check_delegate_didnt_preattest delegate = + check_delegate_attested ~check_not_found:true ~kind:Preattestation delegate + +let check_delegate_didnt_attest delegate = + check_delegate_attested ~check_not_found:true ~kind:Attestation delegate + +let check_delegate_preattested delegate = + check_delegate_attested ~check_not_found:false ~kind:Preattestation delegate + +let check_delegate_attested delegate = + check_delegate_attested ~check_not_found:false ~kind:Attestation delegate + +let check_aggregated_committee ~check_not_found ~kind delegates = + let open Lwt_result_syntax in + exec_unit (fun (block, state) -> + let* delegates = + List.map_es + (fun delegate_name -> + let delegate = State.find_account delegate_name state in + let* consensus_key_info = + Context.Delegate.consensus_key (B state.grandparent) delegate.pkh + in + let consensus_key = consensus_key_info.active in + let* consensus_key = Account.find consensus_key.consensus_key_pkh in + return (delegate.pkh, consensus_key.pkh)) + delegates + in + let metadata = Stdlib.Option.get state.previous_metadata in + check_attestation_aggregate_metadata + ~check_not_found + ~kind + delegates + metadata + (block, state)) + +let check_aggregated_wrong_committee = + check_aggregated_committee ~check_not_found:true + +let check_aggregated_committee = + check_aggregated_committee ~check_not_found:false + +let test_attest_simple = + init_constants () + --> begin_test ["delegate"; "dummy"] ~force_attest_all:false + --> next_block --> attest_with "delegate" --> next_block + (* Sanity checks. The positive checks are done every time there is an attestation + or a preattestation. *) + --> check_delegate_attested "delegate" + --> check_delegate_didnt_attest "dummy" + +let test_preattest_simple = + init_constants () + --> begin_test ["delegate"] ~force_preattest_all:false + --> set_baked_round 1 --> next_block + --> finalize_payload ~payload_round:0 () + --> preattest_with "delegate" --> finalize_block + (* Sanity checks *) + --> check_delegate_preattested "delegate" + --> check_delegate_didnt_preattest "dummy" + +let test_preattest_less_simple = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~force_preattest_all:false + --> set_baked_round 1 --> next_block --> start_payload + --> transfer "delegate1" "delegate2" (Amount (Tez_helpers.of_mutez 100L)) + --> transfer "delegate2" "delegate1" (Amount (Tez_helpers.of_mutez 99L)) + --> finalize_payload ~payload_round:0 () + --> preattest_with "delegate1" --> preattest_with "delegate2" + --> finalize_block + (* Sanity checks *) + --> check_delegate_preattested "delegate1" + --> check_delegate_preattested "delegate2" + +let test_attest_all = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~force_attest_all:true + --> next_block (* This block does not contain attestations; check next. *) + --> next_block + (* Sanity checks *) + --> check_delegate_attested "delegate1" + --> check_delegate_attested "delegate2" + --> check_aggregated_wrong_committee + ~kind:Attestation + ["delegate1"; "delegate2"] + +let test_preattest_all = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~force_preattest_all:true + --> set_baked_round ~payload_round:0 1 + --> next_block + (* Sanity checks *) + --> check_delegate_preattested "delegate1" + --> check_delegate_preattested "delegate2" + --> check_aggregated_wrong_committee + ~kind:Preattestation + ["delegate1"; "delegate2"] + +let test_attest_aggreg = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~algo:Bls ~force_attest_all:false + --> next_block + --> attest_aggreg_with ["delegate1"; "delegate2"] + --> next_block + (* Sanity checks. Aggregated committees are always handled separately. *) + --> check_aggregated_committee ~kind:Attestation ["delegate1"; "delegate2"] + (* Check that bls attestations cannot be found alone, i.e. non aggregated. *) + --> check_delegate_didnt_attest "delegate1" + --> check_delegate_didnt_attest "delegate2" + +let test_preattest_aggreg = + init_constants () + --> begin_test ["delegate1"; "delegate2"] ~algo:Bls ~force_preattest_all:false + --> set_baked_round 1 --> next_block + --> finalize_payload ~payload_round:0 () + --> preattest_aggreg_with ["delegate1"; "delegate2"] + --> finalize_block + (* Sanity checks *) + --> check_aggregated_committee ~kind:Preattestation ["delegate1"; "delegate2"] + (* Check that bls attestations cannot be found alone, i.e. non aggregated. *) + --> check_delegate_didnt_preattest "delegate1" + --> check_delegate_didnt_preattest "delegate2" + +let tests = + tests_of_scenarios + @@ [ + ("Test simple attestation", test_attest_simple); + ("Test simple preattestation", test_preattest_less_simple); + ("Test less simple preattestation", test_preattest_less_simple); + ("Test attest all", test_attest_all); + ("Test preattest all", test_preattest_all); + ("Test attest aggreg", test_attest_aggreg); + ("Test preattest aggreg", test_preattest_aggreg); + ] + +let () = + register_tests ~__FILE__ ~tags:["protocol"; "scenario"; "consensus"] tests