From fa2afb7ff952137c08610ce100d7a183ba9f48db Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Tue, 6 Feb 2024 11:54:50 +0100
Subject: [PATCH 1/9] Proto/AI: actually use
 Misbehaviour_repr.Double_preattesting

---
 src/proto_alpha/lib_protocol/apply.ml         | 41 ++++++++-----------
 .../test_adaptive_issuance_roundtrip.ml       | 25 ++++-------
 2 files changed, 25 insertions(+), 41 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 29816a098079..632cd55f7720 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -2406,29 +2406,24 @@ let punish_double_attestation_or_preattestation (type kind) ctxt ~operation_hash
     | Single (Attestation _) ->
         Double_attestation_evidence_result {forbidden_delegate; balance_updates}
   in
-  match op1.protocol_data.contents with
-  | Single (Preattestation e1)
-  | Single (Attestation {consensus_content = e1; dal_content = _}) ->
-      let level = Level.from_raw ctxt e1.level in
-      let* ctxt, consensus_pk1 =
-        Stake_distribution.slot_owner ctxt level e1.slot
-      in
-      let misbehaviour =
-        {
-          Misbehaviour.kind = Double_attesting;
-          level = e1.level;
-          round = e1.round;
-          slot = e1.slot;
-        }
-      in
-      punish_delegate
-        ctxt
-        ~operation_hash
-        consensus_pk1.delegate
-        level
-        misbehaviour
-        mk_result
-        ~payload_producer
+  let {slot; level = raw_level; round; block_payload_hash = _}, kind =
+    match op1.protocol_data.contents with
+    | Single (Preattestation consensus_content) ->
+        (consensus_content, Misbehaviour.Double_preattesting)
+    | Single (Attestation {consensus_content; dal_content = _}) ->
+        (consensus_content, Misbehaviour.Double_attesting)
+  in
+  let level = Level.from_raw ctxt raw_level in
+  let* ctxt, consensus_pk1 = Stake_distribution.slot_owner ctxt level slot in
+  let misbehaviour = {Misbehaviour.kind; level = raw_level; round; slot} in
+  punish_delegate
+    ctxt
+    ~operation_hash
+    consensus_pk1.delegate
+    level
+    misbehaviour
+    mk_result
+    ~payload_producer
 
 let punish_double_baking ctxt ~operation_hash (bh1 : Block_header.t)
     ~payload_producer =
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index e2a22bf8a44c..187d901fa4f0 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -160,14 +160,9 @@ let default_params =
       Q.(Int32.to_int edge_of_baking_over_staking_billionth // 1_000_000_000);
   }
 
-type double_signing_kind =
-  | Double_baking
-  | Double_attesting
-  | Double_preattesting
-
 type double_signing_state = {
   culprit : Signature.Public_key_hash.t;
-  kind : double_signing_kind;
+  kind : Protocol.Misbehaviour_repr.kind;
   evidence : Context.t -> Protocol.Alpha_context.packed_operation;
   denounced : bool;
   level : Int32.t;
@@ -1400,11 +1395,7 @@ let check_pending_slashings (block, state) : unit tzresult Lwt.t =
     else
       let c2 = Signature.Public_key_hash.compare r1 r2 in
       if c2 <> 0 then c2
-      else
-        match (m1.kind, m2.kind) with
-        | Double_baking, Double_attesting -> -1
-        | x, y when x = y -> 0
-        | _ -> 1
+      else Protocol.Misbehaviour_repr.compare_kind m1.kind m2.kind
   in
   let denunciations_rpc = List.sort compare_denunciations denunciations_rpc in
   let denunciations_state =
@@ -1504,7 +1495,11 @@ let double_attest_op ?other_bakers ~op ~op_evidence ~kind delegate_name
   let open Lwt_result_syntax in
   Log.info
     ~color:Log_module.event_color
-    "Double (pre)attesting with %s"
+    "Double %s with %s"
+    (match kind with
+    | Protocol.Misbehaviour_repr.Double_preattesting -> "preattesting"
+    | Double_attesting -> "attesting"
+    | Double_baking -> assert false)
     delegate_name ;
   let delegate = State.find_account delegate_name state in
   let* baker, _, _, _ =
@@ -1623,12 +1618,6 @@ let update_state_denunciation (block, state)
            following cycle? *)
         return (state, denounced)
       else
