From 92738864050473cb092875c9082d606269333bc9 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 1 Feb 2024 11:07:26 +0100
Subject: [PATCH 01/16] Proto: introduce the slash_percentage module

---
 src/proto_alpha/lib_protocol/TEZOS_PROTOCOL     |  1 +
 .../delegate_slashed_deposits_storage.ml        | 17 ++++-------------
 src/proto_alpha/lib_protocol/dune               |  4 ++++
 .../lib_protocol/slash_percentage.ml            | 13 +++++++++++++
 .../lib_protocol/slash_percentage.mli           | 10 ++++++++++
 5 files changed, 32 insertions(+), 13 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/slash_percentage.ml
 create mode 100644 src/proto_alpha/lib_protocol/slash_percentage.mli

diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
index 219574dce74e..c18a7b164d81 100644
--- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
+++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
@@ -182,6 +182,7 @@
         "Delegate_rewards",
         "Delegate_missed_attestations_storage",
         "Forbidden_delegates_storage",
+	"Slash_percentage",
         "Delegate_slashed_deposits_storage",
         "Staking",
         "Delegate_cycles",
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 fe14425c5c08..c4f1bf519d6e 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -74,15 +74,11 @@ let punish_double_signing ctxt ~operation_hash
     | Double_baking ->
         ( for_double_baking,
           {denounced with for_double_baking = true},
-          Constants_storage
-          .percentage_of_frozen_deposits_slashed_per_double_baking
-            ctxt )
+          Slash_percentage.for_double_baking ctxt )
     | Double_attesting ->
         ( for_double_attesting,
           {denounced with for_double_attesting = true},
-          Constants_storage
-          .percentage_of_frozen_deposits_slashed_per_double_attestation
-            ctxt )
+          Slash_percentage.for_double_attestation ctxt )
   in
   assert (Compare.Bool.(already_denounced = false)) ;
   let delegate_contract = Contract_repr.Implicit delegate in
@@ -203,14 +199,9 @@ let apply_and_clear_denunciations ctxt =
                  Denunciations_repr.{operation_hash; rewarded; misbehaviour} ->
               let slashing_percentage =
                 match misbehaviour.kind with
-                | Double_baking ->
-                    Constants_storage
-                    .percentage_of_frozen_deposits_slashed_per_double_baking
-                      ctxt
+                | Double_baking -> Slash_percentage.for_double_baking ctxt
                 | Double_attesting ->
