From 5d01fdba358d8d86a5dfe301d3d11c8282c1a203 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Tue, 13 Feb 2024 17:32:50 +0100
Subject: [PATCH 1/6] Proto/AI: remove unneeded slot from misbehaviour_repr

Also reorder the remaining fields as level-round-kind, so that
Misbehaviour_repr.compare is actually the lexicographical order
on these fields.

It's ok to modify the type Misbehaviour_repr.t because the
Pending_denunciations storage gets emptied during the stitching
from Oxford to P.
---
 .../lib_protocol/alpha_context.mli            |  2 +-
 src/proto_alpha/lib_protocol/apply.ml         | 13 ++-------
 .../lib_protocol/misbehaviour_repr.ml         | 16 ++++-------
 .../lib_protocol/misbehaviour_repr.mli        | 28 +++++++++----------
 .../test_adaptive_issuance_roundtrip.ml       |  5 ++--
 5 files changed, 23 insertions(+), 41 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index bc310be2552c..314453349df3 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2195,7 +2195,7 @@ end
 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}
+  type t = {level : Raw_level.t; round : Round.t; kind : kind}
 
   val kind_encoding : kind Data_encoding.t
 
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 632cd55f7720..d656dc187526 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -2415,13 +2415,12 @@ let punish_double_attestation_or_preattestation (type kind) ctxt ~operation_hash
   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
+    {level = raw_level; round; kind}
     mk_result
     ~payload_producer
 
@@ -2435,20 +2434,12 @@ let punish_double_baking ctxt ~operation_hash (bh1 : Block_header.t)
   let committee_size = Constants.consensus_committee_size ctxt in
   let*? slot1 = Round.to_slot round1 ~committee_size in
   let* ctxt, consensus_pk1 = Stake_distribution.slot_owner ctxt level slot1 in
-  let misbehaviour =
-    {
-      Misbehaviour.kind = Double_baking;
-      level = raw_level;
-      round = round1;
-      slot = slot1;
-    }
-  in
   punish_delegate
     ctxt
     ~operation_hash
     consensus_pk1.delegate
     level
-    misbehaviour
+    {level = raw_level; round = round1; kind = Double_baking}
     ~payload_producer
     (fun forbidden_delegate balance_updates ->
       Double_baking_evidence_result {forbidden_delegate; balance_updates})
diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
index f0f83d474177..74b2e33a25df 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
@@ -32,12 +32,7 @@ let kind_encoding =
         (fun () -> Double_preattesting);
     ]
 
-type t = {
-  kind : kind;
-  level : Raw_level_repr.t;
-  round : Round_repr.t;
-  slot : Slot_repr.t;
-}
+type t = {level : Raw_level_repr.t; round : Round_repr.t; kind : kind}
 
 let compare_kind a b =
   let to_int = function
@@ -57,10 +52,9 @@ let compare a b =
 let encoding =
   let open Data_encoding in
   conv
-    (fun {kind; level; round; slot} -> (kind, level, round, slot))
-    (fun (kind, level, round, slot) -> {kind; level; round; slot})
-    (obj4
-       (req "kind" kind_encoding)
+    (fun {level; round; kind} -> (level, round, kind))
+    (fun (level, round, kind) -> {level; round; kind})
+    (obj3
        (req "level" Raw_level_repr.encoding)
        (req "round" Round_repr.encoding)
-       (req "slot" Slot_repr.encoding))
+       (req "kind" kind_encoding))
diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
index 258262b9ef46..d7dd11a5b7fe 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
@@ -11,32 +11,30 @@ type kind = Double_baking | Double_attesting | Double_preattesting
 (** Internal representation of a double signing event used in
     {!Denunciations_repr.item}.
 
-    For a double baking event, [level] and [round] are those of the
-    duplicate blocks, and [slot] is [Round_repr.to_slot round].
-
-    For a double (pre)attestation event, [level], [round], and [slot]
-    are those indicated in the {!Operation_repr.consensus_content} of
-    the consensus operation that appears first in the denunciation
-    operation. Note that both duplicate operations always have the
-    same [level] and [round] anyway, but might have different [slot]s.
+    For a double baking event, the [level] and [round] are those of
+    both duplicate blocks. For a double (pre)attestating event, the
+    [level] and [round] are those that appear in the
+    {!Operation_repr.consensus_content} of both duplicate consensus
+    operations.
 
     Note: the culprit pkh doesn't appear as a field here because it is
     typically used as a key when storing denunciation items in the
     context. *)
-type t = {
-  kind : kind;
-  level : Raw_level_repr.t;
-  round : Round_repr.t;
-  slot : Slot_repr.t;
-}
+type t = {level : Raw_level_repr.t; round : Round_repr.t; kind : kind}
 
 val kind_encoding : kind Data_encoding.t
 
 val encoding : t Data_encoding.t
 
