From ae68b9090fd5f4e78c77442b90cba5c79679bbf5 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Fri, 23 May 2025 15:17:31 +0200
Subject: [PATCH 01/12] Proto/tests/scenario: update activity from aggregated
 attestations

---
 .../test/helpers/scenario_bake.ml             | 30 +++++++++++++++++--
 1 file changed, 28 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
index d191335c730a..2898cf8d833e 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
@@ -371,17 +371,43 @@ let bake ?baker : t -> t tzresult Lwt.t =
           op
         in
         match protocol_data.contents with
-        | Single (Attestation {consensus_content; _}) ->
+        | Single (Attestation {consensus_content; _})
+        | Single (Preattestation consensus_content) ->
             let*@ _, owner =
               Stake_distribution.slot_owner
                 ctxt
                 (Level.from_raw ctxt consensus_content.level)
                 consensus_content.slot
             in
-            return_some owner.delegate
+            return_some [owner.delegate]
+        | Single (Attestations_aggregate {committee; consensus_content}) ->
+            let*@ owners =
+              List.map_es
+                (fun (slot, _) ->
+                  Stake_distribution.slot_owner
+                    ctxt
+                    (Level.from_raw ctxt consensus_content.level)
+                    slot)
+                committee
+            in
+            return_some
+              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
+        | Single (Preattestations_aggregate {committee; consensus_content}) ->
+            let*@ owners =
+              List.map_es
+                (fun slot ->
+                  Stake_distribution.slot_owner
+                    ctxt
+                    (Level.from_raw ctxt consensus_content.level)
+                    slot)
+                committee
+            in
+            return_some
+              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
         | _ -> return_none)
       operations
   in