-                    Constants_storage
-                    .percentage_of_frozen_deposits_slashed_per_double_attestation
-                      ctxt
+                    Slash_percentage.for_double_attestation ctxt
               in
               let misbehaviour_cycle =
                 (Level_repr.level_from_raw
diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune
index e12415dba87c..22248cfa95b7 100644
--- a/src/proto_alpha/lib_protocol/dune
+++ b/src/proto_alpha/lib_protocol/dune
@@ -198,6 +198,7 @@
   Delegate_rewards
   Delegate_missed_attestations_storage
   Forbidden_delegates_storage
+  Slash_percentage
   Delegate_slashed_deposits_storage
   Staking
   Delegate_cycles
@@ -496,6 +497,7 @@
   delegate_missed_attestations_storage.ml
   delegate_missed_attestations_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
   staking.ml staking.mli
   delegate_cycles.ml delegate_cycles.mli
@@ -795,6 +797,7 @@
   delegate_missed_attestations_storage.ml
   delegate_missed_attestations_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
   staking.ml staking.mli
   delegate_cycles.ml delegate_cycles.mli
@@ -1078,6 +1081,7 @@
   delegate_missed_attestations_storage.ml
   delegate_missed_attestations_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
   staking.ml staking.mli
   delegate_cycles.ml delegate_cycles.mli
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.ml b/src/proto_alpha/lib_protocol/slash_percentage.ml
new file mode 100644
index 000000000000..de9b881602af
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/slash_percentage.ml
@@ -0,0 +1,13 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+let for_double_baking ctxt =
+  Constants_storage.percentage_of_frozen_deposits_slashed_per_double_baking ctxt
+
+let for_double_attestation ctxt =
+  Constants_storage.percentage_of_frozen_deposits_slashed_per_double_attestation
+    ctxt
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.mli b/src/proto_alpha/lib_protocol/slash_percentage.mli
new file mode 100644
index 000000000000..5c23129cee16
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/slash_percentage.mli
@@ -0,0 +1,10 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+val for_double_baking : Raw_context.t -> Percentage.t
+
+val for_double_attestation : Raw_context.t -> Percentage.t
-- 
GitLab


From ce3d09399be104477c7c398f36bfc10c2cd9aadb Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 1 Feb 2024 11:56:01 +0100
Subject: [PATCH 02/16] Proto: increase Percentage's internal precision

---
 .../delegate_slashed_deposits_storage.ml      | 15 +++++++++++++++
 .../delegate_slashed_deposits_storage.mli     |  2 ++
 src/proto_alpha/lib_protocol/init_storage.ml  |  4 ++++
 src/proto_alpha/lib_protocol/percentage.ml    | 19 +++++++++++++------
 src/proto_alpha/lib_protocol/percentage.mli   |  6 ++++--
 5 files changed, 38 insertions(+), 8 deletions(-)

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 c4f1bf519d6e..a3f15e03f07e 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -25,6 +25,21 @@
 (*                                                                           *)
 (*****************************************************************************)
 
+(* Remove after P *)
+let update_slashing_storage_for_p ctxt =
+  Storage.Contract.Slashed_deposits.fold
+    ctxt
+    ~order:`Undefined
+    ~init:ctxt
+    ~f:(fun contract slashed_history ctxt ->
+      let slashed_history =
+        List.map
+          (fun (cycle, percentage) ->
+            (cycle, Percentage.convert_from_o_to_p percentage))
+          slashed_history
+      in
+      Storage.Contract.Slashed_deposits.add ctxt contract slashed_history)
+
 let already_denounced_for_double_attesting ctxt delegate (level : Level_repr.t)
     round =
   let open Lwt_result_syntax in
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 9d45a438aaa7..4e613275087e 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -90,3 +90,5 @@ val clear_outdated_already_denounced :
 
 val apply_and_clear_denunciations :
   Raw_context.t -> (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t
+
+val update_slashing_storage_for_p : Raw_context.t -> Raw_context.t Lwt.t
diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml
index 1418a8e75fa2..f94f34f018e8 100644
--- a/src/proto_alpha/lib_protocol/init_storage.ml
+++ b/src/proto_alpha/lib_protocol/init_storage.ml
@@ -321,6 +321,10 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract
         let* ctxt =
           cleanup_values_for_protocol_p ctxt previous_proto_constants level
         in
+        (* Update the percentage representation of the stored slashes *)
+        let*! ctxt =
+          Delegate_slashed_deposits_storage.update_slashing_storage_for_p ctxt
+        in
         return (ctxt, [])
   in
   let* ctxt =
diff --git a/src/proto_alpha/lib_protocol/percentage.ml b/src/proto_alpha/lib_protocol/percentage.ml
index d801e358cd09..67c99e6af570 100644
--- a/src/proto_alpha/lib_protocol/percentage.ml
+++ b/src/proto_alpha/lib_protocol/percentage.ml
@@ -7,17 +7,24 @@
 
 type t = int
 
-let one_hundred_percent = 100
+(* The factor by which to multiply the smallest non-zero representation in
+   order to obtain 1%. A factor of 100 means that the precision is 0.01%. *)
+let precision_factor = 100
+
+let one_hundred_percent = 100 * precision_factor
+
+(* Remove after P *)
+let convert_from_o_to_p x = x * precision_factor
 
 let of_int_guarded i =
   if Compare.Int.(i >= 0 && i <= one_hundred_percent) then Ok i
-  else Error "Value must be between 0 and 100"
+  else Error "Value must be between 0 and 10000"
 
 let of_int_bounded i = Compare.Int.(max 0 (min one_hundred_percent i))
 
 let encoding =
   let open Data_encoding in
-  conv_with_guard (fun i -> i) of_int_guarded uint8
+  conv_with_guard (fun i -> i) of_int_guarded uint16
 
 let of_ratio_bounded Ratio_repr.{numerator; denominator} =
   of_int_bounded (one_hundred_percent * numerator / denominator)
@@ -32,11 +39,11 @@ let sub_bounded p1 p2 = Compare.Int.max 0 (p1 - p2)
 
 let p0 = 0
 
-let p5 = 5
+let p5 = 5 * precision_factor
 
-let p50 = 50
+let p50 = 50 * precision_factor
 
-let p51 = 51
+let p51 = 51 * precision_factor
 
 let p100 = one_hundred_percent
 
diff --git a/src/proto_alpha/lib_protocol/percentage.mli b/src/proto_alpha/lib_protocol/percentage.mli
index 29a8097c5bfa..ee913288578f 100644
--- a/src/proto_alpha/lib_protocol/percentage.mli
+++ b/src/proto_alpha/lib_protocol/percentage.mli
@@ -6,12 +6,12 @@
 (*****************************************************************************)
 
 (** A value representing percentages, between 0% and 100%, inclusive.
-    Precision of the representation is 1% *)
+    Precision of the representation is 0.01% *)
 type t
 
 val encoding : t Data_encoding.t
 
-(** Rounds down to the nearest percent *)
+(** Rounds down to the nearest 0.01% *)
 val of_ratio_bounded : Ratio_repr.t -> t
 
 val to_q : t -> Q.t
@@ -43,3 +43,5 @@ val p100 : t
 module Compare : sig
   val ( >= ) : t -> t -> bool
 end
+
+val convert_from_o_to_p : t -> t
-- 
GitLab


From 142eed6aa455f544c2f2f37968b25af44c67409f Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Wed, 7 Feb 2024 15:46:22 +0100
Subject: [PATCH 03/16] Proto: Properly change percentage encoding

---
 .../constants_parametric_previous_repr.ml     |  4 +--
 .../delegate_slashed_deposits_storage.ml      | 30 +++++++++++--------
 src/proto_alpha/lib_protocol/percentage.ml    | 15 ++++++++--
 src/proto_alpha/lib_protocol/percentage.mli   |  3 ++
 src/proto_alpha/lib_protocol/storage.ml       | 24 ++++++++++++++-
 src/proto_alpha/lib_protocol/storage.mli      | 11 +++++++
 6 files changed, 69 insertions(+), 18 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/constants_parametric_previous_repr.ml b/src/proto_alpha/lib_protocol/constants_parametric_previous_repr.ml
index bf32fb497b76..96b257e4cd1d 100644
--- a/src/proto_alpha/lib_protocol/constants_parametric_previous_repr.ml
+++ b/src/proto_alpha/lib_protocol/constants_parametric_previous_repr.ml
@@ -632,10 +632,10 @@ let encoding =
                    (req "limit_of_delegation_over_baking" uint8)
                    (req
                       "percentage_of_frozen_deposits_slashed_per_double_baking"
-                      Percentage.encoding)
+                      Percentage.encoding_legacy_in_o)
                    (req
                       "percentage_of_frozen_deposits_slashed_per_double_attestation"
-                      Percentage.encoding)
+                      Percentage.encoding_legacy_in_o)
                    (opt "testnet_dictator" Signature.Public_key_hash.encoding)
                    (opt "initial_seed" State_hash.encoding))
                 (merge_objs
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 a3f15e03f07e..be00e919d369 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -25,20 +25,24 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(* Remove after P *)
+(* TODO #6918: Remove after P *)
 let update_slashing_storage_for_p ctxt =
-  Storage.Contract.Slashed_deposits.fold
-    ctxt
-    ~order:`Undefined
-    ~init:ctxt
-    ~f:(fun contract slashed_history ctxt ->
-      let slashed_history =
-        List.map
-          (fun (cycle, percentage) ->
-            (cycle, Percentage.convert_from_o_to_p percentage))
-          slashed_history
-      in
-      Storage.Contract.Slashed_deposits.add ctxt contract slashed_history)
+  let open Lwt_result_syntax in
+  let*! ctxt =
+    Storage.Contract.Slashed_deposits__Oxford.fold
+      ctxt
+      ~order:`Undefined
+      ~init:ctxt
+      ~f:(fun contract slashed_history ctxt ->
+        let slashed_history =
+          List.map
+            (fun (cycle, percentage) ->
+              (cycle, Percentage.convert_from_o_to_p percentage))
+            slashed_history
+        in
+        Storage.Contract.Slashed_deposits.add ctxt contract slashed_history)
+  in
+  Storage.Contract.Slashed_deposits__Oxford.clear ctxt
 
 let already_denounced_for_double_attesting ctxt delegate (level : Level_repr.t)
     round =
diff --git a/src/proto_alpha/lib_protocol/percentage.ml b/src/proto_alpha/lib_protocol/percentage.ml
index 67c99e6af570..98dd565bc2f5 100644
--- a/src/proto_alpha/lib_protocol/percentage.ml
+++ b/src/proto_alpha/lib_protocol/percentage.ml
@@ -13,15 +13,26 @@ let precision_factor = 100
 
 let one_hundred_percent = 100 * precision_factor
 
-(* Remove after P *)
+(* TODO #6918: Remove after P *)
 let convert_from_o_to_p x = x * precision_factor
 
+(* TODO #6918: Remove after P *)
+let of_int_guarded_legacy_in_o i =
+  if Compare.Int.(i >= 0 && i <= 100) then Ok i
+  else Error "Value must be between 0 and 100"
+
 let of_int_guarded i =
   if Compare.Int.(i >= 0 && i <= one_hundred_percent) then Ok i
-  else Error "Value must be between 0 and 10000"
+  else
+    Error (Format.asprintf "Value must be between 0 and %d" one_hundred_percent)
 
 let of_int_bounded i = Compare.Int.(max 0 (min one_hundred_percent i))
 
+(* TODO #6918: Remove after P *)
+let encoding_legacy_in_o =
+  let open Data_encoding in
+  conv_with_guard (fun i -> i) of_int_guarded_legacy_in_o uint8
+
 let encoding =
   let open Data_encoding in
   conv_with_guard (fun i -> i) of_int_guarded uint16
diff --git a/src/proto_alpha/lib_protocol/percentage.mli b/src/proto_alpha/lib_protocol/percentage.mli
index ee913288578f..3670371f58f9 100644
--- a/src/proto_alpha/lib_protocol/percentage.mli
+++ b/src/proto_alpha/lib_protocol/percentage.mli
@@ -9,6 +9,9 @@
     Precision of the representation is 0.01% *)
 type t
 
+(* TODO #6918: Remove after P *)
+val encoding_legacy_in_o : t Data_encoding.t
+
 val encoding : t Data_encoding.t
 
 (** Rounds down to the nearest 0.01% *)
diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml
index e0e2fb3d3279..f013bd216c5d 100644
--- a/src/proto_alpha/lib_protocol/storage.ml
+++ b/src/proto_alpha/lib_protocol/storage.ml
@@ -187,6 +187,18 @@ module Slashed_deposits_history = struct
     | _ -> Percentage.p0
 end
 
+(* TODO #6918: Remove after P *)
+module Slashed_deposits_history__Oxford = struct
+  include Slashed_deposits_history
+
+  let encoding =
+    let open Data_encoding in
+    list
+      (obj2
+         (req "cycle" Cycle_repr.encoding)
+         (req "slashed_percentage" Percentage.encoding_legacy_in_o))
+end
+
 module Unstake_request = struct
   type request = Cycle_repr.t * Tez_repr.t
 
@@ -475,14 +487,24 @@ module Contract = struct
       end)
       (Tez_repr)
 
+  (* TODO #6918: change name back after P *)
   module Slashed_deposits =
     Indexed_context.Make_map
       (Registered)
       (struct
-        let name = ["slashed_deposits"]
+        let name = ["slashed_deposits_p"]
       end)
       (Slashed_deposits_history)
 
+  (* TODO #6918: Remove after P *)
+  module Slashed_deposits__Oxford =
+    Indexed_context.Make_map
+      (Ghost)
+      (struct
+        let name = ["slashed_deposits"]
+      end)
+      (Slashed_deposits_history__Oxford)
+
   module Bond_id_index =
     Make_indexed_subcontext
       (Make_subcontext (Registered) (Indexed_context.Raw_context)
diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index dbd3fabb56b4..fcfd823b7953 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -70,6 +70,10 @@ module Slashed_deposits_history : sig
   val get : Cycle_repr.t -> t -> slashed_percentage
 end
 
+(* TODO #6918: Remove after P *)
+module Slashed_deposits_history__Oxford :
+    module type of Slashed_deposits_history
+
 module Unstake_request : sig
   type request = Cycle_repr.t * Tez_repr.t
 
@@ -283,6 +287,13 @@ module Contract : sig
        and type value = Slashed_deposits_history.t
        and type t := Raw_context.t
 
+  (* TODO #6918: Remove after P *)
+  module Slashed_deposits__Oxford :
+    Indexed_data_storage
+      with type key = Contract_repr.t
+       and type value = Slashed_deposits_history.t
+       and type t := Raw_context.t
+
   (** Associates a contract and a bond_id with a bond, i.e. an amount of tez
       that is frozen. *)
   module Frozen_bonds :
-- 
GitLab


From eab5d05dc16030502180256f10d6e779709492bd Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Wed, 7 Feb 2024 17:03:59 +0100
Subject: [PATCH 04/16] Proto: convert percentage constants

---
 src/proto_alpha/lib_protocol/raw_context.ml | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml
index b7a6ef968f89..2858d3b27ddd 100644
--- a/src/proto_alpha/lib_protocol/raw_context.ml
+++ b/src/proto_alpha/lib_protocol/raw_context.ml
@@ -1228,9 +1228,11 @@ let prepare_first_block ~level ~timestamp _chain_id ctxt =
               limit_of_delegation_over_baking =
                 c.limit_of_delegation_over_baking;
               percentage_of_frozen_deposits_slashed_per_double_baking =
-                c.percentage_of_frozen_deposits_slashed_per_double_baking;
+                Percentage.convert_from_o_to_p
+                  c.percentage_of_frozen_deposits_slashed_per_double_baking;
               percentage_of_frozen_deposits_slashed_per_double_attestation =
-                c.percentage_of_frozen_deposits_slashed_per_double_attestation;
+                Percentage.convert_from_o_to_p
+                  c.percentage_of_frozen_deposits_slashed_per_double_attestation;
               (* The `testnet_dictator` should absolutely be None on mainnet *)
               testnet_dictator = c.testnet_dictator;
               initial_seed = c.initial_seed;
-- 
GitLab


From a932bb08199c27e9cf773ed5a9720bb102921dbb Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 1 Feb 2024 14:34:11 +0100
Subject: [PATCH 05/16] Proto: add slashing parameters

---
 .../kaitai-struct-files/files/alpha__constants.ksy   |  8 ++++++--
 .../files/alpha__constants__parametric.ksy           |  8 ++++++--
 .../kaitai-struct-files/files/alpha__parameters.ksy  |  8 ++++++--
 src/proto_alpha/lib_parameters/default_parameters.ml | 10 ++++++++--
 src/proto_alpha/lib_protocol/alpha_context.mli       |  3 +++
 .../lib_protocol/constants_parametric_repr.ml        | 12 +++++++++++-
 .../lib_protocol/constants_parametric_repr.mli       |  2 ++
 src/proto_alpha/lib_protocol/constants_repr.ml       |  4 ++++
 src/proto_alpha/lib_protocol/constants_repr.mli      |  1 +
 src/proto_alpha/lib_protocol/raw_context.ml          |  6 ++++++
 10 files changed, 53 insertions(+), 9 deletions(-)

diff --git a/contrib/kaitai-struct-files/files/alpha__constants.ksy b/contrib/kaitai-struct-files/files/alpha__constants.ksy
index dcf100fd8c7e..83f23985dbd1 100644
--- a/contrib/kaitai-struct-files/files/alpha__constants.ksy
+++ b/contrib/kaitai-struct-files/files/alpha__constants.ksy
@@ -269,9 +269,13 @@ seq:
 - id: limit_of_delegation_over_baking
   type: u1
 - id: percentage_of_frozen_deposits_slashed_per_double_baking
-  type: u1
+  type: u2
 - id: percentage_of_frozen_deposits_slashed_per_double_attestation
-  type: u1
+  type: u2
+- id: max_slashing_per_block
+  type: u2
+- id: max_slashing_threshold
+  type: int31
 - id: testnet_dictator_tag
   type: u1
   enum: bool
diff --git a/contrib/kaitai-struct-files/files/alpha__constants__parametric.ksy b/contrib/kaitai-struct-files/files/alpha__constants__parametric.ksy
index b187e1770c59..cddf94099bcb 100644
--- a/contrib/kaitai-struct-files/files/alpha__constants__parametric.ksy
+++ b/contrib/kaitai-struct-files/files/alpha__constants__parametric.ksy
@@ -241,9 +241,13 @@ seq:
 - id: limit_of_delegation_over_baking
   type: u1
 - id: percentage_of_frozen_deposits_slashed_per_double_baking
-  type: u1
+  type: u2
 - id: percentage_of_frozen_deposits_slashed_per_double_attestation
-  type: u1
+  type: u2
+- id: max_slashing_per_block
+  type: u2
+- id: max_slashing_threshold
+  type: int31
 - id: testnet_dictator_tag
   type: u1
   enum: bool
diff --git a/contrib/kaitai-struct-files/files/alpha__parameters.ksy b/contrib/kaitai-struct-files/files/alpha__parameters.ksy
index 23d37f392b7e..5979bfa3ec3e 100644
--- a/contrib/kaitai-struct-files/files/alpha__parameters.ksy
+++ b/contrib/kaitai-struct-files/files/alpha__parameters.ksy
@@ -519,9 +519,13 @@ seq:
 - id: limit_of_delegation_over_baking
   type: u1
 - id: percentage_of_frozen_deposits_slashed_per_double_baking
-  type: u1
+  type: u2
 - id: percentage_of_frozen_deposits_slashed_per_double_attestation
-  type: u1
+  type: u2
+- id: max_slashing_per_block
+  type: u2
+- id: max_slashing_threshold
+  type: int31
 - id: testnet_dictator_tag
   type: u1
   enum: bool
diff --git a/src/proto_alpha/lib_parameters/default_parameters.ml b/src/proto_alpha/lib_parameters/default_parameters.ml
index c4c3909547a9..55e8729a9bd1 100644
--- a/src/proto_alpha/lib_parameters/default_parameters.ml
+++ b/src/proto_alpha/lib_parameters/default_parameters.ml
@@ -163,6 +163,7 @@ let constants_mainnet : Constants.Parametric.t =
               seed_nonce_revelation_tip_weight;
               vdf_revelation_tip_weight;
             };
+          max_slashing_threshold;
         } =
     Constants.Generated.generate ~consensus_committee_size
   in
@@ -247,6 +248,8 @@ let constants_mainnet : Constants.Parametric.t =
       Protocol.Percentage.p5;
     percentage_of_frozen_deposits_slashed_per_double_attestation =
       Protocol.Percentage.p50;
+    max_slashing_per_block = Protocol.Percentage.p100;
+    max_slashing_threshold;
     (* The `testnet_dictator` should absolutely be None on mainnet *)
     testnet_dictator = None;
     initial_seed = None;
@@ -318,7 +321,8 @@ let derive_cryptobox_parameters ~redundancy_factor ~mainnet_constants_divider =
 let constants_sandbox =
   let consensus_committee_size = 256 in
   let block_time = 1 in
-  let Constants.Generated.{consensus_threshold = _; issuance_weights} =
+  let Constants.Generated.
+        {max_slashing_threshold; consensus_threshold = _; issuance_weights} =
     Constants.Generated.generate ~consensus_committee_size
   in
   {
@@ -347,13 +351,15 @@ let constants_sandbox =
     delay_increment_per_round = Period.one_second;
     consensus_committee_size = 256;
     consensus_threshold = 0;
+    max_slashing_threshold;
     limit_of_delegation_over_baking = 19;
     max_operations_time_to_live = 8;
   }
 
 let constants_test =
   let consensus_committee_size = 25 in
-  let Constants.Generated.{consensus_threshold; issuance_weights} =
+  let Constants.Generated.
+        {max_slashing_threshold = _; consensus_threshold; issuance_weights} =
     Constants.Generated.generate ~consensus_committee_size
   in
   {
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 72123322e830..1ae4b7620fff 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -921,6 +921,8 @@ module Constants : sig
       percentage_of_frozen_deposits_slashed_per_double_baking : Percentage.t;
       percentage_of_frozen_deposits_slashed_per_double_attestation :
         Percentage.t;
+      max_slashing_per_block : Percentage.t;
+      max_slashing_threshold : int;
       testnet_dictator : public_key_hash option;
       initial_seed : State_hash.t option;
       cache_script_size : int;
@@ -946,6 +948,7 @@ module Constants : sig
     type t = {
       consensus_threshold : int;
       issuance_weights : Parametric.issuance_weights;
+      max_slashing_threshold : int;
     }
 
     val generate : consensus_committee_size:int -> t
diff --git a/src/proto_alpha/lib_protocol/constants_parametric_repr.ml b/src/proto_alpha/lib_protocol/constants_parametric_repr.ml
index 8bac5ec48cb1..0f7414b51fd4 100644
--- a/src/proto_alpha/lib_protocol/constants_parametric_repr.ml
+++ b/src/proto_alpha/lib_protocol/constants_parametric_repr.ml
@@ -202,6 +202,8 @@ type t = {
   limit_of_delegation_over_baking : int;
   percentage_of_frozen_deposits_slashed_per_double_baking : Percentage.t;
   percentage_of_frozen_deposits_slashed_per_double_attestation : Percentage.t;
+  max_slashing_per_block : Percentage.t;
+  max_slashing_threshold : int;
   testnet_dictator : Signature.Public_key_hash.t option;
   initial_seed : State_hash.t option;
   (* If a new cache is added, please also modify the
@@ -548,6 +550,8 @@ let encoding =
                 c.limit_of_delegation_over_baking,
                 c.percentage_of_frozen_deposits_slashed_per_double_baking,
                 c.percentage_of_frozen_deposits_slashed_per_double_attestation,
+                c.max_slashing_per_block,
+                c.max_slashing_threshold,
                 c.testnet_dictator,
                 c.initial_seed ),
               ( ( c.cache_script_size,
@@ -587,6 +591,8 @@ let encoding =
                    limit_of_delegation_over_baking,
                    percentage_of_frozen_deposits_slashed_per_double_baking,
                    percentage_of_frozen_deposits_slashed_per_double_attestation,
+                   max_slashing_per_block,
+                   max_slashing_threshold,
                    testnet_dictator,
                    initial_seed ),
                  ( ( cache_script_size,
@@ -627,6 +633,8 @@ let encoding =
         limit_of_delegation_over_baking;
         percentage_of_frozen_deposits_slashed_per_double_baking;
         percentage_of_frozen_deposits_slashed_per_double_attestation;
+        max_slashing_per_block;
+        max_slashing_threshold;
         testnet_dictator;
         initial_seed;
         cache_script_size;
@@ -677,7 +685,7 @@ let encoding =
                 (req "consensus_committee_size" int31)
                 (req "consensus_threshold" int31))
              (merge_objs
-                (obj6
+                (obj8
                    (req "minimal_participation_ratio" Ratio_repr.encoding)
                    (req "limit_of_delegation_over_baking" uint8)
                    (req
@@ -686,6 +694,8 @@ let encoding =
                    (req
                       "percentage_of_frozen_deposits_slashed_per_double_attestation"
                       Percentage.encoding)
+                   (req "max_slashing_per_block" Percentage.encoding)
+                   (req "max_slashing_threshold" int31)
                    (opt "testnet_dictator" Signature.Public_key_hash.encoding)
                    (opt "initial_seed" State_hash.encoding))
                 (merge_objs
diff --git a/src/proto_alpha/lib_protocol/constants_parametric_repr.mli b/src/proto_alpha/lib_protocol/constants_parametric_repr.mli
index b3f4d88a41b7..eb61c83f8451 100644
--- a/src/proto_alpha/lib_protocol/constants_parametric_repr.mli
+++ b/src/proto_alpha/lib_protocol/constants_parametric_repr.mli
@@ -211,6 +211,8 @@ type t = {
   (* upper bound on the (delegated tz / own frozen tz) ratio *)
   percentage_of_frozen_deposits_slashed_per_double_baking : Percentage.t;
   percentage_of_frozen_deposits_slashed_per_double_attestation : Percentage.t;
+  max_slashing_per_block : Percentage.t;
+  max_slashing_threshold : int;
   testnet_dictator : Signature.Public_key_hash.t option;
   initial_seed : State_hash.t option;
   cache_script_size : int;
diff --git a/src/proto_alpha/lib_protocol/constants_repr.ml b/src/proto_alpha/lib_protocol/constants_repr.ml
index 14d4387913ff..9baca9476477 100644
--- a/src/proto_alpha/lib_protocol/constants_repr.ml
+++ b/src/proto_alpha/lib_protocol/constants_repr.ml
@@ -338,11 +338,14 @@ module Generated = struct
   type t = {
     consensus_threshold : int;
     issuance_weights : Constants_parametric_repr.issuance_weights;
+    max_slashing_threshold : int;
   }
 
   let generate ~consensus_committee_size =
     (* The weights are expressed in [(256 * 80)]th of the total
        reward, because it is the smallest proportion used so far*)
+    (* let f = consensus_committee_size / 3 in *)
+    let max_slashing_threshold = (consensus_committee_size / 3) + 1 in
     let consensus_threshold = (consensus_committee_size * 2 / 3) + 1 in
     let bonus_committee_size = consensus_committee_size - consensus_threshold in
     let base_total_issued_per_minute = Tez_repr.of_mutez_exn 85_007_812L in
@@ -351,6 +354,7 @@ module Generated = struct
     let reward_parts_quarter = 5120 (* = reward_parts_whole / 4 *) in
     let reward_parts_16th = 1280 (* = reward_parts_whole / 16 *) in
     {
+      max_slashing_threshold;
       consensus_threshold;
       issuance_weights =
         {
diff --git a/src/proto_alpha/lib_protocol/constants_repr.mli b/src/proto_alpha/lib_protocol/constants_repr.mli
index 97ca8e81c69e..29e20a85e38f 100644
--- a/src/proto_alpha/lib_protocol/constants_repr.mli
+++ b/src/proto_alpha/lib_protocol/constants_repr.mli
@@ -120,6 +120,7 @@ module Generated : sig
   type t = {
     consensus_threshold : int;
     issuance_weights : Constants_parametric_repr.issuance_weights;
+    max_slashing_threshold : int;
   }
 
   (* This function is meant to be used just in lib_parameters and in the
diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml
index 2858d3b27ddd..c67c6343d8fd 100644
--- a/src/proto_alpha/lib_protocol/raw_context.ml
+++ b/src/proto_alpha/lib_protocol/raw_context.ml
@@ -1193,6 +1193,10 @@ let prepare_first_block ~level ~timestamp _chain_id ctxt =
           (* We change the consensus_rights_delay value only for mainnet *)
           if Compare.Int.(c.preserved_cycles = 5) then 2 else c.preserved_cycles
         in
+        let Constants_repr.Generated.{max_slashing_threshold; _} =
+          Constants_repr.Generated.generate
+            ~consensus_committee_size:c.consensus_committee_size
+        in
         let constants =
           Constants_parametric_repr.
             {
@@ -1233,6 +1237,8 @@ let prepare_first_block ~level ~timestamp _chain_id ctxt =
               percentage_of_frozen_deposits_slashed_per_double_attestation =
                 Percentage.convert_from_o_to_p
                   c.percentage_of_frozen_deposits_slashed_per_double_attestation;
+              max_slashing_per_block = Percentage.p100;
+              max_slashing_threshold;
               (* The `testnet_dictator` should absolutely be None on mainnet *)
               testnet_dictator = c.testnet_dictator;
               initial_seed = c.initial_seed;
-- 
GitLab


From 0e5549f021559a8f5ec83fedde145c94da6c858b Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Mon, 5 Feb 2024 15:57:51 +0100
Subject: [PATCH 06/16] Proto: add third denunciation kind

---
 .../lib_protocol/alpha_context.mli            |  2 +-
 .../delegate_slashed_deposits_storage.ml      |  4 ++--
 .../lib_protocol/misbehaviour_repr.ml         | 21 ++++++++++++++++++-
 .../lib_protocol/misbehaviour_repr.mli        | 10 +++++----
 .../test/helpers/adaptive_issuance_helpers.ml |  2 +-
 .../test_adaptive_issuance_roundtrip.ml       |  5 +++--
 .../lib_protocol/unstake_requests_storage.ml  |  2 +-
 7 files changed, 34 insertions(+), 12 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 1ae4b7620fff..ff2d0d4be1cd 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2193,7 +2193,7 @@ end
 
 (** This module re-exports definitions from {!Misbehaviour_repr}. *)
 module Misbehaviour : sig
-  type kind = Double_baking | Double_attesting
+  type kind = Double_baking | Double_attesting | Double_preattesting
 
   type t = {kind : kind; level : Raw_level.t; round : Round.t; slot : Slot.t}
 end
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 be00e919d369..b377e3eaf759 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -94,7 +94,7 @@ let punish_double_signing ctxt ~operation_hash
         ( for_double_baking,
           {denounced with for_double_baking = true},
           Slash_percentage.for_double_baking ctxt )
-    | Double_attesting ->
+    | Double_attesting | Double_preattesting ->
         ( for_double_attesting,
           {denounced with for_double_attesting = true},
           Slash_percentage.for_double_attestation ctxt )
@@ -219,7 +219,7 @@ let apply_and_clear_denunciations ctxt =
               let slashing_percentage =
                 match misbehaviour.kind with
                 | Double_baking -> Slash_percentage.for_double_baking ctxt
-                | Double_attesting ->
+                | Double_attesting | Double_preattesting ->
                     Slash_percentage.for_double_attestation ctxt
               in
               let misbehaviour_cycle =
diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
index dcae67d85697..84cc3cf3f1aa 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
@@ -5,7 +5,7 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type kind = Double_baking | Double_attesting
+type kind = Double_baking | Double_attesting | Double_preattesting
 
 let kind_encoding =
   let open Data_encoding in
@@ -24,6 +24,12 @@ let kind_encoding =
         (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);
     ]
 
 type t = {
@@ -33,6 +39,19 @@ type t = {
   slot : Slot_repr.t;
 }
 
+let compare_kind a b =
+  let to_int = function
+    | Double_baking -> 0
+    | Double_attesting -> 1
+    | Double_preattesting -> 2
+  in
+  Compare.Int.compare (to_int a) (to_int b)
+
+let compare a b =
+  Compare.or_else (Raw_level_repr.compare a.level b.level) @@ fun () ->
+  Compare.or_else (Round_repr.compare a.round b.round) @@ fun () ->
+  compare_kind a.kind b.kind
+
 let encoding =
   let open Data_encoding in
   conv
diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
index 93e89fe300d5..fcce609d8610 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
@@ -6,10 +6,7 @@
 (*****************************************************************************)
 
 (** Which double signing event has occurred. *)
-type kind =
-  | Double_baking
-  | Double_attesting
-      (** Includes both double preattestion and double attestion. *)
+type kind = Double_baking | Double_attesting | Double_preattesting
 
 (** Internal representation of a double signing event used in
     {!Denunciations_repr.item}.
@@ -34,3 +31,8 @@ type t = {
 }
 
 val encoding : t Data_encoding.t
+
+val compare_kind : kind -> kind -> int
+
+(** Note: the field [slot] is not taken into account in this comparison *)
+val compare : t -> t -> int
diff --git a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
index f529f3d33d50..504bb7859556 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
@@ -1044,7 +1044,7 @@ let apply_slashing
         constants
           .Protocol.Alpha_context.Constants.Parametric
            .percentage_of_frozen_deposits_slashed_per_double_baking
-    | Double_attesting ->
+    | Double_attesting | Double_preattesting ->
         constants.percentage_of_frozen_deposits_slashed_per_double_attestation
   in
   let get_total_supply acc_map =
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 561088f9eaa2..e2a22bf8a44c 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
@@ -1422,7 +1422,8 @@ let check_pending_slashings (block, state) : unit tzresult Lwt.t =
       rewarded
       (match misbehaviour.kind with
       | Double_baking -> "double baking"
-      | Double_attesting -> "double attesting")
+      | Double_attesting -> "double attesting"
+      | Double_preattesting -> "double preattesting")
   in
   let denunciations_pp = Format.pp_print_list denunciations_obj_pp in
   let* () =
@@ -1575,7 +1576,7 @@ let pct_from_kind (block : Block.t) = function
         block.constants.percentage_of_frozen_deposits_slashed_per_double_baking
       |> Q.(mul (100 // 1))
       |> Q.to_int
-  | Double_attesting ->
+  | Double_attesting | Double_preattesting ->
       Protocol.Percentage.to_q
         block.constants
           .percentage_of_frozen_deposits_slashed_per_double_attestation
diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml
index 817b5c8d5ea8..579378b7cf2e 100644
--- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml
+++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml
@@ -214,7 +214,7 @@ module For_RPC = struct
                         (Constants_storage
                          .percentage_of_frozen_deposits_slashed_per_double_baking
                            ctxt)
-                  | Double_attesting ->
+                  | Double_attesting | Double_preattesting ->
                       Percentage.add_bounded
                         acc
                         (Constants_storage
-- 
GitLab


From 45cf30ca23378ee402a7ded17adcbb19d233e8e6 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 6 Feb 2024 09:34:19 +0100
Subject: [PATCH 07/16] Proto: create a misbehaviour map for denunciation
 application

This is mainly a refactor, this can be checked by running the tests.
Some comments have been added, which might not be accurate in the
current commit, but instead describe the specification that we
eventually want.
---
 .../delegate_slashed_deposits_storage.ml      | 49 ++++++++++++++++---
 .../delegate_slashed_deposits_storage.mli     | 16 ++++++
 2 files changed, 57 insertions(+), 8 deletions(-)

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 b377e3eaf759..4bbd005c8229 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -144,6 +144,12 @@ let clear_outdated_already_denounced ctxt ~new_cycle =
   | 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
+   - for the kind: double baking > double attesting > double preattesting *)
+module MisMap = Map.Make (Misbehaviour_repr)
+
 let apply_and_clear_denunciations ctxt =
   let open Lwt_result_syntax in
   let current_cycle = (Raw_context.current_level ctxt).cycle in
@@ -181,13 +187,14 @@ let apply_and_clear_denunciations ctxt =
     let+ amount_to_burn = Tez_repr.(punishing_amount -? reward) in
     {reward; amount_to_burn}
   in
-  let* ctxt, balance_updates, remaining_denunciations =
+  (* Split denunciations into two groups: to be applied, and to be delayed *)
+  let*! block_denunciations_map, remaining_denunciations =
     Pending_denunciations_storage.fold
       ctxt
       ~order:`Undefined
-      ~init:(Ok (ctxt, [], []))
+      ~init:(MisMap.empty, [])
       ~f:(fun delegate denunciations acc ->
-        let*? ctxt, balance_updates, remaining_denunciations = acc in
+        let block_map, remaining_denunciations = acc in
         (* Since the [max_slashing_period] is 2, and we want to apply denunciations at the
            end of this period, we "delay" the current cycle's misbehaviour's denunciations,
            while we apply the older denunciations.
@@ -212,10 +219,35 @@ let apply_and_clear_denunciations ctxt =
                 Cycle_repr.(misb_cycle < current_cycle))
               denunciations
         in
+        let block_map =
+          List.fold_left
+            (fun block_map denunciation ->
+              MisMap.update
+                denunciation.Denunciations_repr.misbehaviour
+                (function
+                  | None -> Some [(delegate, denunciation)]
+                  | Some l -> Some ((delegate, denunciation) :: l))
+                block_map)
+            block_map
+            denunciations_to_apply
+        in
+        Lwt.return
+          ( block_map,
+            (delegate, denunciations_to_delay) :: remaining_denunciations ))
+  in
+  (* Processes the applicable denunciations *)
+  let* ctxt, balance_updates =
+    MisMap.fold_es
+      (fun {Misbehaviour_repr.level = _; round = _; kind = _; _}
+           denunciations
+           acc ->
+        let ctxt, balance_updates = acc in
         let+ ctxt, balance_updates =
           List.fold_left_es
             (fun (ctxt, balance_updates)
-                 Denunciations_repr.{operation_hash; rewarded; misbehaviour} ->
+                 ( delegate,
+                   Denunciations_repr.{operation_hash; rewarded; misbehaviour}
+                 ) ->
               let slashing_percentage =
                 match misbehaviour.kind with
                 | Double_baking -> Slash_percentage.for_double_baking ctxt
@@ -331,12 +363,13 @@ let apply_and_clear_denunciations ctxt =
                 punish_balance_updates @ reward_balance_updates
                 @ balance_updates ))
             (ctxt, balance_updates)
-            denunciations_to_apply
+            denunciations
         in
-        ( ctxt,
-          balance_updates,
-          (delegate, denunciations_to_delay) :: remaining_denunciations ))
+        (ctxt, balance_updates))
+      block_denunciations_map
+      (ctxt, [])
   in
