From 02e8abeb2ffe4576c8e2cd778e293348ba5c3d77 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Mon, 20 Oct 2025 10:17:07 +0200
Subject: [PATCH 1/6] Proto/validate&apply: fix level used when considering a
 block's attestations

---
 src/proto_alpha/lib_protocol/apply.ml    | 25 ++++++++++++-------
 src/proto_alpha/lib_protocol/validate.ml | 31 +++++++++++++++---------
 2 files changed, 35 insertions(+), 21 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 0078267eca66..8b5f4d874905 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -3155,11 +3155,8 @@ let finalize_application ctxt block_data_contents ~round ~predecessor_hash
       (Gas.Arith.fp @@ Constants.hard_gas_limit_per_block ctxt)
       (Gas.block_level ctxt)
   in
-  let level = Level.current ctxt in
+  let current_level = Level.current ctxt in
   let attesting_power = Consensus.current_attesting_power ctxt in
-  let* required_attestations =
-    are_attestations_required ctxt ~level:level.level
-  in
   let block_payload_hash =
     Block_payload.hash
       ~predecessor_hash
@@ -3191,12 +3188,22 @@ let finalize_application ctxt block_data_contents ~round ~predecessor_hash
   in
   let* ctxt, dal_attestation = Dal_apply.finalisation ctxt in
   let* ctxt, reward_bonus =
+    let* required_attestations =
+      are_attestations_required ctxt ~level:current_level.level
+    in
     if required_attestations then
       let* ctxt = record_attesting_participation ctxt dal_attestation in