-        let kind =
-          match kind with
-          | Double_baking -> Protocol.Misbehaviour_repr.Double_baking
-          | Double_attesting -> Double_attesting
-          | Double_preattesting -> Double_attesting
-        in
         let misbehaviour =
           {
             Protocol.Misbehaviour_repr.kind;
-- 
GitLab


From 1f4ce7ecbc770300711bfb8d16fd6cfcd7eccffa Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 9 Feb 2024 15:40:49 +0100
Subject: [PATCH 2/9] Proto/AI: new file already_denounced_storage

---
 src/proto_alpha/lib_protocol/TEZOS_PROTOCOL                | 1 +
 src/proto_alpha/lib_protocol/already_denounced_storage.ml  | 6 ++++++
 src/proto_alpha/lib_protocol/already_denounced_storage.mli | 6 ++++++
 src/proto_alpha/lib_protocol/dune                          | 4 ++++
 4 files changed, 17 insertions(+)
 create mode 100644 src/proto_alpha/lib_protocol/already_denounced_storage.ml
 create mode 100644 src/proto_alpha/lib_protocol/already_denounced_storage.mli

diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
index c18a7b164d81..355f5509e016 100644
--- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
+++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
@@ -181,6 +181,7 @@
         "Delegate_sampler",
         "Delegate_rewards",
         "Delegate_missed_attestations_storage",
+        "Already_denounced_storage",
         "Forbidden_delegates_storage",
 	"Slash_percentage",
         "Delegate_slashed_deposits_storage",
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.ml b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
new file mode 100644
index 000000000000..0a966492a536
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
@@ -0,0 +1,6 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.mli b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
new file mode 100644
index 000000000000..0a966492a536
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
@@ -0,0 +1,6 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune
index 22248cfa95b7..c99c16b5c140 100644
--- a/src/proto_alpha/lib_protocol/dune
+++ b/src/proto_alpha/lib_protocol/dune
@@ -197,6 +197,7 @@
   Delegate_sampler
   Delegate_rewards
   Delegate_missed_attestations_storage
+  Already_denounced_storage
   Forbidden_delegates_storage
   Slash_percentage
   Delegate_slashed_deposits_storage
@@ -496,6 +497,7 @@
   delegate_rewards.ml delegate_rewards.mli
   delegate_missed_attestations_storage.ml
   delegate_missed_attestations_storage.mli
+  already_denounced_storage.ml already_denounced_storage.mli
   forbidden_delegates_storage.ml forbidden_delegates_storage.mli
   slash_percentage.ml slash_percentage.mli
   delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli
@@ -796,6 +798,7 @@
   delegate_rewards.ml delegate_rewards.mli
   delegate_missed_attestations_storage.ml
   delegate_missed_attestations_storage.mli
+  already_denounced_storage.ml already_denounced_storage.mli
   forbidden_delegates_storage.ml forbidden_delegates_storage.mli
   slash_percentage.ml slash_percentage.mli
   delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli
@@ -1080,6 +1083,7 @@
   delegate_rewards.ml delegate_rewards.mli
   delegate_missed_attestations_storage.ml
   delegate_missed_attestations_storage.mli
+  already_denounced_storage.ml already_denounced_storage.mli
   forbidden_delegates_storage.ml forbidden_delegates_storage.mli
   slash_percentage.ml slash_percentage.mli
   delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli
-- 
GitLab


From d17ca3155f9f6b2daa428f8fa54080959b0e5db3 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 9 Feb 2024 15:51:19 +0100
Subject: [PATCH 3/9] Proto/AI:
 Already_denounced_storage.already_denounced_for_...

---
 src/proto_alpha/lib_protocol/alpha_context.ml |  1 +
 .../lib_protocol/already_denounced_storage.ml | 28 ++++++++++++++++++-
 .../already_denounced_storage.mli             | 28 ++++++++++++++++++-
 .../delegate_slashed_deposits_storage.ml      | 24 ----------------
 .../delegate_slashed_deposits_storage.mli     | 18 ------------
 5 files changed, 55 insertions(+), 44 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml
index 0070f7fd9456..931781a2fd22 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -524,6 +524,7 @@ module Misbehaviour = Misbehaviour_repr
 module Delegate = struct
   include Delegate_storage
   include Delegate_missed_attestations_storage
+  include Already_denounced_storage
   include Delegate_slashed_deposits_storage
   include Delegate_cycles
 
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.ml b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
index 0a966492a536..d62ff69619c0 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.ml
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
@@ -1,6 +1,32 @@
 (*****************************************************************************)
 (*                                                                           *)
 (* SPDX-License-Identifier: MIT                                              *)
-(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(* Copyright (c) 2022 G.B. Fefe, <gb.fefe@protonmail.com>                    *)
 (*                                                                           *)
 (*****************************************************************************)
+
+let already_denounced_for_double_attesting ctxt delegate (level : Level_repr.t)
+    round =
+  let open Lwt_result_syntax in
+  let* denounced_opt =
+    Storage.Already_denounced.find
+      (ctxt, level.cycle)
+      ((level.level, round), delegate)
+  in
+  match denounced_opt with
+  | None -> return_false
+  | Some denounced -> return denounced.for_double_attesting
+
+let already_denounced_for_double_baking ctxt delegate (level : Level_repr.t)
+    round =
+  let open Lwt_result_syntax in
+  let* denounced_opt =
+    Storage.Already_denounced.find
+      (ctxt, level.cycle)
+      ((level.level, round), delegate)
+  in
+  match denounced_opt with
+  | None -> return_false
+  | Some denounced -> return denounced.for_double_baking
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.mli b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
index 0a966492a536..993b65ada027 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.mli
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
@@ -1,6 +1,32 @@
 (*****************************************************************************)
 (*                                                                           *)
 (* SPDX-License-Identifier: MIT                                              *)
-(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(* Copyright (c) 2022 G.B. Fefe, <gb.fefe@protonmail.com>                    *)
 (*                                                                           *)
 (*****************************************************************************)
+
+(** This module is responsible for ensuring that a delegate doesn't
+    get slashed twice for the same offense. To do so, it maintains the
+    {!Storage.Already_denounced} table, which tracks which
+    denunciations have already been seen in blocks. *)
+
+(** Returns true if the given delegate has already been denounced for
+    double baking for the given level and round. *)
+val already_denounced_for_double_baking :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Level_repr.t ->
+  Round_repr.t ->
+  bool tzresult Lwt.t
+
+(** Returns true if the given delegate has already been denounced for
+    double preattesting or double attesting for the given level and
+    round. *)
+val already_denounced_for_double_attesting :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Level_repr.t ->
+  Round_repr.t ->
+  bool tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 3d44b1ccb504..75362a3b2d3c 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -44,30 +44,6 @@ let update_slashing_storage_for_p ctxt =
   in
   Storage.Contract.Slashed_deposits__Oxford.clear ctxt
 
-let already_denounced_for_double_attesting ctxt delegate (level : Level_repr.t)
-    round =
-  let open Lwt_result_syntax in
-  let* denounced_opt =
-    Storage.Already_denounced.find
-      (ctxt, level.cycle)
-      ((level.level, round), delegate)
-  in
-  match denounced_opt with
-  | None -> return_false
-  | Some denounced -> return denounced.for_double_attesting
-
-let already_denounced_for_double_baking ctxt delegate (level : Level_repr.t)
-    round =
-  let open Lwt_result_syntax in
-  let* denounced_opt =
-    Storage.Already_denounced.find
-      (ctxt, level.cycle)
-      ((level.level, round), delegate)
-  in
-  match denounced_opt with
-  | None -> return_false
-  | Some denounced -> return denounced.for_double_baking
-
 type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
 
 type punishing_amounts = {
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
index ee066bab8623..cdfc17ba8890 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -31,24 +31,6 @@
    {!Storage.Pending_denunciations} tables.
 *)
 
-(** Returns true if the given delegate has already been denounced
-    for double baking for the given level. *)
-val already_denounced_for_double_baking :
-  Raw_context.t ->
-  Signature.Public_key_hash.t ->
-  Level_repr.t ->
-  Round_repr.t ->
-  bool tzresult Lwt.t
-
-(** Returns true if the given delegate has already been denounced
-    for double preattesting or double attesting for the given level. *)
-val already_denounced_for_double_attesting :
-  Raw_context.t ->
-  Signature.Public_key_hash.t ->
-  Level_repr.t ->
-  Round_repr.t ->
-  bool tzresult Lwt.t
-
 (** The [reward_and_burn] type embeds amounts involved when slashing a
     delegate for double attesting or double baking. *)
 type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
-- 
GitLab


From 41b878d45f8841193a07e4d1365dee4a6c772418 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 9 Feb 2024 16:24:19 +0100
Subject: [PATCH 4/9] Proto/AI: Already_denounced_storage.add_denunciation

---
 .../lib_protocol/already_denounced_storage.ml | 27 +++++++++++++++++
 .../already_denounced_storage.mli             | 12 ++++++++
 .../delegate_slashed_deposits_storage.ml      | 29 +++++--------------
 3 files changed, 46 insertions(+), 22 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.ml b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
index d62ff69619c0..825a7261a520 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.ml
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
@@ -30,3 +30,30 @@ let already_denounced_for_double_baking ctxt delegate (level : Level_repr.t)
   match denounced_opt with
   | None -> return_false
   | Some denounced -> return denounced.for_double_baking
+
+let add_denunciation ctxt delegate (level : Level_repr.t) round kind =
+  let open Lwt_result_syntax in
+  let* denounced_opt =
+    Storage.Already_denounced.find
+      (ctxt, level.cycle)
+      ((level.level, round), delegate)
+  in
+  let denounced =
+    Option.value denounced_opt ~default:Storage.default_denounced
+  in
+  let already_denounced, updated_denounced =
+    let Storage.{for_double_baking; for_double_attesting} = denounced in
+    match kind with
+    | Misbehaviour_repr.Double_baking ->
+        (for_double_baking, {denounced with for_double_baking = true})
+    | Double_attesting | Double_preattesting ->
+        (for_double_attesting, {denounced with for_double_attesting = true})
+  in
+  assert (Compare.Bool.(already_denounced = false)) ;
+  let*! ctxt =
+    Storage.Already_denounced.add
+      (ctxt, level.cycle)
+      ((level.level, round), delegate)
+      updated_denounced
+  in
+  return ctxt
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.mli b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
index 993b65ada027..991454ddee35 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.mli
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
@@ -30,3 +30,15 @@ val already_denounced_for_double_attesting :
   Level_repr.t ->
   Round_repr.t ->
   bool tzresult Lwt.t
+
+(** Records a denunciation in {!Storage.Already_denounced}.
+
+    @raise [Assert_failure] if the same denunciation is already
+    present in {!Storage.Already_denounced}. *)
+val add_denunciation :
+  Raw_context.t ->
+  Signature.public_key_hash ->
+  Level_repr.t ->
+  Round_repr.t ->
+  Misbehaviour_repr.kind ->
+  Raw_context.t tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 75362a3b2d3c..0b2641ec04cf 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -55,35 +55,20 @@ let punish_double_signing ctxt ~operation_hash
     (misbehaviour : Misbehaviour_repr.t) delegate (level : Level_repr.t)
     ~rewarded =
   let open Lwt_result_syntax in
-  let* denounced_opt =
-    Storage.Already_denounced.find
-      (ctxt, level.cycle)
-      ((level.level, misbehaviour.round), delegate)
-  in
-  let denounced =
-    Option.value denounced_opt ~default:Storage.default_denounced
+  let* ctxt =
+    Already_denounced_storage.add_denunciation
+      ctxt
+      delegate
+      level
+      misbehaviour.round
+      misbehaviour.kind
   in
   (* Placeholder value *)
   let* ctxt, slashing_percentage =
     Slash_percentage.get ctxt ~kind:misbehaviour.kind ~level [delegate]
   in
-  let already_denounced, updated_denounced =
-    let Storage.{for_double_baking; for_double_attesting} = denounced in
-    match misbehaviour.kind with
-    | Double_baking ->
-        (for_double_baking, {denounced with for_double_baking = true})
-    | Double_attesting | Double_preattesting ->
-        (for_double_attesting, {denounced with for_double_attesting = true})
-  in
-  assert (Compare.Bool.(already_denounced = false)) ;
   let delegate_contract = Contract_repr.Implicit delegate in
   let current_cycle = (Raw_context.current_level ctxt).cycle in
-  let*! ctxt =
-    Storage.Already_denounced.add
-      (ctxt, level.cycle)
-      ((level.level, misbehaviour.round), delegate)
-      updated_denounced
-  in
   let* slash_history_opt =
     Storage.Contract.Slashed_deposits.find ctxt delegate_contract
   in
-- 
GitLab


From 5b5ecb56f55a0b593f6f7ec538108c566a1bfb78 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 9 Feb 2024 16:44:17 +0100
Subject: [PATCH 5/9] Proto/AI: Already_denounced_storage.clear_outdated_cycle

---
 .../lib_protocol/already_denounced_storage.ml |  5 +++++
 .../already_denounced_storage.mli             | 20 ++++++++++++++++++-
 .../lib_protocol/delegate_cycles.ml           |  6 +-----
 .../delegate_slashed_deposits_storage.ml      |  6 ------
 .../delegate_slashed_deposits_storage.mli     |  6 ------
 5 files changed, 25 insertions(+), 18 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.ml b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
index 825a7261a520..7a594ee3574d 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.ml
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
@@ -57,3 +57,8 @@ let add_denunciation ctxt delegate (level : Level_repr.t) round kind =
       updated_denounced
   in
   return ctxt
+
+let clear_outdated_cycle ctxt ~new_cycle =
+  match Cycle_repr.(sub new_cycle Constants_repr.max_slashing_period) with
+  | None -> Lwt.return ctxt
+  | Some outdated_cycle -> Storage.Already_denounced.clear (ctxt, outdated_cycle)
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.mli b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
index 991454ddee35..781c1634052b 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.mli
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
@@ -10,7 +10,13 @@
 (** This module is responsible for ensuring that a delegate doesn't
     get slashed twice for the same offense. To do so, it maintains the
     {!Storage.Already_denounced} table, which tracks which
-    denunciations have already been seen in blocks. *)
+    denunciations have already been seen in blocks.
+
+    Invariant: {!Storage.Already_denounced} is empty for cycles equal
+    to [current_cycle - max_slashing_period] or older. Indeed, such
+    denunciations are no longer allowed (see
+    [Anonymous.check_denunciation_age] in {!Validate}) so there is no
+    need to track them anymore. *)
 
 (** Returns true if the given delegate has already been denounced for
     double baking for the given level and round. *)
@@ -33,6 +39,12 @@ val already_denounced_for_double_attesting :
 
 (** Records a denunciation in {!Storage.Already_denounced}.
 
+    Precondition: the given level should be more recent than
+    [current_cycle - max_slashing_period] in order to maintain the
+    invariant on the age of tracked denunciations. Fortunately, this
+    is already enforced in {!Validate} by
+    [Anonymous.check_denunciation_age].
+
     @raise [Assert_failure] if the same denunciation is already
     present in {!Storage.Already_denounced}. *)
 val add_denunciation :
@@ -42,3 +54,9 @@ val add_denunciation :
   Round_repr.t ->
   Misbehaviour_repr.kind ->
   Raw_context.t tzresult Lwt.t
+
+(** Clear {!Storage.Already_denounced} for the cycle [new_cycle -
+    max_slashing_period]. Indeed, denunciations on events which
+    happened during this cycle are no longer allowed anyway. *)
+val clear_outdated_cycle :
+  Raw_context.t -> new_cycle:Cycle_repr.t -> Raw_context.t Lwt.t
diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml
index 62665da782ed..4bd8974f7cc2 100644
--- a/src/proto_alpha/lib_protocol/delegate_cycles.ml
+++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml
@@ -208,11 +208,7 @@ let cycle_end ctxt last_cycle =
     Delegate_sampler.select_new_distribution_at_cycle_end ctxt ~new_cycle
   in
   let*! ctxt = Delegate_consensus_key.activate ctxt ~new_cycle in
-  let*! ctxt =
-    Delegate_slashed_deposits_storage.clear_outdated_already_denounced
-      ctxt
-      ~new_cycle
-  in
+  let*! ctxt = Already_denounced_storage.clear_outdated_cycle ctxt ~new_cycle in
   let* ctxt, deactivated_delegates = update_activity ctxt last_cycle in
   let* ctxt, autostake_balance_updates =
     match Staking.staking_automation ctxt with
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 0b2641ec04cf..3bb9ecb9e728 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -99,12 +99,6 @@ let punish_double_signing ctxt ~operation_hash
   in
   return ctxt
 
-let clear_outdated_already_denounced ctxt ~new_cycle =
-  let max_slashable_period = Constants_repr.max_slashing_period in
-  match Cycle_repr.(sub new_cycle max_slashable_period) with
-  | None -> Lwt.return ctxt
-  | Some outdated_cycle -> Storage.Already_denounced.clear (ctxt, outdated_cycle)
-
 (* Misbehaviour Map: orders denunciations for application.
    See {!Misbehaviour_repr.compare} for the order on misbehaviours:
    - by increasing level, then increasing round, then kind, ignoring the slot
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
index cdfc17ba8890..4c19d8189c7e 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -64,12 +64,6 @@ val punish_double_signing :
   rewarded:Signature.public_key_hash ->
   Raw_context.t tzresult Lwt.t
 
-(** Clear the part of {!Storage.Already_denounced} about the cycle
-    [new_cycle - max_slashable_period]. Indeed, denunciations on
-    events which happened during this cycle are no longer allowed. *)
-val clear_outdated_already_denounced :
-  Raw_context.t -> new_cycle:Cycle_repr.t -> Raw_context.t Lwt.t
-
 (** Applies pending denunciations in {!Storage.Pending_denunciations}
     at the end of a cycle. The applicable denunciations are those that
     point to a misbehavior whose max slashable period is ending.
-- 
GitLab


From 0561e3cd839a7fcbf9ff1acc3a6b0f88d038979e Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Mon, 5 Feb 2024 18:52:42 +0100
Subject: [PATCH 6/9] Proto/AI: validate similar denunciation with distinct op
 kind than a

preexisting denunciation in the storage
---
 src/proto_alpha/lib_protocol/alpha_context.ml |  3 +-
 .../lib_protocol/alpha_context.mli            | 13 ++--
 .../lib_protocol/already_denounced_storage.ml | 35 ++++------
 .../already_denounced_storage.mli             | 22 +++----
 src/proto_alpha/lib_protocol/init_storage.ml  |  9 ++-
 src/proto_alpha/lib_protocol/storage.ml       | 64 ++++++++++++++-----
 src/proto_alpha/lib_protocol/storage.mli      | 11 +++-
 src/proto_alpha/lib_protocol/validate.ml      | 14 ++--
 8 files changed, 104 insertions(+), 67 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml
index 931781a2fd22..4af0f09dd8a0 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -524,7 +524,6 @@ module Misbehaviour = Misbehaviour_repr
 module Delegate = struct
   include Delegate_storage
   include Delegate_missed_attestations_storage
-  include Already_denounced_storage
   include Delegate_slashed_deposits_storage
   include Delegate_cycles
 
@@ -541,6 +540,8 @@ module Delegate = struct
 
   let is_forbidden_delegate = Forbidden_delegates_storage.is_forbidden
 
+  let already_denounced = Already_denounced_storage.already_denounced
+
   module Consensus_key = Delegate_consensus_key
 
   module Rewards = struct
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index ff2d0d4be1cd..32d8b5b36946 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2231,11 +2231,14 @@ module Delegate : sig
     Cycle.t ->
     (context * Receipt.balance_updates * public_key_hash list) tzresult Lwt.t
 
-  val already_denounced_for_double_attesting :
-    context -> public_key_hash -> Level.t -> Round.t -> bool tzresult Lwt.t
-
-  val already_denounced_for_double_baking :
-    context -> public_key_hash -> Level.t -> Round.t -> bool tzresult Lwt.t
+  (** See {!Already_denounced_storage.already_denounced}. *)
+  val already_denounced :
+    context ->
+    public_key_hash ->
+    Level.t ->
+    Round.t ->
+    Misbehaviour.kind ->
+    bool tzresult Lwt.t
 
   type reward_and_burn = {reward : Tez.t; amount_to_burn : Tez.t}
 
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.ml b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
index 7a594ee3574d..8bc71b462041 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.ml
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
@@ -7,29 +7,19 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-let already_denounced_for_double_attesting ctxt delegate (level : Level_repr.t)
-    round =
+let already_denounced ctxt delegate (level : Level_repr.t) round kind =
   let open Lwt_result_syntax in
   let* denounced_opt =
     Storage.Already_denounced.find
       (ctxt, level.cycle)
       ((level.level, round), delegate)
   in
-  match denounced_opt with
-  | None -> return_false
-  | Some denounced -> return denounced.for_double_attesting
-
-let already_denounced_for_double_baking ctxt delegate (level : Level_repr.t)
-    round =
-  let open Lwt_result_syntax in
-  let* denounced_opt =
-    Storage.Already_denounced.find
-      (ctxt, level.cycle)
-      ((level.level, round), delegate)
-  in
-  match denounced_opt with
-  | None -> return_false
-  | Some denounced -> return denounced.for_double_baking
+  match (denounced_opt, (kind : Misbehaviour_repr.kind)) with
+  | None, _ -> return_false
+  | Some denounced, Double_preattesting ->
+      return denounced.for_double_preattesting
+  | Some denounced, Double_attesting -> return denounced.for_double_attesting
+  | Some denounced, Double_baking -> return denounced.for_double_baking
 
 let add_denunciation ctxt delegate (level : Level_repr.t) round kind =
   let open Lwt_result_syntax in
@@ -42,12 +32,15 @@ let add_denunciation ctxt delegate (level : Level_repr.t) round kind =
     Option.value denounced_opt ~default:Storage.default_denounced
   in
   let already_denounced, updated_denounced =
-    let Storage.{for_double_baking; for_double_attesting} = denounced in
     match kind with
     | Misbehaviour_repr.Double_baking ->
-        (for_double_baking, {denounced with for_double_baking = true})
-    | Double_attesting | Double_preattesting ->
-        (for_double_attesting, {denounced with for_double_attesting = true})
+        (denounced.for_double_baking, {denounced with for_double_baking = true})
+    | Double_attesting ->
+        ( denounced.for_double_attesting,
+          {denounced with for_double_attesting = true} )
+    | Double_preattesting ->
+        ( denounced.for_double_preattesting,
+          {denounced with for_double_preattesting = true} )
   in
   assert (Compare.Bool.(already_denounced = false)) ;
   let*! ctxt =
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.mli b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
index 781c1634052b..d4615b859d1f 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.mli
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
@@ -12,29 +12,25 @@
     {!Storage.Already_denounced} table, which tracks which
     denunciations have already been seen in blocks.
 
+    A denunciation is uniquely characterized by the delegate (the
+    culprit), the level and round of the duplicate block or
+    (pre)attestation, and the {!type-Misbehaviour_repr.kind} (double
+    baking/attesting/preattesting).
+
     Invariant: {!Storage.Already_denounced} is empty for cycles equal
     to [current_cycle - max_slashing_period] or older. Indeed, such
     denunciations are no longer allowed (see
     [Anonymous.check_denunciation_age] in {!Validate}) so there is no
     need to track them anymore. *)
 
-(** Returns true if the given delegate has already been denounced for
-    double baking for the given level and round. *)
-val already_denounced_for_double_baking :
-  Raw_context.t ->
-  Signature.Public_key_hash.t ->
-  Level_repr.t ->
-  Round_repr.t ->
-  bool tzresult Lwt.t
-
-(** Returns true if the given delegate has already been denounced for
-    double preattesting or double attesting for the given level and
-    round. *)
-val already_denounced_for_double_attesting :
+(** Returns true if the given delegate has already been denounced
+    for the given misbehaviour kind at the given level and round. *)
+val already_denounced :
   Raw_context.t ->
   Signature.Public_key_hash.t ->
   Level_repr.t ->
   Round_repr.t ->
+  Misbehaviour_repr.kind ->
   bool tzresult Lwt.t
 
 (** Records a denunciation in {!Storage.Already_denounced}.
diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml
index f94f34f018e8..911147c4ee29 100644
--- a/src/proto_alpha/lib_protocol/init_storage.ml
+++ b/src/proto_alpha/lib_protocol/init_storage.ml
@@ -117,11 +117,16 @@ let migrate_already_denounced_from_Oxford ctxt =
         (ctxt, cycle)
         ~order:`Undefined
         ~init:ctxt
-        ~f:(fun (level, delegate) denounced ctxt ->
+        ~f:(fun (level, delegate) {for_double_attesting; for_double_baking} ctxt
+           ->
           Storage.Already_denounced.add
             (ctxt, cycle)
             ((level, Round_repr.zero), delegate)
-            denounced)
+            {
+              for_double_preattesting = for_double_attesting;
+              for_double_attesting;
+              for_double_baking;
+            })
     in
     Storage.Already_denounced__Oxford.clear (ctxt, cycle)
   in
diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml
index f013bd216c5d..ed3ae0cc68d0 100644
--- a/src/proto_alpha/lib_protocol/storage.ml
+++ b/src/proto_alpha/lib_protocol/storage.ml
@@ -1112,23 +1112,20 @@ module Pending_denunciations =
 
 (** Per cycle storage *)
 
-type denounced = {for_double_attesting : bool; for_double_baking : bool}
+type denounced__Oxford = {for_double_attesting : bool; for_double_baking : bool}
 
-let default_denounced =
-  {for_double_attesting = false; for_double_baking = false}
-
-module Denounced = struct
-  type t = denounced
+type denounced = {
+  for_double_preattesting : bool;
+  for_double_attesting : bool;
+  for_double_baking : bool;
+}
 
-  let encoding =
-    let open Data_encoding in
-    conv
-      (fun {for_double_attesting; for_double_baking} ->
-        (for_double_attesting, for_double_baking))
-      (fun (for_double_attesting, for_double_baking) ->
-        {for_double_attesting; for_double_baking})
-      (obj2 (req "for_double_attesting" bool) (req "for_double_baking" bool))
-end
+let default_denounced =
+  {
+    for_double_preattesting = false;
+    for_double_attesting = false;
+    for_double_baking = false;
+  }
 
 module Cycle = struct
   module Indexed_context =
@@ -1151,7 +1148,27 @@ module Cycle = struct
                   (Raw_level_repr.Index))
                   (Make_index (Round_repr.Index)))
                (Public_key_hash_index))
-      (Denounced)
+      (struct
+        type t = denounced
+
+        let encoding =
+          let open Data_encoding in
+          conv
+            (fun {
+                   for_double_preattesting;
+                   for_double_attesting;
+                   for_double_baking;
+                 } ->
+              (for_double_preattesting, for_double_attesting, for_double_baking))
+            (fun ( for_double_preattesting,
+                   for_double_attesting,
+                   for_double_baking ) ->
+              {for_double_preattesting; for_double_attesting; for_double_baking})
+            (obj3
+               (req "for_double_preattesting" bool)
+               (req "for_double_attesting" bool)
+               (req "for_double_baking" bool))
+      end)
 
   module Already_denounced__Oxford =
     Make_indexed_data_storage
@@ -1160,7 +1177,20 @@ module Cycle = struct
            let name = ["slashed_deposits"]
          end))
          (Pair (Make_index (Raw_level_repr.Index)) (Public_key_hash_index))
-      (Denounced)
+      (struct
+        type t = denounced__Oxford
+
+        let encoding =
+          let open Data_encoding in
+          conv
+            (fun ({for_double_attesting; for_double_baking} : denounced__Oxford) ->
+              (for_double_attesting, for_double_baking))
+            (fun (for_double_attesting, for_double_baking) ->
+              {for_double_attesting; for_double_baking})
+            (obj2
+               (req "for_double_attesting" bool)
+               (req "for_double_baking" bool))
+      end)
 
   module Selected_stake_distribution =
     Indexed_context.Make_map
diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index fcfd823b7953..c801340207a6 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -485,9 +485,16 @@ module Pending_denunciations :
      and type key = Signature.public_key_hash
      and type value = Denunciations_repr.t
 
+(** Needed for the stitching from Oxford to P. Remove this in Q. *)
+type denounced__Oxford = {for_double_attesting : bool; for_double_baking : bool}
+
 (** This type is used to track which denunciations have already been
     recorded, to avoid slashing multiple times the same event. *)
-type denounced = {for_double_attesting : bool; for_double_baking : bool}
+type denounced = {
+  for_double_preattesting : bool;
+  for_double_attesting : bool;
+  for_double_baking : bool;
+}
 
 (** {!denounced} with all fields set to [false]. *)
 val default_denounced : denounced
@@ -505,7 +512,7 @@ module Already_denounced__Oxford :
   Indexed_data_storage
     with type t := Raw_context.t * Cycle_repr.t
      and type key = Raw_level_repr.t * Signature.Public_key_hash.t
-     and type value = denounced
+     and type value = denounced__Oxford
 
 module Pending_staking_parameters :
   Indexed_data_storage
diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index b24594a23cc6..f2c8c276638e 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -1358,11 +1358,13 @@ module Anonymous = struct
         in
         let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in
         let* already_slashed =
-          Delegate.already_denounced_for_double_attesting
-            ctxt
-            delegate
-            level
-            e1.round
+          let kind =
+            match denunciation_kind with
+            | Preattestation -> Misbehaviour.Double_preattesting
+            | Attestation -> Double_attesting
+            | Block -> Double_baking
+          in
+          Delegate.already_denounced ctxt delegate level e1.round kind
         in
         let*? () =
           error_unless
@@ -1528,7 +1530,7 @@ module Anonymous = struct
     in
     let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in
     let* already_slashed =
-      Delegate.already_denounced_for_double_baking ctxt delegate level round1
+      Delegate.already_denounced ctxt delegate level round1 Double_baking
     in
     let*? () =
       error_unless
-- 
GitLab


From 1a7388b96609b7b132270168037596435c63bb93 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 9 Feb 2024 17:22:04 +0100
Subject: [PATCH 7/9] Proto/AI: validate similar denunciation with distinct op
 kind in the

same block or in the mempool
---
 .../lib_protocol/alpha_context.mli            |  4 +
 .../lib_protocol/misbehaviour_repr.mli        |  2 +
 src/proto_alpha/lib_protocol/validate.ml      | 96 ++++++++++---------
 3 files changed, 57 insertions(+), 45 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 32d8b5b36946..bc310be2552c 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2196,6 +2196,10 @@ module Misbehaviour : sig
   type kind = Double_baking | Double_attesting | Double_preattesting
 
   type t = {kind : kind; level : Raw_level.t; round : Round.t; slot : Slot.t}
+
+  val kind_encoding : kind Data_encoding.t
+
+  val compare_kind : kind -> kind -> int
 end
 
 (** This module re-exports definitions from {!Delegate_storage},
diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
index 0ced59700c1b..258262b9ef46 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
@@ -30,6 +30,8 @@ type t = {
   slot : Slot_repr.t;
 }
 
+val kind_encoding : kind Data_encoding.t
+
 val encoding : t Data_encoding.t
 
 val compare_kind : kind -> kind -> int
diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index f2c8c276638e..ff8a5461dead 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -142,14 +142,15 @@ module Double_baking_evidence_map = struct
         list (tup2 (tup2 Raw_level.encoding Round.encoding) elt_encoding))
 end
 
-module Double_attesting_evidence_map = struct
+module Double_operation_evidence_map = struct
   include Map.Make (struct
-    type t = Raw_level.t * Round.t * Slot.t
+    type t = Raw_level.t * Round.t * Slot.t * Misbehaviour.kind
 
-    let compare (l, r, s) (l', r', s') =
+    let compare (l, r, s, k) (l', r', s', k') =
       Compare.or_else (Raw_level.compare l l') @@ fun () ->
       Compare.or_else (Round.compare r r') @@ fun () ->
-      Compare.or_else (Slot.compare s s') @@ fun () -> 0
+      Compare.or_else (Slot.compare s s') @@ fun () ->
+      Misbehaviour.compare_kind k k'
   end)
 
   let encoding elt_encoding =
@@ -159,7 +160,11 @@ module Double_attesting_evidence_map = struct
       Data_encoding.(
         list
           (tup2
-             (tup3 Raw_level.encoding Round.encoding Slot.encoding)
+             (tup4
+                Raw_level.encoding
+                Round.encoding
+                Slot.encoding
+                Misbehaviour.kind_encoding)
              elt_encoding))
 end
 
@@ -179,7 +184,7 @@ type anonymous_state = {
   activation_pkhs_seen : Operation_hash.t Ed25519.Public_key_hash.Map.t;
   double_baking_evidences_seen : Operation_hash.t Double_baking_evidence_map.t;
   double_attesting_evidences_seen :
-    Operation_hash.t Double_attesting_evidence_map.t;
+    Operation_hash.t Double_operation_evidence_map.t;
   seed_nonce_levels_seen : Operation_hash.t Raw_level.Map.t;
   vdf_solution_seen : Operation_hash.t option;
 }
@@ -229,7 +234,7 @@ let anonymous_state_encoding =
              (Double_baking_evidence_map.encoding Operation_hash.encoding))
           (req
              "double_attesting_evidences_seen"
-             (Double_attesting_evidence_map.encoding Operation_hash.encoding))
+             (Double_operation_evidence_map.encoding Operation_hash.encoding))
           (req
              "seed_nonce_levels_seen"
              (raw_level_map_encoding Operation_hash.encoding))
@@ -239,7 +244,7 @@ let empty_anonymous_state =
   {
     activation_pkhs_seen = Ed25519.Public_key_hash.Map.empty;
     double_baking_evidences_seen = Double_baking_evidence_map.empty;
-    double_attesting_evidences_seen = Double_attesting_evidence_map.empty;
+    double_attesting_evidences_seen = Double_operation_evidence_map.empty;
     seed_nonce_levels_seen = Raw_level.Map.empty;
     vdf_solution_seen = None;
   }
@@ -1393,19 +1398,26 @@ module Anonymous = struct
     in
     check_double_attesting_evidence ~consensus_operation:Attestation vi op1 op2
 
+  let double_operation_conflict_key (type kind)
+      (op1 : kind Kind.consensus Operation.t) =
+    let {slot; level; round; block_payload_hash = _}, kind =
+      match op1.protocol_data.contents with
+      | Single (Preattestation cc) -> (cc, Misbehaviour.Double_preattesting)
+      | Single (Attestation {consensus_content; dal_content = _}) ->
+          (consensus_content, Double_attesting)
+    in
+    (level, round, slot, kind)
+
   let check_double_attesting_evidence_conflict (type kind) vs oph
       (op1 : kind Kind.consensus Operation.t) =
-    match op1.protocol_data.contents with
-    | Single (Preattestation e1)
-    | Single (Attestation {consensus_content = e1; dal_content = _}) -> (
-        match
-          Double_attesting_evidence_map.find
-            (e1.level, e1.round, e1.slot)
-            vs.anonymous_state.double_attesting_evidences_seen
-        with
-        | None -> ok_unit
-        | Some existing ->
-            Error (Operation_conflict {existing; new_operation = oph}))
+    match
+      Double_operation_evidence_map.find
+        (double_operation_conflict_key op1)
+        vs.anonymous_state.double_attesting_evidences_seen
+    with
+    | None -> ok_unit
+    | Some existing ->
+        Error (Operation_conflict {existing; new_operation = oph})
 
   let check_double_preattestation_evidence_conflict vs oph
       (operation : Kind.double_preattestation_evidence operation) =
@@ -1427,20 +1439,17 @@ module Anonymous = struct
 
   let add_double_attesting_evidence (type kind) vs oph
       (op1 : kind Kind.consensus Operation.t) =
-    match op1.protocol_data.contents with
-    | Single (Preattestation e1)
-    | Single (Attestation {consensus_content = e1; dal_content = _}) ->
-        let double_attesting_evidences_seen =
-          Double_attesting_evidence_map.add
-            (e1.level, e1.round, e1.slot)
-            oph
-            vs.anonymous_state.double_attesting_evidences_seen
-        in
-        {
-          vs with
-          anonymous_state =
-            {vs.anonymous_state with double_attesting_evidences_seen};
-        }
+    let double_attesting_evidences_seen =
+      Double_operation_evidence_map.add
+        (double_operation_conflict_key op1)
+        oph
+        vs.anonymous_state.double_attesting_evidences_seen
+    in
+    {
+      vs with
+      anonymous_state =
+        {vs.anonymous_state with double_attesting_evidences_seen};
+    }
 
   let add_double_attestation_evidence vs oph
       (operation : Kind.double_attestation_evidence operation) =
@@ -1458,18 +1467,15 @@ module Anonymous = struct
 
   let remove_double_attesting_evidence (type kind) vs
       (op : kind Kind.consensus Operation.t) =
-    match op.protocol_data.contents with
-    | Single (Attestation {consensus_content = e; dal_content = _})
-    | Single (Preattestation e) ->
-        let double_attesting_evidences_seen =
-          Double_attesting_evidence_map.remove
-            (e.level, e.round, e.slot)
-            vs.anonymous_state.double_attesting_evidences_seen
-        in
-        let anonymous_state =
-          {vs.anonymous_state with double_attesting_evidences_seen}
-        in
-        {vs with anonymous_state}
+    let double_attesting_evidences_seen =
+      Double_operation_evidence_map.remove
+        (double_operation_conflict_key op)
+        vs.anonymous_state.double_attesting_evidences_seen
+    in
+    let anonymous_state =
+      {vs.anonymous_state with double_attesting_evidences_seen}
+    in
+    {vs with anonymous_state}
 
   let remove_double_preattestation_evidence vs
       (operation : Kind.double_preattestation_evidence operation) =
-- 
GitLab


From a9b7626a138b9b3110fcb007dd0f64717f3ba1dd Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 9 Feb 2024 18:49:27 +0100
Subject: [PATCH 8/9] Proto/AI: do not fail while applying a duplicate
 denunciation because

it might happen in a very specific scenario. Ignore it silently instead.
---
 .../lib_protocol/already_denounced_storage.ml | 29 +++++-----
 .../already_denounced_storage.mli             | 14 +++--
 .../delegate_slashed_deposits_storage.ml      | 55 ++++++++++++++++---
 3 files changed, 69 insertions(+), 29 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.ml b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
index 8bc71b462041..1d74a0887a04 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.ml
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
@@ -31,25 +31,24 @@ let add_denunciation ctxt delegate (level : Level_repr.t) round kind =
   let denounced =
     Option.value denounced_opt ~default:Storage.default_denounced
   in
-  let already_denounced, updated_denounced =
+  let already_denounced =
     match kind with
-    | Misbehaviour_repr.Double_baking ->
-        (denounced.for_double_baking, {denounced with for_double_baking = true})
-    | Double_attesting ->
-        ( denounced.for_double_attesting,
-          {denounced with for_double_attesting = true} )
-    | Double_preattesting ->
-        ( denounced.for_double_preattesting,
-          {denounced with for_double_preattesting = true} )
+    | Misbehaviour_repr.Double_baking -> denounced.for_double_baking
+    | Double_attesting -> denounced.for_double_attesting
+    | Double_preattesting -> denounced.for_double_preattesting
   in
-  assert (Compare.Bool.(already_denounced = false)) ;
   let*! ctxt =
-    Storage.Already_denounced.add
-      (ctxt, level.cycle)
-      ((level.level, round), delegate)
-      updated_denounced
+    if already_denounced then Lwt.return ctxt
+    else
+      Storage.Already_denounced.add
+        (ctxt, level.cycle)
+        ((level.level, round), delegate)
+        (match kind with
+        | Double_baking -> {denounced with for_double_baking = true}
+        | Double_attesting -> {denounced with for_double_attesting = true}
+        | Double_preattesting -> {denounced with for_double_preattesting = true})
   in
-  return ctxt
+  return (ctxt, already_denounced)
 
 let clear_outdated_cycle ctxt ~new_cycle =
   match Cycle_repr.(sub new_cycle Constants_repr.max_slashing_period) with
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.mli b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
index d4615b859d1f..a7adfb5b049d 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.mli
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
@@ -35,21 +35,25 @@ val already_denounced :
 
 (** Records a denunciation in {!Storage.Already_denounced}.
 
+    Returns a pair [(ctxt, already_denounced)], where
+    [already_denounced] is a boolean indicating whether the
+    denunciation was already recorded in the storage previously.
+
+    When [already_denounced] is [true], the returned [ctxt] is
+    actually the unchanged context argument.
+
     Precondition: the given level should be more recent than
     [current_cycle - max_slashing_period] in order to maintain the
     invariant on the age of tracked denunciations. Fortunately, this
     is already enforced in {!Validate} by
-    [Anonymous.check_denunciation_age].
-
-    @raise [Assert_failure] if the same denunciation is already
-    present in {!Storage.Already_denounced}. *)
+    [Anonymous.check_denunciation_age]. *)
 val add_denunciation :
   Raw_context.t ->
   Signature.public_key_hash ->
   Level_repr.t ->
   Round_repr.t ->
   Misbehaviour_repr.kind ->
-  Raw_context.t tzresult Lwt.t
+  (Raw_context.t * bool) tzresult Lwt.t
 
 (** Clear {!Storage.Already_denounced} for the cycle [new_cycle -
     max_slashing_period]. Indeed, denunciations on events which
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 3bb9ecb9e728..a2570709e17c 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -51,18 +51,10 @@ type punishing_amounts = {
   unstaked : (Cycle_repr.t * reward_and_burn) list;
 }
 
-let punish_double_signing ctxt ~operation_hash
+let record_denunciation ctxt ~operation_hash
     (misbehaviour : Misbehaviour_repr.t) delegate (level : Level_repr.t)
     ~rewarded =
   let open Lwt_result_syntax in
-  let* ctxt =
-    Already_denounced_storage.add_denunciation
-      ctxt
-      delegate
-      level
-      misbehaviour.round
-      misbehaviour.kind
-  in
   (* Placeholder value *)
   let* ctxt, slashing_percentage =
     Slash_percentage.get ctxt ~kind:misbehaviour.kind ~level [delegate]
@@ -99,6 +91,51 @@ let punish_double_signing ctxt ~operation_hash
   in
   return ctxt
 
+let punish_double_signing ctxt ~operation_hash misbehaviour delegate
+    (level : Level_repr.t) ~rewarded =
+  let open Lwt_result_syntax in
+  let* ctxt, was_already_denounced =
+    Already_denounced_storage.add_denunciation
+      ctxt
+      delegate
+      level
+      misbehaviour.Misbehaviour_repr.round
+      misbehaviour.kind
+  in
+  if was_already_denounced then
+    (* This can only happen in the very specific case where a delegate
+       has crafted at least three attestations (respectively
+       preattestations) on the same level and round but with three
+       different slots owned by this delegate. Indeed, this makes it
+       possible to have two denunciations about the same delegate,
+       level, round, and kind, but different slots. Such denunciations
+       are considered identical by {!Already_denounced_storage}, which
+       is good because the delegate shouldn't get slashed twice on the
+       same level, round, and kind. However, {!Validate}'s conflict
+       handler identifies denunciations via their slot rather than
+       delegate for technical reasons (because the slot is readily
+       available whereas retrieving the delegate requires a call to
+       {!Delegate_sampler.slot_owner} which is in Lwt and thus
+       incompatible with some signatures). Therefore, if these
+       denunciations (which differ only in their slots) are both
+       included in the same block, then they will both be successfully
+       validated, and then [was_already_denounced] will be [true]
+       during the application of the second one.
+
+       In this unlikely scenario, we simply ignore the redundant
+       denunciation silently. Returning an error or raising an
+       exception here would cause the whole block application to fail,
+       which we don't want. *)
+    return ctxt
+  else
+    record_denunciation
+      ctxt
+      ~operation_hash
+      misbehaviour
+      delegate
+      level
+      ~rewarded
+
 (* Misbehaviour Map: orders denunciations for application.
    See {!Misbehaviour_repr.compare} for the order on misbehaviours:
    - by increasing level, then increasing round, then kind, ignoring the slot
-- 
GitLab


From e91a54ce97717ee2798d314548094a04ff943df1 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Wed, 7 Feb 2024 17:22:26 +0100
Subject: [PATCH 9/9] Changelog: may now be slashed for both preattesting and
 attesting at

the same level and round
---
 docs/protocols/alpha.rst | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst
index 48e3a169edf8..647d5a36559d 100644
--- a/docs/protocols/alpha.rst
+++ b/docs/protocols/alpha.rst
@@ -181,9 +181,11 @@ Minor Changes
   consistent by adding errors in some cases (BLS12-381 values, Sapling
   transactions, and timelocks). (MR :gl:`!10227`)
 
-- A delegate may now be slashed once per double baking event and once
-  per double (pre)attesting event at every level and round
-  (previously, only at every level, no matter the round). (MR :gl:`!11826`)
+- At every level, a delegate may now be slashed for one double baking
+  per round, one double attesting per round, and one double
+  preattesting per round. Previously, it was at most one double baking
+  for the whole level, and one double operation (either attestion or
+  preattestion) for the whole level. (MRs :gl:`!11826`, :gl:`!11844`)
 
 Internal
 --------
-- 
GitLab