+  (* Updates the storage to only contain the remaining denunciations *)
   let*! ctxt = Pending_denunciations_storage.clear ctxt in
   let*! ctxt =
     List.fold_left_s
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 4e613275087e..ee066bab8623 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -88,6 +88,22 @@ val punish_double_signing :
 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.
+    (because [max_slashable_period = 2], the misbehavior must be
+    in the previous cycle).
+
+    The denunciations are applied in chronological order of misbehaviour.
+    This function slashes the misbehaving bakers, by a proportion defined
+    in {!Slash_percentage}, and updates the respective
+    {!Storage.Contract.Slashed_deposits}. The applied denunciations are
+    removed from the storage.
+
+    It returns the updated context, and all the balance updates,
+    which includes slashes for the bakers, the stakers, and the rewards
+    for the denouncers.
+*)
 val apply_and_clear_denunciations :
   Raw_context.t -> (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t
 
-- 
GitLab


From 7542a79f041b5f7d6e07b5e3f221f0a603c2acdb Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 6 Feb 2024 11:37:06 +0100
Subject: [PATCH 08/16] Proto: add attesting_rights_count to Delegate_sampler

Similar to Baking.attesting_rights, but for the Raw_context.t
---
 .../lib_protocol/delegate_sampler.ml          | 19 +++++++++++++++++++
 .../lib_protocol/delegate_sampler.mli         |  8 ++++++++
 2 files changed, 27 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml
index 7ecece83bf89..76a140ee5d50 100644
--- a/src/proto_alpha/lib_protocol/delegate_sampler.ml
+++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml
@@ -259,6 +259,25 @@ let cleanup_values_for_protocol_p ctxt ~preserved_cycles ~consensus_rights_delay
       ctxt
       Cycle_repr.(start_cycle ---> end_cycle)
 
+let attesting_rights_count ctxt level =
+  let consensus_committee_size =
+    Constants_storage.consensus_committee_size ctxt
+  in
+  let open Lwt_result_syntax in
+  let*? slots = Slot_repr.Range.create ~min:0 ~count:consensus_committee_size in
+  Slot_repr.Range.fold_es
+    (fun (ctxt, map) slot ->
+      let* ctxt, consensus_pk = slot_owner ctxt level slot in
+      let map =
+        Signature.Public_key_hash.Map.update
+          consensus_pk.delegate
+          (function None -> Some 1 | Some slots_n -> Some (slots_n + 1))
+          map
+      in
+      return (ctxt, map))
+    (ctxt, Signature.Public_key_hash.Map.empty)
+    slots
+
 module For_RPC = struct
   let delegate_current_baking_power ctxt delegate =
     let open Lwt_result_syntax in
diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.mli b/src/proto_alpha/lib_protocol/delegate_sampler.mli
index 801d20b58faf..6dd6001bdd96 100644
--- a/src/proto_alpha/lib_protocol/delegate_sampler.mli
+++ b/src/proto_alpha/lib_protocol/delegate_sampler.mli
@@ -77,6 +77,14 @@ val cleanup_values_for_protocol_p :
   new_cycle:Cycle_repr.t ->
   Raw_context.t tzresult Lwt.t
 
+(** [attesting_rights_count ctxt level] returns a map of the delegates to
+    their number of attestation slots for the given level. Fails if the
+    given level is in a cycle for which the seed is not in the storage *)
+val attesting_rights_count :
+  Raw_context.t ->
+  Level_repr.t ->
+  (Raw_context.t * int Signature.Public_key_hash.Map.t) tzresult Lwt.t
+
 module For_RPC : sig
   (** The baking power for a given delegate computed from its current
     stake. *)
-- 
GitLab


From 66740e4ece40024254060063573a2d1f64481a8d Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 6 Feb 2024 11:38:25 +0100
Subject: [PATCH 09/16] Proto: abstract slash percentage computation

---
 .../delegate_slashed_deposits_storage.ml      | 47 +++++++++++--------
 .../lib_protocol/slash_percentage.ml          |  7 +++
 .../lib_protocol/slash_percentage.mli         | 16 ++++++-
 3 files changed, 48 insertions(+), 22 deletions(-)

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 4bbd005c8229..63f0ba5b1160 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -87,17 +87,21 @@ let punish_double_signing ctxt ~operation_hash
   let denounced =
     Option.value denounced_opt ~default:Storage.default_denounced
   in
-  let already_denounced, updated_denounced, slashing_percentage =
+  (* Placeholder value *)
+  let* ctxt, slashing_percentage =
+    Slash_percentage.get
+      ctxt
+      ~kind:misbehaviour.kind
+      ~level
+      [(delegate, {operation_hash; rewarded; misbehaviour})]
+  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},
-          Slash_percentage.for_double_baking ctxt )
+        (for_double_baking, {denounced with for_double_baking = true})
     | Double_attesting | Double_preattesting ->