-      let* ctxt, rewards_bonus =
-        Baking.bonus_baking_reward ctxt level ~attesting_power
-      in
-      return (ctxt, Some rewards_bonus)
+      (* The attested level is the predecessor of the block's level. *)
+      match Level.pred ctxt current_level with
+      | None ->
+          (* This cannot happen because [required_attestations = true]
+             ensures that [current_level >= 2]. *)
+          assert false
+      | Some attested_level ->
+          let* ctxt, rewards_bonus =
+            Baking.bonus_baking_reward ctxt attested_level ~attesting_power
+          in
+          return (ctxt, Some rewards_bonus)
     else return (ctxt, None)
   in
   let*? baking_reward = Delegate.Rewards.baking_reward_fixed_portion ctxt in
@@ -3227,7 +3234,7 @@ let finalize_application ctxt block_data_contents ~round ~predecessor_hash
       {
         proposer = payload_producer;
         baker = block_producer;
-        level_info = level;
+        level_info = current_level;
         voting_period_info;
         nonce_hash = block_data_contents.seed_nonce_hash;
         consumed_gas;
diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index 666f3785c108..21fdd38dd53c 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -4031,18 +4031,25 @@ let check_attesting_power vi bs =
     return Compare.Int32.(level_position_in_protocol > 1l)
   in
   if are_attestations_required then
-    (* We can safely drop the context: it is only updated for the cache of
-       the stake info for a given level, which should already be cached
-       at this time anyways. *)
-    let* _ctxt, required =
-      Attesting_power.consensus_threshold vi.ctxt vi.current_level
-    in
-    let provided =
-      Attesting_power.get vi.ctxt vi.current_level bs.attesting_power
-    in
-    fail_unless
-      Compare.Int64.(provided >= required)
-      (Not_enough_attestations {required; provided})
+    (* The attested level is the predecessor of the block's level. *)
+    match Level.pred vi.ctxt vi.current_level with
+    | None ->
+        (* This cannot happen because [required_attestations = true]
+           ensures that [vi.current_level >= 2]. *)
+        assert false
+    | Some attested_level ->
+        (* We can safely drop the context: it is only updated for the
+           cache of the stake info for a given level, which should
+           already be cached at this time anyways. *)
+        let* _ctxt, required =
+          Attesting_power.consensus_threshold vi.ctxt attested_level
+        in
+        let provided =
+          Attesting_power.get vi.ctxt attested_level bs.attesting_power
+        in
+        fail_unless
+          Compare.Int64.(provided >= required)
+          (Not_enough_attestations {required; provided})
   else return_unit
 
 (** Check that the locked round in the fitness and the locked round
-- 
GitLab


From b8490fca598ce74c3267394e964862cd12b00f24 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Mon, 20 Oct 2025 10:22:17 +0200
Subject: [PATCH 2/6] Proto: introduce is_all_bakers_attest_enabled_for_cycle

for when we are considering a whole cycle rather than a single level
---
 .../lib_protocol/consensus_parameters_storage.ml     |  7 +++++++
 .../lib_protocol/consensus_parameters_storage.mli    | 12 ++++++++++++
 src/proto_alpha/lib_protocol/delegate_cycles.ml      |  8 ++------
 .../delegate_missed_attestations_storage.ml          | 12 ++++--------
 4 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml b/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml
index e4502d20b82d..9183c458a56c 100644
--- a/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml
+++ b/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml
@@ -38,3 +38,10 @@ let consensus_threshold ctxt level =
   else
     return
       (ctxt, Int64.of_int @@ Constants_storage.consensus_threshold_size ctxt)
+
+let is_all_bakers_attest_enabled_for_cycle ctxt cycle =
+  let cycle_eras = Raw_context.cycle_eras ctxt in
+  let first_level_of_cycle =
+    Level_repr.first_level_in_cycle_from_eras ~cycle_eras cycle
+  in
+  check_all_bakers_attest_at_level ctxt first_level_of_cycle
diff --git a/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli b/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli
index 4c0589517090..60c78c6d27cc 100644
--- a/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli
+++ b/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli
@@ -14,3 +14,15 @@ val consensus_threshold :
 
 val consensus_committee :
   Raw_context.t -> Level_repr.t -> (Raw_context.t * int64) tzresult Lwt.t
+
+(** Returns true IFF the first level of the given cycle is greater
+    than or equal to the activation level of all-bakers-attest.
+
+    This is used by some mechanisms that must do something consistent
+    accross the whole cycle, such as cycle rewards or missed
+    attestations tracking.
+
+    Remark: the activation level will always be set to the first level
+    of a cycle anyway. *)
+val is_all_bakers_attest_enabled_for_cycle :
+  Raw_context.t -> Cycle_repr.t -> bool
diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml
index 2a0bdad18cf4..a666a47b9b40 100644
--- a/src/proto_alpha/lib_protocol/delegate_cycles.ml
+++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml
@@ -132,14 +132,10 @@ let maybe_distribute_dal_attesting_rewards ctxt delegate ~gets_consensus_rewards
 (* This includes DAL rewards. *)
 let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces =
   let open Lwt_result_syntax in
-  let cycle_eras = Raw_context.cycle_eras ctxt in
-  let first_level =
-    Level_repr.first_level_in_cycle_from_eras ~cycle_eras last_cycle
-  in
   let all_bakers_attest_enabled =
-    Consensus_parameters_storage.check_all_bakers_attest_at_level
+    Consensus_parameters_storage.is_all_bakers_attest_enabled_for_cycle
       ctxt
-      first_level
+      last_cycle
   in
   let*? attesting_reward_per_block =
     Delegate_rewards.attesting_reward_per_block ctxt
diff --git a/src/proto_alpha/lib_protocol/delegate_missed_attestations_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_attestations_storage.ml
index 38a9f2ef262d..77cac1481d93 100644
--- a/src/proto_alpha/lib_protocol/delegate_missed_attestations_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_missed_attestations_storage.ml
@@ -237,14 +237,10 @@ let check_and_reset_delegate_participation ctxt delegate =
   | Some missed_attestations ->
       let*! ctxt = Storage.Contract.Missed_attestations.remove ctxt contract in
       let current_cycle = (Raw_context.current_level ctxt).cycle in
-      let cycle_eras = Raw_context.cycle_eras ctxt in
-      let first_level_of_cycle =
-        Level_repr.first_level_in_cycle_from_eras ~cycle_eras current_cycle
-      in
       let all_bakers_attest_enabled =
-        Consensus_parameters_storage.check_all_bakers_attest_at_level
+        Consensus_parameters_storage.is_all_bakers_attest_enabled_for_cycle
           ctxt
-          first_level_of_cycle
+          current_cycle
       in
       if all_bakers_attest_enabled then
         let Ratio_repr.{numerator; denominator} =
@@ -339,9 +335,9 @@ module For_RPC = struct
           Delegate_rewards.attesting_reward_per_block ctxt
         in
         let all_bakers_attest_enabled =
-          Consensus_parameters_storage.check_all_bakers_attest_at_level
+          Consensus_parameters_storage.is_all_bakers_attest_enabled_for_cycle
             ctxt
-            level
+            level.cycle
         in
         let minimal_cycle_activity =
           expected_cycle_activity * numerator / denominator
-- 
GitLab


From 227446fcb8878c3209b3cbdd8d6fe93375598900 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Mon, 20 Oct 2025 10:52:25 +0200
Subject: [PATCH 3/6] Proto: pass full misbehaviour to Slash_percentage.get

to avoid having to determine which level and round to pass
---
 .../delegate_slashed_deposits_storage.ml      | 27 ++++++-------------
 .../lib_protocol/slash_percentage.ml          | 17 +++++++-----
 .../lib_protocol/slash_percentage.mli         | 21 ++++++++-------
 .../test/helpers/slashing_helpers.ml          | 10 ++-----
 4 files changed, 32 insertions(+), 43 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 6feec642dee8..ef3f6dc8ef64 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -198,23 +198,16 @@ let apply_block_denunciations ctxt current_cycle block_denunciations_map =
     Constants_storage.adaptive_issuance_global_limit_of_staking_over_baking ctxt
   in
   MisMap.fold_es
-    (fun ({Misbehaviour_repr.level = raw_level; round = _; kind; _} as miskey)
-         denunciations_map
-         acc
-       ->
+    (fun miskey denunciations_map acc ->
       let ctxt, balance_updates = acc in
-      let misbehaviour_level =
-        Level_repr.level_from_raw
-          ~cycle_eras:(Raw_context.cycle_eras ctxt)
-          raw_level
-      in
+      let misbehaviour_level = Level_storage.from_raw ctxt miskey.level in
       let misbehaviour_cycle = misbehaviour_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:misbehaviour_level denounced
+        Slash_percentage.get ctxt miskey denounced
       in
       let+ ctxt, balance_updates =
         List.fold_left_es
@@ -508,8 +501,7 @@ module For_RPC = struct
         let*! pending_misbehaviour_map = get_pending_misbehaviour_map ctxt in
         List.fold_left_es
           (fun estimated_punishing_amount denunciation ->
-            let ({Misbehaviour_repr.level = raw_level; kind; _} as
-                 misbehaviour_key) =
+            let misbehaviour_key =
               denunciation.Denunciations_repr.misbehaviour
             in
             match MisMap.find misbehaviour_key pending_misbehaviour_map with
@@ -519,20 +511,17 @@ module For_RPC = struct
                    [denunciation] belongs to [Storage.Pending_denunciations]. *)
                 return estimated_punishing_amount
             | Some denunciations ->
-                let level =
-                  Level_repr.level_from_raw
-                    ~cycle_eras:(Raw_context.cycle_eras ctxt)
-                    raw_level
-                in
                 let denounced_pkhs =
                   List.map
                     fst
                     (Signature.Public_key_hash.Map.bindings denunciations)
                 in
                 let* ctxt, slashing_percentage =
-                  Slash_percentage.get ctxt ~kind ~level denounced_pkhs
+                  Slash_percentage.get ctxt misbehaviour_key denounced_pkhs
+                in
+                let misbehaviour_cycle =
+                  (Level_storage.from_raw ctxt misbehaviour_key.level).cycle
                 in
-                let misbehaviour_cycle = level.cycle in
                 let* frozen_deposits =
                   (* We ignore the context because this function is only used for RPCs *)
                   let* _ctxt, initial_amount =
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.ml b/src/proto_alpha/lib_protocol/slash_percentage.ml
index ac9559847625..c0da5a4fadcd 100644
--- a/src/proto_alpha/lib_protocol/slash_percentage.ml
+++ b/src/proto_alpha/lib_protocol/slash_percentage.ml
@@ -39,20 +39,25 @@ let for_double_attestation ctxt ~committee_size rights denounced =
     let den_z = Z.(pow (of_int64 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 : Level_repr.t)
-    (denounced : Signature.public_key_hash list) =
+let get ctxt misbehaviour (denounced : Signature.public_key_hash list) =
   let open Lwt_result_syntax in
-  match kind with
+  match misbehaviour.Misbehaviour_repr.kind with
   | Double_baking -> return (ctxt, for_double_baking ctxt)
   | Double_attesting | Double_preattesting ->
+      let misbehaviour_level = Level_storage.from_raw ctxt misbehaviour.level in
       let all_bakers_attest_enabled =
-        Consensus_parameters_storage.check_all_bakers_attest_at_level ctxt level
+        Consensus_parameters_storage.check_all_bakers_attest_at_level
+          ctxt
+          misbehaviour_level
       in
       let* ctxt, rights =
-        Delegate_sampler.attesting_power ~all_bakers_attest_enabled ctxt level
+        Delegate_sampler.attesting_power
+          ~all_bakers_attest_enabled
+          ctxt
+          misbehaviour_level
       in
       let* ctxt, committee_size =
-        Consensus_parameters_storage.consensus_committee ctxt level
+        Consensus_parameters_storage.consensus_committee ctxt misbehaviour_level
       in
       return (ctxt, for_double_attestation ctxt ~committee_size rights denounced)
 
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.mli b/src/proto_alpha/lib_protocol/slash_percentage.mli
index e450c13b7621..cae1ac90bea7 100644
--- a/src/proto_alpha/lib_protocol/slash_percentage.mli
+++ b/src/proto_alpha/lib_protocol/slash_percentage.mli
@@ -5,19 +5,20 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(** [get ctxt ~kind ~level denounced] returns the percentage that needs to be
-    applied for the given misbehaviour.
+(** [get ctxt misbehaviour denounced] returns the percentage that
+    needs to be applied for the given [misbehaviour].
 
-    [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] . *)
+    [denounced] is the list of delegates that have been denounced
+    together for the same level, round, and {!Misbehaviour_repr.kind}
+    as the [misbehaviour]. 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 ->
+  Misbehaviour_repr.t ->
   Signature.public_key_hash list ->
   (Raw_context.t * Percentage.t) tzresult Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/test/helpers/slashing_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/slashing_helpers.ml
index 17593d655867..ac5b76e891c4 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/slashing_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/slashing_helpers.ml
@@ -5,18 +5,12 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-let slashing_percentage ~block_before_slash
-    {Protocol.Misbehaviour_repr.level; round = _; kind} ~all_culprits =
+let slashing_percentage ~block_before_slash misbehaviour ~all_culprits =
   let open Lwt_result_wrap_syntax in
   let* ctxt = Block.get_alpha_ctxt block_before_slash in
   let raw_ctxt = Protocol.Alpha_context.Internal_for_tests.to_raw ctxt in
-  let level =
-    Protocol.Level_repr.level_from_raw
-      ~cycle_eras:(Protocol.Raw_context.cycle_eras raw_ctxt)
-      level
-  in
   let*@ _, slashing_pct =
-    Protocol.Slash_percentage.get raw_ctxt ~kind ~level all_culprits
+    Protocol.Slash_percentage.get raw_ctxt misbehaviour all_culprits
   in
   return slashing_pct
 
-- 
GitLab


From 6c86f894246c3e8e3bb10009c1e85e7560dcae4f Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Mon, 20 Oct 2025 11:05:40 +0200
Subject: [PATCH 4/6] Proto: pass full misbehaviour to
 Already_denounced_storage functions

to avoid having to determine which level and round to pass
---
 src/proto_alpha/lib_protocol/alpha_context.mli         |  8 +-------
 .../lib_protocol/already_denounced_storage.ml          |  6 ++++--
 .../lib_protocol/already_denounced_storage.mli         |  8 ++------
 src/proto_alpha/lib_protocol/apply.ml                  |  5 +----
 .../lib_protocol/delegate_slashed_deposits_storage.ml  | 10 ++--------
 .../lib_protocol/delegate_slashed_deposits_storage.mli |  1 -
 src/proto_alpha/lib_protocol/validate.ml               |  8 ++++++--
 7 files changed, 16 insertions(+), 30 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index acb01c813672..4642be2bc37c 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2361,12 +2361,7 @@ module Delegate : sig
 
   (** See {!Already_denounced_storage.already_denounced}. *)
   val already_denounced :
-    context ->
-    public_key_hash ->
-    Level.t ->
-    Round.t ->
-    Misbehaviour.kind ->
-    bool tzresult Lwt.t
+    context -> public_key_hash -> Misbehaviour.t -> bool tzresult Lwt.t
 
   type reward_and_burn = {reward : Tez.t; amount_to_burn : Tez.t}
 
@@ -2381,7 +2376,6 @@ module Delegate : sig
     operation_hash:Operation_hash.t ->
     Misbehaviour.t ->
     public_key_hash ->
-    Level.t ->
     rewarded:public_key_hash ->
     context tzresult Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.ml b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
index ccafdb900b8f..a020bbe86d54 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.ml
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.ml
@@ -21,8 +21,9 @@ let already_denounced_aux ctxt delegate (level : Level_repr.t) round kind =
   | Some denounced, Double_attesting -> return denounced.for_double_attesting
   | Some denounced, Double_baking -> return denounced.for_double_baking
 
-let already_denounced ctxt delegate level round kind =
+let already_denounced ctxt delegate {Misbehaviour_repr.level; round; kind} =
   let open Lwt_result_syntax in
+  let level = Level_storage.from_raw ctxt level in
   let* answer = already_denounced_aux ctxt delegate level round kind in
   if answer || Round_repr.(round = zero) then return answer
   else
@@ -48,8 +49,9 @@ let already_denounced ctxt delegate level round kind =
          protocol Q. *)
       already_denounced_aux ctxt delegate level Round_repr.zero kind
 
-let add_denunciation ctxt delegate (level : Level_repr.t) round kind =
+let add_denunciation ctxt delegate {Misbehaviour_repr.level; round; kind} =
   let open Lwt_result_syntax in
+  let level = Level_storage.from_raw ctxt level in
   let* denounced_opt =
     Storage.Already_denounced.find
       (ctxt, level.cycle)
diff --git a/src/proto_alpha/lib_protocol/already_denounced_storage.mli b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
index ca133b01ae5a..75e79ee7b59c 100644
--- a/src/proto_alpha/lib_protocol/already_denounced_storage.mli
+++ b/src/proto_alpha/lib_protocol/already_denounced_storage.mli
@@ -28,9 +28,7 @@
 val already_denounced :
   Raw_context.t ->
   Signature.Public_key_hash.t ->
-  Level_repr.t ->
-  Round_repr.t ->
-  Misbehaviour_repr.kind ->
+  Misbehaviour_repr.t ->
   bool tzresult Lwt.t
 
 (** Records a denunciation in {!Storage.Already_denounced}.
@@ -50,9 +48,7 @@ val already_denounced :
 val add_denunciation :
   Raw_context.t ->
   Signature.public_key_hash ->
-  Level_repr.t ->
-  Round_repr.t ->
-  Misbehaviour_repr.kind ->
+  Misbehaviour_repr.t ->
   (Raw_context.t * bool) tzresult Lwt.t
 
 (** Clear {!Storage.Already_denounced} for old cycles that we no
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 8b5f4d874905..0c2d4fc83d1e 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -2514,7 +2514,7 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode
   in
   return (ctxt, contents_result_list)
 
-let punish_double_signing ctxt ~operation_hash delegate level misbehaviour
+let punish_double_signing ctxt ~operation_hash delegate misbehaviour
     ~payload_producer =
   let open Lwt_result_syntax in
   let rewarded_delegate = payload_producer.Consensus_key.delegate in
@@ -2524,7 +2524,6 @@ let punish_double_signing ctxt ~operation_hash delegate level misbehaviour
       ~operation_hash
       misbehaviour
       delegate
-      level
       ~rewarded:rewarded_delegate
   in
   let contents_result =
@@ -2557,7 +2556,6 @@ let punish_double_consensus_operation ctxt ~operation_hash ~payload_producer
       ctxt
       ~operation_hash
       delegate
-      level
       misbehaviour
       ~payload_producer
   in
@@ -2581,7 +2579,6 @@ let punish_double_baking ctxt ~operation_hash (bh1 : Block_header.t)
       ctxt
       ~operation_hash
       delegate
-      level
       {level = raw_level; round; kind = Double_baking}
       ~payload_producer
   in
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 ef3f6dc8ef64..84a2b844593d 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -43,16 +43,10 @@ let record_denunciation ctxt ~operation_hash
     ~rewarded_delegate:rewarded
     misbehaviour
 
-let punish_double_signing ctxt ~operation_hash misbehaviour delegate
-    (level : Level_repr.t) ~rewarded =
+let punish_double_signing ctxt ~operation_hash misbehaviour delegate ~rewarded =
   let open Lwt_result_syntax in
   let* ctxt, was_already_denounced =
-    Already_denounced_storage.add_denunciation
-      ctxt
-      delegate
-      level
-      misbehaviour.Misbehaviour_repr.round
-      misbehaviour.kind
+    Already_denounced_storage.add_denunciation ctxt delegate misbehaviour
   in
   if was_already_denounced then
     (* This can only happen in the very specific case where a delegate
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 02e0705ade68..37d6bc50eba6 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -64,7 +64,6 @@ val punish_double_signing :
   operation_hash:Operation_hash.t ->
   Misbehaviour_repr.t ->
   Signature.Public_key_hash.t ->
-  Level_repr.t ->
   rewarded:Signature.public_key_hash ->
   Raw_context.t tzresult Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index 21fdd38dd53c..aed577ac8bbc 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -2101,6 +2101,7 @@ module Anonymous = struct
         && Round.(round = round2))
         (Invalid_denunciation kind)
     in
+    let misbehaviour = {Misbehaviour.level; round; kind} in
     let*? () =
       (* Both denounced operations must involve [slot]. That is,
          they must be either a standalone (pre)attestation for [slot],
@@ -2170,7 +2171,7 @@ module Anonymous = struct
     in
     let delegate = consensus_key.delegate in
     let* already_slashed =
-      Delegate.already_denounced ctxt delegate level round kind
+      Delegate.already_denounced ctxt delegate misbehaviour
     in
     let*? () =
       error_unless
@@ -2266,6 +2267,9 @@ module Anonymous = struct
         (Invalid_double_baking_evidence
            {hash1; level1; round1; hash2; level2; round2})
     in
+    let misbehaviour =
+      {Misbehaviour.level = level1; round = round1; kind = Double_baking}
+    in
     let*? () =
       check_denunciation_age
         vi
@@ -2289,7 +2293,7 @@ module Anonymous = struct
     in
     let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in
     let* already_slashed =
-      Delegate.already_denounced ctxt delegate level round1 Double_baking
+      Delegate.already_denounced ctxt delegate misbehaviour
     in
     let*? () =
       error_unless
-- 
GitLab


From 8552350109fb7b3fc5a543a162a279302d8df183 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Fri, 17 Oct 2025 17:17:06 +0200
Subject: [PATCH 5/6] Proto: introduce ~attested_level label to force each
 caller

to carefully consider which level to provide when checking
ABAAB activation level
---
 src/proto_alpha/lib_plugin/RPC.ml             | 31 ++++---
 src/proto_alpha/lib_plugin/mempool.ml         | 14 ++--
 src/proto_alpha/lib_protocol/alpha_context.ml | 12 +--
 .../lib_protocol/alpha_context.mli            | 32 ++++++--
 src/proto_alpha/lib_protocol/apply.ml         | 25 ++++--
 src/proto_alpha/lib_protocol/baking.ml        | 32 +++++---
 src/proto_alpha/lib_protocol/baking.mli       | 12 ++-
 .../consensus_parameters_storage.ml           | 18 ++---
 .../consensus_parameters_storage.mli          | 60 ++++++++++++--
 src/proto_alpha/lib_protocol/main.ml          |  8 +-
 .../lib_protocol/slash_percentage.ml          |  6 +-
 .../integration/consensus/test_aggregate.ml   | 81 ++++++++-----------
 src/proto_alpha/lib_protocol/validate.ml      | 33 +++++---
 13 files changed, 234 insertions(+), 130 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml
index 17a4e84380e3..e228a632c941 100644
--- a/src/proto_alpha/lib_plugin/RPC.ml
+++ b/src/proto_alpha/lib_plugin/RPC.ml
@@ -3863,9 +3863,11 @@ module Attestation_rights = struct
         attestation_path
   end
 
-  let attestation_rights_at_level ctxt level =
+  let attestation_rights_at_level ctxt attested_level =
     let open Lwt_result_syntax in
-    let* ctxt, rights = Baking.attesting_rights_by_first_slot ctxt level in
+    let* ctxt, rights =
+      Baking.attesting_rights_by_first_slot ctxt ~attested_level
+    in
     let* current_round = Round.get ctxt in
     let current_level = Level.current ctxt in
     let current_timestamp = Timestamp.current ctxt in
@@ -3876,7 +3878,7 @@ module Attestation_rights = struct
         ~current_level
         ~current_round
         ~current_timestamp
-        ~level
+        ~level:attested_level
         ~round:Round.zero
     in
     let rights =
@@ -3910,7 +3912,12 @@ module Attestation_rights = struct
     in
     (* returns the ctxt with an updated cache of slot holders *)
     return
-      (ctxt, {level = level.level; delegates_rights = rights; estimated_time})
+      ( ctxt,
+        {
+          level = attested_level.level;
+          delegates_rights = rights;
+          estimated_time;
+        } )
 
   let get_attestation_rights ctxt (q : S.attestation_rights_query) =
     let open Lwt_result_syntax in
@@ -4069,9 +4076,9 @@ module Validators = struct
         path
   end
 
-  let attestation_slots_at_level ctxt level =
+  let attestation_slots_at_level ctxt attested_level =
     let open Lwt_result_syntax in
-    let* ctxt, rights = Baking.attesting_rights ctxt level in
+    let* ctxt, rights = Baking.attesting_rights ctxt ~attested_level in
     let aggregate_attestation = Constants.aggregate_attestation ctxt in
     return
       ( ctxt,
@@ -4112,18 +4119,20 @@ module Validators = struct
         in
         let+ _ctxt, rights =
           List.fold_left_es
-            (fun (ctxt, acc) level ->
+            (fun (ctxt, acc) attested_level ->
               let* ctxt, consensus_threshold =
-                Attesting_power.consensus_threshold ctxt level
+                Attesting_power.consensus_threshold ctxt ~attested_level
               in
               let* ctxt, consensus_committee =
-                Attesting_power.consensus_committee ctxt level
+                Attesting_power.consensus_committee ctxt ~attested_level
+              in
+              let* ctxt, delegates =
+                attestation_slots_at_level ctxt attested_level
               in
-              let* ctxt, delegates = attestation_slots_at_level ctxt level in
               return
                 ( ctxt,
                   ( {
-                      level = level.level;
+                      level = attested_level.level;
                       consensus_threshold;
                       consensus_committee;
                       delegates = [];
diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml
index 903a0668e1d2..58fa927f2602 100644
--- a/src/proto_alpha/lib_plugin/mempool.ml
+++ b/src/proto_alpha/lib_plugin/mempool.ml
@@ -822,9 +822,11 @@ let get_context context ~(head : Tezos_base.Block_header.shell_header) =
   in
   return ctxt
 
-let sources_from_level_and_slot ctxt level slot =
+let sources_from_level_and_slot ctxt ~attested_level slot =
   let open Lwt_syntax in
-  let* slot_owner = Stake_distribution.attestation_slot_owner ctxt level slot in
+  let* slot_owner =
+    Stake_distribution.attestation_slot_owner ctxt ~attested_level slot
+  in
   match slot_owner with
   | Ok
       ( _ctxt,
@@ -841,10 +843,10 @@ let sources_from_level_and_slot ctxt level slot =
 let sources_from_aggregate ctxt
     (consensus_content : consensus_aggregate_content) slots =
   let open Lwt_syntax in
-  let level = Level.from_raw ctxt consensus_content.level in
+  let attested_level = Level.from_raw ctxt consensus_content.level in
   Lwt_list.fold_left_s
     (fun acc slot ->
-      let* sources = sources_from_level_and_slot ctxt level slot in
+      let* sources = sources_from_level_and_slot ctxt ~attested_level slot in
       return (sources @ acc))
     []
     slots
@@ -857,8 +859,8 @@ let sources_from_operation ctxt
   | Single (Failing_noop _) -> return_nil
   | Single (Preattestation consensus_content)
   | Single (Attestation {consensus_content; dal_content = _}) ->
-      let level = Level.from_raw ctxt consensus_content.level in
-      sources_from_level_and_slot ctxt level consensus_content.slot
+      let attested_level = Level.from_raw ctxt consensus_content.level in
+      sources_from_level_and_slot ctxt ~attested_level consensus_content.slot
   | Single (Preattestations_aggregate {consensus_content; committee}) ->
       sources_from_aggregate ctxt consensus_content committee
   | Single (Attestations_aggregate {consensus_content; committee}) ->
diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml
index 383d61425c1f..81aa581aa3cf 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -656,14 +656,16 @@ end
 module Stake_distribution = struct
   let baking_rights_owner = Delegate_sampler.baking_rights_owner
 
-  let attestation_slot_owner ctxt level slot =
+  let attestation_slot_owner ctxt ~attested_level slot =
     let all_bakers_attest_enabled =
-      Consensus_parameters_storage.check_all_bakers_attest_at_level ctxt level
+      Consensus_parameters_storage.check_all_bakers_attest_at_level
+        ctxt
+        ~attested_level
     in
     Delegate_sampler.attestation_slot_owner
       ~all_bakers_attest_enabled
       ctxt
-      level
+      attested_level
       slot
 
   let stake_info_for_cycle = Delegate_sampler.stake_info_for_cycle
@@ -713,9 +715,9 @@ module Attesting_power = struct
   include Attesting_power_repr
   include Consensus_parameters_storage
 
-  let get ctxt level {slots; stake} =
+  let get ctxt ~attested_level {slots; stake} =
     let all_bakers_attest_enabled =
-      check_all_bakers_attest_at_level ctxt level
+      check_all_bakers_attest_at_level ctxt ~attested_level
     in
     if all_bakers_attest_enabled then stake else Int64.of_int slots
 
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 4642be2bc37c..88f4cde6ab03 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2264,17 +2264,26 @@ module Attesting_power : sig
 
   val add : t -> t -> t
 
-  val get : context -> Level.t -> t -> int64
+  (** Numerical value for the attesting power: either number of slots
+      or baking power, depending on whether all-bakers-attest is
+      already active at the [attested_level]. *)
+  val get : context -> attested_level:Level.t -> t -> int64
 
   val get_slots : t -> int
 
-  val check_all_bakers_attest_at_level : context -> Level.t -> bool
+  val check_all_bakers_attest_at_level :
+    context -> attested_level:Level.t -> bool
 
+  (** See {!Consensus_parameters_storage.is_all_bakers_attest_enabled_for_cycle}. *)
+  val is_all_bakers_attest_enabled_for_cycle : context -> Cycle.t -> bool
+
+  (** See {!Consensus_parameters_storage.consensus_threshold}. *)
   val consensus_threshold :
-    context -> Level.t -> (context * int64) tzresult Lwt.t
+    context -> attested_level:Level.t -> (context * int64) tzresult Lwt.t
 
+  (** See {!Consensus_parameters_storage.consensus_committee}. *)
   val consensus_committee :
-    context -> Level.t -> (context * int64) tzresult Lwt.t
+    context -> attested_level:Level.t -> (context * int64) tzresult Lwt.t
 end
 
 (** This module re-exports definitions from {!Delegate_consensus_key}. *)
@@ -5300,8 +5309,21 @@ module Stake_distribution : sig
     round:Round.t ->
     (context * Slot.t * Consensus_key.pk) tzresult Lwt.t
 
+  (** Which delegate owns the given slot at the [attested_level].
+
+      If all-bakers-attest is not yet active at the [attested_level],
+      the slot is considered a Tenderbake slot (out of 7000 on
+      mainnet) and its owner is the delegate sampled for this slot.
+
+      If all-bakers-attest is active at the [attested_level], the
+      owner is the delegate whose index in
+      {!Delegate_sampler.stake_info_for_cycle} is the provided
+      slot. *)
   val attestation_slot_owner :
-    context -> Level.t -> Slot.t -> (context * Consensus_key.pk) tzresult Lwt.t
+    context ->
+    attested_level:Level.t ->
+    Slot.t ->
+    (context * Consensus_key.pk) tzresult Lwt.t
 
   val stake_info_for_cycle :
     context ->
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 0c2d4fc83d1e..6b33dff059af 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -2307,8 +2307,10 @@ let record_preattestation ctxt (mode : mode) (content : consensus_content) :
          preattestations), but we don't need to, because there is no block
          to finalize anyway in this mode. *)
       let* ctxt, consensus_key =
-        let level = Level.from_raw ctxt content.level in
-        Stake_distribution.attestation_slot_owner ctxt level content.slot
+        Stake_distribution.attestation_slot_owner
+          ctxt
+          ~attested_level:(Level.from_raw ctxt content.level)
+          content.slot
       in
       return
         ( ctxt,
@@ -2362,8 +2364,10 @@ let record_attestation ctxt (mode : mode) (consensus : consensus_content)
          attestations), but we don't need to, because there is no block
          to finalize anyway in this mode. *)
       let* ctxt, consensus_key =
-        let level = Level.from_raw ctxt consensus.level in
-        Stake_distribution.attestation_slot_owner ctxt level consensus.slot
+        Stake_distribution.attestation_slot_owner
+          ctxt
+          ~attested_level:(Level.from_raw ctxt consensus.level)
+          consensus.slot
       in
       return
         ( ctxt,
@@ -2547,9 +2551,11 @@ let punish_double_consensus_operation ctxt ~operation_hash ~payload_producer
         | Attestations_aggregate {consensus_content = {level; round; _}; _} ) ->
         Misbehaviour.{level; round; kind = Double_attesting}
   in
-  let level = Level.from_raw ctxt misbehaviour.level in
   let* ctxt, {delegate; _} =
-    Stake_distribution.attestation_slot_owner ctxt level slot
+    Stake_distribution.attestation_slot_owner
+      ctxt
+      ~attested_level:(Level.from_raw ctxt misbehaviour.level)
+      slot
   in
   let* ctxt, contents_result =
     punish_double_signing
@@ -2661,7 +2667,10 @@ let apply_contents_list (type kind) ctxt chain_id (mode : mode)
       in
       let level = Level.from_raw ctxt level in
       let* ctxt, consensus_pk =
-        Stake_distribution.attestation_slot_owner ctxt level consensus_slot
+        Stake_distribution.attestation_slot_owner
+          ctxt
+          ~attested_level:level
+          consensus_slot
       in
       let delegate = consensus_pk.delegate in
       let*! ctxt, _already_denounced =
@@ -3198,7 +3207,7 @@ let finalize_application ctxt block_data_contents ~round ~predecessor_hash
           assert false
       | Some attested_level ->
           let* ctxt, rewards_bonus =
-            Baking.bonus_baking_reward ctxt attested_level ~attesting_power
+            Baking.bonus_baking_reward ctxt ~attested_level ~attesting_power
           in
           return (ctxt, Some rewards_bonus)
     else return (ctxt, None)
diff --git a/src/proto_alpha/lib_protocol/baking.ml b/src/proto_alpha/lib_protocol/baking.ml
index 1388bc3ea728..7cf362b2595f 100644
--- a/src/proto_alpha/lib_protocol/baking.ml
+++ b/src/proto_alpha/lib_protocol/baking.ml
@@ -56,14 +56,16 @@ let () =
     (fun (attesting_power, consensus_threshold) ->
       Insufficient_attesting_power {attesting_power; consensus_threshold})
 
-let bonus_baking_reward ctxt level ~attesting_power =
+let bonus_baking_reward ctxt ~attested_level ~attesting_power =
   let open Lwt_result_syntax in
-  let attesting_power = Attesting_power.get ctxt level attesting_power in
+  let attesting_power =
+    Attesting_power.get ctxt ~attested_level attesting_power
+  in
   let* ctxt, consensus_threshold =
-    Attesting_power.consensus_threshold ctxt level
+    Attesting_power.consensus_threshold ctxt ~attested_level
   in
   let* ctxt, consensus_committee =
-    Attesting_power.consensus_committee ctxt level
+    Attesting_power.consensus_committee ctxt ~attested_level
   in
   let*? baking_reward_bonus_per_block =
     Delegate.Rewards.baking_reward_bonus_per_block ctxt
@@ -82,7 +84,9 @@ let bonus_baking_reward ctxt level ~attesting_power =
      the order of operations (because the division will always result in 0 otherwise). *)
   let* reward =
     if Compare.Int64.(max_extra_attesting_power <= 0L) then return (Ok Tez.zero)
-    else if Attesting_power.check_all_bakers_attest_at_level ctxt level then
+    else if
+      Attesting_power.check_all_bakers_attest_at_level ctxt ~attested_level
+    then
       return
       @@ Tez.mul_ratio
            ~rounding:`Up
@@ -109,13 +113,13 @@ type ordered_slots = {
 
 (* Slots returned by this function are assumed by consumers to be in increasing
    order, hence the use of [Slot.Range.rev_fold_es]. *)
-let attesting_rights (ctxt : t) level =
+let attesting_rights (ctxt : t) ~attested_level =
   let consensus_committee_size = Constants.consensus_committee_size ctxt in
   let all_bakers_attest_enabled =
-    Attesting_power.check_all_bakers_attest_at_level ctxt level
+    Attesting_power.check_all_bakers_attest_at_level ctxt ~attested_level
   in
   let open Lwt_result_syntax in
-  let* ctxt, _, delegates = Stake_distribution.stake_info ctxt level in
+  let* ctxt, _, delegates = Stake_distribution.stake_info ctxt attested_level in
   let* attesting_power_map, _ =
     List.fold_left_es
       (fun (acc_map, i) ((consensus_pk : Consensus_key.pk), power) ->
@@ -136,7 +140,7 @@ let attesting_rights (ctxt : t) level =
       (fun (ctxt, map) slot ->
         let*? round = Round.of_slot slot in
         let* ctxt, _, consensus_pk =
-          Stake_distribution.baking_rights_owner ctxt level ~round
+          Stake_distribution.baking_rights_owner ctxt attested_level ~round
         in
         let map =
           Signature.Public_key_hash.Map.update
@@ -216,7 +220,7 @@ let incr_slot att_rights =
   let one = Attesting_power.make ~slots:1 ~stake:0L in
   Attesting_power.add one att_rights
 
-let attesting_rights_by_first_slot ctxt level :
+let attesting_rights_by_first_slot ctxt ~attested_level :
     (t * Consensus_key.power Slot.Map.t) tzresult Lwt.t =
   let open Lwt_result_syntax in
   let*? slots =
@@ -228,7 +232,7 @@ let attesting_rights_by_first_slot ctxt level :
       (fun (ctxt, (delegates_map, slots_map)) slot ->
         let*? round = Round.of_slot slot in
         let+ ctxt, _, consensus_key =
-          Stake_distribution.baking_rights_owner ctxt level ~round
+          Stake_distribution.baking_rights_owner ctxt attested_level ~round
         in
         let initial_slot, delegates_map =
           match
@@ -278,9 +282,11 @@ let attesting_rights_by_first_slot ctxt level :
       slots
   in
   let all_bakers_attest_enabled =
-    Attesting_power.check_all_bakers_attest_at_level ctxt level
+    Attesting_power.check_all_bakers_attest_at_level ctxt ~attested_level
+  in
+  let* ctxt, _, stake_info_list =
+    Stake_distribution.stake_info ctxt attested_level
   in
-  let* ctxt, _, stake_info_list = Stake_distribution.stake_info ctxt level in
   let* slots_map, _ =
     List.fold_left_es
       (fun (acc, i) ((consensus_key, weight) : Consensus_key.pk * Int64.t) ->
diff --git a/src/proto_alpha/lib_protocol/baking.mli b/src/proto_alpha/lib_protocol/baking.mli
index dc5c687d1df6..810cd2f6572c 100644
--- a/src/proto_alpha/lib_protocol/baking.mli
+++ b/src/proto_alpha/lib_protocol/baking.mli
@@ -51,7 +51,7 @@ type ordered_slots = private {
    This function is only used by the 'validators' RPC.  *)
 val attesting_rights :
   context ->
-  Level.t ->
+  attested_level:Level.t ->
   (context * ordered_slots Signature.Public_key_hash.Map.t) tzresult Lwt.t
 
 (** Computes attesting rights for a given level.
@@ -60,12 +60,16 @@ val attesting_rights :
      attesting power, and DAL attesting power. *)
 val attesting_rights_by_first_slot :
   context ->
-  Level.t ->
+  attested_level:Level.t ->
   (context * Consensus_key.power Slot.Map.t) tzresult Lwt.t
 
-(** Computes the bonus baking reward depending on the attestation power. *)
+(** Computes the bonus baking reward depending on the attestation power.
+
+    [attested_level] is the level written in the attestations whose
+    total [attesting_power] is provided, not the level of the block
+    being baked. *)
 val bonus_baking_reward :
   context ->
-  Level.t ->
+  attested_level:Level.t ->
   attesting_power:Attesting_power.t ->
   (context * Tez.t) tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml b/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml
index 9183c458a56c..1aa758db7890 100644
--- a/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml
+++ b/src/proto_alpha/lib_protocol/consensus_parameters_storage.ml
@@ -5,26 +5,26 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-let check_all_bakers_attest_at_level ctxt level =
+let check_all_bakers_attest_at_level ctxt ~attested_level =
   match Constants_storage.all_bakers_attest_first_level ctxt with
   | None -> false
-  | Some act_level -> Level_repr.(level >= act_level)
+  | Some act_level -> Level_repr.(attested_level >= act_level)
 
-let consensus_committee ctxt level =
+let consensus_committee ctxt ~attested_level =
   let open Lwt_result_syntax in
-  if check_all_bakers_attest_at_level ctxt level then
+  if check_all_bakers_attest_at_level ctxt ~attested_level then
     let* ctxt, total_staking_weight, _ =
-      Delegate_sampler.stake_info ctxt level
+      Delegate_sampler.stake_info ctxt attested_level
     in
     return (ctxt, total_staking_weight)
   else
     return
       (ctxt, Int64.of_int @@ Constants_storage.consensus_committee_size ctxt)
 
-let consensus_threshold ctxt level =
+let consensus_threshold ctxt ~attested_level =
   let open Lwt_result_syntax in
-  if check_all_bakers_attest_at_level ctxt level then
-    let* ctxt, committee = consensus_committee ctxt level in
+  if check_all_bakers_attest_at_level ctxt ~attested_level then
+    let* ctxt, committee = consensus_committee ctxt ~attested_level in
     let const_committee =
       Int64.of_int @@ Constants_storage.consensus_committee_size ctxt
     in
@@ -44,4 +44,4 @@ let is_all_bakers_attest_enabled_for_cycle ctxt cycle =
   let first_level_of_cycle =
     Level_repr.first_level_in_cycle_from_eras ~cycle_eras cycle
   in
-  check_all_bakers_attest_at_level ctxt first_level_of_cycle
+  check_all_bakers_attest_at_level ctxt ~attested_level:first_level_of_cycle
diff --git a/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli b/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli
index 60c78c6d27cc..5ed3a285a744 100644
--- a/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli
+++ b/src/proto_alpha/lib_protocol/consensus_parameters_storage.mli
@@ -5,15 +5,65 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(** [check_all_bakers_attest_at_level ctxt level] checks that at the given
-    level, all bakers were allowed (and expected) to attest. *)
-val check_all_bakers_attest_at_level : Raw_context.t -> Level_repr.t -> bool
+(** Checks whether all bakers are allowed (and expected) to attest
+    blocks at the [attested_level].
 
+    Note that when handling a block's attestations, what matters is
+    whether all-bakers-attest was active at the level written in the
+    attestations' content, not at the level of the block containing
+    the attestations (which is one level higher), hence the
+    [attested_level] label.
+
+    When handling preattestations, the [attested_level] is the level
+    written in the preattestations's content, which is the same as the
+    level of the block containing them.
+*)
+val check_all_bakers_attest_at_level :
+  Raw_context.t -> attested_level:Level_repr.t -> bool
+
+(** Returns the minimal required attesting power for a block to be
+    valid.
+
+    If all-bakers-attest is not yet active at [attested_level], this
+    is the [consensus_threshold_size] (equal to 4667 slots out of the
+    7000 available on mainnet as of protocol T).
+
+    If all-bakers-attest is active, this is instead the total baking
+    power of all bakers for the cycle of [attested_level], multiplied
+    by the [consensus_threshold_size] constant and divided by the
+    [consensus_committee_size] constant (approximately 2/3).
+
+    Note that, as in {!check_all_bakers_attest_at_level},
+    [attested_level] is the level of the consensus operations of
+    interest, which may not be the same as the level of the block
+    being validated.
+*)
 val consensus_threshold :
-  Raw_context.t -> Level_repr.t -> (Raw_context.t * int64) tzresult Lwt.t
+  Raw_context.t ->
+  attested_level:Level_repr.t ->
+  (Raw_context.t * int64) tzresult Lwt.t
+
+(** Returns the total attesting power over all bakers that have rights
+    at the [attested_level].
+
+    If all-bakers-attest is not yet active at [attested_level], this
+    is the [consensus_committee_size] (equal to 7000 on mainnet as of
+    protocol T).
+
+    If all-bakers-attest is active, this is instead the total baking
+    power of all bakers that have rights for the cycle of
+    [attested_level] (so it is identical for all levels in the same
+    cycle).
 
+    Note that, as in {!check_all_bakers_attest_at_level},
+    [attested_level] is the level of the consensus operations of
+    interest, which may not be the same as the level of the block
+    being validated.
+*)
 val consensus_committee :
-  Raw_context.t -> Level_repr.t -> (Raw_context.t * int64) tzresult Lwt.t
+  Raw_context.t ->
+  attested_level:Level_repr.t ->
+  (Raw_context.t * int64) tzresult Lwt.t
 
 (** Returns true IFF the first level of the given cycle is greater
     than or equal to the activation level of all-bakers-attest.
diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml
index b422d0c62ae0..84ac4e536c43 100644
--- a/src/proto_alpha/lib_protocol/main.ml
+++ b/src/proto_alpha/lib_protocol/main.ml
@@ -130,13 +130,15 @@ let init_consensus_rights_for_block ctxt mode ~predecessor_level =
   let open Lwt_result_syntax in
   let open Alpha_context in
   let* ctxt, attestations_map =
-    Baking.attesting_rights_by_first_slot ctxt predecessor_level
+    Baking.attesting_rights_by_first_slot ctxt ~attested_level:predecessor_level
   in
   let*? can_contain_preattestations = can_contain_preattestations mode in
   let* ctxt, allowed_preattestations =
     if can_contain_preattestations then
       let* ctxt, preattestations_map =
-        Baking.attesting_rights_by_first_slot ctxt (Level.current ctxt)
+        Baking.attesting_rights_by_first_slot
+          ctxt
+          ~attested_level:(Level.current ctxt)
       in
       return (ctxt, Some preattestations_map)
     else return (ctxt, None)
@@ -173,7 +175,7 @@ let init_consensus_rights_for_mempool ctxt ~predecessor_level =
     List.fold_left_es
       (fun (ctxt, minimal_slots) level ->
         let* ctxt, level_minimal_slot =
-          Baking.attesting_rights_by_first_slot ctxt level
+          Baking.attesting_rights_by_first_slot ctxt ~attested_level:level
         in
         return (ctxt, Level.Map.add level level_minimal_slot minimal_slots))
       (ctxt, Level.Map.empty)
diff --git a/src/proto_alpha/lib_protocol/slash_percentage.ml b/src/proto_alpha/lib_protocol/slash_percentage.ml
index c0da5a4fadcd..f5396634e4cc 100644
--- a/src/proto_alpha/lib_protocol/slash_percentage.ml
+++ b/src/proto_alpha/lib_protocol/slash_percentage.ml
@@ -48,7 +48,7 @@ let get ctxt misbehaviour (denounced : Signature.public_key_hash list) =
       let all_bakers_attest_enabled =
         Consensus_parameters_storage.check_all_bakers_attest_at_level
           ctxt
-          misbehaviour_level
+          ~attested_level:misbehaviour_level
       in
       let* ctxt, rights =
         Delegate_sampler.attesting_power
@@ -57,7 +57,9 @@ let get ctxt misbehaviour (denounced : Signature.public_key_hash list) =
           misbehaviour_level
       in
       let* ctxt, committee_size =
-        Consensus_parameters_storage.consensus_committee ctxt misbehaviour_level
+        Consensus_parameters_storage.consensus_committee
+          ctxt
+          ~attested_level:misbehaviour_level
       in
       return (ctxt, for_double_attestation ctxt ~committee_size rights denounced)
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml
index ec7e1f8f1a0f..a3c28c706828 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_aggregate.ml
@@ -74,11 +74,30 @@ type 'kind aggregate =
   | Preattestation : Alpha_context.Kind.preattestations_aggregate aggregate
   | Attestation : Alpha_context.Kind.attestations_aggregate aggregate
 
-let check_aggregate_result (type kind) (kind : kind aggregate) ~attesters ~ctxt
-    ~level
-    (result : kind Tezos_protocol_alpha__Protocol.Apply_results.contents_result)
-    =
+(* Finds the result of the aggregate of the given kind (preattestation
+   or attestation) in [op_receipts] (kind) and checks that it has the
+   following properties:
+   - [balance_update] is empty;
+   - [voting_power] equals the sum of slots owned by [attesters];
+   - the public key hashes in [result] committee match those of [attesters]. *)
+let check_aggregate_result (type kind) (kind : kind aggregate) ~attesters
+    ((block, (_, op_receipts)) : Block.block_with_metadata) =
   let open Lwt_result_syntax in
+  let (result
+        : kind Tezos_protocol_alpha__Protocol.Apply_results.contents_result) =
+    match kind with
+    | Preattestation -> find_preattestations_aggregate_result op_receipts
+    | Attestation -> find_attestations_aggregate_result op_receipts
+  in
+  let* ctxt = Block.get_alpha_ctxt block in
+  let block_level = Alpha_context.Level.current ctxt in
+  let attested_level =
+    match kind with
+    | Preattestation -> block_level
+    | Attestation ->
+        Alpha_context.Level.pred ctxt block_level
+        |> WithExceptions.Option.get ~loc:__LOC__
+  in
   match (kind, result) with
   | ( Preattestation,
       Preattestations_aggregate_result
@@ -110,7 +129,10 @@ let check_aggregate_result (type kind) (kind : kind aggregate) ~attesters ~ctxt
             attesters
         in
         let total_consensus_power =
-          Alpha_context.Attesting_power.get ctxt level total_consensus_power
+          Alpha_context.Attesting_power.get
+            ctxt
+            ~attested_level
+            total_consensus_power
         in
         if Int64.equal voting_power total_consensus_power then return_unit
         else
@@ -135,7 +157,8 @@ let check_aggregate_result (type kind) (kind : kind aggregate) ~attesters ~ctxt
       in
       let resulting_committee =
         List.map
-          (fun (a, b) -> (a, Alpha_context.Attesting_power.get ctxt level b))
+          (fun (a, b) ->
+            (a, Alpha_context.Attesting_power.get ctxt ~attested_level b))
           resulting_committee
       in
       if
@@ -171,38 +194,6 @@ let check_aggregate_result (type kind) (kind : kind aggregate) ~attesters ~ctxt
           pp
           resulting_committee
 
-(* [check_preattestations_aggregate_result ~committee result] verifies that
-   [result] has the following properties:
-   - [balance_update] is empty;
-   - [voting_power] equals the sum of slots owned by attesters in [committee];
-   - the public key hashes in [result] committee match those of [committee]. *)
-let check_preattestations_aggregate_result ~attesters
-    (result :
-      Alpha_context.Kind.preattestations_aggregate
-      Tezos_protocol_alpha__Protocol.Apply_results.contents_result) =
-  check_aggregate_result Preattestation ~attesters result
-
-(* [check_attestations_aggregate_result ~committee result] verifies that
-   [result] has the following properties:
-   - [balance_update] is empty;
-   - [voting_power] equals the sum of slots owned by attesters in [committee];
-   - the public key hashes in [result] committee match those of [committee]. *)
-let check_attestations_aggregate_result ~attesters
-    (result :
-      Alpha_context.Kind.attestations_aggregate
-      Tezos_protocol_alpha__Protocol.Apply_results.contents_result) =
-  check_aggregate_result Attestation ~attesters result
-
-let check_after_preattestations_aggregate
-    ((_, (_, op_receipts)) : Block.block_with_metadata) =
-  check_preattestations_aggregate_result
-    (find_preattestations_aggregate_result op_receipts)
-
-let check_after_attestations_aggregate
-    ((_, (_, op_receipts)) : Block.block_with_metadata) =
-  check_attestations_aggregate_result
-    (find_attestations_aggregate_result op_receipts)
-
 (** Tests the validation and application of a preattestations_aggregate.
 
     [attesting_slots] defaults to the respective canonical slots of
@@ -236,14 +227,8 @@ let check_preattestations_aggregate_validation_and_application ~loc ~attesters
   in
   match error with
   | None ->
-      let*? ((b, _) as block_with_metadata) = res in
-      let* ctxt = Block.get_alpha_ctxt b in
-      let level = Alpha_context.Level.current ctxt in
-      check_after_preattestations_aggregate
-        ~attesters
-        ~ctxt
-        ~level
-        block_with_metadata
+      let*? block_with_metadata = res in
+      check_aggregate_result Preattestation ~attesters block_with_metadata
   | Some error -> Assert.proto_error ~loc res error
 
 (** Tests the validation and application of an attestations_aggregate.
@@ -269,11 +254,9 @@ let check_attestations_aggregate_validation_and_application ~loc ~attesters
     | None -> List.map Op.attesting_slot_of_attester attesters
   in
   let* operation = Op.attestations_aggregate ~committee attested_block in
-  let* ctxt = Block.get_alpha_ctxt attested_block in
-  let level = Alpha_context.Level.current ctxt in
   let check_after_block_mode =
     match error with
-    | None -> Some (check_after_attestations_aggregate ~ctxt ~level ~attesters)
+    | None -> Some (check_aggregate_result Attestation ~attesters)
     | Some _ -> None
   in
   Op.check_validation_and_application_all_modes_different_outcomes
diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index aed577ac8bbc..610d4140a3bf 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -1957,14 +1957,17 @@ module Anonymous = struct
     | Single
         (Preattestations_aggregate {consensus_content = {level; _}; committee})
       ->
-        let level = Level.from_raw vi.ctxt level in
+        let attested_level = Level.from_raw vi.ctxt level in
         let* _ctxt, public_keys =
           (* [ctxt] is part of the accumulator so that attesting
              rights data for [level] are loaded at most once. *)
           List.fold_left_es
             (fun (ctxt, public_keys) slot ->
               let* ctxt, consensus_key =
-                Stake_distribution.attestation_slot_owner ctxt level slot
+                Stake_distribution.attestation_slot_owner
+                  ctxt
+                  ~attested_level
+                  slot
               in
               match consensus_key.consensus_pk with
               | Bls pk -> return (ctxt, pk :: public_keys)
@@ -1993,12 +1996,14 @@ module Anonymous = struct
           Operation.(
             serialize_unsigned_operation bls_mode_unsigned_encoding attestation)
         in
-        let level = Level.from_raw vi.ctxt level in
         let* _ctxt, pks, weighted_pks =
           List.fold_left_es
             (fun (ctxt, pks, weighted_pks) (slot, dal) ->
               let* ctxt, consensus_key =
-                Stake_distribution.attestation_slot_owner ctxt level slot
+                Stake_distribution.attestation_slot_owner
+                  ctxt
+                  ~attested_level:(Level.from_raw vi.ctxt level)
+                  slot
               in
               match consensus_key.consensus_pk with
               | Bls consensus_pk -> (
@@ -2167,7 +2172,10 @@ module Anonymous = struct
       check_denunciation_age vi (`Consensus_denounciation kind) level.level
     in
     let* ctxt, consensus_key =
-      Stake_distribution.attestation_slot_owner vi.ctxt level slot
+      Stake_distribution.attestation_slot_owner
+        vi.ctxt
+        ~attested_level:level
+        slot
     in
     let delegate = consensus_key.delegate in
     let* already_slashed =
@@ -2446,7 +2454,10 @@ module Anonymous = struct
         let*? () = check_denunciation_age vi `Dal_denounciation level in
         let level = Level.from_raw vi.ctxt level in
         let* ctxt, consensus_key =
-          Stake_distribution.attestation_slot_owner vi.ctxt level consensus_slot
+          Stake_distribution.attestation_slot_owner
+            vi.ctxt
+            ~attested_level:level
+            consensus_slot
         in
         let delegate = consensus_key.delegate in
         let*! already_denounced =
@@ -4046,10 +4057,10 @@ let check_attesting_power vi bs =
            cache of the stake info for a given level, which should
            already be cached at this time anyways. *)
         let* _ctxt, required =
-          Attesting_power.consensus_threshold vi.ctxt attested_level
+          Attesting_power.consensus_threshold vi.ctxt ~attested_level
         in
         let provided =
-          Attesting_power.get vi.ctxt attested_level bs.attesting_power
+          Attesting_power.get vi.ctxt ~attested_level bs.attesting_power
         in
         fail_unless
           Compare.Int64.(provided >= required)
@@ -4096,14 +4107,16 @@ let check_preattestation_round_and_power vi vs round =
           (Locked_round_after_block_round
              {locked_round = preattestation_round; round})
       in
+      (* The preattestations' level is the same as the block's level. *)
+      let attested_level = vi.current_level in
       (* We can safely drop the context: it is only updated for the cache of
          the stake info for a given level, which should already be cached
          at this time anyways. *)
       let* _ctxt, consensus_threshold =
-        Attesting_power.consensus_threshold vi.ctxt vi.current_level
+        Attesting_power.consensus_threshold vi.ctxt ~attested_level
       in
       let total_attesting_power =
-        Attesting_power.get vi.ctxt vi.current_level total_attesting_power
+        Attesting_power.get vi.ctxt ~attested_level total_attesting_power
       in
       let*? () =
         error_when
-- 
GitLab


From cf1e427002ef43f287fa8adfbb25208caa1232d9 Mon Sep 17 00:00:00 2001
From: Diane Gallois-Wong <diane.gallois-wong@nomadic-labs.com>
Date: Mon, 20 Oct 2025 14:32:50 +0200
Subject: [PATCH 6/6] Scripts: update profile_alpha.patch

---
 scripts/profile_alpha.patch | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/scripts/profile_alpha.patch b/scripts/profile_alpha.patch
index 67832359b5c4..b3d68cb46f3e 100644
--- a/scripts/profile_alpha.patch
+++ b/scripts/profile_alpha.patch
@@ -19,7 +19,7 @@ diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protoco
 index 0078267eca..a301359869 100644
 --- a/src/proto_alpha/lib_protocol/apply.ml
 +++ b/src/proto_alpha/lib_protocol/apply.ml
-@@ -2497,7 +2497,11 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode
+@@ -2501,7 +2501,11 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode
      ~source ~operation contents_list =
    let open Lwt_result_syntax in
    let ctxt = if mempool_mode then Gas.reset_block_gas ctxt else ctxt in
@@ -32,7 +32,7 @@ index 0078267eca..a301359869 100644
    let gas_cost_for_sig_check =
      let algo =
        Michelson_v1_gas.Cost_of.Interpreter.algo_of_public_key_hash source
-@@ -2774,11 +2778,12 @@ let may_start_new_cycle ctxt =
+@@ -2780,11 +2784,12 @@ let may_start_new_cycle ctxt =
    match Level.dawn_of_a_new_cycle ctxt with
    | None -> return (ctxt, [], [])
    | Some last_cycle ->
@@ -54,16 +54,16 @@ diff --git a/src/proto_alpha/lib_protocol/baking.ml b/src/proto_alpha/lib_protoc
 index 1388bc3ea7..ae55ed9ae2 100644
 --- a/src/proto_alpha/lib_protocol/baking.ml
 +++ b/src/proto_alpha/lib_protocol/baking.ml
-@@ -110,7 +110,7 @@ type ordered_slots = {
+@@ -114,7 +114,7 @@ type ordered_slots = {
  (* Slots returned by this function are assumed by consumers to be in increasing
     order, hence the use of [Slot.Range.rev_fold_es]. *)
- let attesting_rights (ctxt : t) level =
+ let attesting_rights (ctxt : t) ~attested_level =
 -  let consensus_committee_size = Constants.consensus_committee_size ctxt in
 +  (let consensus_committee_size = Constants.consensus_committee_size ctxt in
    let all_bakers_attest_enabled =
-     Attesting_power.check_all_bakers_attest_at_level ctxt level
+     Attesting_power.check_all_bakers_attest_at_level ctxt ~attested_level
    in
-@@ -210,7 +210,7 @@ let attesting_rights (ctxt : t) level =
+@@ -214,7 +214,7 @@ let attesting_rights (ctxt : t) level =
          map
      else map
    in
@@ -76,7 +76,7 @@ diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/l
 index 2a0bdad18c..d208afc53b 100644
 --- a/src/proto_alpha/lib_protocol/delegate_cycles.ml
 +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml
-@@ -229,42 +229,92 @@ let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces =
+@@ -225,42 +225,92 @@ let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces =
  let cycle_end ctxt last_cycle =
    let open Lwt_result_syntax in
    (* attributing attesting rewards   *)
-- 
GitLab