+(** Comparison function for double signing kinds.
+
+    [Double_baking < Double_attesting < Double_preattesting] *)
 val compare_kind : kind -> kind -> int
 
 val equal_kind : kind -> kind -> bool
 
-(** Note: the field [slot] is not taken into account in this comparison *)
+(** Comparison function for misbehaviours.
+
+    Misbehaviours are ordered by increasing level, then increasing
+    round, then kind using {!compare_kind}. *)
 val compare : t -> t -> int
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 187d901fa4f0..7298683ba0e8 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
@@ -1620,11 +1620,10 @@ let update_state_denunciation (block, state)
       else
         let misbehaviour =
           {
-            Protocol.Misbehaviour_repr.kind;
-            (* Fields level, round, and slot are unused for now. *)
+            (* Fields level and round are unused for now. *)
             level = Protocol.Raw_level_repr.of_int32_exn level;
             round = Protocol.Round_repr.zero;
-            slot = Protocol.Slot_repr.zero;
+            Protocol.Misbehaviour_repr.kind;
           }
         in
         (* for simplicity's sake (lol), the block producer and the payload producer are the same
-- 
GitLab


From dcf6c833fbf161b90c53e5aae4f93affe072a54a Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Thu, 8 Feb 2024 12:10:32 +0100
Subject: [PATCH 2/6] Proto/AI/misbehaviour_repr: simplify kind_encoding and
 make it

identical Validate_errors.Anonymous.denunciation_kind_encoding

This encoding is ok to modify because Storage.Pending_denunciations
is emptied during stitching.
---
 .../lib_protocol/misbehaviour_repr.ml         | 24 ++++---------------
 1 file changed, 4 insertions(+), 20 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
index 74b2e33a25df..a2a57ace6416 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
@@ -9,27 +9,11 @@ type kind = Double_baking | Double_attesting | Double_preattesting
 
 let kind_encoding =
   let open Data_encoding in
-  union
-    ~tag_size:`Uint8
+  string_enum
     [
-      case
-        (Tag 0)
-        ~title:"Double baking"
-        (constant "double baking")
-        (function Double_baking -> Some () | _ -> None)
-        (fun () -> Double_baking);
-      case
-        (Tag 1)
-        ~title:"Double attesting"
-        (constant "double attesting")
-        (function Double_attesting -> Some () | _ -> None)
-        (fun () -> Double_attesting);
-      case
-        (Tag 2)
-        ~title:"Double preattesting"
-        (constant "double preattesting")
-        (function Double_preattesting -> Some () | _ -> None)
-        (fun () -> Double_preattesting);
+      ("preattestation", Double_preattesting);
+      ("attestation", Double_attesting);
+      ("block", Double_baking);
     ]
 
 type t = {level : Raw_level_repr.t; round : Round_repr.t; kind : kind}
-- 
GitLab


From 8cb8ba89a958148c5e95385362bb3995bff96508 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Thu, 8 Feb 2024 12:25:56 +0100
Subject: [PATCH 3/6] Proto/AI/validate: remove unnecessary argument

---
 src/proto_alpha/lib_protocol/validate.ml | 165 +++++++++++------------
 1 file changed, 82 insertions(+), 83 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index ff8a5461dead..5f02ffe91e8c 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -1299,104 +1299,103 @@ module Anonymous = struct
       (Outdated_denunciation
          {kind; level = given_level; last_cycle = last_slashable_cycle})
 
-  let check_double_attesting_evidence (type kind)
-      ~consensus_operation:denunciation_kind vi
+  let check_double_attesting_evidence (type kind) vi
       (op1 : kind Kind.consensus Operation.t)
       (op2 : kind Kind.consensus Operation.t) =
     let open Lwt_result_syntax in
-    match (op1.protocol_data.contents, op2.protocol_data.contents) with
-    | Single (Preattestation e1), Single (Preattestation e2)
-    | ( Single (Attestation {consensus_content = e1; dal_content = _}),
-        Single (Attestation {consensus_content = e2; dal_content = _}) ) ->
-        let op1_hash = Operation.hash op1 in
-        let op2_hash = Operation.hash op2 in
-        let same_levels = Raw_level.(e1.level = e2.level) in
-        let same_rounds = Round.(e1.round = e2.round) in
-        let same_payload =
-          Block_payload_hash.(e1.block_payload_hash = e2.block_payload_hash)
-        in
-        let same_branches = Block_hash.(op1.shell.branch = op2.shell.branch) in
-        let same_slots = Slot.(e1.slot = e2.slot) in
-        let ordered_hashes = Operation_hash.(op1_hash < op2_hash) in
-        let is_denunciation_consistent =
-          same_levels && same_rounds
-          (* For the double (pre)attestations to be punishable, they
-             must point to the same block (same level and round), but
-             also have at least a difference that is the delegate's
-             fault: different payloads, different branches, or
-             different slots. Note that different payloads would
-             endanger the consensus process, while different branches
-             or slots could be used to spam mempools with a lot of
-             valid operations (since the minimality of the slot in not
-             checked in mempool mode, only in block-related modes). On
-             the other hand, if the operations have identical levels,
-             rounds, payloads, branches, and slots, then only their
-             signatures are different, which is not considered the
-             delegate's fault and therefore is not punished. *)
-          && ((not same_payload) || (not same_branches) || not same_slots)
-          && (* we require an order on hashes to avoid the existence of
-                   equivalent evidences *)
-          ordered_hashes
-        in
-        let*? () =
-          error_unless
-            is_denunciation_consistent
-            (Invalid_denunciation denunciation_kind)
-        in
-        (* Disambiguate: levels are equal *)
-        let level = Level.from_raw vi.ctxt e1.level in
-        let*? () = check_denunciation_age vi denunciation_kind level.level in
-        let* ctxt, consensus_key1 =
-          Stake_distribution.slot_owner vi.ctxt level e1.slot
-        in
-        let* ctxt, consensus_key2 =
-          Stake_distribution.slot_owner ctxt level e2.slot
-        in
-        let delegate1, delegate2 =
-          (consensus_key1.delegate, consensus_key2.delegate)
-        in
-        let*? () =
-          error_unless
-            (Signature.Public_key_hash.equal delegate1 delegate2)
-            (Inconsistent_denunciation
-               {kind = denunciation_kind; delegate1; delegate2})
-        in
-        let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in
-        let* already_slashed =
-          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
-            (not already_slashed)
-            (Already_denounced {kind = denunciation_kind; delegate; level})
-        in
-        let*? () = Operation.check_signature delegate_pk vi.chain_id op1 in
-        let*? () = Operation.check_signature delegate_pk vi.chain_id op2 in
-        return_unit
+    let e1, e2, denunciation_kind =
+      match (op1.protocol_data.contents, op2.protocol_data.contents) with
+      | Single (Preattestation e1), Single (Preattestation e2) ->
+          (e1, e2, Preattestation)
+      | ( Single (Attestation {consensus_content = e1; dal_content = _}),
+          Single (Attestation {consensus_content = e2; dal_content = _}) ) ->
+          (e1, e2, Attestation)
+    in
+    let op1_hash = Operation.hash op1 in
+    let op2_hash = Operation.hash op2 in
+    let same_levels = Raw_level.(e1.level = e2.level) in
+    let same_rounds = Round.(e1.round = e2.round) in
+    let same_payload =
+      Block_payload_hash.(e1.block_payload_hash = e2.block_payload_hash)
+    in
+    let same_branches = Block_hash.(op1.shell.branch = op2.shell.branch) in
+    let same_slots = Slot.(e1.slot = e2.slot) in
+    let ordered_hashes = Operation_hash.(op1_hash < op2_hash) in
+    let is_denunciation_consistent =
+      same_levels && same_rounds
+      (* For the double (pre)attestations to be punishable, they
+         must point to the same block (same level and round), but
+         also have at least a difference that is the delegate's
+         fault: different payloads, different branches, or
+         different slots. Note that different payloads would
+         endanger the consensus process, while different branches
+         or slots could be used to spam mempools with a lot of
+         valid operations (since the minimality of the slot in not
+         checked in mempool mode, only in block-related modes). On
+         the other hand, if the operations have identical levels,
+         rounds, payloads, branches, and slots, then only their
+         signatures are different, which is not considered the
+         delegate's fault and therefore is not punished. *)
+      && ((not same_payload) || (not same_branches) || not same_slots)
+      && (* we require an order on hashes to avoid the existence of
+               equivalent evidences *)
+      ordered_hashes
+    in
+    let*? () =
+      error_unless
+        is_denunciation_consistent
+        (Invalid_denunciation denunciation_kind)
+    in
+    (* Disambiguate: levels are equal *)
+    let level = Level.from_raw vi.ctxt e1.level in
+    let*? () = check_denunciation_age vi denunciation_kind level.level in
+    let* ctxt, consensus_key1 =
+      Stake_distribution.slot_owner vi.ctxt level e1.slot
+    in
+    let* ctxt, consensus_key2 =
+      Stake_distribution.slot_owner ctxt level e2.slot
+    in
+    let delegate1, delegate2 =
+      (consensus_key1.delegate, consensus_key2.delegate)
+    in
+    let*? () =
+      error_unless
+        (Signature.Public_key_hash.equal delegate1 delegate2)
+        (Inconsistent_denunciation
+           {kind = denunciation_kind; delegate1; delegate2})
+    in
+    let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in
+    let* already_slashed =
+      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
+        (not already_slashed)
+        (Already_denounced {kind = denunciation_kind; delegate; level})
+    in
+    let*? () = Operation.check_signature delegate_pk vi.chain_id op1 in
+    let*? () = Operation.check_signature delegate_pk vi.chain_id op2 in
+    return_unit
 
   let check_double_preattestation_evidence vi
       (operation : Kind.double_preattestation_evidence operation) =
     let (Single (Double_preattestation_evidence {op1; op2})) =
       operation.protocol_data.contents
     in
-    check_double_attesting_evidence
-      ~consensus_operation:Preattestation
-      vi
-      op1
-      op2
+    check_double_attesting_evidence vi op1 op2
 
   let check_double_attestation_evidence vi
       (operation : Kind.double_attestation_evidence operation) =
     let (Single (Double_attestation_evidence {op1; op2})) =
       operation.protocol_data.contents
     in
-    check_double_attesting_evidence ~consensus_operation:Attestation vi op1 op2
+    check_double_attesting_evidence vi op1 op2
 
   let double_operation_conflict_key (type kind)
       (op1 : kind Kind.consensus Operation.t) =
-- 
GitLab


From 099b303e9af55c6be6a635d0f64ac6ff61e3760b Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Thu, 8 Feb 2024 16:34:12 +0100
Subject: [PATCH 4/6] Proto/AI: use Misbehaviour.kind in validate_errors.ml

---
 .../consensus/test_double_attestation.ml      | 32 ++++++++---------
 .../consensus/test_double_baking.ml           | 12 +++----
 .../consensus/test_double_preattestation.ml   | 20 +++++------
 .../test_adaptive_issuance_roundtrip.ml       | 16 +++++----
 src/proto_alpha/lib_protocol/validate.ml      | 35 +++++++------------
 .../lib_protocol/validate_errors.ml           | 29 ++++++---------
 .../lib_protocol/validate_errors.mli          |  2 +-
 7 files changed, 66 insertions(+), 80 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml
index a603b289a95a..bbf5c482c51f 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml
@@ -535,8 +535,8 @@ let test_invalid_double_attestation () =
   Op.double_attestation (B b) attestation attestation |> fun operation ->
   let*! res = Block.bake ~operation b in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Invalid_denunciation kind
-        when kind = Validate_errors.Anonymous.Attestation ->
+      | Validate_errors.Anonymous.Invalid_denunciation
+          Misbehaviour.Double_attesting ->
           true
       | _ -> false)
 
@@ -559,8 +559,8 @@ let test_invalid_double_attestation_variant () =
   |> fun operation ->
   let*! res = Block.bake ~operation genesis in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Invalid_denunciation kind
-        when kind = Validate_errors.Anonymous.Attestation ->
+      | Validate_errors.Anonymous.Invalid_denunciation
+          Misbehaviour.Double_attesting ->
           true
       | _ -> false)
 
@@ -577,8 +577,8 @@ let test_too_early_double_attestation_evidence () =
   double_attestation (B genesis) attestation_a attestation_b |> fun operation ->
   let*! res = Block.bake ~operation genesis in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Too_early_denunciation {kind; _}
-        when kind = Validate_errors.Anonymous.Attestation ->
+      | Validate_errors.Anonymous.Too_early_denunciation
+          {kind = Misbehaviour.Double_attesting; _} ->
           true
       | _ -> false)
 
@@ -604,8 +604,8 @@ let test_too_late_double_attestation_evidence () =
   double_attestation (B blk) attestation_a attestation_b |> fun operation ->
   let*! res = Block.bake ~operation blk in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Outdated_denunciation {kind; _}
-        when kind = Validate_errors.Anonymous.Attestation ->
+      | Validate_errors.Anonymous.Outdated_denunciation
+          {kind = Misbehaviour.Double_attesting; _} ->
           true
       | _ -> false)
 
@@ -627,8 +627,8 @@ let test_different_delegates () =
   double_attestation (B blk_b) e_a e_b |> fun operation ->
   let*! res = Block.bake ~operation blk_b in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Inconsistent_denunciation {kind; _}
-        when kind = Validate_errors.Anonymous.Attestation ->
+      | Validate_errors.Anonymous.Inconsistent_denunciation
+          {kind = Misbehaviour.Double_attesting; _} ->
           true
       | _ -> false)
 
@@ -652,8 +652,8 @@ let test_wrong_delegate () =
   double_attestation (B blk_b) attestation_a attestation_b |> fun operation ->
   let*! res = Block.bake ~operation blk_b in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Inconsistent_denunciation {kind; _}
-        when kind = Validate_errors.Anonymous.Attestation ->
+      | Validate_errors.Anonymous.Inconsistent_denunciation
+          {kind = Misbehaviour.Double_attesting; _} ->
           true
       | _ -> false)
 
@@ -879,8 +879,8 @@ let test_two_double_attestation_evidences_leads_to_duplicate_denunciation () =
   in
   let* () =
     Assert.proto_error ~loc:__LOC__ e (function
-        | Validate_errors.Anonymous.Conflicting_denunciation {kind; _}
-          when kind = Validate_errors.Anonymous.Attestation ->
+        | Validate_errors.Anonymous.Conflicting_denunciation
+            {kind = Misbehaviour.Double_attesting; _} ->
             true
         | _ -> false)
   in
@@ -891,8 +891,8 @@ let test_two_double_attestation_evidences_leads_to_duplicate_denunciation () =
     Block.bake ~policy:(By_account baker) ~operation blk_with_evidence1
   in
   Assert.proto_error ~loc:__LOC__ e (function
-      | Validate_errors.Anonymous.Already_denounced {kind; _}
-        when kind = Validate_errors.Anonymous.Attestation ->
+      | Validate_errors.Anonymous.Already_denounced
+          {kind = Misbehaviour.Double_attesting; _} ->
           true
       | _ -> false)
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml
index 136e1d32cd76..0f04bb884285 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml
@@ -485,8 +485,8 @@ let test_too_early_double_baking_evidence () =
   double_baking (B b) blk_a.header blk_b.header |> fun operation ->
   let*! res = Block.bake ~operation genesis in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Too_early_denunciation {kind; _}
-        when kind = Validate_errors.Anonymous.Block ->
+      | Validate_errors.Anonymous.Too_early_denunciation
+          {kind = Misbehaviour.Double_baking; _} ->
           true
       | _ -> false)
 
@@ -501,8 +501,8 @@ let test_too_late_double_baking_evidence () =
   double_baking (B blk) blk_a.header blk_b.header |> fun operation ->
   let*! res = Block.bake ~operation blk in
   Assert.proto_error ~loc:__LOC__ res (function
-      | Validate_errors.Anonymous.Outdated_denunciation {kind; _}
-        when kind = Validate_errors.Anonymous.Block ->
+      | Validate_errors.Anonymous.Outdated_denunciation
+          {kind = Misbehaviour.Double_baking; _} ->
           true
       | _ -> false)
 
@@ -584,8 +584,8 @@ let test_double_evidence () =
   let*! e = Block.bake ~operations:[evidence; evidence] blk in
   let* () =
     Assert.proto_error ~loc:__LOC__ e (function
-        | Validate_errors.Anonymous.Conflicting_denunciation {kind; _}
-          when kind = Validate_errors.Anonymous.Block ->
+        | Validate_errors.Anonymous.Conflicting_denunciation
+            {kind = Misbehaviour.Double_baking; _} ->
             true
         | _ -> false)
   in
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml
index 12ec47e48455..0ed039a49913 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml
@@ -68,8 +68,8 @@ end = struct
 
   let invalid_denunciation loc res =
     Assert.proto_error ~loc res (function
-        | Validate_errors.Anonymous.Invalid_denunciation kind
-          when kind = Validate_errors.Anonymous.Preattestation ->
+        | Validate_errors.Anonymous.Invalid_denunciation
+            Misbehaviour.Double_preattesting ->
             true
         | _ -> false)
 
@@ -101,22 +101,22 @@ end = struct
 
   let already_denounced loc res =
     Assert.proto_error ~loc res (function
-        | Validate_errors.Anonymous.Already_denounced {kind; _}
-          when kind = Validate_errors.Anonymous.Preattestation ->
+        | Validate_errors.Anonymous.Already_denounced
+            {kind = Misbehaviour.Double_preattesting; _} ->
             true
         | _ -> false)
 
   let inconsistent_denunciation loc res =
     Assert.proto_error ~loc res (function
-        | Validate_errors.Anonymous.Inconsistent_denunciation {kind; _}
-          when kind = Validate_errors.Anonymous.Preattestation ->
+        | Validate_errors.Anonymous.Inconsistent_denunciation
+            {kind = Misbehaviour.Double_preattesting; _} ->
             true
         | _ -> false)
 
   let outdated_denunciation loc res =
     Assert.proto_error ~loc res (function
-        | Validate_errors.Anonymous.Outdated_denunciation {kind; _}
-          when kind = Validate_errors.Anonymous.Preattestation ->
+        | Validate_errors.Anonymous.Outdated_denunciation
+            {kind = Misbehaviour.Double_preattesting; _} ->
             true
         | _ -> false)
 
@@ -394,8 +394,8 @@ end = struct
     in
     let* () =
       Assert.proto_error ~loc:__LOC__ e (function
-          | Validate_errors.Anonymous.Conflicting_denunciation {kind; _}
-            when kind = Validate_errors.Anonymous.Preattestation ->
+          | Validate_errors.Anonymous.Conflicting_denunciation
+              {kind = Misbehaviour.Double_preattesting; _} ->
               true
           | _ -> false)
     in
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 7298683ba0e8..87e6b48a335a 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
@@ -2566,12 +2566,6 @@ module Slashing = struct
                  ~expected_error:(fun (_block, state) ->
                    let ds = state.State.double_signings in
                    let ds = match ds with [a] -> a | _ -> assert false in
-                   let kind =
-                     match ds.kind with
-                     | Double_baking -> Protocol.Validate_errors.Anonymous.Block
-                     | Double_attesting -> Attestation
-                     | Double_preattesting -> Preattestation
-                   in
                    let level =
                      Protocol.Alpha_context.Raw_level.of_int32_exn
                        (Int32.succ ds.level)
@@ -2584,6 +2578,16 @@ module Slashing = struct
                           ~current_level:ds.level)
                        Protocol.Constants_repr.max_slashing_period
                    in
+                   let (kind : Protocol.Alpha_context.Misbehaviour.kind) =
+                     (* This conversion would not be needed if
+                        Misbehaviour_repr.kind were moved to a
+                        separate file that doesn't have under/over
+                        Alpha_context versions. *)
+                     match ds.kind with
+                     | Double_baking -> Double_baking
+                     | Double_attesting -> Double_attesting
+                     | Double_preattesting -> Double_preattesting
+                   in
                    [
                      Environment.Ecoproto_error
                        (Protocol.Validate_errors.Anonymous.Outdated_denunciation
diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index 5f02ffe91e8c..6775bf626eb6 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -1303,13 +1303,13 @@ module Anonymous = struct
       (op1 : kind Kind.consensus Operation.t)
       (op2 : kind Kind.consensus Operation.t) =
     let open Lwt_result_syntax in
-    let e1, e2, denunciation_kind =
+    let e1, e2, kind =
       match (op1.protocol_data.contents, op2.protocol_data.contents) with
       | Single (Preattestation e1), Single (Preattestation e2) ->
-          (e1, e2, Preattestation)
+          (e1, e2, Misbehaviour.Double_preattesting)
       | ( Single (Attestation {consensus_content = e1; dal_content = _}),
           Single (Attestation {consensus_content = e2; dal_content = _}) ) ->
-          (e1, e2, Attestation)
+          (e1, e2, Double_attesting)
     in
     let op1_hash = Operation.hash op1 in
     let op2_hash = Operation.hash op2 in
@@ -1342,13 +1342,11 @@ module Anonymous = struct
       ordered_hashes
     in
     let*? () =
-      error_unless
-        is_denunciation_consistent
-        (Invalid_denunciation denunciation_kind)
+      error_unless is_denunciation_consistent (Invalid_denunciation kind)
     in
     (* Disambiguate: levels are equal *)
     let level = Level.from_raw vi.ctxt e1.level in
-    let*? () = check_denunciation_age vi denunciation_kind level.level in
+    let*? () = check_denunciation_age vi kind level.level in
     let* ctxt, consensus_key1 =
       Stake_distribution.slot_owner vi.ctxt level e1.slot
     in
@@ -1361,23 +1359,16 @@ module Anonymous = struct
     let*? () =
       error_unless
         (Signature.Public_key_hash.equal delegate1 delegate2)
-        (Inconsistent_denunciation
-           {kind = denunciation_kind; delegate1; delegate2})
+        (Inconsistent_denunciation {kind; delegate1; delegate2})
     in
     let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in
     let* already_slashed =
-      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
         (not already_slashed)
-        (Already_denounced {kind = denunciation_kind; delegate; level})
+        (Already_denounced {kind; delegate; level})
     in
     let*? () = Operation.check_signature delegate_pk vi.chain_id op1 in
     let*? () = Operation.check_signature delegate_pk vi.chain_id op2 in
@@ -1514,7 +1505,7 @@ module Anonymous = struct
         (Invalid_double_baking_evidence
            {hash1; level1; round1; hash2; level2; round2})
     in
-    let*? () = check_denunciation_age vi Block level1 in
+    let*? () = check_denunciation_age vi Double_baking level1 in
     let level = Level.from_raw vi.ctxt level1 in
     let committee_size = Constants.consensus_committee_size vi.ctxt in
     let*? slot1 = Round.to_slot round1 ~committee_size in
@@ -1531,7 +1522,7 @@ module Anonymous = struct
     let*? () =
       error_unless
         Signature.Public_key_hash.(delegate1 = delegate2)
-        (Inconsistent_denunciation {kind = Block; delegate1; delegate2})
+        (Inconsistent_denunciation {kind = Double_baking; delegate1; delegate2})
     in
     let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in
     let* already_slashed =
@@ -1540,7 +1531,7 @@ module Anonymous = struct
     let*? () =
       error_unless
         (not already_slashed)
-        (Already_denounced {kind = Block; delegate; level})
+        (Already_denounced {kind = Double_baking; delegate; level})
     in
     let*? () = Block_header.check_signature bh1 vi.chain_id delegate_pk in
     let*? () = Block_header.check_signature bh2 vi.chain_id delegate_pk in
@@ -2737,7 +2728,7 @@ let validate_operation ?(check_signature = true)
               operation_state
               oph
               operation
-            |> wrap_denunciation_conflict Preattestation
+            |> wrap_denunciation_conflict Double_preattesting
           in
           let operation_state =
             add_double_preattestation_evidence operation_state oph operation
@@ -2751,7 +2742,7 @@ let validate_operation ?(check_signature = true)
               operation_state
               oph
               operation
-            |> wrap_denunciation_conflict Attestation
+            |> wrap_denunciation_conflict Double_attesting
           in
           let operation_state =
             add_double_attestation_evidence operation_state oph operation
@@ -2762,7 +2753,7 @@ let validate_operation ?(check_signature = true)
           let* () = check_double_baking_evidence info operation in
           let*? () =
             check_double_baking_evidence_conflict operation_state oph operation
-            |> wrap_denunciation_conflict Block
+            |> wrap_denunciation_conflict Double_baking
           in
           let operation_state =
             add_double_baking_evidence operation_state oph operation
diff --git a/src/proto_alpha/lib_protocol/validate_errors.ml b/src/proto_alpha/lib_protocol/validate_errors.ml
index 902d909b7f6b..c7ba3d04c201 100644
--- a/src/proto_alpha/lib_protocol/validate_errors.ml
+++ b/src/proto_alpha/lib_protocol/validate_errors.ml
@@ -669,21 +669,12 @@ module Anonymous = struct
         | _ -> None)
       (fun (edpkh, conflict) -> Conflicting_activation {edpkh; conflict})
 
-  type denunciation_kind = Preattestation | Attestation | Block
-
-  let denunciation_kind_encoding =
-    let open Data_encoding in
-    string_enum
-      [
-        ("preattestation", Preattestation);
-        ("attestation", Attestation);
-        ("block", Block);
-      ]
+  type denunciation_kind = Misbehaviour.kind
 
   let pp_denunciation_kind fmt : denunciation_kind -> unit = function
-    | Preattestation -> Format.fprintf fmt "preattestation"
-    | Attestation -> Format.fprintf fmt "attestation"
-    | Block -> Format.fprintf fmt "block"
+    | Double_preattesting -> Format.fprintf fmt "preattestation"
+    | Double_attesting -> Format.fprintf fmt "attestation"
+    | Double_baking -> Format.fprintf fmt "block"
 
   type error +=
     | Invalid_double_baking_evidence of {
@@ -767,7 +758,7 @@ module Anonymous = struct
           "Malformed double-%a evidence"
           pp_denunciation_kind
           kind)
-      Data_encoding.(obj1 (req "kind" denunciation_kind_encoding))
+      Data_encoding.(obj1 (req "kind" Misbehaviour.kind_encoding))
       (function Invalid_denunciation kind -> Some kind | _ -> None)
       (fun kind -> Invalid_denunciation kind) ;
     register_error_kind
@@ -788,7 +779,7 @@ module Anonymous = struct
           delegate2)
       Data_encoding.(
         obj3
-          (req "kind" denunciation_kind_encoding)
+          (req "kind" Misbehaviour.kind_encoding)
           (req "delegate1" Signature.Public_key_hash.encoding)
           (req "delegate2" Signature.Public_key_hash.encoding))
       (function
@@ -814,7 +805,7 @@ module Anonymous = struct
           kind)
       Data_encoding.(
         obj3
-          (req "denunciation_kind" denunciation_kind_encoding)
+          (req "denunciation_kind" Misbehaviour.kind_encoding)
           (req "delegate" Signature.Public_key_hash.encoding)
           (req "level" Level.encoding))
       (function
@@ -840,7 +831,7 @@ module Anonymous = struct
           existing)
       Data_encoding.(
         obj2
-          (req "denunciation_kind" denunciation_kind_encoding)
+          (req "denunciation_kind" Misbehaviour.kind_encoding)
           (req "conflict" operation_conflict_encoding))
       (function
         | Conflicting_denunciation {kind; conflict} -> Some (kind, conflict)
@@ -864,7 +855,7 @@ module Anonymous = struct
           level)
       Data_encoding.(
         obj3
-          (req "kind" denunciation_kind_encoding)
+          (req "kind" Misbehaviour.kind_encoding)
           (req "level" Raw_level.encoding)
           (req "current" Raw_level.encoding))
       (function
@@ -891,7 +882,7 @@ module Anonymous = struct
           level)
       Data_encoding.(
         obj3
-          (req "kind" denunciation_kind_encoding)
+          (req "kind" Misbehaviour.kind_encoding)
           (req "level" Raw_level.encoding)
           (req "last" Cycle.encoding))
       (function
diff --git a/src/proto_alpha/lib_protocol/validate_errors.mli b/src/proto_alpha/lib_protocol/validate_errors.mli
index 3a790ef96dbf..01793ab0c7e9 100644
--- a/src/proto_alpha/lib_protocol/validate_errors.mli
+++ b/src/proto_alpha/lib_protocol/validate_errors.mli
@@ -113,7 +113,7 @@ end
 
 (** Errors that may arise while validating an anonymous operation. *)
 module Anonymous : sig
-  type denunciation_kind = Preattestation | Attestation | Block
+  type denunciation_kind = Misbehaviour.kind
 
   type error +=
     | Invalid_activation of {pkh : Ed25519.Public_key_hash.t}
-- 
GitLab


From 1ba6c841793d78b1645f3a3ab3d2b55ba5f96506 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 19 Jan 2024 16:14:19 +0100
Subject: [PATCH 5/6] Proto/round_repr: rename Internal_for_tests for
 homogeneity

---
 src/proto_alpha/lib_protocol/round_repr.ml                | 2 +-
 src/proto_alpha/lib_protocol/round_repr.mli               | 2 +-
 src/proto_alpha/lib_protocol/test/unit/test_round_repr.ml | 6 +++---
 3 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/round_repr.ml b/src/proto_alpha/lib_protocol/round_repr.ml
index 124c8e535654..bebf5c459088 100644
--- a/src/proto_alpha/lib_protocol/round_repr.ml
+++ b/src/proto_alpha/lib_protocol/round_repr.ml
@@ -521,7 +521,7 @@ module Index = struct
   let compare = compare
 end
 
-module Internals_for_test = struct
+module Internal_for_tests = struct
   type round_and_offset_raw = {round : round; offset : Period_repr.t}
 
   let round_and_offset round_durations ~level_offset =
diff --git a/src/proto_alpha/lib_protocol/round_repr.mli b/src/proto_alpha/lib_protocol/round_repr.mli
index 9fc6e54ac2c1..3adef4ec00c4 100644
--- a/src/proto_alpha/lib_protocol/round_repr.mli
+++ b/src/proto_alpha/lib_protocol/round_repr.mli
@@ -223,7 +223,7 @@ val round_of_timestamp :
 
 module Index : Storage_description.INDEX with type t = round
 
-module Internals_for_test : sig
+module Internal_for_tests : sig
   type round_and_offset_raw = {round : round; offset : Period_repr.t}
 
   (** [round_and_offset round_durations ~level_offset], where [level_offset]
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_round_repr.ml b/src/proto_alpha/lib_protocol/test/unit/test_round_repr.ml
index 4c8028367154..8b3f91869d30 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_round_repr.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_round_repr.ml
@@ -174,7 +174,7 @@ let process_test_case (round_durations, ios, _) =
           (Period_repr.to_seconds dur))
       ios.round_duration
   in
-  let open Internals_for_test in
+  let open Internal_for_tests in
   (* test [round_and_offset] *)
   let* () =
     List.iter_es
@@ -595,7 +595,7 @@ let round_and_offset_oracle (round_durations : Round_repr.Durations.t)
           bin_search min_r (Round_repr.to_int32 round)
         else
           return
-            Round_repr.Internals_for_test.
+            Round_repr.Internal_for_tests.
               {
                 round;
                 offset =
@@ -632,7 +632,7 @@ let test_round_and_offset_correction =
       in
       let@ expected = round_and_offset_oracle round_duration ~level_offset in
       let computed =
-        Round_repr.Internals_for_test.round_and_offset
+        Round_repr.Internal_for_tests.round_and_offset
           round_duration
           ~level_offset
       in
-- 
GitLab


From f6b5d5edee49e304de73e8f9b76be99f07642cec Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Wed, 14 Feb 2024 12:00:33 +0100
Subject: [PATCH 6/6] Proto/alpha_context/tests: expose functions to convert
 to/from repr

---
 src/proto_alpha/lib_protocol/alpha_context.ml  | 12 ++++++++++++
 src/proto_alpha/lib_protocol/alpha_context.mli | 10 ++++++++++
 2 files changed, 22 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml
index 4af0f09dd8a0..dcecaeefcd05 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -227,6 +227,10 @@ module Raw_level = struct
     let add = add
 
     let sub = sub
+
+    let from_repr (level : raw_level) = level
+
+    let to_repr (level : raw_level) = level
   end
 end
 
@@ -269,6 +273,14 @@ module Round = struct
   let update ctxt round = Storage.Block_round.update ctxt round
 
   let get ctxt = Storage.Block_round.get ctxt
+
+  module Internal_for_tests = struct
+    include Internal_for_tests
+
+    let from_repr (round : round) = round
+
+    let to_repr (round : round) = round
+  end
 end
 
 module Gas = struct
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 314453349df3..372d92abafdc 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -264,6 +264,10 @@ module Raw_level : sig
     val add : raw_level -> int -> raw_level
 
     val sub : raw_level -> int -> raw_level option
+
+    val from_repr : Raw_level_repr.t -> raw_level
+
+    val to_repr : raw_level -> Raw_level_repr.t
   end
 end
 
@@ -376,6 +380,12 @@ module Round : sig
 
   (* store a round in context *)
   val update : context -> t -> context tzresult Lwt.t
+
+  module Internal_for_tests : sig
+    val from_repr : Round_repr.t -> t
+
+    val to_repr : t -> Round_repr.t
+  end
 end
 
 module Gas : sig
-- 
GitLab