-        ( for_double_attesting,
-          {denounced with for_double_attesting = true},
-          Slash_percentage.for_double_attestation ctxt )
+        (for_double_attesting, {denounced with for_double_attesting = true})
   in
   assert (Compare.Bool.(already_denounced = false)) ;
   let delegate_contract = Contract_repr.Implicit delegate in
@@ -238,28 +242,31 @@ let apply_and_clear_denunciations ctxt =
   (* Processes the applicable denunciations *)
   let* ctxt, balance_updates =
     MisMap.fold_es
-      (fun {Misbehaviour_repr.level = _; round = _; kind = _; _}
+      (fun ({Misbehaviour_repr.level = raw_level; round = _; kind; _} as miskey)
            denunciations
            acc ->
         let ctxt, balance_updates = acc in
+        let level =
+          Level_repr.level_from_raw
+            ~cycle_eras:(Raw_context.cycle_eras ctxt)
+            raw_level
+        in
+        let misbehaviour_cycle = level.cycle in
+        let* ctxt, slashing_percentage =
+          Slash_percentage.get ctxt ~kind ~level denunciations
+        in
         let+ ctxt, balance_updates =
           List.fold_left_es
             (fun (ctxt, balance_updates)
                  ( delegate,
                    Denunciations_repr.{operation_hash; rewarded; misbehaviour}
                  ) ->
-              let slashing_percentage =
-                match misbehaviour.kind with
-                | Double_baking -> Slash_percentage.for_double_baking ctxt
-                | Double_attesting | Double_preattesting ->
-                    Slash_percentage.for_double_attestation ctxt
-              in
-              let misbehaviour_cycle =
-                (Level_repr.level_from_raw
-                   ~cycle_eras:(Raw_context.cycle_eras ctxt)
-                   misbehaviour.level)
-                  .cycle
-              in
+              assert (
+                Compare.Int.equal
+                  (* This compare ignores the slot *)
+                  (Misbehaviour_repr.compare miskey misbehaviour)
+                  0) ;
+              (* Validate ensures that [denunciations] contains [delegate] at most once *)
               let get_initial_frozen_deposits_of_misbehaviour_cycle =
                 if Cycle_repr.equal current_cycle misbehaviour_cycle then
                   Delegate_storage.initial_frozen_deposits
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.ml b/src/proto_alpha/lib_protocol/slash_percentage.ml
index de9b881602af..f230f7707d16 100644
--- a/src/proto_alpha/lib_protocol/slash_percentage.ml
+++ b/src/proto_alpha/lib_protocol/slash_percentage.ml
@@ -11,3 +11,10 @@ let for_double_baking ctxt =
 let for_double_attestation ctxt =
   Constants_storage.percentage_of_frozen_deposits_slashed_per_double_attestation
     ctxt
+
+let get ctxt ~(kind : Misbehaviour_repr.kind) ~level denunciations =
+  ignore level ;
+  ignore denunciations ;
+  match kind with
+  | Double_baking -> for_double_baking ctxt
+  | Double_attesting | Double_preattesting -> for_double_attestation ctxt
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.mli b/src/proto_alpha/lib_protocol/slash_percentage.mli
index 5c23129cee16..9c2dffe3630d 100644
--- a/src/proto_alpha/lib_protocol/slash_percentage.mli
+++ b/src/proto_alpha/lib_protocol/slash_percentage.mli
@@ -5,6 +5,18 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-val for_double_baking : Raw_context.t -> Percentage.t
+(** [get ctxt ~kind ~level denounced] returns the percentage that needs to be
+    applied for the given misbehaviour.
 
-val for_double_attestation : Raw_context.t -> Percentage.t
+    [denounced] is the list of delegates that have been denounced together for
+    the given [kind], for the given [level] and for the same round. The amount
+    slashed increases quadratically as the number of attesting slots of
+    denounced delegates increases. The maximum slashing value
+    [max_slashing_per_block] is reached when that number of slots reaches
+    [max_slashing_threshold] . *)
+val get :
+  Raw_context.t ->
+  kind:Misbehaviour_repr.kind ->
+  level:Level_repr.t ->
+  (Signature.public_key_hash * Denunciations_repr.item) list ->
+  (Raw_context.t * Percentage.t) tzresult Lwt.t
-- 
GitLab


From a56f158b5dbbeb95d53e8c45825d2e3cf0b5ad07 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 6 Feb 2024 13:48:20 +0100
Subject: [PATCH 10/16] Proto: implement adaptive slashing

---
 .../delegate_slashed_deposits_storage.ml      |  9 ++--
 .../lib_protocol/misbehaviour_repr.ml         |  2 +
 .../lib_protocol/misbehaviour_repr.mli        |  2 +
 src/proto_alpha/lib_protocol/percentage.ml    | 12 ++++++
 src/proto_alpha/lib_protocol/percentage.mli   |  6 +++
 .../lib_protocol/slash_percentage.ml          | 42 +++++++++++++++----
 .../lib_protocol/slash_percentage.mli         |  2 +-
 7 files changed, 60 insertions(+), 15 deletions(-)

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 63f0ba5b1160..e39c07919340 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -89,11 +89,7 @@ let punish_double_signing ctxt ~operation_hash
   in
   (* Placeholder value *)
   let* ctxt, slashing_percentage =
-    Slash_percentage.get
-      ctxt
-      ~kind:misbehaviour.kind
-      ~level
-      [(delegate, {operation_hash; rewarded; misbehaviour})]
+    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
@@ -252,8 +248,9 @@ let apply_and_clear_denunciations ctxt =
             raw_level
         in
         let misbehaviour_cycle = level.cycle in
+        let denounced = List.map fst denunciations in
         let* ctxt, slashing_percentage =
-          Slash_percentage.get ctxt ~kind ~level denunciations
+          Slash_percentage.get ctxt ~kind ~level denounced
         in
         let+ ctxt, balance_updates =
           List.fold_left_es
diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
index 84cc3cf3f1aa..f0f83d474177 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.ml
@@ -47,6 +47,8 @@ let compare_kind a b =
   in
   Compare.Int.compare (to_int a) (to_int b)
 
+let equal_kind a b = Compare.Int.equal 0 (compare_kind a b)
+
 let compare a b =
   Compare.or_else (Raw_level_repr.compare a.level b.level) @@ fun () ->
   Compare.or_else (Round_repr.compare a.round b.round) @@ fun () ->
diff --git a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
index fcce609d8610..0ced59700c1b 100644
--- a/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
+++ b/src/proto_alpha/lib_protocol/misbehaviour_repr.mli
@@ -34,5 +34,7 @@ val encoding : t Data_encoding.t
 
 val compare_kind : kind -> kind -> int
 
+val equal_kind : kind -> kind -> bool
+
 (** Note: the field [slot] is not taken into account in this comparison *)
 val compare : t -> t -> int
diff --git a/src/proto_alpha/lib_protocol/percentage.ml b/src/proto_alpha/lib_protocol/percentage.ml
index 98dd565bc2f5..7696be983d96 100644
--- a/src/proto_alpha/lib_protocol/percentage.ml
+++ b/src/proto_alpha/lib_protocol/percentage.ml
@@ -40,6 +40,14 @@ let encoding =
 let of_ratio_bounded Ratio_repr.{numerator; denominator} =
   of_int_bounded (one_hundred_percent * numerator / denominator)
 
+let of_q_bounded ~round (Q.{num; den} as q) =
+  if Compare.Q.(q >= Q.one) then one_hundred_percent
+  else
+    (* Ensures that [to_int] doesn't overflow *)
+    let div = match round with `Down -> Z.div | `Up -> Z.cdiv in
+    of_int_bounded
+      (Z.to_int (div (Z.mul (Z.of_int one_hundred_percent) num) den))
+
 let to_q x = Q.of_ints x one_hundred_percent
 
 let neg p = one_hundred_percent - p
@@ -48,6 +56,10 @@ let add_bounded p1 p2 = Compare.Int.min one_hundred_percent (p1 + p2)
 
 let sub_bounded p1 p2 = Compare.Int.max 0 (p1 - p2)
 
+let mul ~round a b = Q.mul (to_q a) (to_q b) |> of_q_bounded ~round
+
+let mul_q_bounded ~round a q = Q.mul (to_q a) q |> of_q_bounded ~round
+
 let p0 = 0
 
 let p5 = 5 * precision_factor
diff --git a/src/proto_alpha/lib_protocol/percentage.mli b/src/proto_alpha/lib_protocol/percentage.mli
index 3670371f58f9..c86d4cb14899 100644
--- a/src/proto_alpha/lib_protocol/percentage.mli
+++ b/src/proto_alpha/lib_protocol/percentage.mli
@@ -17,6 +17,8 @@ val encoding : t Data_encoding.t
 (** Rounds down to the nearest 0.01% *)
 val of_ratio_bounded : Ratio_repr.t -> t
 
+val of_q_bounded : round:[`Down | `Up] -> Q.t -> t
+
 val to_q : t -> Q.t
 
 (** [neg p] is [100% - p]. *)
@@ -26,6 +28,10 @@ val add_bounded : t -> t -> t
 
 val sub_bounded : t -> t -> t
 
+val mul : round:[`Down | `Up] -> t -> t -> t
+
+val mul_q_bounded : round:[`Down | `Up] -> t -> Q.t -> t
+
 (** Constants *)
 
 (** 0% *)
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.ml b/src/proto_alpha/lib_protocol/slash_percentage.ml
index f230f7707d16..68c9f28c94aa 100644
--- a/src/proto_alpha/lib_protocol/slash_percentage.ml
+++ b/src/proto_alpha/lib_protocol/slash_percentage.ml
@@ -8,13 +8,39 @@
 let for_double_baking ctxt =
   Constants_storage.percentage_of_frozen_deposits_slashed_per_double_baking ctxt
 
-let for_double_attestation ctxt =
-  Constants_storage.percentage_of_frozen_deposits_slashed_per_double_attestation
-    ctxt
+let for_double_attestation ctxt rights denounced =
+  if
+    not
+      (Constants_storage.adaptive_issuance_ns_enable ctxt
+      && Constants_storage.adaptive_issuance_enable ctxt)
+  then
+    Constants_storage
+    .percentage_of_frozen_deposits_slashed_per_double_attestation
+      ctxt
+  else
+    let total_rights_denounced =
+      List.fold_left
+        (fun total delegate ->
+          Option.value
+            (Signature.Public_key_hash.Map.find delegate rights)
+            ~default:0
+          |> ( + ) total)
+        0
+        denounced
+    in
+    let threshold_max = (Raw_context.constants ctxt).max_slashing_threshold in
+    let max_slashing = (Raw_context.constants ctxt).max_slashing_per_block in
+    if Compare.Int.(total_rights_denounced >= threshold_max) then max_slashing
+    else
+      let num_z = Z.(pow (of_int total_rights_denounced) 2) in
+      let den_z = Z.(pow (of_int threshold_max) 2) in
+      Percentage.mul_q_bounded ~round:`Up max_slashing Q.(num_z /// den_z)
 
-let get ctxt ~(kind : Misbehaviour_repr.kind) ~level denunciations =
-  ignore level ;
-  ignore denunciations ;
+let get ctxt ~(kind : Misbehaviour_repr.kind) ~(level : Level_repr.t)
+    (denounced : Signature.public_key_hash list) =
+  let open Lwt_result_syntax in
   match kind with
-  | Double_baking -> for_double_baking ctxt
-  | Double_attesting | Double_preattesting -> for_double_attestation ctxt
+  | Double_baking -> return (ctxt, for_double_baking ctxt)
+  | Double_attesting | Double_preattesting ->
+      let* ctxt, rights = Delegate_sampler.attesting_rights_count ctxt level in
+      return (ctxt, for_double_attestation ctxt rights denounced)
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.mli b/src/proto_alpha/lib_protocol/slash_percentage.mli
index 9c2dffe3630d..2f8a71eca851 100644
--- a/src/proto_alpha/lib_protocol/slash_percentage.mli
+++ b/src/proto_alpha/lib_protocol/slash_percentage.mli
@@ -18,5 +18,5 @@ val get :
   Raw_context.t ->
   kind:Misbehaviour_repr.kind ->
   level:Level_repr.t ->
-  (Signature.public_key_hash * Denunciations_repr.item) list ->
+  Signature.public_key_hash list ->
   (Raw_context.t * Percentage.t) tzresult Lwt.t
-- 
GitLab


From 0bd7dd52a8533dc00cdbd57c288d9c9b81f4efff Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 6 Feb 2024 14:18:09 +0100
Subject: [PATCH 11/16] Proto/tests: fix current integration tests

---
 src/proto_alpha/lib_parameters/default_parameters.ml | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/proto_alpha/lib_parameters/default_parameters.ml b/src/proto_alpha/lib_parameters/default_parameters.ml
index 55e8729a9bd1..70b30e51b148 100644
--- a/src/proto_alpha/lib_parameters/default_parameters.ml
+++ b/src/proto_alpha/lib_parameters/default_parameters.ml
@@ -392,6 +392,9 @@ let constants_test =
       (* Not 9 so that multiplication by a percentage and
          divisions by a limit do not easily get intermingled. *);
     max_operations_time_to_live = 8;
+    (* This has the same slashing behaviour as before P *)
+    max_slashing_per_block = Protocol.Percentage.p50;
+    max_slashing_threshold = 1;
   }
 
 let test_commitments =
-- 
GitLab


From 0ced82a6e53faa5b094c12bd9caa2dadcadc8afd Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 6 Feb 2024 14:37:49 +0100
Subject: [PATCH 12/16] Proto/tests: add unit tests for `Percentage`

---
 .../lib_protocol/test/unit/test_percentage.ml | 58 +++++++++++++++++++
 1 file changed, 58 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/test/unit/test_percentage.ml b/src/proto_alpha/lib_protocol/test/unit/test_percentage.ml
index fb4b48d049d6..3fd6886a3474 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_percentage.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_percentage.ml
@@ -25,6 +25,10 @@ let assert_equal ~loc n (pct : Percentage.t) =
 let assert_equal_tez ~loc t1 t2 =
   Assert.equal ~loc Tez_repr.equal "Tez aren't equal" Tez_repr.pp t1 t2
 
+let assert_equal_q ~loc q (pct : Percentage.t) =
+  let pct_q = Percentage.to_q pct in
+  Assert.equal_q ~loc q pct_q
+
 let f = Tez_repr.mul_percentage
 
 let test_constant_values () =
@@ -101,6 +105,58 @@ let test_mul_percentage () =
   in
   return_unit
 
+let test_mul () =
+  let open Lwt_result_syntax in
+  let mul = Percentage.mul ~round:`Down in
+  let* () =
+    assert_equal_q
+      ~loc:__LOC__
+      Q.(25 // 100)
+      (mul Percentage.p50 Percentage.p50)
+  in
+  let* () =
+    assert_equal_q
+      ~loc:__LOC__
+      Q.(25 // 10000)
+      (mul Percentage.p5 Percentage.p5)
+  in
+  return_unit
+
+let test_of_q () =
+  let open Lwt_result_syntax in
+  let round = `Down in
+  let of_q = Percentage.of_q_bounded in
+  let* () =
+    assert_equal_q ~loc:__LOC__ Q.(11 // 100) (of_q ~round Q.(11 // 100))
+  in
+  let* () = assert_equal_q ~loc:__LOC__ Q.one (of_q ~round Q.(199 // 100)) in
+  (* round down *)
+  let* () =
+    assert_equal_q ~loc:__LOC__ Q.(777 // 10000) (of_q ~round Q.(777 // 9999))
+  in
+  (* round up *)
+  let* () =
+    assert_equal_q
+      ~loc:__LOC__
+      Q.(778 // 10000)
+      (of_q ~round:`Up Q.(777 // 9999))
+  in
+
+  (* precision *)
+  let* () = assert_equal_q ~loc:__LOC__ Q.zero (of_q ~round Q.(1 // 10001)) in
+  let* () =
+    assert_equal_q ~loc:__LOC__ Q.(1 // 10000) (of_q ~round Q.(1 // 10000))
+  in
+  let* () =
+    assert_equal_q ~loc:__LOC__ Q.(1 // 10000) (of_q ~round:`Up Q.(1 // 10001))
+  in
+  (* no overflow *)
+  let big_z = Z.of_int64 9131138316486228048L in
+  let* () =
+    assert_equal_q ~loc:__LOC__ Q.one (of_q ~round Q.(big_z /// Z.one))
+  in
+  return_unit
+
 let tests =
   Tztest.
     [
@@ -108,6 +164,8 @@ let tests =
       tztest "Test neg" `Quick test_neg;
       tztest "Test bounded" `Quick test_bounded;
       tztest "Test mul_percentage" `Quick test_mul_percentage;
+      tztest "Test mul" `Quick test_mul;
+      tztest "Test of_q" `Quick test_of_q;
     ]
 
 let () =
-- 
GitLab


From 275620d828f02421253a8d186cddfefc8ccc8ac5 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 1 Feb 2024 14:50:32 +0100
Subject: [PATCH 13/16] Proto/tests: reset regressions

---
 ...ha- (mode client) RPC regression tests- misc_protocol.out | 5 +++--
 ...pha- (mode light) RPC regression tests- misc_protocol.out | 5 +++--
 ...pha- (mode proxy) RPC regression tests- misc_protocol.out | 5 +++--
 ..._server_data_dir) RPC regression tests- misc_protocol.out | 5 +++--
 ...proxy_server_rpc) RPC regression tests- misc_protocol.out | 5 +++--
 5 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/tezt/tests/expected/RPC_test.ml/Alpha- (mode client) RPC regression tests- misc_protocol.out b/tezt/tests/expected/RPC_test.ml/Alpha- (mode client) RPC regression tests- misc_protocol.out
index 305e5e95a3da..d8135ede97b1 100644
--- a/tezt/tests/expected/RPC_test.ml/Alpha- (mode client) RPC regression tests- misc_protocol.out	
+++ b/tezt/tests/expected/RPC_test.ml/Alpha- (mode client) RPC regression tests- misc_protocol.out	
@@ -31,8 +31,9 @@
   "consensus_threshold": 0,
   "minimal_participation_ratio": { "numerator": 2, "denominator": 3 },
   "limit_of_delegation_over_baking": 19,
-  "percentage_of_frozen_deposits_slashed_per_double_baking": 5,
-  "percentage_of_frozen_deposits_slashed_per_double_attestation": 50,
+  "percentage_of_frozen_deposits_slashed_per_double_baking": 500,
+  "percentage_of_frozen_deposits_slashed_per_double_attestation": 5000,
+  "max_slashing_per_block": 10000, "max_slashing_threshold": 86,
   "cache_script_size": 100000000, "cache_stake_distribution_cycles": 8,
   "cache_sampler_state_cycles": 8,
   "dal_parametric":
diff --git a/tezt/tests/expected/RPC_test.ml/Alpha- (mode light) RPC regression tests- misc_protocol.out b/tezt/tests/expected/RPC_test.ml/Alpha- (mode light) RPC regression tests- misc_protocol.out
index 9a22690a671d..45fa33e0a8ff 100644
--- a/tezt/tests/expected/RPC_test.ml/Alpha- (mode light) RPC regression tests- misc_protocol.out	
+++ b/tezt/tests/expected/RPC_test.ml/Alpha- (mode light) RPC regression tests- misc_protocol.out	
@@ -31,8 +31,9 @@
   "consensus_threshold": 0,
   "minimal_participation_ratio": { "numerator": 2, "denominator": 3 },
   "limit_of_delegation_over_baking": 19,
-  "percentage_of_frozen_deposits_slashed_per_double_baking": 5,
-  "percentage_of_frozen_deposits_slashed_per_double_attestation": 50,
+  "percentage_of_frozen_deposits_slashed_per_double_baking": 500,
+  "percentage_of_frozen_deposits_slashed_per_double_attestation": 5000,
+  "max_slashing_per_block": 10000, "max_slashing_threshold": 86,
   "cache_script_size": 100000000, "cache_stake_distribution_cycles": 8,
   "cache_sampler_state_cycles": 8,
   "dal_parametric":
diff --git a/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy) RPC regression tests- misc_protocol.out b/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy) RPC regression tests- misc_protocol.out
index 15a3f8f6b6d4..36e4b18f568a 100644
--- a/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy) RPC regression tests- misc_protocol.out	
+++ b/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy) RPC regression tests- misc_protocol.out	
@@ -31,8 +31,9 @@
   "consensus_threshold": 0,
   "minimal_participation_ratio": { "numerator": 2, "denominator": 3 },
   "limit_of_delegation_over_baking": 19,
-  "percentage_of_frozen_deposits_slashed_per_double_baking": 5,
-  "percentage_of_frozen_deposits_slashed_per_double_attestation": 50,
+  "percentage_of_frozen_deposits_slashed_per_double_baking": 500,
+  "percentage_of_frozen_deposits_slashed_per_double_attestation": 5000,
+  "max_slashing_per_block": 10000, "max_slashing_threshold": 86,
   "cache_script_size": 100000000, "cache_stake_distribution_cycles": 8,
   "cache_sampler_state_cycles": 8,
   "dal_parametric":
diff --git a/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_data_dir) RPC regression tests- misc_protocol.out b/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_data_dir) RPC regression tests- misc_protocol.out
index 5d43abbe2957..ee32b3da1c7f 100644
--- a/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_data_dir) RPC regression tests- misc_protocol.out	
+++ b/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_data_dir) RPC regression tests- misc_protocol.out	
@@ -31,8 +31,9 @@
   "consensus_threshold": 0,
   "minimal_participation_ratio": { "numerator": 2, "denominator": 3 },
   "limit_of_delegation_over_baking": 19,
-  "percentage_of_frozen_deposits_slashed_per_double_baking": 5,
-  "percentage_of_frozen_deposits_slashed_per_double_attestation": 50,
+  "percentage_of_frozen_deposits_slashed_per_double_baking": 500,
+  "percentage_of_frozen_deposits_slashed_per_double_attestation": 5000,
+  "max_slashing_per_block": 10000, "max_slashing_threshold": 86,
   "cache_script_size": 100000000, "cache_stake_distribution_cycles": 8,
   "cache_sampler_state_cycles": 8,
   "dal_parametric":
diff --git a/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_rpc) RPC regression tests- misc_protocol.out b/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_rpc) RPC regression tests- misc_protocol.out
index 5d43abbe2957..ee32b3da1c7f 100644
--- a/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_rpc) RPC regression tests- misc_protocol.out	
+++ b/tezt/tests/expected/RPC_test.ml/Alpha- (mode proxy_server_rpc) RPC regression tests- misc_protocol.out	
@@ -31,8 +31,9 @@
   "consensus_threshold": 0,
   "minimal_participation_ratio": { "numerator": 2, "denominator": 3 },
   "limit_of_delegation_over_baking": 19,
-  "percentage_of_frozen_deposits_slashed_per_double_baking": 5,
-  "percentage_of_frozen_deposits_slashed_per_double_attestation": 50,
+  "percentage_of_frozen_deposits_slashed_per_double_baking": 500,
+  "percentage_of_frozen_deposits_slashed_per_double_attestation": 5000,
+  "max_slashing_per_block": 10000, "max_slashing_threshold": 86,
   "cache_script_size": 100000000, "cache_stake_distribution_cycles": 8,
   "cache_sampler_state_cycles": 8,
   "dal_parametric":
-- 
GitLab


From 76c93d9ea23afb304bd80470daffcabc45294226 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Wed, 14 Feb 2024 16:05:15 +0100
Subject: [PATCH 14/16] Proto/tests: fix mockup tests

---
 tezt/tests/mockup.ml | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/tezt/tests/mockup.ml b/tezt/tests/mockup.ml
index 57b0f3bfb1ca..dec4ff3351b0 100644
--- a/tezt/tests/mockup.ml
+++ b/tezt/tests/mockup.ml
@@ -1184,10 +1184,15 @@ let test_create_mockup_config_show_init_roundtrip protocols =
     let constant_parametric_constants : JSON.t =
       JSON.annotate ~origin:"constant_parametric_constants"
       @@ `O
-           [
-             (* DO NOT EDIT the value consensus_threshold this is actually a constant, not a parameter *)
-             ("consensus_threshold", `Float 0.0);
-           ]
+           ((* DO NOT EDIT the value consensus_threshold this is actually a constant, not a parameter *)
+            ("consensus_threshold", `Float 0.0)
+           ::
+           (if Protocol.number protocol >= 019 then
+            [
+              (* Constraint: 0 <= max_slashing_per_block <= 10_000 *)
+              ("max_slashing_per_block", `Float 10_000.0);
+            ]
+           else []))
     in
     (* To fulfill the requirement that [blocks_per_epoch], present in protocols
        up to O, divides [blocks_per_cycle], we set [blocks_per_cycle] to 1, for
-- 
GitLab


From 00838ef52023c6b1c1c4721ccf00465ab4047a52 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Wed, 14 Feb 2024 14:13:34 +0100
Subject: [PATCH 15/16] Doc: update alpha changelog

---
 docs/protocols/alpha.rst | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst
index e9ebd75b4d5a..48e3a169edf8 100644
--- a/docs/protocols/alpha.rst
+++ b/docs/protocols/alpha.rst
@@ -84,6 +84,18 @@ Adaptive Issuance (ongoing)
   double bake/attest, by giving them some time to fix it. (MR
   :gl:`!11704`)
 
+- Denunciations are now applied in chronological order of the denounced
+  double signing events, instead of chronological order of denunciation
+  inclusion. (MR :gl:`!11854`)
+
+- Under the new slashing feature flag, the amount slashed for a double
+  attestation or pre-attestation depends on the number of slots owned
+  by misbehaving delegates in the exact block this double signing
+  event occurred. This greatly diminishes potential losses in cases of
+  legitimate accidents that do not threaten the chain, while keeping
+  a strong incentive against potential consensus attacks. (MR
+  :gl:`!11854`)
+
 - Activating adaptive issuance per-block vote (MR !11935)
 
 Gas improvements
-- 
GitLab


From 27c8bdb91db06555b4f2dcb2c26eee7085be5e27 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 15 Feb 2024 10:17:06 +0100
Subject: [PATCH 16/16] Proto: ensure delegate only appears once in denounced

Keep first denunciation in case of conflict.
Works regardless of Validate's invariants.
---
 .../delegate_slashed_deposits_storage.ml      | 20 ++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

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 e39c07919340..3d44b1ccb504 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -225,8 +225,19 @@ let apply_and_clear_denunciations ctxt =
               MisMap.update
                 denunciation.Denunciations_repr.misbehaviour
                 (function
-                  | None -> Some [(delegate, denunciation)]
-                  | Some l -> Some ((delegate, denunciation) :: l))
+                  | None ->
+                      Some
+                        (Signature.Public_key_hash.Map.singleton
+                           delegate
+                           denunciation)
+                  | Some map ->
+                      Some
+                        (Signature.Public_key_hash.Map.update
+                           delegate
+                           (function
+                             | None -> Some denunciation
+                             | Some old_d -> Some old_d)
+                           map))
                 block_map)
             block_map
             denunciations_to_apply
@@ -239,7 +250,7 @@ let apply_and_clear_denunciations ctxt =
   let* ctxt, balance_updates =
     MisMap.fold_es
       (fun ({Misbehaviour_repr.level = raw_level; round = _; kind; _} as miskey)
-           denunciations
+           denunciations_map
            acc ->
         let ctxt, balance_updates = acc in
         let level =
@@ -248,6 +259,9 @@ let apply_and_clear_denunciations ctxt =
             raw_level
         in
         let misbehaviour_cycle = level.cycle in
+        let denunciations =
+          Signature.Public_key_hash.Map.bindings denunciations_map
+        in
         let denounced = List.map fst denunciations in
         let* ctxt, slashing_percentage =
           Slash_percentage.get ctxt ~kind ~level denounced
-- 
GitLab