diff --git a/src/proto_alpha/lib_delegate/client_baking_denunciation.ml b/src/proto_alpha/lib_delegate/client_baking_denunciation.ml index 1972f8c4c78f76321673f012f8e6d138700a439e..ac69cc47a44809bf69aad9d6d4a60836098d7631 100644 --- a/src/proto_alpha/lib_delegate/client_baking_denunciation.ml +++ b/src/proto_alpha/lib_delegate/client_baking_denunciation.ml @@ -96,21 +96,9 @@ type 'a state = { mutable ops_stream_stopper : unit -> unit; } -type error += Aggregate_denunciation_not_implemented - -let () = - register_error_kind - `Permanent - ~id:"client_baking_denunciation.aggregate_denunciation_not_implemented" - ~title:"Aggregate denunciation not implemented" - ~description:"Denunciation of aggregate operations is not yet implemented" - ~pp:(fun ppf () -> - Format.fprintf - ppf - "Denunciation of aggregate operations is not yet implemented") - Data_encoding.empty - (function Aggregate_denunciation_not_implemented -> Some () | _ -> None) - (fun () -> Aggregate_denunciation_not_implemented) +type 'a denunciable_consensus_operation = + | Attestation : Kind.attestation denunciable_consensus_operation + | Preattestation : Kind.preattestation denunciable_consensus_operation let create_state ~preserved_levels blocks_stream ops_stream ops_stream_stopper = let clean_frequency = max 1 (preserved_levels / 10) in @@ -154,32 +142,22 @@ let get_block_offset level = in return (`Head 0) -let get_payload_hash (type kind) (op_kind : kind consensus_operation_type) - (op : kind Operation.t) = - let open Lwt_result_syntax in +let get_payload_hash (type kind) + (op_kind : kind denunciable_consensus_operation) (op : kind Operation.t) = match (op_kind, op.protocol_data.contents) with | Preattestation, Single (Preattestation consensus_content) | Attestation, Single (Attestation {consensus_content; _}) -> - return consensus_content.block_payload_hash - | Attestations_aggregate, Single (Attestations_aggregate _) -> - (* TODO : https://gitlab.com/tezos/tezos/-/issues/7598 - handle denunciation for aggregates. *) - tzfail Aggregate_denunciation_not_implemented + consensus_content.block_payload_hash -let get_slot (type kind) (op_kind : kind consensus_operation_type) +let get_slot (type kind) (op_kind : kind denunciable_consensus_operation) (op : kind Operation.t) = - let open Lwt_result_syntax in match (op_kind, op.protocol_data.contents) with | Preattestation, Single (Preattestation consensus_content) | Attestation, Single (Attestation {consensus_content; _}) -> - return consensus_content.slot - | Attestations_aggregate, Single (Attestations_aggregate _) -> - (* TODO : https://gitlab.com/tezos/tezos/-/issues/7598 - handle denunciation for aggregates. *) - tzfail Aggregate_denunciation_not_implemented + consensus_content.slot let double_consensus_op_evidence (type kind) : - kind consensus_operation_type -> + kind denunciable_consensus_operation -> #Protocol_client_context.full -> 'a -> branch:Block_hash.t -> @@ -189,29 +167,19 @@ let double_consensus_op_evidence (type kind) : bytes Environment.Error_monad.shell_tzresult Lwt.t = function | Attestation -> Plugin.RPC.Forge.double_attestation_evidence | Preattestation -> Plugin.RPC.Forge.double_preattestation_evidence - | Attestations_aggregate -> - fun _ _ ~branch:_ ~op1:_ ~op2:_ () -> - (* TODO : https://gitlab.com/tezos/tezos/-/issues/7598 - handle denunciation for aggregates. *) - Lwt_result_syntax.tzfail Aggregate_denunciation_not_implemented let lookup_recorded_consensus (type kind) consensus_key - (op_kind : kind consensus_operation_type) map : - (kind recorded_consensus, error trace) result Lwt.t = - let open Lwt_result_syntax in + (op_kind : kind denunciable_consensus_operation) map : + kind recorded_consensus = match Delegate_map.find consensus_key map with - | None -> return No_operation_seen + | None -> No_operation_seen | Some {attestation; preattestation} -> ( match op_kind with - | Attestation -> return attestation - | Preattestation -> return preattestation - | Attestations_aggregate -> - (* TODO : https://gitlab.com/tezos/tezos/-/issues/7598 - handle denunciation for aggregates. *) - tzfail Aggregate_denunciation_not_implemented) + | Attestation -> attestation + | Preattestation -> preattestation) let add_consensus_operation (type kind) consensus_key - (op_kind : kind consensus_operation_type) + (op_kind : kind denunciable_consensus_operation) (recorded_operation : kind recorded_consensus) map = Delegate_map.update consensus_key @@ -227,8 +195,7 @@ let add_consensus_operation (type kind) consensus_key in match op_kind with | Attestation -> Some {record with attestation = recorded_operation} - | Preattestation -> Some {record with preattestation = recorded_operation} - | Attestations_aggregate -> x) + | Preattestation -> Some {record with preattestation = recorded_operation}) map let get_validator_rights state cctxt level = @@ -253,7 +220,7 @@ let get_validator_rights state cctxt level = | Some t -> return t let process_consensus_op (type kind) state cctxt - (op_kind : kind consensus_operation_type) (new_op : kind Operation.t) + (op_kind : kind denunciable_consensus_operation) (new_op : kind Operation.t) chain_id level round slot = let open Lwt_result_syntax in let diff = Raw_level.diff state.highest_level_encountered level in @@ -283,10 +250,7 @@ let process_consensus_op (type kind) state cctxt state.consensus_operations_table (chain_id, level, round) in - let* recorded_consensus = - lookup_recorded_consensus consensus_key op_kind round_map - in - match recorded_consensus with + match lookup_recorded_consensus consensus_key op_kind round_map with | No_operation_seen -> return @@ HLevel.add @@ -299,9 +263,9 @@ let process_consensus_op (type kind) state cctxt {operation = new_op; previously_denounced_oph = None}) round_map) | Operation_seen {operation = existing_op; previously_denounced_oph} -> - let* existing_payload_hash = get_payload_hash op_kind existing_op in - let* new_payload_hash = get_payload_hash op_kind new_op in - let* existing_slot = get_slot op_kind existing_op in + let existing_payload_hash = get_payload_hash op_kind existing_op in + let new_payload_hash = get_payload_hash op_kind new_op in + let existing_slot = get_slot op_kind existing_op in if Block_payload_hash.(existing_payload_hash <> new_payload_hash) || Slot.(existing_slot <> slot) @@ -343,11 +307,7 @@ let process_consensus_op (type kind) state cctxt | Preattestation -> return ( double_preattestation_detected, - double_preattestation_denounced ) - | Attestations_aggregate -> - (* TODO : https://gitlab.com/tezos/tezos/-/issues/7598 - handle denunciation for aggregates. *) - tzfail Aggregate_denunciation_not_implemented) + double_preattestation_denounced )) in let*! () = Events.(emit double_op_detected) (new_op_hash, existing_op_hash)