+  let attesters = List.flatten attesters in
   let state =
     State.update_map
       ~f:(fun acc_map ->
-- 
GitLab


From 1929b2ffcdc9baa2440a9df97badb5877d30ca29 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 27 May 2025 11:18:28 +0200
Subject: [PATCH 02/12] Proto/tests/scenario: upgrade end of block checks with
 metadata

---
 .../lib_protocol/test/helpers/block.ml        |  2 ++
 .../lib_protocol/test/helpers/block.mli       |  2 ++
 .../test/helpers/scenario_bake.ml             | 31 ++++++++++++----
 .../test/helpers/scenario_begin.ml            |  7 ++--
 .../lib_protocol/test/helpers/state.ml        |  5 ++-
 .../consensus/test_companion_key.ml           | 36 +++++++++----------
 6 files changed, 54 insertions(+), 29 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml
index df34be2c2649..f04560b00faf 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/block.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml
@@ -41,6 +41,8 @@ type t = {
 
 type block = t
 
+type full_metadata = block_header_metadata * operation_receipt list
+
 let get_alpha_ctxt b =
   let open Lwt_result_wrap_syntax in
   let*@ ctxt, _migration_balance_updates, _migration_operation_results =
diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.mli b/src/proto_alpha/lib_protocol/test/helpers/block.mli
index a703ec3ec13d..4315ccb8b8f6 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/block.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/block.mli
@@ -39,6 +39,8 @@ type t = {
 
 type block = t
 
+type full_metadata = block_header_metadata * operation_receipt list
+
 (** Not the same as [Context.get_alpha_ctxt] as it does not construct a new block *)
 val get_alpha_ctxt : t -> context tzresult Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
index 2898cf8d833e..705da4125bd5 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
@@ -328,8 +328,8 @@ let bake ?baker : t -> t tzresult Lwt.t =
   in
   let* () = check_issuance_rpc block in
   let state, operations = State.pop_pending_operations state in
-  let* block, state =
-    let* block', _metadata =
+  let* metadata, block, state =
+    let* block', metadata =
       Block.bake_with_metadata ?policy ~adaptive_issuance_vote ~operations block
     in
     if state.burn_rewards then
@@ -347,11 +347,18 @@ let bake ?baker : t -> t tzresult Lwt.t =
           block_rewards
       in
       let i = Incremental.set_alpha_ctxt i context in
-      let* i = List.fold_left_es Incremental.add_operation i operations in
-      let* block = Incremental.finalize_block i in
+      let* i, op_metadata =
+        List.fold_left_es
+          (fun (i, metadata) op ->
+            let* i, m = Incremental.add_operation_with_metadata i op in
+            return (i, m :: metadata))
+          (i, [])
+          operations
+      in
+      let* block, block_metadata = Incremental.finalize_block_with_metadata i in
       let state = State.apply_burn block_rewards baker_name state in
-      return (block, state)
-    else return (block', state)
+      return ((block_metadata, List.rev op_metadata), block, state)
+    else return (metadata, block', state)
   in
   let baker_acc = State.find_account baker_name state in
   (* update baker and attesters activity *)
@@ -451,7 +458,17 @@ let bake ?baker : t -> t tzresult Lwt.t =
     if state.force_attest_all then attest_all_ previous_block (block, state)
     else return (block, state)
   in
-  let* () = state.check_finalized_block (block, state) in
+  let* () =
+    List.iter_es
+      (fun f -> f metadata (block, state))
+      state.check_finalized_block_perm
+  in
+  let* () =
+    List.iter_es
+      (fun f -> f metadata (block, state))
+      state.check_finalized_block_temp
+  in
+  let state = {state with check_finalized_block_temp = []} in
   return (block, state)
 
 let rec repeat n f acc =
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
index 071ec8588567..5aa247715313 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
@@ -82,8 +82,8 @@ let init_constants ?(default = Test) ?(reward_per_block = 0L)
 
 (** Initialize the test, given some initial parameters *)
 let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
-    ?(check_finalized_block = fun _ -> Lwt_result_syntax.return_unit)
-    delegates_name_list : (constants, t) scenarios =
+    ?(check_finalized_block_perm = []) delegates_name_list :
+    (constants, t) scenarios =
   exec (fun (constants : constants) ->
       let open Lwt_result_syntax in
       let bootstrap = "__bootstrap__" in
@@ -152,7 +152,8 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
             pending_slashes = [];
             double_signings = [];
             force_attest_all;
-            check_finalized_block;
+            check_finalized_block_perm;
+            check_finalized_block_temp = [];
             operation_mode = Bake;
           }
       in
diff --git a/src/proto_alpha/lib_protocol/test/helpers/state.ml b/src/proto_alpha/lib_protocol/test/helpers/state.ml
index 8400df702277..2ade7d114d4f 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/state.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/state.ml
@@ -37,7 +37,10 @@ type t = {
     (Signature.Public_key_hash.t * Protocol.Denunciations_repr.item) list;
   double_signings : double_signing_state list;
   force_attest_all : bool;
-  check_finalized_block : Block.t * t -> unit tzresult Lwt.t;
+  check_finalized_block_perm :
+    (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
+  check_finalized_block_temp :
+    (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
   operation_mode : operation_mode;
 }
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_companion_key.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_companion_key.ml
index d91328dfa813..4d7c9959891d 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_companion_key.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_companion_key.ml
@@ -214,19 +214,19 @@ let test_simple_register_consensus_and_companion_keys =
   let consensus_rights_delay =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
   --> (Tag "is bootstrap"
        --> begin_test
              ~force_attest_all:true
-             ~check_finalized_block
+             ~check_finalized_block_perm
              (delegate :: bootstrap_accounts)
       |+ Tag "is created"
          --> begin_test
                ~force_attest_all:true
-               ~check_finalized_block
+               ~check_finalized_block_perm
                ~algo:Bls
                bootstrap_accounts
          --> add_account_with_funds
@@ -329,7 +329,7 @@ let test_register_other_accounts_as_ck =
   --> set S.consensus_rights_delay consensus_rights_delay
   --> begin_test
         ~algo:Bls
-        ~check_finalized_block:check_all_cks
+        ~check_finalized_block_perm:[(fun _ -> check_all_cks)]
         ~force_attest_all:true
         ["delegate"; "victim_1"; "victim_2"]
   (* Both victims start with themselves as their own consensus_keys *)
@@ -386,14 +386,14 @@ let test_self_register_as_companion =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   (* As expected, a delegate cannot register itself as a companion,
      if it is already itself its own consensus key *)
@@ -530,7 +530,7 @@ let test_register_same_key_multiple_times =
   in
   let delegate = "delegate" in
   let ck = "ck" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let update_either_ck ~ck_name delegate =
     Tag "consensus" --> update_consensus_key ~ck_name delegate
     |+ Tag "companion" --> update_companion_key ~ck_name delegate
@@ -596,7 +596,7 @@ let test_register_same_key_multiple_times =
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls ck
   --> update_either_ck ~ck_name:ck delegate
@@ -617,7 +617,7 @@ let test_register_new_key_every_cycle =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let update_both_cks delegate =
     add_account "consensus_key"
     --> update_consensus_key ~ck_name:"consensus_key" delegate
@@ -630,7 +630,7 @@ let test_register_new_key_every_cycle =
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> loop (consensus_rights_delay + 2) (update_both_cks delegate --> next_cycle)
 
@@ -639,14 +639,14 @@ let test_register_key_end_of_cycle =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls "ck"
   --> exec bake_until_next_cycle_end_but_one
@@ -665,13 +665,13 @@ let test_register_key_end_of_cycle =
 
 let test_registration_override =
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls "ck1"
   --> add_account ~algo:Bls "ck2"
@@ -725,7 +725,7 @@ let test_in_registration_table_twice =
      This ensures that a key can be pending for two different cycles at the same time. *)
   let consensus_rights_delay = 4 in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let check_is_pending_twice ~loc ~ck ~registered_for kind =
     let open Lwt_result_syntax in
     exec_unit (fun (block, state) ->
@@ -771,7 +771,7 @@ let test_in_registration_table_twice =
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls "ck1"
   --> add_account ~algo:Bls "ck2"
@@ -875,7 +875,7 @@ let test_fail_noop =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let assert_fail_with_invalid_consensus_key_update_noop kind =
     assert_failure ~loc:__LOC__ ~expected_error:(fun (_block, state) err ->
         let delegate = State.find_account delegate state in
@@ -898,7 +898,7 @@ let test_fail_noop =
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
-  --> begin_test ~force_attest_all:true ~check_finalized_block [delegate]
+  --> begin_test ~force_attest_all:true ~check_finalized_block_perm [delegate]
   --> add_account ~algo:Bls "ck"
   --> fold_tag
         (fun kind ->
-- 
GitLab


From 96754343c2e70a4a6524aad28f182bb58e738b10 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 27 May 2025 11:53:12 +0200
Subject: [PATCH 03/12] Proto/tests/scenario: add previous block metadata

Mostly for explicit checks
---
 .../lib_protocol/test/helpers/scenario_bake.ml            | 8 +++++++-
 .../lib_protocol/test/helpers/scenario_base.ml            | 5 +++++
 .../lib_protocol/test/helpers/scenario_begin.ml           | 1 +
 src/proto_alpha/lib_protocol/test/helpers/state.ml        | 1 +
 4 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
index 705da4125bd5..4c49c9a0e53d 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
@@ -468,7 +468,13 @@ let bake ?baker : t -> t tzresult Lwt.t =
       (fun f -> f metadata (block, state))
       state.check_finalized_block_temp
   in
-  let state = {state with check_finalized_block_temp = []} in
+  let state =
+    {
+      state with
+      check_finalized_block_temp = [];
+      previous_metadata = Some metadata;
+    }
+  in
   return (block, state)
 
 let rec repeat n f acc =
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
index 4352f9fd05c6..d07ad62e4a6b 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
@@ -299,3 +299,8 @@ let check_balance_fields ?(loc = __LOC__) src_name ~liquid ~staked
         src_name
         `Unstaked_finalizable
         unstaked_finalizable
+
+let with_metadata f (block, state) =
+  match state.previous_metadata with
+  | None -> assert false
+  | Some metadata -> f metadata (block, state)
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
index 5aa247715313..6b335ba4fa7e 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
@@ -154,6 +154,7 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
             force_attest_all;
             check_finalized_block_perm;
             check_finalized_block_temp = [];
+            previous_metadata = None;
             operation_mode = Bake;
           }
       in
diff --git a/src/proto_alpha/lib_protocol/test/helpers/state.ml b/src/proto_alpha/lib_protocol/test/helpers/state.ml
index 2ade7d114d4f..55345efec078 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/state.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/state.ml
@@ -41,6 +41,7 @@ type t = {
     (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
   check_finalized_block_temp :
     (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
+  previous_metadata : Block.full_metadata option;
   operation_mode : operation_mode;
 }
 
-- 
GitLab


From 710b86ef0467699e0f2edc3784626967281c7833 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 19 Jun 2025 15:21:24 +0200
Subject: [PATCH 04/12] Proto/tests/scenario: make incremental steps

---
 .../lib_protocol/test/helpers/incremental.ml  |   2 +
 .../lib_protocol/test/helpers/incremental.mli |   2 +
 .../test/helpers/scenario_bake.ml             | 133 +++++++++---------
 .../test/helpers/scenario_base.ml             |   6 +-
 4 files changed, 74 insertions(+), 69 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml
index 44d8ed58a0b2..ad3732df7541 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml
@@ -47,6 +47,8 @@ let rev_operations {rev_operations; _} = rev_operations
 
 let rev_tickets {rev_tickets; _} = rev_tickets
 
+let delegate {delegate; _} = delegate
+
 let validation_state {state = vs, _; _} = vs
 
 let level st = st.header.shell.level
diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli
index 301765a07215..9c813180a733 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli
@@ -38,6 +38,8 @@ val rev_operations : incremental -> Operation.packed list
 
 val rev_tickets : incremental -> operation_receipt list
 
+val delegate : incremental -> Account.t
+
 val validation_state : incremental -> validation_state
 
 val level : incremental -> int32
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
index 4c49c9a0e53d..cc787dd11714 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
@@ -284,11 +284,20 @@ let check_ai_launch_cycle_is_zero ~loc block =
     Test.fail ~__LOC__:loc "AI launch cycle should always be zero" ;
   return_unit
 
-(** Bake a block, with the given baker and the given operations. *)
-let bake ?baker : t -> t tzresult Lwt.t =
+(** Apply all operations pending in the [state].
+    It is imperative that the list of pending operations in the state
+    is empty before finalizing the block, either manually, or by calling this function. *)
+let apply_all_pending_operations_ : t_incr -> t_incr tzresult Lwt.t =
+ fun (i, state) ->
+  let open Lwt_result_wrap_syntax in
+  let state, operations = State.pop_pending_operations state in
+  let* i = List.fold_left_es Incremental.add_operation i operations in
+  return (i, state)
+
+(** finalize the payload of the next block. Can start including preattestations. *)
+let finalize_payload_ ?payload_round ?baker : t -> t_incr tzresult Lwt.t =
  fun (block, state) ->
   let open Lwt_result_wrap_syntax in
-  let previous_block = block in
   let policy =
     match baker with
     | None -> state.baking_policy
@@ -308,7 +317,6 @@ let bake ?baker : t -> t tzresult Lwt.t =
   let baker_name, {contract = baker_contract; _} =
     State.find_account_from_pkh baker state
   in
-  let current_cycle = Block.current_cycle block in
   let* level = Plugin.RPC.current_level Block.rpc_ctxt block in
   let* next_level =
     let* ctxt = Context.get_alpha_ctxt (B block) in
@@ -327,16 +335,17 @@ let bake ?baker : t -> t tzresult Lwt.t =
     else Per_block_vote_pass
   in
   let* () = check_issuance_rpc block in
-  let state, operations = State.pop_pending_operations state in
-  let* metadata, block, state =
-    let* block', metadata =
-      Block.bake_with_metadata ?policy ~adaptive_issuance_vote ~operations block
-    in
+  let* block' = Block.bake ?policy ~adaptive_issuance_vote block in
+  let* i =
+    Incremental.begin_construction
+      ?payload_round
+      ~payload:state.pending_operations
+      ?policy
+      ~adaptive_issuance_vote
+      block
+  in
+  let* i, state =
     if state.burn_rewards then
-      (* Incremental mode *)
-      let* i =
-        Incremental.begin_construction ?policy ~adaptive_issuance_vote block
-      in
       let* block_rewards = Context.get_issuance_per_minute (B block') in
       let ctxt = Incremental.alpha_ctxt i in
       let*@ context, _ =
@@ -347,20 +356,26 @@ let bake ?baker : t -> t tzresult Lwt.t =
           block_rewards
       in
       let i = Incremental.set_alpha_ctxt i context in
-      let* i, op_metadata =
-        List.fold_left_es
-          (fun (i, metadata) op ->
-            let* i, m = Incremental.add_operation_with_metadata i op in
-            return (i, m :: metadata))
-          (i, [])
-          operations
-      in
-      let* block, block_metadata = Incremental.finalize_block_with_metadata i in
       let state = State.apply_burn block_rewards baker_name state in
-      return ((block_metadata, List.rev op_metadata), block, state)
-    else return (metadata, block', state)
+      return (i, state)
+    else return (i, state)
   in
-  let baker_acc = State.find_account baker_name state in
+  apply_all_pending_operations_ (i, state)
+
+let finalize_payload ?payload_round ?baker () : (t, t_incr) scenarios =
+  exec (finalize_payload_ ?payload_round ?baker)
+
+let finalize_block_ : t_incr -> t tzresult Lwt.t =
+ fun (i, state) ->
+  let open Lwt_result_wrap_syntax in
+  assert (List.is_empty state.pending_operations) ;
+  let* block, block_metadata = Incremental.finalize_block_with_metadata i in
+  let ((_, op_metadata) as metadata) =
+    (block_metadata, List.rev (Incremental.rev_tickets i))
+  in
+  let previous_block = Incremental.predecessor i in
+  let baker = Incremental.delegate i in
+  let baker_name, baker_acc = State.find_account_from_pkh baker.pkh state in
   (* update baker and attesters activity *)
   let update_activity delegate_account =
     Account_helpers.update_activity
@@ -369,50 +384,23 @@ let bake ?baker : t -> t tzresult Lwt.t =
       (Block.current_cycle block)
   in
   let* attesters =
-    let open Tezos_raw_protocol_alpha.Alpha_context in
-    let* ctxt = Context.get_alpha_ctxt (B previous_block) in
     List.filter_map_es
-      (fun op ->
-        let ({protocol_data = Operation_data protocol_data; _}
-              : packed_operation) =
-          op
-        in
-        match protocol_data.contents with
-        | Single (Attestation {consensus_content; _})
-        | Single (Preattestation consensus_content) ->
-            let*@ _, owner =
-              Stake_distribution.slot_owner
-                ctxt
-                (Level.from_raw ctxt consensus_content.level)
-                consensus_content.slot
-            in
-            return_some [owner.delegate]
-        | Single (Attestations_aggregate {committee; consensus_content}) ->
-            let*@ owners =
-              List.map_es
-                (fun (slot, _) ->
-                  Stake_distribution.slot_owner
-                    ctxt
-                    (Level.from_raw ctxt consensus_content.level)
-                    slot)
-                committee
-            in
-            return_some
-              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
-        | Single (Preattestations_aggregate {committee; consensus_content}) ->
-            let*@ owners =
-              List.map_es
-                (fun slot ->
-                  Stake_distribution.slot_owner
-                    ctxt
-                    (Level.from_raw ctxt consensus_content.level)
-                    slot)
-                committee
-            in
-            return_some
-              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
-        | _ -> return_none)
-      operations
+      (function
+        | Protocol.Apply_results.No_operation_metadata -> return_none
+        | Operation_metadata {contents} -> (
+            match contents with
+            | Single_result (Attestation_result {delegate; _})
+            | Single_result (Preattestation_result {delegate; _}) ->
+                return_some [delegate]
+            | Single_result (Attestations_aggregate_result {committee; _})
+            | Single_result (Preattestations_aggregate_result {committee; _}) ->
+                return_some
+                  (List.map
+                     (fun ((ck : Protocol.Alpha_context.Consensus_key.t), _) ->
+                       ck.delegate)
+                     committee)
+            | _ -> return_none))
+      op_metadata
   in
   let attesters = List.flatten attesters in
   let state =
@@ -433,6 +421,7 @@ let bake ?baker : t -> t tzresult Lwt.t =
   in
   let* () = check_ai_launch_cycle_is_zero ~loc:__LOC__ block in
   let* state = State.apply_rewards ~baker:baker_name block state in
+  let current_cycle = Block.current_cycle previous_block in
   let new_future_current_cycle = Cycle.succ (Block.current_cycle block) in
   (* Dawn of a new cycle: apply cycle end operations *)
   let* state =
@@ -477,6 +466,14 @@ let bake ?baker : t -> t tzresult Lwt.t =
   in
   return (block, state)
 
+let finalize_block : (t_incr, t) scenarios = exec finalize_block_
+
+(** Bake a block, with the given baker and the given operations. *)
+let bake ?baker : t -> t tzresult Lwt.t =
+ fun input ->
+  let ( |=> ) = Lwt_result.bind in
+  finalize_payload_ ?baker input |=> finalize_block_
+
 let rec repeat n f acc =
   let open Lwt_result_syntax in
   if n <= 0 then return acc
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
index d07ad62e4a6b..b90c73265941 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
@@ -14,10 +14,14 @@ open State
 open Scenario_dsl
 open Log_helpers
 
-(** Usual threaded state for the tests. Contains the current block, pending operations
+(** Usual threaded state for the tests. Contains the current block
     and the known [State.t] *)
 type t = Block.t * State.t
 
+(** Threaded state when constructing a block step by step in incremental mode.
+    The operation metadata list is built as operations are getting applied. *)
+type t_incr = Incremental.t * State.t
+
 let log ?(level = Cli.Logs.Info) ?color format =
   Format.kasprintf
     (fun s ->
-- 
GitLab


From d0e3b8fcc1c29ecffb9930cbc1dc047fb8e059a7 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 24 Jun 2025 15:40:06 +0200
Subject: [PATCH 05/12] Proto/tests/scenario: add grandparent in state

It is used to get the accurate active consensus key for attestations
---
 src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml  | 1 +
 src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml | 4 ++++
 src/proto_alpha/lib_protocol/test/helpers/state.ml          | 1 +
 3 files changed, 6 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
index cc787dd11714..98ecdaad3f9c 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_bake.ml
@@ -462,6 +462,7 @@ let finalize_block_ : t_incr -> t tzresult Lwt.t =
       state with
       check_finalized_block_temp = [];
       previous_metadata = Some metadata;
+      grandparent = previous_block;
     }
   in
   return (block, state)
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
index 6b335ba4fa7e..06e6d8ed339e 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_begin.ml
@@ -156,6 +156,10 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
             check_finalized_block_temp = [];
             previous_metadata = None;
             operation_mode = Bake;
+            (* The grandparent is only used to get the consensus key, so it is
+               fine to set it to Genesis here. If needed in the future, an option
+               type would be more appropriate. *)
+            grandparent = block;
           }
       in
       let* () = check_all_balances block state in
diff --git a/src/proto_alpha/lib_protocol/test/helpers/state.ml b/src/proto_alpha/lib_protocol/test/helpers/state.ml
index 55345efec078..ec99172479a9 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/state.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/state.ml
@@ -43,6 +43,7 @@ type t = {
     (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
   previous_metadata : Block.full_metadata option;
   operation_mode : operation_mode;
+  grandparent : Block.t;
 }
 
 (** Expected number of cycles before staking parameters get applied *)
-- 
GitLab


From 62c59e29535388f49e9cde667ad76f547d0a8df9 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 3 Jul 2025 16:49:46 +0200
Subject: [PATCH 06/12] Proto/tests/scenario: more state modifiers

---
 src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml | 5 +++++
 src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml   | 4 ++++
 2 files changed, 9 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
index b90c73265941..79bbf05b7b73 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
@@ -59,6 +59,11 @@ let exclude_bakers bakers : (t, t) scenarios =
       return
         {state with State.baking_policy = Some (Block.Excluding bakers_pkh)})
 
+let set_baked_round (round : int) : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_block, state) ->
+      return {state with State.baking_policy = Some (Block.By_round round)})
+
 (** Unsets the baking policy, it returns to default ([By_round 0]) *)
 let unset_baking_policy : (t, t) scenarios =
   let open Lwt_result_syntax in
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
index ecce91f405c3..a4610cc125c7 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
@@ -659,6 +659,10 @@ let make_denunciations ?single ?rev ?filter () =
 let add_account_with_funds ?algo name ~funder amount =
   add_account ?algo name --> transfer funder name amount --> reveal name
 
+let start_payload : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_, state) -> return {state with State.operation_mode = Wait})
+
 let batch ~source : (t, t) scenarios =
   let open Lwt_result_syntax in
   exec_state (fun (_, state) ->
-- 
GitLab


From 976a67ebbc0bfe4ea4ce86786d815709cab32f9a Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Mon, 7 Jul 2025 16:59:54 +0200
Subject: [PATCH 07/12] 023_PtSeouLo/Proto/tests/scenario: update activity from
 aggregated attestations

Porting to proto 023_PtSeouLo 93efe36bb10c774df5258cf43c2b0a0c75ce734c - Proto/tests/scenario: update activity from aggregated attestations
---
 .../test/helpers/scenario_bake.ml             | 30 +++++++++++++++++--
 1 file changed, 28 insertions(+), 2 deletions(-)

diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
index fd25cc076cfa..b123741ed884 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
@@ -371,17 +371,43 @@ let bake ?baker : t -> t tzresult Lwt.t =
           op
         in
         match protocol_data.contents with
-        | Single (Attestation {consensus_content; _}) ->
+        | Single (Attestation {consensus_content; _})
+        | Single (Preattestation consensus_content) ->
             let*@ _, owner =
               Stake_distribution.slot_owner
                 ctxt
                 (Level.from_raw ctxt consensus_content.level)
                 consensus_content.slot
             in
-            return_some owner.delegate
+            return_some [owner.delegate]
+        | Single (Attestations_aggregate {committee; consensus_content}) ->
+            let*@ owners =
+              List.map_es
+                (fun (slot, _) ->
+                  Stake_distribution.slot_owner
+                    ctxt
+                    (Level.from_raw ctxt consensus_content.level)
+                    slot)
+                committee
+            in
+            return_some
+              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
+        | Single (Preattestations_aggregate {committee; consensus_content}) ->
+            let*@ owners =
+              List.map_es
+                (fun slot ->
+                  Stake_distribution.slot_owner
+                    ctxt
+                    (Level.from_raw ctxt consensus_content.level)
+                    slot)
+                committee
+            in
+            return_some
+              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
         | _ -> return_none)
       operations
   in
+  let attesters = List.flatten attesters in
   let state =
     State.update_map
       ~f:(fun acc_map ->
-- 
GitLab


From 7b24038af3bea993a74e0978edc571a9243170f3 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Mon, 7 Jul 2025 17:00:07 +0200
Subject: [PATCH 08/12] 023_PtSeouLo/Proto/tests/scenario: upgrade end of block
 checks with metadata

Porting to proto 023_PtSeouLo 4092305bee378bb967e665b5f6af623018fff9f4 - Proto/tests/scenario: upgrade end of block checks with metadata
---
 .../lib_protocol/test/helpers/block.ml        |  2 ++
 .../lib_protocol/test/helpers/block.mli       |  2 ++
 .../test/helpers/scenario_bake.ml             | 31 ++++++++++++----
 .../test/helpers/scenario_begin.ml            |  7 ++--
 .../lib_protocol/test/helpers/state.ml        |  5 ++-
 .../consensus/test_companion_key.ml           | 36 +++++++++----------
 6 files changed, 54 insertions(+), 29 deletions(-)

diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml
index 80e6286b7b35..c25500bafeea 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.ml
@@ -41,6 +41,8 @@ type t = {
 
 type block = t
 
+type full_metadata = block_header_metadata * operation_receipt list
+
 let get_alpha_ctxt b =
   let open Lwt_result_wrap_syntax in
   let*@ ctxt, _migration_balance_updates, _migration_operation_results =
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli
index a703ec3ec13d..4315ccb8b8f6 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/block.mli
@@ -39,6 +39,8 @@ type t = {
 
 type block = t
 
+type full_metadata = block_header_metadata * operation_receipt list
+
 (** Not the same as [Context.get_alpha_ctxt] as it does not construct a new block *)
 val get_alpha_ctxt : t -> context tzresult Lwt.t
 
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
index b123741ed884..56adfac534d9 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
@@ -328,8 +328,8 @@ let bake ?baker : t -> t tzresult Lwt.t =
   in
   let* () = check_issuance_rpc block in
   let state, operations = State.pop_pending_operations state in
-  let* block, state =
-    let* block', _metadata =
+  let* metadata, block, state =
+    let* block', metadata =
       Block.bake_with_metadata ?policy ~adaptive_issuance_vote ~operations block
     in
     if state.burn_rewards then
@@ -347,11 +347,18 @@ let bake ?baker : t -> t tzresult Lwt.t =
           block_rewards
       in
       let i = Incremental.set_alpha_ctxt i context in
-      let* i = List.fold_left_es Incremental.add_operation i operations in
-      let* block = Incremental.finalize_block i in
+      let* i, op_metadata =
+        List.fold_left_es
+          (fun (i, metadata) op ->
+            let* i, m = Incremental.add_operation_with_metadata i op in
+            return (i, m :: metadata))
+          (i, [])
+          operations
+      in
+      let* block, block_metadata = Incremental.finalize_block_with_metadata i in
       let state = State.apply_burn block_rewards baker_name state in
-      return (block, state)
-    else return (block', state)
+      return ((block_metadata, List.rev op_metadata), block, state)
+    else return (metadata, block', state)
   in
   let baker_acc = State.find_account baker_name state in
   (* update baker and attesters activity *)
@@ -451,7 +458,17 @@ let bake ?baker : t -> t tzresult Lwt.t =
     if state.force_attest_all then attest_all_ previous_block (block, state)
     else return (block, state)
   in
-  let* () = state.check_finalized_block (block, state) in
+  let* () =
+    List.iter_es
+      (fun f -> f metadata (block, state))
+      state.check_finalized_block_perm
+  in
+  let* () =
+    List.iter_es
+      (fun f -> f metadata (block, state))
+      state.check_finalized_block_temp
+  in
+  let state = {state with check_finalized_block_temp = []} in
   return (block, state)
 
 let rec repeat n f acc =
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
index 071ec8588567..5aa247715313 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
@@ -82,8 +82,8 @@ let init_constants ?(default = Test) ?(reward_per_block = 0L)
 
 (** Initialize the test, given some initial parameters *)
 let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
-    ?(check_finalized_block = fun _ -> Lwt_result_syntax.return_unit)
-    delegates_name_list : (constants, t) scenarios =
+    ?(check_finalized_block_perm = []) delegates_name_list :
+    (constants, t) scenarios =
   exec (fun (constants : constants) ->
       let open Lwt_result_syntax in
       let bootstrap = "__bootstrap__" in
@@ -152,7 +152,8 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
             pending_slashes = [];
             double_signings = [];
             force_attest_all;
-            check_finalized_block;
+            check_finalized_block_perm;
+            check_finalized_block_temp = [];
             operation_mode = Bake;
           }
       in
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
index 8400df702277..2ade7d114d4f 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
@@ -37,7 +37,10 @@ type t = {
     (Signature.Public_key_hash.t * Protocol.Denunciations_repr.item) list;
   double_signings : double_signing_state list;
   force_attest_all : bool;
-  check_finalized_block : Block.t * t -> unit tzresult Lwt.t;
+  check_finalized_block_perm :
+    (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
+  check_finalized_block_temp :
+    (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
   operation_mode : operation_mode;
 }
 
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/test_companion_key.ml b/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/test_companion_key.ml
index 5106de6c55ee..e7b2f98aea9e 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/test_companion_key.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/integration/consensus/test_companion_key.ml
@@ -214,19 +214,19 @@ let test_simple_register_consensus_and_companion_keys =
   let consensus_rights_delay =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
   --> (Tag "is bootstrap"
        --> begin_test
              ~force_attest_all:true
-             ~check_finalized_block
+             ~check_finalized_block_perm
              (delegate :: bootstrap_accounts)
       |+ Tag "is created"
          --> begin_test
                ~force_attest_all:true
-               ~check_finalized_block
+               ~check_finalized_block_perm
                ~algo:Bls
                bootstrap_accounts
          --> add_account_with_funds
@@ -329,7 +329,7 @@ let test_register_other_accounts_as_ck =
   --> set S.consensus_rights_delay consensus_rights_delay
   --> begin_test
         ~algo:Bls
-        ~check_finalized_block:check_all_cks
+        ~check_finalized_block_perm:[(fun _ -> check_all_cks)]
         ~force_attest_all:true
         ["delegate"; "victim_1"; "victim_2"]
   (* Both victims start with themselves as their own consensus_keys *)
@@ -386,14 +386,14 @@ let test_self_register_as_companion =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   (* As expected, a delegate cannot register itself as a companion,
      if it is already itself its own consensus key *)
@@ -530,7 +530,7 @@ let test_register_same_key_multiple_times =
   in
   let delegate = "delegate" in
   let ck = "ck" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let update_either_ck ~ck_name delegate =
     Tag "consensus" --> update_consensus_key ~ck_name delegate
     |+ Tag "companion" --> update_companion_key ~ck_name delegate
@@ -596,7 +596,7 @@ let test_register_same_key_multiple_times =
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls ck
   --> update_either_ck ~ck_name:ck delegate
@@ -617,7 +617,7 @@ let test_register_new_key_every_cycle =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let update_both_cks delegate =
     add_account "consensus_key"
     --> update_consensus_key ~ck_name:"consensus_key" delegate
@@ -630,7 +630,7 @@ let test_register_new_key_every_cycle =
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> loop (consensus_rights_delay + 2) (update_both_cks delegate --> next_cycle)
 
@@ -639,14 +639,14 @@ let test_register_key_end_of_cycle =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls "ck"
   --> exec bake_until_next_cycle_end_but_one
@@ -665,13 +665,13 @@ let test_register_key_end_of_cycle =
 
 let test_registration_override =
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls "ck1"
   --> add_account ~algo:Bls "ck2"
@@ -725,7 +725,7 @@ let test_in_registration_table_twice =
      This ensures that a key can be pending for two different cycles at the same time. *)
   let consensus_rights_delay = 4 in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let check_is_pending_twice ~loc ~ck ~registered_for kind =
     let open Lwt_result_syntax in
     exec_unit (fun (block, state) ->
@@ -771,7 +771,7 @@ let test_in_registration_table_twice =
   --> begin_test
         ~algo:Bls
         ~force_attest_all:true
-        ~check_finalized_block
+        ~check_finalized_block_perm
         [delegate]
   --> add_account ~algo:Bls "ck1"
   --> add_account ~algo:Bls "ck2"
@@ -875,7 +875,7 @@ let test_fail_noop =
     Default_parameters.constants_mainnet.consensus_rights_delay
   in
   let delegate = "delegate" in
-  let check_finalized_block = check_cks delegate in
+  let check_finalized_block_perm = [(fun _ -> check_cks delegate)] in
   let assert_fail_with_invalid_consensus_key_update_noop kind =
     assert_failure ~loc:__LOC__ ~expected_error:(fun (_block, state) err ->
         let delegate = State.find_account delegate state in
@@ -898,7 +898,7 @@ let test_fail_noop =
   init_constants ()
   --> set S.allow_tz4_delegate_enable true
   --> set S.consensus_rights_delay consensus_rights_delay
-  --> begin_test ~force_attest_all:true ~check_finalized_block [delegate]
+  --> begin_test ~force_attest_all:true ~check_finalized_block_perm [delegate]
   --> add_account ~algo:Bls "ck"
   --> fold_tag
         (fun kind ->
-- 
GitLab


From f5698dc9da250a98b69bfc5435dc9a340b169fe0 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Mon, 7 Jul 2025 17:00:15 +0200
Subject: [PATCH 09/12] 023_PtSeouLo/Proto/tests/scenario: add previous block
 metadata

Porting to proto 023_PtSeouLo bdb4555254ca8a4eb670e2179e7ae35858760370 - Proto/tests/scenario: add previous block metadata
---
 .../lib_protocol/test/helpers/scenario_bake.ml            | 8 +++++++-
 .../lib_protocol/test/helpers/scenario_base.ml            | 5 +++++
 .../lib_protocol/test/helpers/scenario_begin.ml           | 1 +
 src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml | 1 +
 4 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
index 56adfac534d9..256d99cf1d38 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
@@ -468,7 +468,13 @@ let bake ?baker : t -> t tzresult Lwt.t =
       (fun f -> f metadata (block, state))
       state.check_finalized_block_temp
   in
-  let state = {state with check_finalized_block_temp = []} in
+  let state =
+    {
+      state with
+      check_finalized_block_temp = [];
+      previous_metadata = Some metadata;
+    }
+  in
   return (block, state)
 
 let rec repeat n f acc =
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
index 4352f9fd05c6..d07ad62e4a6b 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
@@ -299,3 +299,8 @@ let check_balance_fields ?(loc = __LOC__) src_name ~liquid ~staked
         src_name
         `Unstaked_finalizable
         unstaked_finalizable
+
+let with_metadata f (block, state) =
+  match state.previous_metadata with
+  | None -> assert false
+  | Some metadata -> f metadata (block, state)
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
index 5aa247715313..6b335ba4fa7e 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
@@ -154,6 +154,7 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
             force_attest_all;
             check_finalized_block_perm;
             check_finalized_block_temp = [];
+            previous_metadata = None;
             operation_mode = Bake;
           }
       in
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
index 2ade7d114d4f..55345efec078 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
@@ -41,6 +41,7 @@ type t = {
     (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
   check_finalized_block_temp :
     (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
+  previous_metadata : Block.full_metadata option;
   operation_mode : operation_mode;
 }
 
-- 
GitLab


From 925f5302c6d07870ec023b950cb313cbbc332b08 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Mon, 7 Jul 2025 17:20:31 +0200
Subject: [PATCH 10/12] 023_PtSeouLo/Proto/tests/scenario: make incremental
 steps

---
 .../lib_protocol/test/helpers/incremental.ml  |   2 +
 .../lib_protocol/test/helpers/incremental.mli |   2 +
 .../test/helpers/scenario_bake.ml             | 133 +++++++++---------
 .../test/helpers/scenario_base.ml             |   6 +-
 4 files changed, 74 insertions(+), 69 deletions(-)

diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.ml
index 44d8ed58a0b2..ad3732df7541 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.ml
@@ -47,6 +47,8 @@ let rev_operations {rev_operations; _} = rev_operations
 
 let rev_tickets {rev_tickets; _} = rev_tickets
 
+let delegate {delegate; _} = delegate
+
 let validation_state {state = vs, _; _} = vs
 
 let level st = st.header.shell.level
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.mli b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.mli
index 301765a07215..9c813180a733 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.mli
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/incremental.mli
@@ -38,6 +38,8 @@ val rev_operations : incremental -> Operation.packed list
 
 val rev_tickets : incremental -> operation_receipt list
 
+val delegate : incremental -> Account.t
+
 val validation_state : incremental -> validation_state
 
 val level : incremental -> int32
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
index 256d99cf1d38..cc787dd11714 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
@@ -284,11 +284,20 @@ let check_ai_launch_cycle_is_zero ~loc block =
     Test.fail ~__LOC__:loc "AI launch cycle should always be zero" ;
   return_unit
 
-(** Bake a block, with the given baker and the given operations. *)
-let bake ?baker : t -> t tzresult Lwt.t =
+(** Apply all operations pending in the [state].
+    It is imperative that the list of pending operations in the state
+    is empty before finalizing the block, either manually, or by calling this function. *)
+let apply_all_pending_operations_ : t_incr -> t_incr tzresult Lwt.t =
+ fun (i, state) ->
+  let open Lwt_result_wrap_syntax in
+  let state, operations = State.pop_pending_operations state in
+  let* i = List.fold_left_es Incremental.add_operation i operations in
+  return (i, state)
+
+(** finalize the payload of the next block. Can start including preattestations. *)
+let finalize_payload_ ?payload_round ?baker : t -> t_incr tzresult Lwt.t =
  fun (block, state) ->
   let open Lwt_result_wrap_syntax in
-  let previous_block = block in
   let policy =
     match baker with
     | None -> state.baking_policy
@@ -308,7 +317,6 @@ let bake ?baker : t -> t tzresult Lwt.t =
   let baker_name, {contract = baker_contract; _} =
     State.find_account_from_pkh baker state
   in
-  let current_cycle = Block.current_cycle block in
   let* level = Plugin.RPC.current_level Block.rpc_ctxt block in
   let* next_level =
     let* ctxt = Context.get_alpha_ctxt (B block) in
@@ -327,16 +335,17 @@ let bake ?baker : t -> t tzresult Lwt.t =
     else Per_block_vote_pass
   in
   let* () = check_issuance_rpc block in
-  let state, operations = State.pop_pending_operations state in
-  let* metadata, block, state =
-    let* block', metadata =
-      Block.bake_with_metadata ?policy ~adaptive_issuance_vote ~operations block
-    in
+  let* block' = Block.bake ?policy ~adaptive_issuance_vote block in
+  let* i =
+    Incremental.begin_construction
+      ?payload_round
+      ~payload:state.pending_operations
+      ?policy
+      ~adaptive_issuance_vote
+      block
+  in
+  let* i, state =
     if state.burn_rewards then
-      (* Incremental mode *)
-      let* i =
-        Incremental.begin_construction ?policy ~adaptive_issuance_vote block
-      in
       let* block_rewards = Context.get_issuance_per_minute (B block') in
       let ctxt = Incremental.alpha_ctxt i in
       let*@ context, _ =
@@ -347,20 +356,26 @@ let bake ?baker : t -> t tzresult Lwt.t =
           block_rewards
       in
       let i = Incremental.set_alpha_ctxt i context in
-      let* i, op_metadata =
-        List.fold_left_es
-          (fun (i, metadata) op ->
-            let* i, m = Incremental.add_operation_with_metadata i op in
-            return (i, m :: metadata))
-          (i, [])
-          operations
-      in
-      let* block, block_metadata = Incremental.finalize_block_with_metadata i in
       let state = State.apply_burn block_rewards baker_name state in
-      return ((block_metadata, List.rev op_metadata), block, state)
-    else return (metadata, block', state)
+      return (i, state)
+    else return (i, state)
   in
-  let baker_acc = State.find_account baker_name state in
+  apply_all_pending_operations_ (i, state)
+
+let finalize_payload ?payload_round ?baker () : (t, t_incr) scenarios =
+  exec (finalize_payload_ ?payload_round ?baker)
+
+let finalize_block_ : t_incr -> t tzresult Lwt.t =
+ fun (i, state) ->
+  let open Lwt_result_wrap_syntax in
+  assert (List.is_empty state.pending_operations) ;
+  let* block, block_metadata = Incremental.finalize_block_with_metadata i in
+  let ((_, op_metadata) as metadata) =
+    (block_metadata, List.rev (Incremental.rev_tickets i))
+  in
+  let previous_block = Incremental.predecessor i in
+  let baker = Incremental.delegate i in
+  let baker_name, baker_acc = State.find_account_from_pkh baker.pkh state in
   (* update baker and attesters activity *)
   let update_activity delegate_account =
     Account_helpers.update_activity
@@ -369,50 +384,23 @@ let bake ?baker : t -> t tzresult Lwt.t =
       (Block.current_cycle block)
   in
   let* attesters =
-    let open Tezos_raw_protocol_023_PtSeouLo.Alpha_context in
-    let* ctxt = Context.get_alpha_ctxt (B previous_block) in
     List.filter_map_es
-      (fun op ->
-        let ({protocol_data = Operation_data protocol_data; _}
-              : packed_operation) =
-          op
-        in
-        match protocol_data.contents with
-        | Single (Attestation {consensus_content; _})
-        | Single (Preattestation consensus_content) ->
-            let*@ _, owner =
-              Stake_distribution.slot_owner
-                ctxt
-                (Level.from_raw ctxt consensus_content.level)
-                consensus_content.slot
-            in
-            return_some [owner.delegate]
-        | Single (Attestations_aggregate {committee; consensus_content}) ->
-            let*@ owners =
-              List.map_es
-                (fun (slot, _) ->
-                  Stake_distribution.slot_owner
-                    ctxt
-                    (Level.from_raw ctxt consensus_content.level)
-                    slot)
-                committee
-            in
-            return_some
-              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
-        | Single (Preattestations_aggregate {committee; consensus_content}) ->
-            let*@ owners =
-              List.map_es
-                (fun slot ->
-                  Stake_distribution.slot_owner
-                    ctxt
-                    (Level.from_raw ctxt consensus_content.level)
-                    slot)
-                committee
-            in
-            return_some
-              (List.map (fun (_, (o : Consensus_key.pk)) -> o.delegate) owners)
-        | _ -> return_none)
-      operations
+      (function
+        | Protocol.Apply_results.No_operation_metadata -> return_none
+        | Operation_metadata {contents} -> (
+            match contents with
+            | Single_result (Attestation_result {delegate; _})
+            | Single_result (Preattestation_result {delegate; _}) ->
+                return_some [delegate]
+            | Single_result (Attestations_aggregate_result {committee; _})
+            | Single_result (Preattestations_aggregate_result {committee; _}) ->
+                return_some
+                  (List.map
+                     (fun ((ck : Protocol.Alpha_context.Consensus_key.t), _) ->
+                       ck.delegate)
+                     committee)
+            | _ -> return_none))
+      op_metadata
   in
   let attesters = List.flatten attesters in
   let state =
@@ -433,6 +421,7 @@ let bake ?baker : t -> t tzresult Lwt.t =
   in
   let* () = check_ai_launch_cycle_is_zero ~loc:__LOC__ block in
   let* state = State.apply_rewards ~baker:baker_name block state in
+  let current_cycle = Block.current_cycle previous_block in
   let new_future_current_cycle = Cycle.succ (Block.current_cycle block) in
   (* Dawn of a new cycle: apply cycle end operations *)
   let* state =
@@ -477,6 +466,14 @@ let bake ?baker : t -> t tzresult Lwt.t =
   in
   return (block, state)
 
+let finalize_block : (t_incr, t) scenarios = exec finalize_block_
+
+(** Bake a block, with the given baker and the given operations. *)
+let bake ?baker : t -> t tzresult Lwt.t =
+ fun input ->
+  let ( |=> ) = Lwt_result.bind in
+  finalize_payload_ ?baker input |=> finalize_block_
+
 let rec repeat n f acc =
   let open Lwt_result_syntax in
   if n <= 0 then return acc
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
index d07ad62e4a6b..b90c73265941 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
@@ -14,10 +14,14 @@ open State
 open Scenario_dsl
 open Log_helpers
 
-(** Usual threaded state for the tests. Contains the current block, pending operations
+(** Usual threaded state for the tests. Contains the current block
     and the known [State.t] *)
 type t = Block.t * State.t
 
+(** Threaded state when constructing a block step by step in incremental mode.
+    The operation metadata list is built as operations are getting applied. *)
+type t_incr = Incremental.t * State.t
+
 let log ?(level = Cli.Logs.Info) ?color format =
   Format.kasprintf
     (fun s ->
-- 
GitLab


From fad734bec6aab30a46f1b0c390a4e7b76f1b624e Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Mon, 7 Jul 2025 17:00:29 +0200
Subject: [PATCH 11/12] 023_PtSeouLo/Proto/tests/scenario: add grandparent in
 state

Porting to proto 023_PtSeouLo 775a6506e19a9e5db3d1913b37dcc29aa0295383 - Proto/tests/scenario: add grandparent in state
---
 .../lib_protocol/test/helpers/scenario_bake.ml                | 1 +
 .../lib_protocol/test/helpers/scenario_begin.ml               | 4 ++++
 src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml     | 1 +
 3 files changed, 6 insertions(+)

diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
index cc787dd11714..98ecdaad3f9c 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_bake.ml
@@ -462,6 +462,7 @@ let finalize_block_ : t_incr -> t tzresult Lwt.t =
       state with
       check_finalized_block_temp = [];
       previous_metadata = Some metadata;
+      grandparent = previous_block;
     }
   in
   return (block, state)
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
index 6b335ba4fa7e..06e6d8ed339e 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_begin.ml
@@ -156,6 +156,10 @@ let begin_test ?algo ?(burn_rewards = false) ?(force_attest_all = false)
             check_finalized_block_temp = [];
             previous_metadata = None;
             operation_mode = Bake;
+            (* The grandparent is only used to get the consensus key, so it is
+               fine to set it to Genesis here. If needed in the future, an option
+               type would be more appropriate. *)
+            grandparent = block;
           }
       in
       let* () = check_all_balances block state in
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
index 55345efec078..ec99172479a9 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/state.ml
@@ -43,6 +43,7 @@ type t = {
     (Block.full_metadata -> Block.t * t -> unit tzresult Lwt.t) list;
   previous_metadata : Block.full_metadata option;
   operation_mode : operation_mode;
+  grandparent : Block.t;
 }
 
 (** Expected number of cycles before staking parameters get applied *)
-- 
GitLab


From be6d89a639f579cf0fe5d9b2952949f66b9f30a5 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Mon, 7 Jul 2025 17:00:42 +0200
Subject: [PATCH 12/12] 023_PtSeouLo/Proto/tests/scenario: more state modifiers

Porting to proto 023_PtSeouLo 746cf47befcf9b2c60706e64075877bdef6b48f4 - Proto/tests/scenario: more state modifiers
---
 .../lib_protocol/test/helpers/scenario_base.ml               | 5 +++++
 .../lib_protocol/test/helpers/scenario_op.ml                 | 4 ++++
 2 files changed, 9 insertions(+)

diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
index b90c73265941..79bbf05b7b73 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_base.ml
@@ -59,6 +59,11 @@ let exclude_bakers bakers : (t, t) scenarios =
       return
         {state with State.baking_policy = Some (Block.Excluding bakers_pkh)})
 
+let set_baked_round (round : int) : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_block, state) ->
+      return {state with State.baking_policy = Some (Block.By_round round)})
+
 (** Unsets the baking policy, it returns to default ([By_round 0]) *)
 let unset_baking_policy : (t, t) scenarios =
   let open Lwt_result_syntax in
diff --git a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml
index ecce91f405c3..a4610cc125c7 100644
--- a/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml
+++ b/src/proto_023_PtSeouLo/lib_protocol/test/helpers/scenario_op.ml
@@ -659,6 +659,10 @@ let make_denunciations ?single ?rev ?filter () =
 let add_account_with_funds ?algo name ~funder amount =
   add_account ?algo name --> transfer funder name amount --> reveal name
 
+let start_payload : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_, state) -> return {state with State.operation_mode = Wait})
+
 let batch ~source : (t, t) scenarios =
   let open Lwt_result_syntax in
   exec_state (fun (_, state) ->
-- 
GitLab