From 9fa26dc75a3ec8237441d244cdd5df1a25cd53c4 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 10:39:10 +0100
Subject: [PATCH 01/18] Proto/tests: add Tezt_core to test helpers

---
 manifest/main.ml                               | 4 ++++
 opam/octez-protocol-alpha-libs.opam            | 2 +-
 src/proto_alpha/lib_protocol/test/helpers/dune | 3 +++
 3 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/manifest/main.ml b/manifest/main.ml
index c3cfd0d4593e..8b587d054941 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -6203,6 +6203,10 @@ let hash = Protocol.hash
         ~opam_only_deps:[octez_protocol_environment; parameters |> if_some]
         ~deps:
           [
+            (if N.(number >= 019) then
+             Some (tezt_core_lib |> open_ |> open_ ~m:"Base")
+            else None)
+            |> if_some;
             qcheck_alcotest;
             octez_test_helpers;
             octez_base |> open_ ~m:"TzPervasives"
diff --git a/opam/octez-protocol-alpha-libs.opam b/opam/octez-protocol-alpha-libs.opam
index 7c257f16e91e..d71995f4b77d 100644
--- a/opam/octez-protocol-alpha-libs.opam
+++ b/opam/octez-protocol-alpha-libs.opam
@@ -15,6 +15,7 @@ depends: [
   "tezos-protocol-alpha"
   "octez-shell-libs"
   "uri" { >= "3.1.0" }
+  "tezt" { >= "4.0.0" & < "5.0.0" }
   "qcheck-alcotest" { >= "0.20" }
   "octez-proto-libs"
   "octez-version"
@@ -22,7 +23,6 @@ depends: [
   "lwt-canceler" { >= "0.3" & < "0.4" }
   "lwt-exit"
   "data-encoding" { >= "0.7.1" & < "1.0.0" }
-  "tezt" { >= "4.0.0" & < "5.0.0" }
   "octez-protocol-compiler"
   "tezos-dal-node-lib"
   "tezos-dac-lib"
diff --git a/src/proto_alpha/lib_protocol/test/helpers/dune b/src/proto_alpha/lib_protocol/test/helpers/dune
index 4cef59fb08f0..e4dbe087d751 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/dune
+++ b/src/proto_alpha/lib_protocol/test/helpers/dune
@@ -6,6 +6,7 @@
  (public_name octez-protocol-alpha-libs.test-helpers)
  (instrumentation (backend bisect_ppx))
  (libraries
+  tezt.core
   qcheck-alcotest
   octez-libs.test-helpers
   octez-libs.base
@@ -22,6 +23,8 @@
   octez-protocol-alpha-libs.smart-rollup)
  (flags
   (:standard)
+  -open Tezt_core
+  -open Tezt_core.Base
   -open Tezos_base.TzPervasives
   -open Tezos_base.TzPervasives.Error_monad.Legacy_monad_globals
   -open Tezos_micheline
-- 
GitLab


From 4f868e5b66712bb679c8bebc26039891224fa5bb Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 11:21:50 +0100
Subject: [PATCH 02/18] Proto/tests: unify Tez helpers

---
 .../test/helpers/adaptive_issuance_helpers.ml | 46 ++----------
 .../lib_protocol/test/helpers/op.ml           |  2 +-
 .../lib_protocol/test/helpers/test_tez.ml     | 25 +++++--
 .../lib_protocol/test/helpers/test_tez.mli    | 70 +++++++++++++++++++
 .../integration/michelson/test_sapling.ml     |  3 +-
 .../integration/operations/test_voting.ml     | 20 ++----
 .../test_adaptive_issuance_roundtrip.ml       | 14 ++--
 .../test/integration/test_liquidity_baking.ml |  6 +-
 8 files changed, 115 insertions(+), 71 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/helpers/test_tez.mli

diff --git a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
index d7ca22863442..dcf4f4a41175 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
@@ -23,6 +23,11 @@
 (*                                                                           *)
 (*****************************************************************************)
 
+module Tez = struct
+  include Test_tez
+  include Test_tez.Compare
+end
+
 let join_errors e1 e2 =
   let open Lwt_result_syntax in
   match (e1, e2) with
@@ -30,47 +35,6 @@ let join_errors e1 e2 =
   | Error e, Ok () | Ok (), Error e -> fail e
   | Error e1, Error e2 -> fail (e1 @ e2)
 
-(** Tez manipulation module *)
-module Tez = struct
-  include Protocol.Alpha_context.Tez
-
-  let ( + ) a b =
-    let open Lwt_result_wrap_syntax in
-    let*?@ s = a +? b in
-    return s
-
-  let ( - ) a b =
-    let open Lwt_result_wrap_syntax in
-    let*?@ s = a -? b in
-    return s
-
-  let ( +! ) a b =
-    let a = to_mutez a in
-    let b = to_mutez b in
-    Int64.add a b |> of_mutez_exn
-
-  let ( -! ) a b =
-    let a = to_mutez a in
-    let b = to_mutez b in
-    Int64.sub a b |> of_mutez_exn
-
-  let of_mutez = of_mutez_exn
-
-  let of_z a = Z.to_int64 a |> of_mutez
-
-  let of_q ~round Q.{num; den} =
-    (match round with `Up -> Z.cdiv num den | `Down -> Z.div num den) |> of_z
-
-  let to_z a = to_mutez a |> Z.of_int64
-
-  let ratio num den =
-    Q.make (Z.of_int64 (to_mutez num)) (Z.of_int64 (to_mutez den))
-
-  let mul_q tez portion =
-    let tez_z = to_mutez tez |> Z.of_int64 in
-    Q.(mul portion ~$$tez_z)
-end
-
 (** Representation of Tez with non integer values *)
 module Partial_tez = struct
   include Q
diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml
index b1ee1cdb0441..c5273bd4213a 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/op.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml
@@ -795,7 +795,7 @@ let dummy_script =
       storage = lazy_expr (strip_locations (Prim ((), D_Unit, [], [])));
     }
 
-let dummy_script_cost = Test_tez.of_mutez_exn 9_500L
+let dummy_script_cost = Test_tez.of_mutez 9_500L
 
 let transfer_ticket ?force_reveal ?counter ?fee ?gas_limit ?storage_limit ctxt
     ~(source : Contract.t) ~contents ~ty ~ticketer ~amount ~destination
diff --git a/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml b/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
index 7d523a82c98e..e1dbe501e09e 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
@@ -26,9 +26,7 @@
 open Protocol
 open Alpha_context
 open Environment
-
-(* This module wraps the errors from the protocol *)
-open Tez
+include Tez
 
 let ( +? ) t1 t2 = t1 +? t2 |> wrap_tzresult
 
@@ -36,6 +34,8 @@ let ( -? ) t1 t2 = t1 -? t2 |> wrap_tzresult
 
 let ( *? ) t1 t2 = t1 *? t2 |> wrap_tzresult
 
+let ( /? ) t1 t2 = t1 /? t2 |> wrap_tzresult
+
 let ( +! ) t1 t2 =
   match t1 +? t2 with Ok r -> r | Error _ -> Pervasives.failwith "adding tez"
 
@@ -59,10 +59,27 @@ let of_int x =
   | None -> invalid_arg "tez_of_int"
   | Some x -> x
 
-let of_mutez_exn x =
+let of_mutez x =
   match Tez.of_mutez x with None -> invalid_arg "tez_of_mutez" | Some x -> x
 
 let to_mutez = Tez.to_mutez
 
+(* Should be the same as Tez.max_mutez *)
 let max_tez =
   match Tez.of_mutez Int64.max_int with None -> assert false | Some p -> p
+
+let of_z a = Z.to_int64 a |> Tez.of_mutez_exn
+
+let of_q ~round Q.{num; den} =
+  (match round with `Up -> Z.cdiv num den | `Down -> Z.div num den) |> of_z
+
+let to_z a = to_mutez a |> Z.of_int64
+
+let ratio num den =
+  Q.make (Z.of_int64 (to_mutez num)) (Z.of_int64 (to_mutez den))
+
+let mul_q tez portion =
+  let tez_z = to_mutez tez |> Z.of_int64 in
+  Q.(mul portion ~$$tez_z)
+
+module Compare = Tez
diff --git a/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli b/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli
new file mode 100644
index 000000000000..ebfd4a3466cb
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This module wraps the errors from the protocol and provides some helpful
+    functions manipulating Tez. *)
+type t = Protocol.Alpha_context.Tez.t
+
+val zero : t
+
+val one_mutez : t
+
+val one_cent : t
+
+val fifty_cents : t
+
+val one : t
+
+(* Same as max_mutez *)
+val max_tez : t
+
+val equal : t -> t -> bool
+
+val ( -? ) : t -> t -> t tzresult
+
+val sub_opt : t -> t -> t option
+
+val ( +? ) : t -> t -> t tzresult
+
+val ( *? ) : t -> int64 -> t tzresult
+
+val ( /? ) : t -> int64 -> t tzresult
+
+(* These operators can raise exceptions *)
+val ( -! ) : t -> t -> t
+
+val ( +! ) : t -> t -> t
+
+val ( *! ) : t -> int64 -> t
+
+val ( /! ) : t -> int64 -> t
+
+val to_mutez : t -> int64
+
+(* Is actually of_mutez_exn *)
+val of_mutez : int64 -> t
+
+val min : t -> t -> t
+
+module Compare : Compare.S with type t := t
+
+val pp : Format.formatter -> t -> unit
+
+val to_string : t -> string
+
+(* Helper functions, not exported from the protocol *)
+val ratio : t -> t -> Q.t
+
+val mul_q : t -> Q.t -> Q.t
+
+val of_int : int -> t
+
+val of_q : round:[`Down | `Up] -> Q.t -> t
+
+val of_z : Z.t -> t
+
+val to_z : t -> Z.t
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
index 6b8dc40341e4..618d90b25042 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
@@ -33,7 +33,6 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
 
 module Raw_context_tests = struct
   open Sapling_helpers.Common
@@ -997,7 +996,7 @@ module Interpreter_tests = struct
         ()
     in
     let fee = Test_tez.of_int 10 in
-    let*? amount_tez = Tez.one_mutez *? Int64.of_int 15 in
+    let*? amount_tez = Test_tez.(one_mutez *? Int64.of_int 15) in
     let* operation1 =
       Op.transaction
         ~gas_limit:High
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml
index d7fc680cea08..52ece63a2fe5 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml
@@ -974,7 +974,7 @@ let test_supermajority_in_proposal there_is_a_winner () =
     else
       let open Result_syntax in
       let* t = Test_tez.( *? ) minimal_stake 2L in
-      Test_tez.( +? ) (Test_tez.of_mutez_exn initial_balance) t
+      Test_tez.( +? ) (Test_tez.of_mutez initial_balance) t
   in
   let* op3 =
     Op.transaction
@@ -1039,7 +1039,7 @@ let test_quorum_in_proposal has_quorum () =
     else Int64.(sub (of_int32 min_proposal_quorum) 10L)
   in
   let bal =
-    Int64.(div (mul total_tokens quorum) 100_00L) |> Test_tez.of_mutez_exn
+    Int64.(div (mul total_tokens quorum) 100_00L) |> Test_tez.of_mutez
   in
   let* op2 = Op.transaction (B b) del2 del1 bal in
   let* b = Block.bake ~policy ~operation:op2 b in
@@ -1257,27 +1257,21 @@ let test_voting_power_updated_each_voting_period () =
     Context.Delegate.current_frozen_deposits (B genesis) baker1
   in
   let*? full_balance1 = balance1 +? frozen_deposits1 in
-  let* () =
-    Assert.equal_tez ~loc:__LOC__ full_balance1 (of_mutez_exn init_bal1)
-  in
+  let* () = Assert.equal_tez ~loc:__LOC__ full_balance1 (of_mutez init_bal1) in
   (* Retrieve balance of con2 *)
   let* balance2 = Context.Contract.balance (B genesis) con2 in
   let* frozen_deposits2 =
     Context.Delegate.current_frozen_deposits (B genesis) baker2
   in
   let*? full_balance2 = balance2 +? frozen_deposits2 in
-  let* () =
-    Assert.equal_tez ~loc:__LOC__ full_balance2 (of_mutez_exn init_bal2)
-  in
+  let* () = Assert.equal_tez ~loc:__LOC__ full_balance2 (of_mutez init_bal2) in
   (* Retrieve balance of con3 *)
   let* balance3 = Context.Contract.balance (B genesis) con3 in
   let* frozen_deposits3 =
     Context.Delegate.current_frozen_deposits (B genesis) baker3
   in
   let*? full_balance3 = balance3 +? frozen_deposits3 in
-  let* () =
-    Assert.equal_tez ~loc:__LOC__ full_balance3 (of_mutez_exn init_bal3)
-  in
+  let* () = Assert.equal_tez ~loc:__LOC__ full_balance3 (of_mutez init_bal3) in
   (* Auxiliary assert_voting_power *)
   let assert_voting_power ~loc n block baker =
     let* voting_power = get_voting_power block baker in
@@ -1317,7 +1311,7 @@ let test_voting_power_updated_each_voting_period () =
   (* Retrieve balance of con1 *)
   let* balance1 = Context.Contract.balance (B block) con1 in
   (* Assert balance has changed by deducing the amount *)
-  let*? balance1_after_deducing_amount = of_mutez_exn init_bal1 -? amount in
+  let*? balance1_after_deducing_amount = of_mutez init_bal1 -? amount in
   let* frozen_deposit1 =
     Context.Delegate.current_frozen_deposits (B block) baker1
   in
@@ -1328,7 +1322,7 @@ let test_voting_power_updated_each_voting_period () =
   (* Retrieve balance of con2 *)
   let* balance2 = Context.Contract.balance (B block) con2 in
   (* Assert balance has changed by adding amount *)
-  let*? balance2_after_adding_amount = of_mutez_exn init_bal2 +? amount in
+  let*? balance2_after_adding_amount = of_mutez init_bal2 +? amount in
   let* frozen_deposit2 =
     Context.Delegate.current_frozen_deposits (B block) baker2
   in
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 7daa633e798d..158a4cb33335 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -142,7 +142,7 @@ let quantity_to_tez all qty =
   | All_but_one ->
       if Tez.(equal all zero) then Tez.zero else Tez.(all -! one_mutez)
   | Half -> Test_tez.(all /! 2L)
-  | Max_tez -> Tez.max_mutez
+  | Max_tez -> Tez.max_tez
   | Amount a -> a
 
 let default_params =
@@ -314,7 +314,7 @@ module State = struct
       let to_frozen = Tez.(delta_rewards -! to_liquid) in
       let state = update_map ~f:(add_liquid_rewards to_liquid baker) state in
       let state = update_map ~f:(add_frozen_rewards to_frozen baker) state in
-      let* total_supply = Tez.(total_supply + delta_rewards) in
+      let*? total_supply = Tez.(total_supply +? delta_rewards) in
       return {state with last_level_rewards = current_level; total_supply}
 
   let apply_slashing
@@ -403,7 +403,7 @@ module State = struct
       optimal
       op
       Tez.pp
-      (Tez.of_mutez_exn amount)
+      (Tez.of_mutez amount)
 
   let apply_autostake ~name ~old_cycle
       ({
@@ -475,7 +475,7 @@ module State = struct
             (Int64.neg autostaked) ;
           apply_unstake
             (Cycle.succ old_cycle)
-            (Test_tez.of_mutez_exn Int64.(neg autostaked))
+            (Test_tez.of_mutez Int64.(neg autostaked))
             name
             state)
         else (
@@ -492,7 +492,7 @@ module State = struct
 
   (** Applies when baking the last block of a cycle *)
   let apply_end_cycle current_cycle block state : t tzresult Lwt.t =
-    let open Lwt_result_wrap_syntax in
+    let open Lwt_result_syntax in
     Log.debug ~color:time_color "Ending cycle %a" Cycle.pp current_cycle ;
     let* launch_cycle_opt =
       Context.get_adaptive_issuance_launch_cycle (B block)
@@ -510,7 +510,7 @@ module State = struct
         state
     in
     (* Apply autostaking *)
-    let*?@ state =
+    let*? state =
       if not state.constants.adaptive_issuance.autostaking_enable then Ok state
       else
         match launch_cycle_opt with
@@ -1226,7 +1226,7 @@ let set_delegate src_name delegate_name_opt : (t, t) scenarios =
       let state =
         if Q.(equal balance.staked_b zero) then state
         else
-          let state = State.apply_unstake cycle Tez.max_mutez src_name state in
+          let state = State.apply_unstake cycle Tez.max_tez src_name state in
           (* Changing delegate applies finalize if unstake happened *)
           State.apply_finalize src_name state
       in
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml b/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml
index 5b379affc9a1..f6b0d23d6895 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml
@@ -467,7 +467,7 @@ let liquidity_baking_origination_result_cpmm_balance () =
   in
   let result = get_cpmm_result origination_results in
   let balance_update = get_balance_update_in_result result in
-  let* () = Assert.equal_tez ~loc:__LOC__ balance_update (of_mutez_exn 100L) in
+  let* () = Assert.equal_tez ~loc:__LOC__ balance_update (of_mutez 100L) in
   return_unit
 
 let liquidity_baking_origination_result_lqt_address () =
@@ -508,8 +508,8 @@ let liquidity_baking_origination_result_lqt_balance () =
   ] ->
       let* () = Assert.equal_tez ~loc:__LOC__ am1 am2 in
       let* () = Assert.equal_tez ~loc:__LOC__ am3 am4 in
-      let* () = Assert.equal_tez ~loc:__LOC__ am1 (of_mutez_exn 64_250L) in
-      Assert.equal_tez ~loc:__LOC__ am3 (of_mutez_exn 494_500L)
+      let* () = Assert.equal_tez ~loc:__LOC__ am1 (of_mutez 64_250L) in
+      Assert.equal_tez ~loc:__LOC__ am3 (of_mutez 494_500L)
   | _ -> failwith "Unexpected balance updates (%s)" __LOC__
 
 (* Test that with no contract at the tzBTC address and the level low enough to indicate we're not on mainnet, three contracts are originated in stitching. *)
-- 
GitLab


From b672cbe7cb7de7b28757c50634f51dbcc7078dbc Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 11:38:25 +0100
Subject: [PATCH 03/18] Proto/tests: move account logic in dedicated file

---
 .../test/helpers/adaptive_issuance_helpers.ml | 1400 +----------------
 .../test/helpers/state_account.ml             | 1387 ++++++++++++++++
 .../test_adaptive_issuance_launch.ml          |    7 +-
 .../test_adaptive_issuance_roundtrip.ml       |    1 +
 4 files changed, 1403 insertions(+), 1392 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/helpers/state_account.ml

diff --git a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
index dcf4f4a41175..2841b7d2641a 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
@@ -23,1392 +23,12 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-module Tez = struct
-  include Test_tez
-  include Test_tez.Compare
-end
-
-let join_errors e1 e2 =
-  let open Lwt_result_syntax in
-  match (e1, e2) with
-  | Ok (), Ok () -> return_unit
-  | Error e, Ok () | Ok (), Error e -> fail e
-  | Error e1, Error e2 -> fail (e1 @ e2)
-
-(** Representation of Tez with non integer values *)
-module Partial_tez = struct
-  include Q
-
-  let of_tez a = Tez.to_mutez a |> of_int64
-
-  let to_tez_rem {num; den} =
-    let tez, rem = Z.div_rem num den in
-    (Tez.of_z tez, rem /// den)
-
-  let to_tez ~round = Tez.of_q ~round
-
-  let get_rem a = snd (to_tez_rem a)
-
-  let pp fmt a =
-    let tez, rem = to_tez_rem a in
-    (* If rem = 0, we keep the (+ 0), to indicate that it's a partial tez *)
-    Format.fprintf fmt "%a ( +%aµꜩ )" Tez.pp tez Q.pp_print rem
-end
-
-module Cycle = Protocol.Alpha_context.Cycle
-
-(** [Frozen_tez] represents frozen stake and frozen unstaked funds.
-    Properties:
-    - sum of all current partial tez is an integer
-    - Can only add integer amounts
-    - Can always subtract integer amount (if lower than frozen amount)
-    - If subtracting partial amount, must be the whole frozen amount (for given contract).
-      The remainder is then distributed equally amongst remaining accounts, to keep property 1.
-    - All entries of current are positive, non zero.
-*)
-module Frozen_tez = struct
-  (* The map in current maps the stakers' name with their staked value.
-     It contains only delegators of the delegate which owns the frozen tez *)
-  type t = {
-    delegate : string;
-    initial : Tez.t;
-    self_current : Tez.t;
-    co_current : Partial_tez.t String.Map.t;
-  }
-
-  let zero =
-    {
-      delegate = "";
-      initial = Tez.zero;
-      self_current = Tez.zero;
-      co_current = String.Map.empty;
-    }
-
-  let init amount account delegate =
-    if account = delegate then
-      {
-        delegate;
-        initial = amount;
-        self_current = amount;
-        co_current = String.Map.empty;
-      }
-    else
-      {
-        delegate;
-        initial = amount;
-        self_current = Tez.zero;
-        co_current = String.Map.singleton account (Partial_tez.of_tez amount);
-      }
-
-  let union a b =
-    assert (a.delegate = b.delegate) ;
-    {
-      delegate = a.delegate;
-      initial = Tez.(a.initial +! b.initial);
-      self_current = Tez.(a.self_current +! b.self_current);
-      co_current =
-        String.Map.union
-          (fun _ x y -> Some Partial_tez.(x + y))
-          a.co_current
-          b.co_current;
-    }
-
-  let get account frozen_tez =
-    if account = frozen_tez.delegate then
-      Partial_tez.of_tez frozen_tez.self_current
-    else
-      match String.Map.find account frozen_tez.co_current with
-      | None -> Partial_tez.zero
-      | Some p -> p
-
-  let total_co_current_q co_current =
-    String.Map.fold
-      (fun _ x acc -> Partial_tez.(x + acc))
-      co_current
-      Partial_tez.zero
-
-  let total_current a =
-    let r = total_co_current_q a.co_current in
-    let tez, rem = Partial_tez.to_tez_rem r in
-    assert (Q.(equal rem zero)) ;
-    Tez.(tez +! a.self_current)
-
-  (* 0 <= quantity < 1 && co_current + quantity is int *)
-  let add_q_to_all_co_current quantity co_current =
-    let s = total_co_current_q co_current in
-    if Q.(equal quantity zero) then co_current
-    else
-      let f p_amount =
-        let q = Q.div p_amount s in
-        Partial_tez.add p_amount (Q.mul quantity q)
-      in
-      String.Map.map f co_current
-
-  (* For rewards, distribute equally *)
-  let add_tez_to_all_current ~edge tez a =
-    let self_portion = Tez.ratio a.self_current (total_current a) in
-    (* Baker's advantage for the mutez *)
-    let self_quantity = Tez.mul_q tez self_portion |> Tez.of_q ~round:`Up in
-    let remains = Tez.(tez -! self_quantity) in
-    (* Baker's edge. Round up for the baker's advantage again *)
-    let bakers_edge = Tez.mul_q remains edge |> Tez.of_q ~round:`Up in
-    let self_quantity = Tez.(self_quantity +! bakers_edge) in
-    (* The remains are distributed equally *)
-    let co_quantity = Partial_tez.of_tez Tez.(tez -! self_quantity) in
-    let co_current = add_q_to_all_co_current co_quantity a.co_current in
-    {a with co_current; self_current = Tez.(a.self_current +! self_quantity)}
-
-  (* For slashing, slash equally *)
-  let sub_tez_from_all_current tez a =
-    let self_portion = Tez.ratio a.self_current (total_current a) in
-    let self_quantity = Tez.mul_q tez self_portion |> Tez.of_q ~round:`Down in
-    let self_current =
-      if Tez.(self_quantity >= a.self_current) then Tez.zero
-      else Tez.(a.self_current -! self_quantity)
-    in
-    let co_quantity = Tez.(tez -! self_quantity) in
-    let s = total_co_current_q a.co_current in
-    if Partial_tez.(geq (of_tez co_quantity) s) then
-      {a with self_current; co_current = String.Map.empty}
-    else
-      let f p_amount =
-        let q = Q.div p_amount s in
-        Partial_tez.sub p_amount (Tez.mul_q co_quantity q)
-        (* > 0 *)
-      in
-      {a with self_current; co_current = String.Map.map f a.co_current}
-
-  (* Adds frozen to account. Happens each stake in frozen deposits *)
-  let add_current_q amount account a =
-    if account = a.delegate then (
-      let amount, rem = Partial_tez.to_tez_rem amount in
-      assert (Q.(equal rem zero)) ;
-      {a with self_current = Tez.(a.self_current +! amount)})
-    else
-      {
-        a with
-        co_current =
-          String.Map.update
-            account
-            (function
-              | None -> Some amount | Some q -> Some Partial_tez.(add q amount))
-            a.co_current;
-      }
-
-  let add_current amount account a =
-    add_current_q (Partial_tez.of_tez amount) account a
-
-  let add_self_current amount a =
-    let self_current = Tez.(a.self_current +! amount) in
-    {a with self_current}
-
-  (* Adds frozen to account. Happens each unstake to unstaked frozen deposits *)
-  let add_init amount account a = union a (init amount account a.delegate)
-
-  (* Allows amount greater than current frozen amount.
-     Happens each unstake in frozen deposits *)
-  let sub_current amount account a =
-    if account = a.delegate then
-      let amount = Tez.min amount a.self_current in
-      ({a with self_current = Tez.(a.self_current -! amount)}, amount)
-    else
-      match String.Map.find account a.co_current with
-      | None -> (a, Tez.zero)
-      | Some frozen ->
-          let amount_q = Partial_tez.of_tez amount in
-          if Q.(geq amount_q frozen) then
-            let removed, remainder = Partial_tez.to_tez_rem frozen in
-            let co_current = String.Map.remove account a.co_current in
-            let co_current = add_q_to_all_co_current remainder co_current in
-            ({a with co_current}, removed)
-          else
-            let co_current =
-              String.Map.add account Q.(frozen - amount_q) a.co_current
-            in
-            ({a with co_current}, amount)
-
-  (* Remove a partial amount to the co frozen tez table. *)
-  let sub_current_q amount_q account a =
-    if account = a.delegate then assert false
-    else
-      match String.Map.find account a.co_current with
-      | None -> a
-      | Some frozen ->
-          if Q.(geq amount_q frozen) then
-            let co_current = String.Map.remove account a.co_current in
-            {a with co_current}
-          else
-            let co_current =
-              String.Map.add account Q.(frozen - amount_q) a.co_current
-            in
-            {a with co_current}
-
-  let sub_current_and_init amount account a =
-    let a, amount = sub_current amount account a in
-    ({a with initial = Tez.(a.initial -! amount)}, amount)
-
-  let slash base_amount (pct : Protocol.Percentage.t) a =
-    let pct_q = Protocol.Percentage.to_q pct in
-    let slashed_amount = Tez.mul_q base_amount pct_q |> Tez.of_q ~round:`Down in
-    let total_current = total_current a in
-    let slashed_amount_final = Tez.min slashed_amount total_current in
-    (sub_tez_from_all_current slashed_amount a, slashed_amount_final)
-end
-
-(** Representation of Unstaked frozen deposits *)
-module Unstaked_frozen = struct
-  type r = {
-    cycle : Cycle.t;
-    (* initial total requested amount (slash ∝ initial) *)
-    initial : Tez.t;
-    (* current amount, slashes applied here *)
-    current : Tez.t;
-    (* initial requests, don't apply slash unless finalize or balance query *)
-    requests : Tez.t String.Map.t;
-    (* slash pct memory for requests *)
-    slash_pct : int;
-  }
-
-  type t = r list
-
-  type get_info = {cycle : Cycle.t; request : Tez.t; current : Tez.t}
-
-  type get_info_list = get_info list
-
-  type finalizable_info = {
-    amount : Tez.t;
-    slashed_requests : Tez.t String.Map.t;
-  }
-
-  let zero = []
-
-  let init_r cycle request account =
-    {
-      cycle;
-      initial = request;
-      current = request;
-      requests = String.Map.singleton account request;
-      slash_pct = 0;
-    }
-
-  let apply_slash_to_request slash_pct amount =
-    let slashed_amount =
-      Tez.mul_q amount Q.(slash_pct // 100) |> Tez.of_q ~round:`Up
-    in
-    Tez.(amount -! slashed_amount)
-
-  let apply_slash_to_current slash_pct initial current =
-    let slashed_amount =
-      Tez.mul_q initial Q.(slash_pct // 100) |> Tez.of_q ~round:`Down
-    in
-    Tez.sub_opt current slashed_amount |> Option.value ~default:Tez.zero
-
-  let remove_zeros (a : t) : t =
-    List.filter (fun ({current; _} : r) -> Tez.(current > zero)) a
-
-  let get account unstaked : get_info_list =
-    List.filter_map
-      (fun {cycle; requests; slash_pct; _} ->
-        String.Map.find account requests
-        |> Option.map (fun request ->
-               {
-                 cycle;
-                 request;
-                 current = apply_slash_to_request slash_pct request;
-               }))
-      unstaked
-
-  let get_total account unstaked =
-    get account unstaked
-    |> List.fold_left
-         (fun acc ({current; _} : get_info) -> Tez.(acc +! current))
-         Tez.zero
-
-  let sum_current unstaked =
-    List.fold_left
-      (fun acc ({current; _} : r) -> Tez.(acc +! current))
-      Tez.zero
-      unstaked
-
-  (* Happens each unstake operation *)
-  let rec add_unstake cycle amount account : t -> t = function
-    | [] -> [init_r cycle amount account]
-    | ({cycle = c; requests; initial; current; slash_pct} as h) :: t ->
-        let open Tez in
-        if Cycle.equal c cycle then (
-          assert (Int.equal slash_pct 0) ;
-          {
-            cycle;
-            initial = initial +! amount;
-            current = current +! amount;
-            slash_pct;
-            requests =
-              String.Map.update
-                account
-                (function
-                  | None -> Some amount | Some x -> Some Tez.(x +! amount))
-                requests;
-          }
-          :: t)
-        else h :: add_unstake cycle amount account t
-
-  (* Happens in stake from unstake *)
-  let sub_unstake amount account : r -> r =
-   fun {cycle; requests; initial; current; slash_pct} ->
-    assert (slash_pct = 0) ;
-    let open Tez in
-    {
-      cycle;
-      initial = initial -! amount;
-      current = current -! amount;
-      slash_pct;
-      requests =
-        String.Map.update
-          account
-          (function
-            | None ->
-                assert (Tez.(amount = zero)) ;
-                None
-            | Some x ->
-                if Tez.(x = amount) then None else Some Tez.(x -! amount))
-          requests;
-    }
-
-  (* Makes given cycle finalizable (and unslashable) *)
-  let rec pop_cycle cycle : t -> finalizable_info * t = function
-    | [] -> ({amount = Tez.zero; slashed_requests = String.Map.empty}, [])
-    | ({cycle = c; requests; initial = _; current; slash_pct} as h) :: t ->
-        if Cycle.(c = cycle) then
-          let amount = current in
-          let slashed_requests =
-            String.Map.map (apply_slash_to_request slash_pct) requests
-          in
-          ({amount; slashed_requests}, t)
-        else if Cycle.(c < cycle) then
-          Stdlib.failwith
-            "Unstaked_frozen: found unfinalized cycle before given [cycle]. \
-             Make sure to call [apply_unslashable] every cycle"
-        else
-          let info, rest = pop_cycle cycle t in
-          (info, h :: rest)
-
-  let slash ~slashable_deposits_period slashed_cycle pct_times_100 a =
-    remove_zeros a
-    |> List.map
-         (fun
-           ({cycle; requests = _; initial; current; slash_pct = old_slash_pct}
-           as r)
-         ->
-           if
-             Cycle.(
-               cycle > slashed_cycle
-               || add cycle slashable_deposits_period < slashed_cycle)
-           then (r, Tez.zero)
-           else
-             let new_current =
-               apply_slash_to_current pct_times_100 initial current
-             in
-             let slashed = Tez.(current -! new_current) in
-             let slash_pct = min 100 (pct_times_100 + old_slash_pct) in
-             ({r with slash_pct; current = new_current}, slashed))
-    |> List.split
-end
-
-(** Representation of unstaked finalizable tez *)
-module Unstaked_finalizable = struct
-  (* Slashing might put inaccessible tez in this container: they are represented in the remainder.
-     They still count towards the total supply, but are currently owned by noone.
-     At most one mutez per unstaking account per slashed cycle *)
-  type t = {map : Tez.t String.Map.t; remainder : Tez.t}
-
-  let zero = {map = String.Map.empty; remainder = Tez.zero}
-
-  (* Called when unstaked frozen for some cycle becomes finalizable *)
-  let add_from_poped_ufd
-      ({amount; slashed_requests} : Unstaked_frozen.finalizable_info)
-      {map; remainder} =
-    let total_requested =
-      String.Map.fold (fun _ x acc -> Tez.(x +! acc)) slashed_requests Tez.zero
-    in
-    let remainder = Tez.(remainder +! amount -! total_requested) in
-    let map =
-      String.Map.union (fun _ a b -> Some Tez.(a +! b)) map slashed_requests
-    in
-    {map; remainder}
-
-  let total {map; remainder} =
-    String.Map.fold (fun _ x acc -> Tez.(x +! acc)) map remainder
-
-  let get account {map; _} =
-    match String.Map.find account map with None -> Tez.zero | Some x -> x
-end
-
 (** Abstraction of the staking parameters for tests *)
 type staking_parameters = {
   limit_of_staking_over_baking : Q.t;
   edge_of_baking_over_staking : Q.t;
 }
 
-module CycleMap = Map.Make (Cycle)
-
-(** Abstract information of accounts *)
-type account_state = {
-  pkh : Signature.Public_key_hash.t;
-  contract : Protocol.Alpha_context.Contract.t;
-  delegate : string option;
-  parameters : staking_parameters;
-  liquid : Tez.t;
-  bonds : Tez.t;
-  (* The three following fields contain maps from the account's stakers to,
-     respectively, their frozen stake, their unstaked frozen balance, and
-     their unstaked finalizable funds. Additionally, [unstaked_frozen] indexes
-     the maps with the cycle at which the unstake operation occurred. *)
-  frozen_deposits : Frozen_tez.t;
-  unstaked_frozen : Unstaked_frozen.t;
-  unstaked_finalizable : Unstaked_finalizable.t;
-  staking_delegator_numerator : Z.t;
-  staking_delegate_denominator : Z.t;
-  frozen_rights : Tez.t CycleMap.t;
-  slashed_cycles : Cycle.t list;
-}
-
-let init_account ?delegate ~pkh ~contract ~parameters ?(liquid = Tez.zero)
-    ?(bonds = Tez.zero) ?(frozen_deposits = Frozen_tez.zero)
-    ?(unstaked_frozen = Unstaked_frozen.zero)
-    ?(unstaked_finalizable = Unstaked_finalizable.zero)
-    ?(staking_delegator_numerator = Z.zero)
-    ?(staking_delegate_denominator = Z.zero) ?(frozen_rights = CycleMap.empty)
-    ?(slashed_cycles = []) () =
-  {
-    pkh;
-    contract;
-    delegate;
-    parameters;
-    liquid;
-    bonds;
-    frozen_deposits;
-    unstaked_frozen;
-    unstaked_finalizable;
-    staking_delegator_numerator;
-    staking_delegate_denominator;
-    frozen_rights;
-    slashed_cycles;
-  }
-
-type account_map = account_state String.Map.t
-
-(** Balance returned by RPCs. Partial tez are rounded down *)
-type balance = {
-  liquid_b : Tez.t;
-  bonds_b : Tez.t;
-  staked_b : Partial_tez.t;
-  unstaked_frozen_b : Tez.t;
-  unstaked_finalizable_b : Tez.t;
-  staking_delegator_numerator_b : Z.t;
-  staking_delegate_denominator_b : Z.t;
-}
-
-let balance_zero =
-  {
-    liquid_b = Tez.zero;
-    bonds_b = Tez.zero;
-    staked_b = Partial_tez.zero;
-    unstaked_frozen_b = Tez.zero;
-    unstaked_finalizable_b = Tez.zero;
-    staking_delegator_numerator_b = Z.zero;
-    staking_delegate_denominator_b = Z.zero;
-  }
-
-let balance_of_account account_name (account_map : account_map) =
-  match String.Map.find account_name account_map with
-  | None -> raise Not_found
-  | Some
-      {
-        pkh = _;
-        contract = _;
-        delegate;
-        parameters = _;
-        liquid;
-        bonds;
-        frozen_deposits = _;
-        unstaked_frozen = _;
-        unstaked_finalizable = _;
-        staking_delegator_numerator;
-        staking_delegate_denominator;
-        frozen_rights = _;
-        slashed_cycles = _;
-      } ->
-      let balance =
-        {
-          balance_zero with
-          liquid_b = liquid;
-          bonds_b = bonds;
-          staking_delegator_numerator_b = staking_delegator_numerator;
-          staking_delegate_denominator_b = staking_delegate_denominator;
-        }
-      in
-      let balance =
-        match delegate with
-        | None -> balance
-        | Some d -> (
-            match String.Map.find d account_map with
-            | None -> raise Not_found
-            | Some delegate_account ->
-                {
-                  balance with
-                  staked_b =
-                    Frozen_tez.get account_name delegate_account.frozen_deposits;
-                })
-      in
-      (* Because an account can still have frozen or finalizable funds from a delegate
-         that is not its own, we iterate over all of them *)
-      let unstaked_frozen_b, unstaked_finalizable_b =
-        String.Map.fold
-          (fun _delegate_name delegate (frozen, finalzbl) ->
-            let frozen =
-              Tez.(
-                frozen
-                +! Unstaked_frozen.get_total
-                     account_name
-                     delegate.unstaked_frozen)
-            in
-            let finalzbl =
-              Tez.(
-                finalzbl
-                +! Unstaked_finalizable.get
-                     account_name
-                     delegate.unstaked_finalizable)
-            in
-            (frozen, finalzbl))
-          account_map
-          (Tez.zero, Tez.zero)
-      in
-      {balance with unstaked_frozen_b; unstaked_finalizable_b}
-
-let balance_pp fmt
-    {
-      liquid_b;
-      bonds_b;
-      staked_b;
-      unstaked_frozen_b;
-      unstaked_finalizable_b;
-      staking_delegator_numerator_b;
-      staking_delegate_denominator_b;
-    } =
-  Format.fprintf
-    fmt
-    "{@;\
-     @[<v 2>  liquid : %a@;\
-     bonds : %a@;\
-     staked : %a@;\
-     unstaked_frozen : %a@;\
-     unstaked_finalizable : %a@;\
-     staking_delegator_numerator : %a@;\
-     staking_delegate_denominator : %a@;\
-     }@."
-    Tez.pp
-    liquid_b
-    Tez.pp
-    bonds_b
-    Partial_tez.pp
-    staked_b
-    Tez.pp
-    unstaked_frozen_b
-    Tez.pp
-    unstaked_finalizable_b
-    Z.pp_print
-    staking_delegator_numerator_b
-    Z.pp_print
-    staking_delegate_denominator_b
-
-let balance_update_pp fmt
-    ( {
-        liquid_b = a_liquid_b;
-        bonds_b = a_bonds_b;
-        staked_b = a_staked_b;
-        unstaked_frozen_b = a_unstaked_frozen_b;
-        unstaked_finalizable_b = a_unstaked_finalizable_b;
-        staking_delegator_numerator_b = a_staking_delegator_numerator_b;
-        staking_delegate_denominator_b = a_staking_delegate_denominator_b;
-      },
-      {
-        liquid_b = b_liquid_b;
-        bonds_b = b_bonds_b;
-        staked_b = b_staked_b;
-        unstaked_frozen_b = b_unstaked_frozen_b;
-        unstaked_finalizable_b = b_unstaked_finalizable_b;
-        staking_delegator_numerator_b = b_staking_delegator_numerator_b;
-        staking_delegate_denominator_b = b_staking_delegate_denominator_b;
-      } ) =
-  Format.fprintf
-    fmt
-    "{@;\
-     @[<v 2>  liquid : %a -> %a@;\
-     bonds : %a -> %a@;\
-     staked : %a -> %a@;\
-     unstaked_frozen : %a -> %a@;\
-     unstaked_finalizable : %a -> %a@;\
-     staking_delegator_numerator : %a -> %a@;\
-     staking_delegate_denominator : %a -> %a@;\
-     }@."
-    Tez.pp
-    a_liquid_b
-    Tez.pp
-    b_liquid_b
-    Tez.pp
-    a_bonds_b
-    Tez.pp
-    b_bonds_b
-    Partial_tez.pp
-    a_staked_b
-    Partial_tez.pp
-    b_staked_b
-    Tez.pp
-    a_unstaked_frozen_b
-    Tez.pp
-    b_unstaked_frozen_b
-    Tez.pp
-    a_unstaked_finalizable_b
-    Tez.pp
-    b_unstaked_finalizable_b
-    Z.pp_print
-    a_staking_delegator_numerator_b
-    Z.pp_print
-    b_staking_delegator_numerator_b
-    Z.pp_print
-    a_staking_delegate_denominator_b
-    Z.pp_print
-    b_staking_delegate_denominator_b
-
-let assert_balance_equal ~loc account_name
-    {
-      liquid_b = a_liquid_b;
-      bonds_b = a_bonds_b;
-      staked_b = a_staked_b;
-      unstaked_frozen_b = a_unstaked_frozen_b;
-      unstaked_finalizable_b = a_unstaked_finalizable_b;
-      staking_delegator_numerator_b = a_staking_delegator_numerator_b;
-      staking_delegate_denominator_b = a_staking_delegate_denominator_b;
-    }
-    {
-      liquid_b = b_liquid_b;
-      bonds_b = b_bonds_b;
-      staked_b = b_staked_b;
-      unstaked_frozen_b = b_unstaked_frozen_b;
-      unstaked_finalizable_b = b_unstaked_finalizable_b;
-      staking_delegator_numerator_b = b_staking_delegator_numerator_b;
-      staking_delegate_denominator_b = b_staking_delegate_denominator_b;
-    } =
-  let open Lwt_result_syntax in
-  let f s = Format.asprintf "%s: %s" account_name s in
-  let* () =
-    List.fold_left
-      (fun a b ->
-        let*! a in
-        let*! b in
-        join_errors a b)
-      return_unit
-      [
-        Assert.equal
-          ~loc
-          Tez.equal
-          (f "Liquid balances do not match")
-          Tez.pp
-          a_liquid_b
-          b_liquid_b;
-        Assert.equal
-          ~loc
-          Tez.equal
-          (f "Bonds balances do not match")
-          Tez.pp
-          a_bonds_b
-          b_bonds_b;
-        Assert.equal
-          ~loc
-          Tez.equal
-          (f "Staked balances do not match")
-          Tez.pp
-          (Partial_tez.to_tez ~round:`Down a_staked_b)
-          (Partial_tez.to_tez ~round:`Down b_staked_b);
-        Assert.equal
-          ~loc
-          Tez.equal
-          (f "Unstaked frozen balances do not match")
-          Tez.pp
-          a_unstaked_frozen_b
-          b_unstaked_frozen_b;
-        Assert.equal
-          ~loc
-          Tez.equal
-          (f "Unstaked finalizable balances do not match")
-          Tez.pp
-          a_unstaked_finalizable_b
-          b_unstaked_finalizable_b;
-        Assert.equal
-          ~loc
-          Z.equal
-          (f "Staking delegator numerators do not match")
-          Z.pp_print
-          a_staking_delegator_numerator_b
-          b_staking_delegator_numerator_b;
-        Assert.equal
-          ~loc
-          Z.equal
-          (f "Staking delegate denominators do not match")
-          Z.pp_print
-          a_staking_delegate_denominator_b
-          b_staking_delegate_denominator_b;
-      ]
-  in
-  return_unit
-
-let update_account ~f account_name account_map =
-  String.Map.update
-    account_name
-    (function None -> raise Not_found | Some x -> Some (f x))
-    account_map
-
-let add_liquid_rewards amount account_name account_map =
-  let f account =
-    let liquid = Tez.(account.liquid +! amount) in
-    {account with liquid}
-  in
-  update_account ~f account_name account_map
-
-let add_frozen_rewards amount account_name account_map =
-  let f account =
-    let actual_edge =
-      Q.(
-        mul account.parameters.edge_of_baking_over_staking (1_000_000_000 // 1)
-        |> to_int |> of_int
-        |> mul (1 // 1_000_000_000))
-    in
-    let frozen_deposits =
-      Frozen_tez.add_tez_to_all_current
-        ~edge:actual_edge
-        amount
-        account.frozen_deposits
-    in
-    {account with frozen_deposits}
-  in
-  update_account ~f account_name account_map
-
-let apply_burn amount src_name account_map =
-  let f src = {src with liquid = Tez.(src.liquid -! amount)} in
-  update_account ~f src_name account_map
-
-let apply_transfer amount src_name dst_name account_map =
-  match
-    (String.Map.find src_name account_map, String.Map.find dst_name account_map)
-  with
-  | Some src, Some _ ->
-      if Tez.(src.liquid < amount) then
-        (* Invalid amount: operation will fail *)
-        account_map
-      else
-        let f_src src =
-          let liquid = Tez.(src.liquid -! amount) in
-          {src with liquid}
-        in
-        let f_dst dst =
-          let liquid = Tez.(dst.liquid +! amount) in
-          {dst with liquid}
-        in
-        let account_map = update_account ~f:f_src src_name account_map in
-        update_account ~f:f_dst dst_name account_map
-  | _ -> raise Not_found
-
-let stake_from_unstake amount current_cycle consensus_rights_delay delegate_name
-    account_map =
-  match String.Map.find delegate_name account_map with
-  | None -> raise Not_found
-  | Some ({unstaked_frozen; frozen_deposits; slashed_cycles; _} as account) ->
-      let oldest_slashable_cycle =
-        Cycle.(sub current_cycle (consensus_rights_delay + 1))
-        |> Option.value ~default:Cycle.root
-      in
-      if
-        List.exists
-          (fun x -> Cycle.(x >= oldest_slashable_cycle))
-          slashed_cycles
-      then (account_map, amount)
-      else
-        let unstaked_frozen =
-          List.sort
-            (fun (Unstaked_frozen.{cycle = cycle1; _} : Unstaked_frozen.r)
-                 {cycle = cycle2; _} -> Cycle.compare cycle2 cycle1)
-            unstaked_frozen
-        in
-        let rec aux acc_unstakes rem_amount rem_unstakes =
-          match rem_unstakes with
-          | [] -> (acc_unstakes, rem_amount)
-          | (Unstaked_frozen.{initial; _} as h) :: t ->
-              if Tez.(rem_amount = zero) then
-                (acc_unstakes @ rem_unstakes, Tez.zero)
-              else if Tez.(rem_amount >= initial) then
-                let h = Unstaked_frozen.sub_unstake initial delegate_name h in
-                let rem_amount = Tez.(rem_amount -! initial) in
-                aux (acc_unstakes @ [h]) rem_amount t
-              else
-                let h =
-                  Unstaked_frozen.sub_unstake rem_amount delegate_name h
-                in
-                (acc_unstakes @ [h] @ t, Tez.zero)
-        in
-        let unstaked_frozen, rem_amount = aux [] amount unstaked_frozen in
-        let frozen_deposits =
-          Frozen_tez.add_current
-            Tez.(amount -! rem_amount)
-            delegate_name
-            frozen_deposits
-        in
-        let account = {account with unstaked_frozen; frozen_deposits} in
-        let account_map =
-          update_account ~f:(fun _ -> account) delegate_name account_map
-        in
-        (account_map, rem_amount)
-
-let tez_to_pseudo ~round amount delegate_account =
-  let {staking_delegate_denominator; frozen_deposits; _} = delegate_account in
-  let total_q = Frozen_tez.total_co_current_q frozen_deposits.co_current in
-  let total, rem = Partial_tez.to_tez_rem total_q in
-  assert (Q.(equal rem zero)) ;
-  if Tez.(equal total zero) then Tez.to_z amount
-  else
-    let r = Tez.ratio amount total in
-    let p = Q.(r * of_bigint staking_delegate_denominator) in
-    Tez.(of_q ~round p |> to_z)
-
-let pseudo_to_partial_tez amount_pseudo delegate_account =
-  let {staking_delegate_denominator; frozen_deposits; _} = delegate_account in
-  let total_q = Frozen_tez.total_co_current_q frozen_deposits.co_current in
-  let total, rem = Partial_tez.to_tez_rem total_q in
-  assert (Q.(equal rem zero)) ;
-  if Z.(equal staking_delegate_denominator zero) then Q.of_bigint amount_pseudo
-  else
-    let q = Q.(amount_pseudo /// staking_delegate_denominator) in
-    Tez.mul_q total q
-
-(* tez_q <= amount *)
-let stake_values_real amount delegate_account =
-  let pseudo = tez_to_pseudo ~round:`Down amount delegate_account in
-  let tez_q = pseudo_to_partial_tez pseudo delegate_account in
-  (pseudo, tez_q)
-
-(* returned_amount <= amount *)
-let unstake_values_real amount delegate_account =
-  let pseudo = tez_to_pseudo ~round:`Up amount delegate_account in
-  let tez_q = pseudo_to_partial_tez pseudo delegate_account in
-  if Tez.equal (Tez.of_q ~round:`Down tez_q) amount then (pseudo, tez_q)
-  else
-    let pseudo = Z.(pseudo - one) in
-    (pseudo, pseudo_to_partial_tez pseudo delegate_account)
-
-let apply_stake amount current_cycle consensus_rights_delay staker_name
-    account_map =
-  match String.Map.find staker_name account_map with
-  | None -> raise Not_found
-  | Some staker -> (
-      match staker.delegate with
-      | None ->
-          (* Invalid operation: no delegate *)
-          account_map
-      | Some delegate_name ->
-          let old_account_map = account_map in
-          (* If self stake, then try to stake from unstake.
-             Returns the amount that remains to be staked from liquid *)
-          let account_map, amount =
-            if delegate_name = staker_name then
-              stake_from_unstake
-                amount
-                current_cycle
-                consensus_rights_delay
-                staker_name
-                account_map
-            else (account_map, amount)
-          in
-          if Tez.(staker.liquid < amount) then
-            (* Not enough liquid balance: operation will fail *)
-            old_account_map
-          else if delegate_name = staker_name then
-            (* If self stake: increase frozen deposits and decrease liquid balance.
-               "add_current" is easy to resolve since there is no pseudotokens *)
-            let f delegate =
-              let frozen_deposits =
-                Frozen_tez.add_current
-                  amount
-                  staker_name
-                  delegate.frozen_deposits
-              in
-              let liquid = Tez.(delegate.liquid -! amount) in
-              {delegate with frozen_deposits; liquid}
-            in
-            update_account ~f delegate_name account_map
-          else
-            (* If external stake: *)
-            let delegate_account =
-              String.Map.find delegate_name account_map
-              |> Option.value_f ~default:(fun _ -> assert false)
-            in
-            (* Call stake_values_real to know the actual amount staked and the pseudotokens minted *)
-            (* amount_q would be the effective stake on the delegate's side, while
-               amount is the amount removed from the liquid balance *)
-            let pseudo, amount_q = stake_values_real amount delegate_account in
-            let f_staker staker =
-              let liquid = Tez.(staker.liquid -! amount) in
-              let staking_delegator_numerator =
-                Z.add staker.staking_delegator_numerator pseudo
-              in
-              {staker with liquid; staking_delegator_numerator}
-            in
-            let f_delegate delegate =
-              (* The difference between the actual amount and the effective amount is
-                 "distributed" amongst current stake holders.
-                 Indeed, when trading in "amount", the staker receives "pseudo" pseudotokens
-                 valued at "amount_q". So the total amount of value is increased by "amount_q".
-                 Then, "portion" is added to the total, so it must be distributed.
-                 This means that the order is important: first you add_current_q, then
-                 you add the portion to all *)
-              let portion = Partial_tez.(of_tez amount - amount_q) in
-              let frozen_deposits =
-                Frozen_tez.add_current_q
-                  amount_q
-                  staker_name
-                  delegate.frozen_deposits
-              in
-              let co_current =
-                Frozen_tez.add_q_to_all_co_current
-                  portion
-                  frozen_deposits.co_current
-              in
-              let frozen_deposits = {frozen_deposits with co_current} in
-              let staking_delegate_denominator =
-                Z.add delegate.staking_delegate_denominator pseudo
-              in
-              {delegate with frozen_deposits; staking_delegate_denominator}
-            in
-            let account_map =
-              update_account ~f:f_staker staker_name account_map
-            in
-            update_account ~f:f_delegate delegate_name account_map)
-
-let apply_unstake cycle amount staker_name account_map =
-  match String.Map.find staker_name account_map with
-  | None -> raise Not_found
-  | Some staker -> (
-      match staker.delegate with
-      | None -> (* Invalid operation: no delegate *) account_map
-      | Some delegate_name -> (
-          match String.Map.find delegate_name account_map with
-          | None -> raise Not_found
-          | Some delegate ->
-              if delegate_name = staker_name then
-                (* Case self stake *)
-                (* No pseudotokens : no problem *)
-                let frozen_deposits, amount_unstaked =
-                  Frozen_tez.sub_current
-                    amount
-                    staker_name
-                    delegate.frozen_deposits
-                in
-                let unstaked_frozen =
-                  Unstaked_frozen.add_unstake
-                    cycle
-                    amount_unstaked
-                    staker_name
-                    delegate.unstaked_frozen
-                in
-                let delegate =
-                  {delegate with frozen_deposits; unstaked_frozen}
-                in
-                update_account ~f:(fun _ -> delegate) delegate_name account_map
-              else
-                (* Case external stake *)
-                let staked_amount =
-                  Frozen_tez.get staker_name delegate.frozen_deposits
-                in
-                let pseudotokens, amount_q =
-                  if Partial_tez.(staked_amount <= of_tez amount) then
-                    (* Unstake all case *)
-                    (staker.staking_delegator_numerator, staked_amount)
-                  else
-                    (* The staker requests "amount".
-                       It translates to some "pseudotokens", valued at "amount_q".
-                       If those pseudotokens would give strictly more than the requested amount,
-                       then give one less pseudotoken. The actual amount unstaked is always lower than
-                       the requested amount (except in the unstake all case) *)
-                    unstake_values_real amount delegate
-                in
-                (* Actual unstaked amount (that will be finalized) *)
-                let amount = Partial_tez.to_tez ~round:`Down amount_q in
-                (* Delta from pseudotokens' value, to be redistributed amongst all remaining stakers
-                   (including current if still staking) *)
-                let portion = Partial_tez.(amount_q - of_tez amount) in
-                let f_staker staker =
-                  (* The staker's account representation doesn't change much,
-                     the unstake request is stored on the delegate's side *)
-                  let staking_delegator_numerator =
-                    Z.sub staker.staking_delegator_numerator pseudotokens
-                  in
-                  {staker with staking_delegator_numerator}
-                in
-                let account_map =
-                  update_account ~f:f_staker staker_name account_map
-                in
-                let f_delegate delegate =
-                  let staking_delegate_denominator =
-                    Z.sub delegate.staking_delegate_denominator pseudotokens
-                  in
-                  (* Just like in stake *)
-                  (* Do the effective unstake *)
-                  let frozen_deposits =
-                    Frozen_tez.sub_current_q
-                      amount_q
-                      staker_name
-                      delegate.frozen_deposits
-                  in
-                  (* Apply the delta *)
-                  let co_current =
-                    Frozen_tez.add_q_to_all_co_current
-                      portion
-                      frozen_deposits.co_current
-                  in
-                  let frozen_deposits = {frozen_deposits with co_current} in
-                  (* Add unstake request
-                     Note that "amount" might not be the initial requested amount *)
-                  let unstaked_frozen =
-                    Unstaked_frozen.add_unstake
-                      cycle
-                      amount
-                      staker_name
-                      delegate.unstaked_frozen
-                  in
-                  {
-                    delegate with
-                    staking_delegate_denominator;
-                    frozen_deposits;
-                    unstaked_frozen;
-                  }
-                in
-                update_account ~f:f_delegate delegate_name account_map))
-
-let apply_unslashable_f cycle delegate =
-  let amount_unslashable, unstaked_frozen =
-    Unstaked_frozen.pop_cycle cycle delegate.unstaked_frozen
-  in
-  let unstaked_finalizable =
-    Unstaked_finalizable.add_from_poped_ufd
-      amount_unslashable
-      delegate.unstaked_finalizable
-  in
-  {delegate with unstaked_frozen; unstaked_finalizable}
-
-(* Updates unstaked unslashable values for given account *)
-let apply_unslashable cycle account_name account_map =
-  update_account ~f:(apply_unslashable_f cycle) account_name account_map
-
-(* Updates unstaked unslashable values in all accounts *)
-let apply_unslashable_for_all cycle account_map =
-  String.Map.map (apply_unslashable_f cycle) account_map
-
-let apply_finalize staker_name account_map =
-  match String.Map.find staker_name account_map with
-  | None -> raise Not_found
-  | Some _staker ->
-      (* Because an account can still have finalizable funds from a delegate
-         that is not its own, we iterate over all of them *)
-      String.Map.fold
-        (fun delegate_name delegate account_map_acc ->
-          match
-            String.Map.find staker_name delegate.unstaked_finalizable.map
-          with
-          | None -> account_map_acc
-          | Some amount ->
-              let f_staker staker =
-                let liquid = Tez.(staker.liquid +! amount) in
-                {staker with liquid}
-              in
-              let f_delegate delegate =
-                let map =
-                  String.Map.remove
-                    staker_name
-                    delegate.unstaked_finalizable.map
-                in
-                {
-                  delegate with
-                  unstaked_finalizable =
-                    {delegate.unstaked_finalizable with map};
-                }
-              in
-              let account_map_acc =
-                update_account ~f:f_staker staker_name account_map_acc
-              in
-              update_account ~f:f_delegate delegate_name account_map_acc)
-        account_map
-        account_map
-
-let balance_and_total_balance_of_account account_name account_map =
-  let ({
-         liquid_b;
-         bonds_b;
-         staked_b;
-         unstaked_frozen_b;
-         unstaked_finalizable_b;
-         staking_delegator_numerator_b = _;
-         staking_delegate_denominator_b = _;
-       } as balance) =
-    balance_of_account account_name account_map
-  in
-  ( balance,
-    Tez.(
-      liquid_b +! bonds_b
-      +! Partial_tez.to_tez ~round:`Down staked_b
-      +! unstaked_frozen_b +! unstaked_finalizable_b) )
-
-let apply_slashing
-    ( culprit,
-      Protocol.Denunciations_repr.{rewarded; misbehaviour; operation_hash = _}
-    ) constants account_map =
-  let find_account_name_from_pkh_exn pkh account_map =
-    match
-      Option.map
-        fst
-        String.Map.(
-          choose
-          @@ filter
-               (fun _ account ->
-                 Signature.Public_key_hash.equal pkh account.pkh)
-               account_map)
-    with
-    | None -> assert false
-    | Some x -> x
-  in
-  let slashed_cycle =
-    Block.current_cycle_of_level
-      ~blocks_per_cycle:
-        constants.Protocol.Alpha_context.Constants.Parametric.blocks_per_cycle
-      ~current_level:(Protocol.Raw_level_repr.to_int32 misbehaviour.level)
-  in
-  let culprit_name = find_account_name_from_pkh_exn culprit account_map in
-  let rewarded_name = find_account_name_from_pkh_exn rewarded account_map in
-  let slashed_pct =
-    match misbehaviour.kind with
-    | Double_baking ->
-        constants
-          .Protocol.Alpha_context.Constants.Parametric
-           .percentage_of_frozen_deposits_slashed_per_double_baking
-    | Double_attesting | Double_preattesting ->
-        constants.percentage_of_frozen_deposits_slashed_per_double_attestation
-  in
-  let get_total_supply acc_map =
-    String.Map.fold
-      (fun _name
-           {
-             pkh = _;
-             contract = _;
-             delegate = _;
-             parameters = _;
-             liquid;
-             bonds;
-             frozen_deposits;
-             unstaked_frozen;
-             unstaked_finalizable;
-             staking_delegator_numerator = _;
-             staking_delegate_denominator = _;
-             frozen_rights = _;
-             slashed_cycles = _;
-           }
-           tot ->
-        Tez.(
-          liquid +! bonds
-          +! Frozen_tez.total_current frozen_deposits
-          +! Unstaked_frozen.sum_current unstaked_frozen
-          +! Unstaked_finalizable.total unstaked_finalizable
-          +! tot))
-      acc_map
-      Tez.zero
-  in
-  let total_before_slash = get_total_supply account_map in
-  let slash_culprit
-      ({frozen_deposits; unstaked_frozen; frozen_rights; _} as acc) =
-    let base_rights =
-      CycleMap.find slashed_cycle frozen_rights
-      |> Option.value ~default:Tez.zero
-    in
-    let frozen_deposits, slashed_frozen =
-      Frozen_tez.slash base_rights slashed_pct frozen_deposits
-    in
-    let slashed_pct_q = Protocol.Percentage.to_q slashed_pct in
-    let slashed_pct = Q.(100 // 1 * slashed_pct_q |> to_int) in
-    let unstaked_frozen, slashed_unstaked =
-      Unstaked_frozen.slash
-        ~slashable_deposits_period:constants.consensus_rights_delay
-        slashed_cycle
-        slashed_pct
-        unstaked_frozen
-    in
-    ( {acc with frozen_deposits; unstaked_frozen},
-      slashed_frozen :: slashed_unstaked )
-  in
-  let culprit_account =
-    String.Map.find culprit_name account_map
-    |> Option.value_f ~default:(fun () -> raise Not_found)
-  in
-  let slashed_culprit_account, total_slashed = slash_culprit culprit_account in
-  let account_map =
-    update_account
-      ~f:(fun _ -> slashed_culprit_account)
-      culprit_name
-      account_map
-  in
-  let total_after_slash = get_total_supply account_map in
-  let portion_reward =
-    constants.adaptive_issuance.global_limit_of_staking_over_baking + 2
-  in
-  (* For each container slashed, the snitch gets a reward transferred. It gets rounded
-     down each time *)
-  let reward_to_snitch =
-    List.map
-      (fun x -> Tez.mul_q x Q.(1 // portion_reward) |> Tez.of_q ~round:`Down)
-      total_slashed
-    |> List.fold_left Tez.( +! ) Tez.zero
-  in
-  let account_map =
-    add_liquid_rewards reward_to_snitch rewarded_name account_map
-  in
-  let actual_total_burnt_amount =
-    Tez.(total_before_slash -! total_after_slash -! reward_to_snitch)
-  in
-  (account_map, actual_total_burnt_amount)
-
-(* Given cycle is the cycle for which the rights are computed, usually current +
-   consensus rights delay *)
-let update_frozen_rights_cycle cycle account_map =
-  String.Map.map
-    (fun ({frozen_deposits; frozen_rights; _} as acc) ->
-      let total_frozen = Frozen_tez.total_current frozen_deposits in
-      let frozen_rights = CycleMap.add cycle total_frozen frozen_rights in
-      {acc with frozen_rights})
-    account_map
-
-let get_balance_from_context ctxt contract =
-  let open Lwt_result_syntax in
-  let* liquid_b = Context.Contract.balance ctxt contract in
-  let* bonds_b = Context.Contract.frozen_bonds ctxt contract in
-  let* staked_b = Context.Contract.staked_balance ctxt contract in
-  let staked_b =
-    Option.value ~default:Tez.zero staked_b |> Partial_tez.of_tez
-  in
-  let* unstaked_frozen_b =
-    Context.Contract.unstaked_frozen_balance ctxt contract
-  in
-  let unstaked_frozen_b = Option.value ~default:Tez.zero unstaked_frozen_b in
-  let* unstaked_finalizable_b =
-    Context.Contract.unstaked_finalizable_balance ctxt contract
-  in
-  let unstaked_finalizable_b =
-    Option.value ~default:Tez.zero unstaked_finalizable_b
-  in
-  let* total_balance = Context.Contract.full_balance ctxt contract in
-  let* staking_delegator_numerator_b =
-    Context.Contract.staking_numerator ctxt contract
-  in
-  let*! staking_delegate_denominator_b =
-    match (contract : Protocol.Alpha_context.Contract.t) with
-    | Implicit pkh ->
-        let*! result = Context.Delegate.staking_denominator ctxt pkh in
-        Lwt.return
-          (match result with
-          | Ok v -> v
-          | Error _ -> (* Not a delegate *) Z.zero)
-    | Originated _ -> Lwt.return Z.zero
-  in
-  let bd =
-    {
-      liquid_b;
-      bonds_b;
-      staked_b;
-      unstaked_frozen_b;
-      unstaked_finalizable_b;
-      staking_delegator_numerator_b;
-      staking_delegate_denominator_b;
-    }
-  in
-  return (bd, total_balance)
-
-let assert_pseudotokens_consistency ~loc balance account account_name
-    account_map =
-  let open Lwt_result_syntax in
-  let {delegate; staking_delegator_numerator = num_pt; _} = account in
-  let exact_staking_balance = balance.staked_b in
-  match delegate with
-  | None -> return_unit
-  | Some delegate_name -> (
-      if account_name = delegate_name then return_unit
-      else
-        match String.Map.find delegate_name account_map with
-        | None -> raise Not_found
-        | Some delegate_account ->
-            let total_co =
-              Frozen_tez.total_co_current_q
-                delegate_account.frozen_deposits.co_current
-            in
-            let den_pt = delegate_account.staking_delegate_denominator in
-            if Z.(equal den_pt zero) then
-              Assert.equal
-                ~loc
-                Q.equal
-                (Format.asprintf
-                   "%s : Delegate should not have external stake with a 0 \
-                    staking denominator"
-                   account_name)
-                Q.pp_print
-                total_co
-                Q.zero
-            else
-              let expected = Q.(num_pt /// den_pt * total_co) in
-              Assert.equal
-                ~loc
-                Q.equal
-                (Format.asprintf
-                   "%s : Pseudotokens do not match exact staking balance"
-                   account_name)
-                Q.pp_print
-                exact_staking_balance
-                expected)
-
-let assert_balance_check ~loc ctxt account_name account_map =
-  let open Lwt_result_syntax in
-  match String.Map.find account_name account_map with
-  | None -> raise Not_found
-  | Some account ->
-      let* balance_ctxt, total_balance_ctxt =
-        get_balance_from_context ctxt account.contract
-      in
-      let balance, total_balance =
-        balance_and_total_balance_of_account account_name account_map
-      in
-      let*! r0 =
-        assert_pseudotokens_consistency
-          ~loc
-          balance
-          account
-          account_name
-          account_map
-      in
-      let*! r1 = assert_balance_equal ~loc account_name balance_ctxt balance in
-      let*! r1 = join_errors r0 r1 in
-      let*! r2 =
-        Assert.equal
-          ~loc
-          Tez.equal
-          (Format.asprintf "%s : Total balances do not match" account_name)
-          Tez.pp
-          total_balance_ctxt
-          total_balance
-      in
-      join_errors r1 r2
-
 let get_launch_cycle ~loc blk =
   let open Lwt_result_syntax in
   let* launch_cycle_opt = Context.get_adaptive_issuance_launch_cycle (B blk) in
@@ -1420,7 +40,7 @@ let stake ctxt contract amount =
   Op.transaction
     ctxt
     ~entrypoint:Protocol.Alpha_context.Entrypoint.stake
-    ~fee:Tez.zero
+    ~fee:Test_tez.zero
     contract
     contract
     amount
@@ -1446,25 +66,25 @@ let set_delegate_parameters ctxt delegate
     ctxt
     ~entrypoint
     ~parameters
-    ~fee:Tez.zero
+    ~fee:Test_tez.zero
     delegate
     delegate
-    Tez.zero
+    Test_tez.zero
 
 let unstake ctxt contract amount =
   Op.transaction
     ctxt
     ~entrypoint:Protocol.Alpha_context.Entrypoint.unstake
-    ~fee:Tez.zero
+    ~fee:Test_tez.zero
     contract
     contract
     amount
 
-let finalize_unstake ctxt ?(amount = Tez.zero) contract =
+let finalize_unstake ctxt ?(amount = Test_tez.zero) contract =
   Op.transaction
     ctxt
     ~entrypoint:Protocol.Alpha_context.Entrypoint.finalize_unstake
-    ~fee:Tez.zero
+    ~fee:Test_tez.zero
     contract
     contract
     amount
@@ -1474,6 +94,8 @@ let portion_of_rewards_to_liquid_for_cycle ?policy ctxt cycle pkh rewards =
   let* {frozen; weighted_delegated} =
     Context.Delegate.stake_for_cycle ?policy ctxt cycle pkh
   in
-  let portion = Tez.(ratio weighted_delegated (frozen +! weighted_delegated)) in
-  let to_liquid = Tez.mul_q rewards portion in
-  return (Partial_tez.to_tez ~round:`Down to_liquid)
+  let portion =
+    Test_tez.(ratio weighted_delegated (frozen +! weighted_delegated))
+  in
+  let to_liquid = Test_tez.mul_q rewards portion in
+  return (Test_tez.of_q ~round:`Down to_liquid)
diff --git a/src/proto_alpha/lib_protocol/test/helpers/state_account.ml b/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
new file mode 100644
index 000000000000..c3056e7af127
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
@@ -0,0 +1,1387 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+open Adaptive_issuance_helpers
+module Cycle = Protocol.Alpha_context.Cycle
+
+module Tez = struct
+  include Test_tez
+  include Test_tez.Compare
+end
+
+let join_errors e1 e2 =
+  let open Lwt_result_syntax in
+  match (e1, e2) with
+  | Ok (), Ok () -> return_unit
+  | Error e, Ok () | Ok (), Error e -> fail e
+  | Error e1, Error e2 -> fail (e1 @ e2)
+
+(** Representation of Tez with non integer values *)
+module Partial_tez = struct
+  include Q
+
+  let of_tez a = Tez.to_mutez a |> of_int64
+
+  let to_tez_rem {num; den} =
+    let tez, rem = Z.div_rem num den in
+    (Tez.of_z tez, rem /// den)
+
+  let to_tez ~round = Tez.of_q ~round
+
+  let get_rem a = snd (to_tez_rem a)
+
+  let pp fmt a =
+    let tez, rem = to_tez_rem a in
+    (* If rem = 0, we keep the (+ 0), to indicate that it's a partial tez *)
+    Format.fprintf fmt "%a ( +%aµꜩ )" Tez.pp tez Q.pp_print rem
+end
+
+(** [Frozen_tez] represents frozen stake and frozen unstaked funds.
+    Properties:
+    - sum of all current partial tez is an integer
+    - Can only add integer amounts
+    - Can always subtract integer amount (if lower than frozen amount)
+    - If subtracting partial amount, must be the whole frozen amount (for given contract).
+      The remainder is then distributed equally amongst remaining accounts, to keep property 1.
+    - All entries of current are positive, non zero.
+*)
+module Frozen_tez = struct
+  (* The map in current maps the stakers' name with their staked value.
+     It contains only delegators of the delegate which owns the frozen tez *)
+  type t = {
+    delegate : string;
+    initial : Tez.t;
+    self_current : Tez.t;
+    co_current : Partial_tez.t String.Map.t;
+  }
+
+  let zero =
+    {
+      delegate = "";
+      initial = Tez.zero;
+      self_current = Tez.zero;
+      co_current = String.Map.empty;
+    }
+
+  let init amount account delegate =
+    if account = delegate then
+      {
+        delegate;
+        initial = amount;
+        self_current = amount;
+        co_current = String.Map.empty;
+      }
+    else
+      {
+        delegate;
+        initial = amount;
+        self_current = Tez.zero;
+        co_current = String.Map.singleton account (Partial_tez.of_tez amount);
+      }
+
+  let union a b =
+    assert (a.delegate = b.delegate) ;
+    {
+      delegate = a.delegate;
+      initial = Tez.(a.initial +! b.initial);
+      self_current = Tez.(a.self_current +! b.self_current);
+      co_current =
+        String.Map.union
+          (fun _ x y -> Some Partial_tez.(x + y))
+          a.co_current
+          b.co_current;
+    }
+
+  let get account frozen_tez =
+    if account = frozen_tez.delegate then
+      Partial_tez.of_tez frozen_tez.self_current
+    else
+      match String.Map.find account frozen_tez.co_current with
+      | None -> Partial_tez.zero
+      | Some p -> p
+
+  let total_co_current_q co_current =
+    String.Map.fold
+      (fun _ x acc -> Partial_tez.(x + acc))
+      co_current
+      Partial_tez.zero
+
+  let total_current a =
+    let r = total_co_current_q a.co_current in
+    let tez, rem = Partial_tez.to_tez_rem r in
+    assert (Q.(equal rem zero)) ;
+    Tez.(tez +! a.self_current)
+
+  (* 0 <= quantity < 1 && co_current + quantity is int *)
+  let add_q_to_all_co_current quantity co_current =
+    let s = total_co_current_q co_current in
+    if Q.(equal quantity zero) then co_current
+    else
+      let f p_amount =
+        let q = Q.div p_amount s in
+        Partial_tez.add p_amount (Q.mul quantity q)
+      in
+      String.Map.map f co_current
+
+  (* For rewards, distribute equally *)
+  let add_tez_to_all_current ~edge tez a =
+    let self_portion = Tez.ratio a.self_current (total_current a) in
+    (* Baker's advantage for the mutez *)
+    let self_quantity = Tez.mul_q tez self_portion |> Tez.of_q ~round:`Up in
+    let remains = Tez.(tez -! self_quantity) in
+    (* Baker's edge. Round up for the baker's advantage again *)
+    let bakers_edge = Tez.mul_q remains edge |> Tez.of_q ~round:`Up in
+    let self_quantity = Tez.(self_quantity +! bakers_edge) in
+    (* The remains are distributed equally *)
+    let co_quantity = Partial_tez.of_tez Tez.(tez -! self_quantity) in
+    let co_current = add_q_to_all_co_current co_quantity a.co_current in
+    {a with co_current; self_current = Tez.(a.self_current +! self_quantity)}
+
+  (* For slashing, slash equally *)
+  let sub_tez_from_all_current tez a =
+    let self_portion = Tez.ratio a.self_current (total_current a) in
+    let self_quantity = Tez.mul_q tez self_portion |> Tez.of_q ~round:`Down in
+    let self_current =
+      if Tez.(self_quantity >= a.self_current) then Tez.zero
+      else Tez.(a.self_current -! self_quantity)
+    in
+    let co_quantity = Tez.(tez -! self_quantity) in
+    let s = total_co_current_q a.co_current in
+    if Partial_tez.(geq (of_tez co_quantity) s) then
+      {a with self_current; co_current = String.Map.empty}
+    else
+      let f p_amount =
+        let q = Q.div p_amount s in
+        Partial_tez.sub p_amount (Tez.mul_q co_quantity q)
+        (* > 0 *)
+      in
+      {a with self_current; co_current = String.Map.map f a.co_current}
+
+  (* Adds frozen to account. Happens each stake in frozen deposits *)
+  let add_current_q amount account a =
+    if account = a.delegate then (
+      let amount, rem = Partial_tez.to_tez_rem amount in
+      assert (Q.(equal rem zero)) ;
+      {a with self_current = Tez.(a.self_current +! amount)})
+    else
+      {
+        a with
+        co_current =
+          String.Map.update
+            account
+            (function
+              | None -> Some amount | Some q -> Some Partial_tez.(add q amount))
+            a.co_current;
+      }
+
+  let add_current amount account a =
+    add_current_q (Partial_tez.of_tez amount) account a
+
+  let add_self_current amount a =
+    let self_current = Tez.(a.self_current +! amount) in
+    {a with self_current}
+
+  (* Adds frozen to account. Happens each unstake to unstaked frozen deposits *)
+  let add_init amount account a = union a (init amount account a.delegate)
+
+  (* Allows amount greater than current frozen amount.
+     Happens each unstake in frozen deposits *)
+  let sub_current amount account a =
+    if account = a.delegate then
+      let amount = Tez.min amount a.self_current in
+      ({a with self_current = Tez.(a.self_current -! amount)}, amount)
+    else
+      match String.Map.find account a.co_current with
+      | None -> (a, Tez.zero)
+      | Some frozen ->
+          let amount_q = Partial_tez.of_tez amount in
+          if Q.(geq amount_q frozen) then
+            let removed, remainder = Partial_tez.to_tez_rem frozen in
+            let co_current = String.Map.remove account a.co_current in
+            let co_current = add_q_to_all_co_current remainder co_current in
+            ({a with co_current}, removed)
+          else
+            let co_current =
+              String.Map.add account Q.(frozen - amount_q) a.co_current
+            in
+            ({a with co_current}, amount)
+
+  (* Remove a partial amount to the co frozen tez table. *)
+  let sub_current_q amount_q account a =
+    if account = a.delegate then assert false
+    else
+      match String.Map.find account a.co_current with
+      | None -> a
+      | Some frozen ->
+          if Q.(geq amount_q frozen) then
+            let co_current = String.Map.remove account a.co_current in
+            {a with co_current}
+          else
+            let co_current =
+              String.Map.add account Q.(frozen - amount_q) a.co_current
+            in
+            {a with co_current}
+
+  let sub_current_and_init amount account a =
+    let a, amount = sub_current amount account a in
+    ({a with initial = Tez.(a.initial -! amount)}, amount)
+
+  let slash base_amount (pct : Protocol.Percentage.t) a =
+    let pct_q = Protocol.Percentage.to_q pct in
+    let slashed_amount = Tez.mul_q base_amount pct_q |> Tez.of_q ~round:`Down in
+    let total_current = total_current a in
+    let slashed_amount_final = Tez.min slashed_amount total_current in
+    (sub_tez_from_all_current slashed_amount a, slashed_amount_final)
+end
+
+(** Representation of Unstaked frozen deposits *)
+module Unstaked_frozen = struct
+  type r = {
+    cycle : Cycle.t;
+    (* initial total requested amount (slash ∝ initial) *)
+    initial : Tez.t;
+    (* current amount, slashes applied here *)
+    current : Tez.t;
+    (* initial requests, don't apply slash unless finalize or balance query *)
+    requests : Tez.t String.Map.t;
+    (* slash pct memory for requests *)
+    slash_pct : int;
+  }
+
+  type t = r list
+
+  type get_info = {cycle : Cycle.t; request : Tez.t; current : Tez.t}
+
+  type get_info_list = get_info list
+
+  type finalizable_info = {
+    amount : Tez.t;
+    slashed_requests : Tez.t String.Map.t;
+  }
+
+  let zero = []
+
+  let init_r cycle request account =
+    {
+      cycle;
+      initial = request;
+      current = request;
+      requests = String.Map.singleton account request;
+      slash_pct = 0;
+    }
+
+  let apply_slash_to_request slash_pct amount =
+    let slashed_amount =
+      Tez.mul_q amount Q.(slash_pct // 100) |> Tez.of_q ~round:`Up
+    in
+    Tez.(amount -! slashed_amount)
+
+  let apply_slash_to_current slash_pct initial current =
+    let slashed_amount =
+      Tez.mul_q initial Q.(slash_pct // 100) |> Tez.of_q ~round:`Down
+    in
+    Tez.sub_opt current slashed_amount |> Option.value ~default:Tez.zero
+
+  let remove_zeros (a : t) : t =
+    List.filter (fun ({current; _} : r) -> Tez.(current > zero)) a
+
+  let get account unstaked : get_info_list =
+    List.filter_map
+      (fun {cycle; requests; slash_pct; _} ->
+        String.Map.find account requests
+        |> Option.map (fun request ->
+               {
+                 cycle;
+                 request;
+                 current = apply_slash_to_request slash_pct request;
+               }))
+      unstaked
+
+  let get_total account unstaked =
+    get account unstaked
+    |> List.fold_left
+         (fun acc ({current; _} : get_info) -> Tez.(acc +! current))
+         Tez.zero
+
+  let sum_current unstaked =
+    List.fold_left
+      (fun acc ({current; _} : r) -> Tez.(acc +! current))
+      Tez.zero
+      unstaked
+
+  (* Happens each unstake operation *)
+  let rec add_unstake cycle amount account : t -> t = function
+    | [] -> [init_r cycle amount account]
+    | ({cycle = c; requests; initial; current; slash_pct} as h) :: t ->
+        let open Tez in
+        if Cycle.equal c cycle then (
+          assert (Int.equal slash_pct 0) ;
+          {
+            cycle;
+            initial = initial +! amount;
+            current = current +! amount;
+            slash_pct;
+            requests =
+              String.Map.update
+                account
+                (function
+                  | None -> Some amount | Some x -> Some Tez.(x +! amount))
+                requests;
+          }
+          :: t)
+        else h :: add_unstake cycle amount account t
+
+  (* Happens in stake from unstake *)
+  let sub_unstake amount account : r -> r =
+   fun {cycle; requests; initial; current; slash_pct} ->
+    assert (slash_pct = 0) ;
+    let open Tez in
+    {
+      cycle;
+      initial = initial -! amount;
+      current = current -! amount;
+      slash_pct;
+      requests =
+        String.Map.update
+          account
+          (function
+            | None ->
+                assert (Tez.(amount = zero)) ;
+                None
+            | Some x ->
+                if Tez.(x = amount) then None else Some Tez.(x -! amount))
+          requests;
+    }
+
+  (* Makes given cycle finalizable (and unslashable) *)
+  let rec pop_cycle cycle : t -> finalizable_info * t = function
+    | [] -> ({amount = Tez.zero; slashed_requests = String.Map.empty}, [])
+    | ({cycle = c; requests; initial = _; current; slash_pct} as h) :: t ->
+        if Cycle.(c = cycle) then
+          let amount = current in
+          let slashed_requests =
+            String.Map.map (apply_slash_to_request slash_pct) requests
+          in
+          ({amount; slashed_requests}, t)
+        else if Cycle.(c < cycle) then
+          Stdlib.failwith
+            "Unstaked_frozen: found unfinalized cycle before given [cycle]. \
+             Make sure to call [apply_unslashable] every cycle"
+        else
+          let info, rest = pop_cycle cycle t in
+          (info, h :: rest)
+
+  let slash ~slashable_deposits_period slashed_cycle pct_times_100 a =
+    remove_zeros a
+    |> List.map
+         (fun
+           ({cycle; requests = _; initial; current; slash_pct = old_slash_pct}
+           as r)
+         ->
+           if
+             Cycle.(
+               cycle > slashed_cycle
+               || add cycle slashable_deposits_period < slashed_cycle)
+           then (r, Tez.zero)
+           else
+             let new_current =
+               apply_slash_to_current pct_times_100 initial current
+             in
+             let slashed = Tez.(current -! new_current) in
+             let slash_pct = min 100 (pct_times_100 + old_slash_pct) in
+             ({r with slash_pct; current = new_current}, slashed))
+    |> List.split
+end
+
+(** Representation of unstaked finalizable tez *)
+module Unstaked_finalizable = struct
+  (* Slashing might put inaccessible tez in this container: they are represented in the remainder.
+     They still count towards the total supply, but are currently owned by noone.
+     At most one mutez per unstaking account per slashed cycle *)
+  type t = {map : Tez.t String.Map.t; remainder : Tez.t}
+
+  let zero = {map = String.Map.empty; remainder = Tez.zero}
+
+  (* Called when unstaked frozen for some cycle becomes finalizable *)
+  let add_from_poped_ufd
+      ({amount; slashed_requests} : Unstaked_frozen.finalizable_info)
+      {map; remainder} =
+    let total_requested =
+      String.Map.fold (fun _ x acc -> Tez.(x +! acc)) slashed_requests Tez.zero
+    in
+    let remainder = Tez.(remainder +! amount -! total_requested) in
+    let map =
+      String.Map.union (fun _ a b -> Some Tez.(a +! b)) map slashed_requests
+    in
+    {map; remainder}
+
+  let total {map; remainder} =
+    String.Map.fold (fun _ x acc -> Tez.(x +! acc)) map remainder
+
+  let get account {map; _} =
+    match String.Map.find account map with None -> Tez.zero | Some x -> x
+end
+
+module CycleMap = Map.Make (Cycle)
+
+(** Abstract information of accounts *)
+type account_state = {
+  pkh : Signature.Public_key_hash.t;
+  contract : Protocol.Alpha_context.Contract.t;
+  delegate : string option;
+  parameters : staking_parameters;
+  liquid : Tez.t;
+  bonds : Tez.t;
+  (* The three following fields contain maps from the account's stakers to,
+     respectively, their frozen stake, their unstaked frozen balance, and
+     their unstaked finalizable funds. Additionally, [unstaked_frozen] indexes
+     the maps with the cycle at which the unstake operation occurred. *)
+  frozen_deposits : Frozen_tez.t;
+  unstaked_frozen : Unstaked_frozen.t;
+  unstaked_finalizable : Unstaked_finalizable.t;
+  staking_delegator_numerator : Z.t;
+  staking_delegate_denominator : Z.t;
+  frozen_rights : Tez.t CycleMap.t;
+  slashed_cycles : Cycle.t list;
+}
+
+let init_account ?delegate ~pkh ~contract ~parameters ?(liquid = Tez.zero)
+    ?(bonds = Tez.zero) ?(frozen_deposits = Frozen_tez.zero)
+    ?(unstaked_frozen = Unstaked_frozen.zero)
+    ?(unstaked_finalizable = Unstaked_finalizable.zero)
+    ?(staking_delegator_numerator = Z.zero)
+    ?(staking_delegate_denominator = Z.zero) ?(frozen_rights = CycleMap.empty)
+    ?(slashed_cycles = []) () =
+  {
+    pkh;
+    contract;
+    delegate;
+    parameters;
+    liquid;
+    bonds;
+    frozen_deposits;
+    unstaked_frozen;
+    unstaked_finalizable;
+    staking_delegator_numerator;
+    staking_delegate_denominator;
+    frozen_rights;
+    slashed_cycles;
+  }
+
+type account_map = account_state String.Map.t
+
+(** Balance returned by RPCs. Partial tez are rounded down *)
+type balance = {
+  liquid_b : Tez.t;
+  bonds_b : Tez.t;
+  staked_b : Partial_tez.t;
+  unstaked_frozen_b : Tez.t;
+  unstaked_finalizable_b : Tez.t;
+  staking_delegator_numerator_b : Z.t;
+  staking_delegate_denominator_b : Z.t;
+}
+
+let balance_zero =
+  {
+    liquid_b = Tez.zero;
+    bonds_b = Tez.zero;
+    staked_b = Partial_tez.zero;
+    unstaked_frozen_b = Tez.zero;
+    unstaked_finalizable_b = Tez.zero;
+    staking_delegator_numerator_b = Z.zero;
+    staking_delegate_denominator_b = Z.zero;
+  }
+
+let balance_of_account account_name (account_map : account_map) =
+  match String.Map.find account_name account_map with
+  | None -> raise Not_found
+  | Some
+      {
+        pkh = _;
+        contract = _;
+        delegate;
+        parameters = _;
+        liquid;
+        bonds;
+        frozen_deposits = _;
+        unstaked_frozen = _;
+        unstaked_finalizable = _;
+        staking_delegator_numerator;
+        staking_delegate_denominator;
+        frozen_rights = _;
+        slashed_cycles = _;
+      } ->
+      let balance =
+        {
+          balance_zero with
+          liquid_b = liquid;
+          bonds_b = bonds;
+          staking_delegator_numerator_b = staking_delegator_numerator;
+          staking_delegate_denominator_b = staking_delegate_denominator;
+        }
+      in
+      let balance =
+        match delegate with
+        | None -> balance
+        | Some d -> (
+            match String.Map.find d account_map with
+            | None -> raise Not_found
+            | Some delegate_account ->
+                {
+                  balance with
+                  staked_b =
+                    Frozen_tez.get account_name delegate_account.frozen_deposits;
+                })
+      in
+      (* Because an account can still have frozen or finalizable funds from a delegate
+         that is not its own, we iterate over all of them *)
+      let unstaked_frozen_b, unstaked_finalizable_b =
+        String.Map.fold
+          (fun _delegate_name delegate (frozen, finalzbl) ->
+            let frozen =
+              Tez.(
+                frozen
+                +! Unstaked_frozen.get_total
+                     account_name
+                     delegate.unstaked_frozen)
+            in
+            let finalzbl =
+              Tez.(
+                finalzbl
+                +! Unstaked_finalizable.get
+                     account_name
+                     delegate.unstaked_finalizable)
+            in
+            (frozen, finalzbl))
+          account_map
+          (Tez.zero, Tez.zero)
+      in
+      {balance with unstaked_frozen_b; unstaked_finalizable_b}
+
+let balance_pp fmt
+    {
+      liquid_b;
+      bonds_b;
+      staked_b;
+      unstaked_frozen_b;
+      unstaked_finalizable_b;
+      staking_delegator_numerator_b;
+      staking_delegate_denominator_b;
+    } =
+  Format.fprintf
+    fmt
+    "{@;\
+     @[<v 2>  liquid : %a@;\
+     bonds : %a@;\
+     staked : %a@;\
+     unstaked_frozen : %a@;\
+     unstaked_finalizable : %a@;\
+     staking_delegator_numerator : %a@;\
+     staking_delegate_denominator : %a@;\
+     }@."
+    Tez.pp
+    liquid_b
+    Tez.pp
+    bonds_b
+    Partial_tez.pp
+    staked_b
+    Tez.pp
+    unstaked_frozen_b
+    Tez.pp
+    unstaked_finalizable_b
+    Z.pp_print
+    staking_delegator_numerator_b
+    Z.pp_print
+    staking_delegate_denominator_b
+
+let balance_update_pp fmt
+    ( {
+        liquid_b = a_liquid_b;
+        bonds_b = a_bonds_b;
+        staked_b = a_staked_b;
+        unstaked_frozen_b = a_unstaked_frozen_b;
+        unstaked_finalizable_b = a_unstaked_finalizable_b;
+        staking_delegator_numerator_b = a_staking_delegator_numerator_b;
+        staking_delegate_denominator_b = a_staking_delegate_denominator_b;
+      },
+      {
+        liquid_b = b_liquid_b;
+        bonds_b = b_bonds_b;
+        staked_b = b_staked_b;
+        unstaked_frozen_b = b_unstaked_frozen_b;
+        unstaked_finalizable_b = b_unstaked_finalizable_b;
+        staking_delegator_numerator_b = b_staking_delegator_numerator_b;
+        staking_delegate_denominator_b = b_staking_delegate_denominator_b;
+      } ) =
+  Format.fprintf
+    fmt
+    "{@;\
+     @[<v 2>  liquid : %a -> %a@;\
+     bonds : %a -> %a@;\
+     staked : %a -> %a@;\
+     unstaked_frozen : %a -> %a@;\
+     unstaked_finalizable : %a -> %a@;\
+     staking_delegator_numerator : %a -> %a@;\
+     staking_delegate_denominator : %a -> %a@;\
+     }@."
+    Tez.pp
+    a_liquid_b
+    Tez.pp
+    b_liquid_b
+    Tez.pp
+    a_bonds_b
+    Tez.pp
+    b_bonds_b
+    Partial_tez.pp
+    a_staked_b
+    Partial_tez.pp
+    b_staked_b
+    Tez.pp
+    a_unstaked_frozen_b
+    Tez.pp
+    b_unstaked_frozen_b
+    Tez.pp
+    a_unstaked_finalizable_b
+    Tez.pp
+    b_unstaked_finalizable_b
+    Z.pp_print
+    a_staking_delegator_numerator_b
+    Z.pp_print
+    b_staking_delegator_numerator_b
+    Z.pp_print
+    a_staking_delegate_denominator_b
+    Z.pp_print
+    b_staking_delegate_denominator_b
+
+let assert_balance_equal ~loc account_name
+    {
+      liquid_b = a_liquid_b;
+      bonds_b = a_bonds_b;
+      staked_b = a_staked_b;
+      unstaked_frozen_b = a_unstaked_frozen_b;
+      unstaked_finalizable_b = a_unstaked_finalizable_b;
+      staking_delegator_numerator_b = a_staking_delegator_numerator_b;
+      staking_delegate_denominator_b = a_staking_delegate_denominator_b;
+    }
+    {
+      liquid_b = b_liquid_b;
+      bonds_b = b_bonds_b;
+      staked_b = b_staked_b;
+      unstaked_frozen_b = b_unstaked_frozen_b;
+      unstaked_finalizable_b = b_unstaked_finalizable_b;
+      staking_delegator_numerator_b = b_staking_delegator_numerator_b;
+      staking_delegate_denominator_b = b_staking_delegate_denominator_b;
+    } =
+  let open Lwt_result_syntax in
+  let f s = Format.asprintf "%s: %s" account_name s in
+  let* () =
+    List.fold_left
+      (fun a b ->
+        let*! a in
+        let*! b in
+        join_errors a b)
+      return_unit
+      [
+        Assert.equal
+          ~loc
+          Tez.equal
+          (f "Liquid balances do not match")
+          Tez.pp
+          a_liquid_b
+          b_liquid_b;
+        Assert.equal
+          ~loc
+          Tez.equal
+          (f "Bonds balances do not match")
+          Tez.pp
+          a_bonds_b
+          b_bonds_b;
+        Assert.equal
+          ~loc
+          Tez.equal
+          (f "Staked balances do not match")
+          Tez.pp
+          (Partial_tez.to_tez ~round:`Down a_staked_b)
+          (Partial_tez.to_tez ~round:`Down b_staked_b);
+        Assert.equal
+          ~loc
+          Tez.equal
+          (f "Unstaked frozen balances do not match")
+          Tez.pp
+          a_unstaked_frozen_b
+          b_unstaked_frozen_b;
+        Assert.equal
+          ~loc
+          Tez.equal
+          (f "Unstaked finalizable balances do not match")
+          Tez.pp
+          a_unstaked_finalizable_b
+          b_unstaked_finalizable_b;
+        Assert.equal
+          ~loc
+          Z.equal
+          (f "Staking delegator numerators do not match")
+          Z.pp_print
+          a_staking_delegator_numerator_b
+          b_staking_delegator_numerator_b;
+        Assert.equal
+          ~loc
+          Z.equal
+          (f "Staking delegate denominators do not match")
+          Z.pp_print
+          a_staking_delegate_denominator_b
+          b_staking_delegate_denominator_b;
+      ]
+  in
+  return_unit
+
+let update_account ~f account_name account_map =
+  String.Map.update
+    account_name
+    (function None -> raise Not_found | Some x -> Some (f x))
+    account_map
+
+let add_liquid_rewards amount account_name account_map =
+  let f account =
+    let liquid = Tez.(account.liquid +! amount) in
+    {account with liquid}
+  in
+  update_account ~f account_name account_map
+
+let add_frozen_rewards amount account_name account_map =
+  let f account =
+    let actual_edge =
+      Q.(
+        mul account.parameters.edge_of_baking_over_staking (1_000_000_000 // 1)
+        |> to_int |> of_int
+        |> mul (1 // 1_000_000_000))
+    in
+    let frozen_deposits =
+      Frozen_tez.add_tez_to_all_current
+        ~edge:actual_edge
+        amount
+        account.frozen_deposits
+    in
+    {account with frozen_deposits}
+  in
+  update_account ~f account_name account_map
+
+let apply_burn amount src_name account_map =
+  let f src = {src with liquid = Tez.(src.liquid -! amount)} in
+  update_account ~f src_name account_map
+
+let apply_transfer amount src_name dst_name account_map =
+  match
+    (String.Map.find src_name account_map, String.Map.find dst_name account_map)
+  with
+  | Some src, Some _ ->
+      if Tez.(src.liquid < amount) then
+        (* Invalid amount: operation will fail *)
+        account_map
+      else
+        let f_src src =
+          let liquid = Tez.(src.liquid -! amount) in
+          {src with liquid}
+        in
+        let f_dst dst =
+          let liquid = Tez.(dst.liquid +! amount) in
+          {dst with liquid}
+        in
+        let account_map = update_account ~f:f_src src_name account_map in
+        update_account ~f:f_dst dst_name account_map
+  | _ -> raise Not_found
+
+let stake_from_unstake amount current_cycle consensus_rights_delay delegate_name
+    account_map =
+  match String.Map.find delegate_name account_map with
+  | None -> raise Not_found
+  | Some ({unstaked_frozen; frozen_deposits; slashed_cycles; _} as account) ->
+      let oldest_slashable_cycle =
+        Cycle.(sub current_cycle (consensus_rights_delay + 1))
+        |> Option.value ~default:Cycle.root
+      in
+      if
+        List.exists
+          (fun x -> Cycle.(x >= oldest_slashable_cycle))
+          slashed_cycles
+      then (account_map, amount)
+      else
+        let unstaked_frozen =
+          List.sort
+            (fun (Unstaked_frozen.{cycle = cycle1; _} : Unstaked_frozen.r)
+                 {cycle = cycle2; _} -> Cycle.compare cycle2 cycle1)
+            unstaked_frozen
+        in
+        let rec aux acc_unstakes rem_amount rem_unstakes =
+          match rem_unstakes with
+          | [] -> (acc_unstakes, rem_amount)
+          | (Unstaked_frozen.{initial; _} as h) :: t ->
+              if Tez.(rem_amount = zero) then
+                (acc_unstakes @ rem_unstakes, Tez.zero)
+              else if Tez.(rem_amount >= initial) then
+                let h = Unstaked_frozen.sub_unstake initial delegate_name h in
+                let rem_amount = Tez.(rem_amount -! initial) in
+                aux (acc_unstakes @ [h]) rem_amount t
+              else
+                let h =
+                  Unstaked_frozen.sub_unstake rem_amount delegate_name h
+                in
+                (acc_unstakes @ [h] @ t, Tez.zero)
+        in
+        let unstaked_frozen, rem_amount = aux [] amount unstaked_frozen in
+        let frozen_deposits =
+          Frozen_tez.add_current
+            Tez.(amount -! rem_amount)
+            delegate_name
+            frozen_deposits
+        in
+        let account = {account with unstaked_frozen; frozen_deposits} in
+        let account_map =
+          update_account ~f:(fun _ -> account) delegate_name account_map
+        in
+        (account_map, rem_amount)
+
+let tez_to_pseudo ~round amount delegate_account =
+  let {staking_delegate_denominator; frozen_deposits; _} = delegate_account in
+  let total_q = Frozen_tez.total_co_current_q frozen_deposits.co_current in
+  let total, rem = Partial_tez.to_tez_rem total_q in
+  assert (Q.(equal rem zero)) ;
+  if Tez.(equal total zero) then Tez.to_z amount
+  else
+    let r = Tez.ratio amount total in
+    let p = Q.(r * of_bigint staking_delegate_denominator) in
+    Tez.(of_q ~round p |> to_z)
+
+let pseudo_to_partial_tez amount_pseudo delegate_account =
+  let {staking_delegate_denominator; frozen_deposits; _} = delegate_account in
+  let total_q = Frozen_tez.total_co_current_q frozen_deposits.co_current in
+  let total, rem = Partial_tez.to_tez_rem total_q in
+  assert (Q.(equal rem zero)) ;
+  if Z.(equal staking_delegate_denominator zero) then Q.of_bigint amount_pseudo
+  else
+    let q = Q.(amount_pseudo /// staking_delegate_denominator) in
+    Tez.mul_q total q
+
+(* tez_q <= amount *)
+let stake_values_real amount delegate_account =
+  let pseudo = tez_to_pseudo ~round:`Down amount delegate_account in
+  let tez_q = pseudo_to_partial_tez pseudo delegate_account in
+  (pseudo, tez_q)
+
+(* returned_amount <= amount *)
+let unstake_values_real amount delegate_account =
+  let pseudo = tez_to_pseudo ~round:`Up amount delegate_account in
+  let tez_q = pseudo_to_partial_tez pseudo delegate_account in
+  if Tez.equal (Tez.of_q ~round:`Down tez_q) amount then (pseudo, tez_q)
+  else
+    let pseudo = Z.(pseudo - one) in
+    (pseudo, pseudo_to_partial_tez pseudo delegate_account)
+
+let apply_stake amount current_cycle consensus_rights_delay staker_name
+    account_map =
+  match String.Map.find staker_name account_map with
+  | None -> raise Not_found
+  | Some staker -> (
+      match staker.delegate with
+      | None ->
+          (* Invalid operation: no delegate *)
+          account_map
+      | Some delegate_name ->
+          let old_account_map = account_map in
+          (* If self stake, then try to stake from unstake.
+             Returns the amount that remains to be staked from liquid *)
+          let account_map, amount =
+            if delegate_name = staker_name then
+              stake_from_unstake
+                amount
+                current_cycle
+                consensus_rights_delay
+                staker_name
+                account_map
+            else (account_map, amount)
+          in
+          if Tez.(staker.liquid < amount) then
+            (* Not enough liquid balance: operation will fail *)
+            old_account_map
+          else if delegate_name = staker_name then
+            (* If self stake: increase frozen deposits and decrease liquid balance.
+               "add_current" is easy to resolve since there is no pseudotokens *)
+            let f delegate =
+              let frozen_deposits =
+                Frozen_tez.add_current
+                  amount
+                  staker_name
+                  delegate.frozen_deposits
+              in
+              let liquid = Tez.(delegate.liquid -! amount) in
+              {delegate with frozen_deposits; liquid}
+            in
+            update_account ~f delegate_name account_map
+          else
+            (* If external stake: *)
+            let delegate_account =
+              String.Map.find delegate_name account_map
+              |> Option.value_f ~default:(fun _ -> assert false)
+            in
+            (* Call stake_values_real to know the actual amount staked and the pseudotokens minted *)
+            (* amount_q would be the effective stake on the delegate's side, while
+               amount is the amount removed from the liquid balance *)
+            let pseudo, amount_q = stake_values_real amount delegate_account in
+            let f_staker staker =
+              let liquid = Tez.(staker.liquid -! amount) in
+              let staking_delegator_numerator =
+                Z.add staker.staking_delegator_numerator pseudo
+              in
+              {staker with liquid; staking_delegator_numerator}
+            in
+            let f_delegate delegate =
+              (* The difference between the actual amount and the effective amount is
+                 "distributed" amongst current stake holders.
+                 Indeed, when trading in "amount", the staker receives "pseudo" pseudotokens
+                 valued at "amount_q". So the total amount of value is increased by "amount_q".
+                 Then, "portion" is added to the total, so it must be distributed.
+                 This means that the order is important: first you add_current_q, then
+                 you add the portion to all *)
+              let portion = Partial_tez.(of_tez amount - amount_q) in
+              let frozen_deposits =
+                Frozen_tez.add_current_q
+                  amount_q
+                  staker_name
+                  delegate.frozen_deposits
+              in
+              let co_current =
+                Frozen_tez.add_q_to_all_co_current
+                  portion
+                  frozen_deposits.co_current
+              in
+              let frozen_deposits = {frozen_deposits with co_current} in
+              let staking_delegate_denominator =
+                Z.add delegate.staking_delegate_denominator pseudo
+              in
+              {delegate with frozen_deposits; staking_delegate_denominator}
+            in
+            let account_map =
+              update_account ~f:f_staker staker_name account_map
+            in
+            update_account ~f:f_delegate delegate_name account_map)
+
+let apply_unstake cycle amount staker_name account_map =
+  match String.Map.find staker_name account_map with
+  | None -> raise Not_found
+  | Some staker -> (
+      match staker.delegate with
+      | None -> (* Invalid operation: no delegate *) account_map
+      | Some delegate_name -> (
+          match String.Map.find delegate_name account_map with
+          | None -> raise Not_found
+          | Some delegate ->
+              if delegate_name = staker_name then
+                (* Case self stake *)
+                (* No pseudotokens : no problem *)
+                let frozen_deposits, amount_unstaked =
+                  Frozen_tez.sub_current
+                    amount
+                    staker_name
+                    delegate.frozen_deposits
+                in
+                let unstaked_frozen =
+                  Unstaked_frozen.add_unstake
+                    cycle
+                    amount_unstaked
+                    staker_name
+                    delegate.unstaked_frozen
+                in
+                let delegate =
+                  {delegate with frozen_deposits; unstaked_frozen}
+                in
+                update_account ~f:(fun _ -> delegate) delegate_name account_map
+              else
+                (* Case external stake *)
+                let staked_amount =
+                  Frozen_tez.get staker_name delegate.frozen_deposits
+                in
+                let pseudotokens, amount_q =
+                  if Partial_tez.(staked_amount <= of_tez amount) then
+                    (* Unstake all case *)
+                    (staker.staking_delegator_numerator, staked_amount)
+                  else
+                    (* The staker requests "amount".
+                       It translates to some "pseudotokens", valued at "amount_q".
+                       If those pseudotokens would give strictly more than the requested amount,
+                       then give one less pseudotoken. The actual amount unstaked is always lower than
+                       the requested amount (except in the unstake all case) *)
+                    unstake_values_real amount delegate
+                in
+                (* Actual unstaked amount (that will be finalized) *)
+                let amount = Partial_tez.to_tez ~round:`Down amount_q in
+                (* Delta from pseudotokens' value, to be redistributed amongst all remaining stakers
+                   (including current if still staking) *)
+                let portion = Partial_tez.(amount_q - of_tez amount) in
+                let f_staker staker =
+                  (* The staker's account representation doesn't change much,
+                     the unstake request is stored on the delegate's side *)
+                  let staking_delegator_numerator =
+                    Z.sub staker.staking_delegator_numerator pseudotokens
+                  in
+                  {staker with staking_delegator_numerator}
+                in
+                let account_map =
+                  update_account ~f:f_staker staker_name account_map
+                in
+                let f_delegate delegate =
+                  let staking_delegate_denominator =
+                    Z.sub delegate.staking_delegate_denominator pseudotokens
+                  in
+                  (* Just like in stake *)
+                  (* Do the effective unstake *)
+                  let frozen_deposits =
+                    Frozen_tez.sub_current_q
+                      amount_q
+                      staker_name
+                      delegate.frozen_deposits
+                  in
+                  (* Apply the delta *)
+                  let co_current =
+                    Frozen_tez.add_q_to_all_co_current
+                      portion
+                      frozen_deposits.co_current
+                  in
+                  let frozen_deposits = {frozen_deposits with co_current} in
+                  (* Add unstake request
+                     Note that "amount" might not be the initial requested amount *)
+                  let unstaked_frozen =
+                    Unstaked_frozen.add_unstake
+                      cycle
+                      amount
+                      staker_name
+                      delegate.unstaked_frozen
+                  in
+                  {
+                    delegate with
+                    staking_delegate_denominator;
+                    frozen_deposits;
+                    unstaked_frozen;
+                  }
+                in
+                update_account ~f:f_delegate delegate_name account_map))
+
+let apply_unslashable_f cycle delegate =
+  let amount_unslashable, unstaked_frozen =
+    Unstaked_frozen.pop_cycle cycle delegate.unstaked_frozen
+  in
+  let unstaked_finalizable =
+    Unstaked_finalizable.add_from_poped_ufd
+      amount_unslashable
+      delegate.unstaked_finalizable
+  in
+  {delegate with unstaked_frozen; unstaked_finalizable}
+
+(* Updates unstaked unslashable values for given account *)
+let apply_unslashable cycle account_name account_map =
+  update_account ~f:(apply_unslashable_f cycle) account_name account_map
+
+(* Updates unstaked unslashable values in all accounts *)
+let apply_unslashable_for_all cycle account_map =
+  String.Map.map (apply_unslashable_f cycle) account_map
+
+let apply_finalize staker_name account_map =
+  match String.Map.find staker_name account_map with
+  | None -> raise Not_found
+  | Some _staker ->
+      (* Because an account can still have finalizable funds from a delegate
+         that is not its own, we iterate over all of them *)
+      String.Map.fold
+        (fun delegate_name delegate account_map_acc ->
+          match
+            String.Map.find staker_name delegate.unstaked_finalizable.map
+          with
+          | None -> account_map_acc
+          | Some amount ->
+              let f_staker staker =
+                let liquid = Tez.(staker.liquid +! amount) in
+                {staker with liquid}
+              in
+              let f_delegate delegate =
+                let map =
+                  String.Map.remove
+                    staker_name
+                    delegate.unstaked_finalizable.map
+                in
+                {
+                  delegate with
+                  unstaked_finalizable =
+                    {delegate.unstaked_finalizable with map};
+                }
+              in
+              let account_map_acc =
+                update_account ~f:f_staker staker_name account_map_acc
+              in
+              update_account ~f:f_delegate delegate_name account_map_acc)
+        account_map
+        account_map
+
+let balance_and_total_balance_of_account account_name account_map =
+  let ({
+         liquid_b;
+         bonds_b;
+         staked_b;
+         unstaked_frozen_b;
+         unstaked_finalizable_b;
+         staking_delegator_numerator_b = _;
+         staking_delegate_denominator_b = _;
+       } as balance) =
+    balance_of_account account_name account_map
+  in
+  ( balance,
+    Tez.(
+      liquid_b +! bonds_b
+      +! Partial_tez.to_tez ~round:`Down staked_b
+      +! unstaked_frozen_b +! unstaked_finalizable_b) )
+
+let apply_slashing
+    ( culprit,
+      Protocol.Denunciations_repr.{rewarded; misbehaviour; operation_hash = _}
+    ) constants account_map =
+  let find_account_name_from_pkh_exn pkh account_map =
+    match
+      Option.map
+        fst
+        String.Map.(
+          choose
+          @@ filter
+               (fun _ account ->
+                 Signature.Public_key_hash.equal pkh account.pkh)
+               account_map)
+    with
+    | None -> assert false
+    | Some x -> x
+  in
+  let slashed_cycle =
+    Block.current_cycle_of_level
+      ~blocks_per_cycle:
+        constants.Protocol.Alpha_context.Constants.Parametric.blocks_per_cycle
+      ~current_level:(Protocol.Raw_level_repr.to_int32 misbehaviour.level)
+  in
+  let culprit_name = find_account_name_from_pkh_exn culprit account_map in
+  let rewarded_name = find_account_name_from_pkh_exn rewarded account_map in
+  let slashed_pct =
+    match misbehaviour.kind with
+    | Double_baking ->
+        constants
+          .Protocol.Alpha_context.Constants.Parametric
+           .percentage_of_frozen_deposits_slashed_per_double_baking
+    | Double_attesting | Double_preattesting ->
+        constants.percentage_of_frozen_deposits_slashed_per_double_attestation
+  in
+  let get_total_supply acc_map =
+    String.Map.fold
+      (fun _name
+           {
+             pkh = _;
+             contract = _;
+             delegate = _;
+             parameters = _;
+             liquid;
+             bonds;
+             frozen_deposits;
+             unstaked_frozen;
+             unstaked_finalizable;
+             staking_delegator_numerator = _;
+             staking_delegate_denominator = _;
+             frozen_rights = _;
+             slashed_cycles = _;
+           }
+           tot ->
+        Tez.(
+          liquid +! bonds
+          +! Frozen_tez.total_current frozen_deposits
+          +! Unstaked_frozen.sum_current unstaked_frozen
+          +! Unstaked_finalizable.total unstaked_finalizable
+          +! tot))
+      acc_map
+      Tez.zero
+  in
+  let total_before_slash = get_total_supply account_map in
+  let slash_culprit
+      ({frozen_deposits; unstaked_frozen; frozen_rights; _} as acc) =
+    let base_rights =
+      CycleMap.find slashed_cycle frozen_rights
+      |> Option.value ~default:Tez.zero
+    in
+    let frozen_deposits, slashed_frozen =
+      Frozen_tez.slash base_rights slashed_pct frozen_deposits
+    in
+    let slashed_pct_q = Protocol.Percentage.to_q slashed_pct in
+    let slashed_pct = Q.(100 // 1 * slashed_pct_q |> to_int) in
+    let unstaked_frozen, slashed_unstaked =
+      Unstaked_frozen.slash
+        ~slashable_deposits_period:constants.consensus_rights_delay
+        slashed_cycle
+        slashed_pct
+        unstaked_frozen
+    in
+    ( {acc with frozen_deposits; unstaked_frozen},
+      slashed_frozen :: slashed_unstaked )
+  in
+  let culprit_account =
+    String.Map.find culprit_name account_map
+    |> Option.value_f ~default:(fun () -> raise Not_found)
+  in
+  let slashed_culprit_account, total_slashed = slash_culprit culprit_account in
+  let account_map =
+    update_account
+      ~f:(fun _ -> slashed_culprit_account)
+      culprit_name
+      account_map
+  in
+  let total_after_slash = get_total_supply account_map in
+  let portion_reward =
+    constants.adaptive_issuance.global_limit_of_staking_over_baking + 2
+  in
+  (* For each container slashed, the snitch gets a reward transferred. It gets rounded
+     down each time *)
+  let reward_to_snitch =
+    List.map
+      (fun x -> Tez.mul_q x Q.(1 // portion_reward) |> Tez.of_q ~round:`Down)
+      total_slashed
+    |> List.fold_left Tez.( +! ) Tez.zero
+  in
+  let account_map =
+    add_liquid_rewards reward_to_snitch rewarded_name account_map
+  in
+  let actual_total_burnt_amount =
+    Tez.(total_before_slash -! total_after_slash -! reward_to_snitch)
+  in
+  (account_map, actual_total_burnt_amount)
+
+(* Given cycle is the cycle for which the rights are computed, usually current +
+   consensus rights delay *)
+let update_frozen_rights_cycle cycle account_map =
+  String.Map.map
+    (fun ({frozen_deposits; frozen_rights; _} as acc) ->
+      let total_frozen = Frozen_tez.total_current frozen_deposits in
+      let frozen_rights = CycleMap.add cycle total_frozen frozen_rights in
+      {acc with frozen_rights})
+    account_map
+
+let get_balance_from_context ctxt contract =
+  let open Lwt_result_syntax in
+  let* liquid_b = Context.Contract.balance ctxt contract in
+  let* bonds_b = Context.Contract.frozen_bonds ctxt contract in
+  let* staked_b = Context.Contract.staked_balance ctxt contract in
+  let staked_b =
+    Option.value ~default:Tez.zero staked_b |> Partial_tez.of_tez
+  in
+  let* unstaked_frozen_b =
+    Context.Contract.unstaked_frozen_balance ctxt contract
+  in
+  let unstaked_frozen_b = Option.value ~default:Tez.zero unstaked_frozen_b in
+  let* unstaked_finalizable_b =
+    Context.Contract.unstaked_finalizable_balance ctxt contract
+  in
+  let unstaked_finalizable_b =
+    Option.value ~default:Tez.zero unstaked_finalizable_b
+  in
+  let* total_balance = Context.Contract.full_balance ctxt contract in
+  let* staking_delegator_numerator_b =
+    Context.Contract.staking_numerator ctxt contract
+  in
+  let*! staking_delegate_denominator_b =
+    match (contract : Protocol.Alpha_context.Contract.t) with
+    | Implicit pkh ->
+        let*! result = Context.Delegate.staking_denominator ctxt pkh in
+        Lwt.return
+          (match result with
+          | Ok v -> v
+          | Error _ -> (* Not a delegate *) Z.zero)
+    | Originated _ -> Lwt.return Z.zero
+  in
+  let bd =
+    {
+      liquid_b;
+      bonds_b;
+      staked_b;
+      unstaked_frozen_b;
+      unstaked_finalizable_b;
+      staking_delegator_numerator_b;
+      staking_delegate_denominator_b;
+    }
+  in
+  return (bd, total_balance)
+
+let assert_pseudotokens_consistency ~loc balance account account_name
+    account_map =
+  let open Lwt_result_syntax in
+  let {delegate; staking_delegator_numerator = num_pt; _} = account in
+  let exact_staking_balance = balance.staked_b in
+  match delegate with
+  | None -> return_unit
+  | Some delegate_name -> (
+      if account_name = delegate_name then return_unit
+      else
+        match String.Map.find delegate_name account_map with
+        | None -> raise Not_found
+        | Some delegate_account ->
+            let total_co =
+              Frozen_tez.total_co_current_q
+                delegate_account.frozen_deposits.co_current
+            in
+            let den_pt = delegate_account.staking_delegate_denominator in
+            if Z.(equal den_pt zero) then
+              Assert.equal
+                ~loc
+                Q.equal
+                (Format.asprintf
+                   "%s : Delegate should not have external stake with a 0 \
+                    staking denominator"
+                   account_name)
+                Q.pp_print
+                total_co
+                Q.zero
+            else
+              let expected = Q.(num_pt /// den_pt * total_co) in
+              Assert.equal
+                ~loc
+                Q.equal
+                (Format.asprintf
+                   "%s : Pseudotokens do not match exact staking balance"
+                   account_name)
+                Q.pp_print
+                exact_staking_balance
+                expected)
+
+let assert_balance_check ~loc ctxt account_name account_map =
+  let open Lwt_result_syntax in
+  match String.Map.find account_name account_map with
+  | None -> raise Not_found
+  | Some account ->
+      let* balance_ctxt, total_balance_ctxt =
+        get_balance_from_context ctxt account.contract
+      in
+      let balance, total_balance =
+        balance_and_total_balance_of_account account_name account_map
+      in
+      let*! r0 =
+        assert_pseudotokens_consistency
+          ~loc
+          balance
+          account
+          account_name
+          account_map
+      in
+      let*! r1 = assert_balance_equal ~loc account_name balance_ctxt balance in
+      let*! r1 = join_errors r0 r1 in
+      let*! r2 =
+        Assert.equal
+          ~loc
+          Tez.equal
+          (Format.asprintf "%s : Total balances do not match" account_name)
+          Tez.pp
+          total_balance_ctxt
+          total_balance
+      in
+      join_errors r1 r2
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml
index bba07acba2e9..c86f39a1e23c 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml
@@ -32,6 +32,7 @@
 *)
 
 open Adaptive_issuance_helpers
+module Cycle = Protocol.Alpha_context.Cycle
 
 let assert_level ~loc (blk : Block.t) expected =
   let current_level = blk.header.shell.level in
@@ -131,11 +132,11 @@ let test_launch threshold expected_vote_duration () =
         autostaking_enable = false;
       }
     in
-    let cost_per_byte = Tez.zero in
+    let cost_per_byte = Test_tez.zero in
     let issuance_weights =
       {
         Default_parameters.constants_test.issuance_weights with
-        base_total_issued_per_minute = Tez.zero;
+        base_total_issued_per_minute = Test_tez.zero;
       }
     in
     let consensus_threshold = 0 in
@@ -470,7 +471,7 @@ let test_launch_without_vote () =
     let issuance_weights =
       {
         Default_parameters.constants_test.issuance_weights with
-        base_total_issued_per_minute = Tez.zero;
+        base_total_issued_per_minute = Test_tez.zero;
       }
     in
     let adaptive_issuance =
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 158a4cb33335..ce26b234539a 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -32,6 +32,7 @@
 *)
 
 open Adaptive_issuance_helpers
+open State_account
 
 let fs = Format.asprintf
 
-- 
GitLab


From 51114f4f28270da510132379c050c8ba6cd3393e Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 11:41:45 +0100
Subject: [PATCH 04/18] Proto/tests: move logs in dedicated file

Also move account logs in state_account
---
 .../lib_protocol/test/helpers/log_helper.ml   | 22 ++++++
 .../test/helpers/state_account.ml             | 42 +++++++++++
 .../test_adaptive_issuance_roundtrip.ml       | 74 ++-----------------
 3 files changed, 69 insertions(+), 69 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/helpers/log_helper.ml

diff --git a/src/proto_alpha/lib_protocol/test/helpers/log_helper.ml b/src/proto_alpha/lib_protocol/test/helpers/log_helper.ml
new file mode 100644
index 000000000000..af59306b9dd1
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/helpers/log_helper.ml
@@ -0,0 +1,22 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+let begin_end_color = Log.Color.(BG.bright_white ++ FG.black ++ bold)
+
+let time_color = Log.Color.FG.yellow
+
+let action_color = Log.Color.FG.green
+
+let event_color = Log.Color.FG.blue
+
+let warning_color = Log.Color.FG.red
+
+let low_debug_color = Log.Color.FG.gray
+
+let assert_block_color = Log.Color.(BG.blue ++ FG.gray)
+
+let tez_color = Log.Color.FG.bright_white
diff --git a/src/proto_alpha/lib_protocol/test/helpers/state_account.ml b/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
index c3056e7af127..bca86c1c4443 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
@@ -1385,3 +1385,45 @@ let assert_balance_check ~loc ctxt account_name account_map =
           total_balance
       in
       join_errors r1 r2
+
+let log_debug_balance account_name account_map : unit =
+  let balance, total_balance =
+    balance_and_total_balance_of_account account_name account_map
+  in
+  Log.debug
+    "Model balance of %s:\n%aTotal balance: %a\n"
+    account_name
+    balance_pp
+    balance
+    Tez.pp
+    total_balance
+
+let log_debug_rpc_balance name contract block : unit tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  let* balance, total_balance = get_balance_from_context (B block) contract in
+  Log.debug
+    "RPC balance of %s:\n%aTotal balance: %a\n"
+    name
+    balance_pp
+    balance
+    Tez.pp
+    total_balance ;
+  return_unit
+
+let log_debug_balance_update account_name old_account_map new_account_map : unit
+    =
+  let old_balance, old_total_balance =
+    balance_and_total_balance_of_account account_name old_account_map
+  in
+  let new_balance, new_total_balance =
+    balance_and_total_balance_of_account account_name new_account_map
+  in
+  Log.debug
+    "Balance update of %s:\n%aTotal balance: %a -> %a\n"
+    account_name
+    balance_update_pp
+    (old_balance, new_balance)
+    Tez.pp
+    old_total_balance
+    Tez.pp
+    new_total_balance
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index ce26b234539a..b38d80876f50 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -33,6 +33,7 @@
 
 open Adaptive_issuance_helpers
 open State_account
+open Log_helper
 
 let fs = Format.asprintf
 
@@ -49,71 +50,6 @@ let default_param_wait, default_unstake_wait =
   let msp = Protocol.Constants_repr.max_slashing_period in
   (dpad, crd + msp)
 
-(** Contains the functions and constants relative to logging.*)
-module Log_module = struct
-  let begin_end_color = Log.Color.(BG.bright_white ++ FG.black ++ bold)
-
-  let time_color = Log.Color.FG.yellow
-
-  let action_color = Log.Color.FG.green
-
-  let event_color = Log.Color.FG.blue
-
-  let warning_color = Log.Color.FG.red
-
-  let low_debug_color = Log.Color.FG.gray
-
-  let assert_block_color = Log.Color.(BG.blue ++ FG.gray)
-
-  let tez_color = Log.Color.FG.bright_white
-
-  let log_debug_balance account_name account_map : unit =
-    let balance, total_balance =
-      balance_and_total_balance_of_account account_name account_map
-    in
-    Log.debug
-      "Model balance of %s:\n%aTotal balance: %a\n"
-      account_name
-      balance_pp
-      balance
-      Tez.pp
-      total_balance
-
-  let log_debug_rpc_balance name contract block : unit tzresult Lwt.t =
-    let open Lwt_result_syntax in
-    let* balance, total_balance = get_balance_from_context (B block) contract in
-    Log.debug
-      "RPC balance of %s:\n%aTotal balance: %a\n"
-      name
-      balance_pp
-      balance
-      Tez.pp
-      total_balance ;
-    return_unit
-
-  let log_debug_balance_update account_name old_account_map new_account_map :
-      unit =
-    let old_balance, old_total_balance =
-      balance_and_total_balance_of_account account_name old_account_map
-    in
-    let new_balance, new_total_balance =
-      balance_and_total_balance_of_account account_name new_account_map
-    in
-    Log.debug
-      "Balance update of %s:\n%aTotal balance: %a -> %a\n"
-      account_name
-      balance_update_pp
-      (old_balance, new_balance)
-      Tez.pp
-      old_total_balance
-      Tez.pp
-      new_total_balance
-
-  (* end module Log_module *)
-end
-
-open Log_module
-
 (** Aliases for tez values *)
 type tez_quantity =
   | Half
@@ -1331,7 +1267,7 @@ let op_double_baking ?(correct_order = true) bh1 bh2 ctxt =
 
 let double_bake_ delegate_name (block, state) =
   let open Lwt_result_syntax in
-  Log.info ~color:Log_module.event_color "Double baking with %s" delegate_name ;
+  Log.info ~color:event_color "Double baking with %s" delegate_name ;
   let delegate = State.find_account delegate_name state in
   let* operation =
     Adaptive_issuance_helpers.unstake (B block) delegate.contract Tez.one_mutez
@@ -1363,7 +1299,7 @@ let double_attest_op ?other_bakers ~op ~op_evidence ~kind delegate_name
     (block, state) =
   let open Lwt_result_syntax in
   Log.info
-    ~color:Log_module.event_color
+    ~color:event_color
     "Double %s with %s"
     (match kind with
     | Protocol.Misbehaviour_repr.Double_preattesting -> "preattesting"
@@ -1520,7 +1456,7 @@ let update_state_denunciation (block, state)
       in
       (* TODO: better log... *)
       Log.info
-        ~color:Log_module.event_color
+        ~color:event_color
         "Including denunciation (misbehaviour cycle %a)"
         Cycle.pp
         ds_cycle ;
@@ -2282,7 +2218,7 @@ module Autostaking = struct
     if List.mem ~equal:String.equal name for_accounts then
       if compare new_b old_b then return_unit
       else (
-        Log.debug ~color:Log_module.warning_color "Balances changes failed:@." ;
+        Log.debug ~color:warning_color "Balances changes failed:@." ;
         Log.debug "@[<v 2>Old Balance@ %a@]@." balance_pp old_balance ;
         Log.debug "@[<v 2>New Balance@ %a@]@." balance_pp new_balance ;
         failwith "%s Unexpected stake evolution for %s" loc name)
-- 
GitLab


From 0eac54e9c961148f2997203f413226373cb8ea26 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 11:56:23 +0100
Subject: [PATCH 05/18] Proto/tests: move default params

---
 .../test/helpers/adaptive_issuance_helpers.ml     | 15 +++++++++++++++
 .../test_adaptive_issuance_roundtrip.ml           | 15 ---------------
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
index 2841b7d2641a..d51c3af22ec4 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
@@ -29,6 +29,21 @@ type staking_parameters = {
   edge_of_baking_over_staking : Q.t;
 }
 
+let default_params =
+  let Protocol.Staking_parameters_repr.
+        {
+          limit_of_staking_over_baking_millionth;
+          edge_of_baking_over_staking_billionth;
+        } =
+    Protocol.Staking_parameters_repr.default
+  in
+  {
+    limit_of_staking_over_baking =
+      Q.(Int32.to_int limit_of_staking_over_baking_millionth // 1_000_000);
+    edge_of_baking_over_staking =
+      Q.(Int32.to_int edge_of_baking_over_staking_billionth // 1_000_000_000);
+  }
+
 let get_launch_cycle ~loc blk =
   let open Lwt_result_syntax in
   let* launch_cycle_opt = Context.get_adaptive_issuance_launch_cycle (B blk) in
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index b38d80876f50..1c67655ab1e7 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -82,21 +82,6 @@ let quantity_to_tez all qty =
   | Max_tez -> Tez.max_tez
   | Amount a -> a
 
-let default_params =
-  let Protocol.Staking_parameters_repr.
-        {
-          limit_of_staking_over_baking_millionth;
-          edge_of_baking_over_staking_billionth;
-        } =
-    Protocol.Staking_parameters_repr.default
-  in
-  {
-    limit_of_staking_over_baking =
-      Q.(Int32.to_int limit_of_staking_over_baking_millionth // 1_000_000);
-    edge_of_baking_over_staking =
-      Q.(Int32.to_int edge_of_baking_over_staking_billionth // 1_000_000_000);
-  }
-
 type double_signing_state = {
   culprit : Signature.Public_key_hash.t;
   evidence : Context.t -> Protocol.Alpha_context.packed_operation;
-- 
GitLab


From ddff63bdfae27a5bc3e79d296cfd5bc33197c425 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 11:56:58 +0100
Subject: [PATCH 06/18] Proto/tests: create Ez_tez for tez aliases

---
 .../lib_protocol/test/helpers/test_tez.ml     | 33 +++++++++++++++++++
 .../lib_protocol/test/helpers/test_tez.mli    | 19 +++++++++++
 .../test_adaptive_issuance_roundtrip.ml       | 33 +------------------
 3 files changed, 53 insertions(+), 32 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml b/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
index e1dbe501e09e..1be51c6b3a1e 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
@@ -83,3 +83,36 @@ let mul_q tez portion =
   Q.(mul portion ~$$tez_z)
 
 module Compare = Tez
+
+module Ez_tez = struct
+  (** Aliases for tez values *)
+  type tez_quantity =
+    | Half
+    | All
+    | All_but_one
+    | Nothing
+    | Max_tez
+    | Amount of t
+
+  let tez_quantity_pp fmt value =
+    let s =
+      match value with
+      | Nothing -> "Zero"
+      | All -> "All"
+      | All_but_one -> "All but 1µꜩ"
+      | Half -> "Half"
+      | Max_tez -> "Maximum"
+      | Amount a -> Format.asprintf "%aꜩ" pp a
+    in
+    Format.fprintf fmt "%s" s
+
+  (* [all] is the amount returned when [qty = All]. If [qty = Half], returns half of that. *)
+  let quantity_to_tez all qty =
+    match qty with
+    | Nothing -> zero
+    | All -> all
+    | All_but_one -> if equal all zero then zero else all -! one_mutez
+    | Half -> all /! 2L
+    | Max_tez -> max_tez
+    | Amount a -> a
+end
diff --git a/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli b/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli
index ebfd4a3466cb..57d5501364ef 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli
@@ -68,3 +68,22 @@ val of_q : round:[`Down | `Up] -> Q.t -> t
 val of_z : Z.t -> t
 
 val to_z : t -> Z.t
+
+(** Functions to manipulate Tez in a high level way *)
+module Ez_tez : sig
+  (** Aliases for tez values *)
+  type tez_quantity =
+    | Half
+    | All
+    | All_but_one
+    | Nothing
+    | Max_tez
+    | Amount of t
+
+  val tez_quantity_pp : Format.formatter -> tez_quantity -> unit
+
+  (** [quantity_to_tez max qty] returns a tez value corresponding to the given
+      [qty]. If [qty] is [All], then returns [max]. If [qty] is [All_but_one],
+      returns [max - one_mutez]. *)
+  val quantity_to_tez : t -> tez_quantity -> t
+end
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 1c67655ab1e7..e4249f913932 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -34,6 +34,7 @@
 open Adaptive_issuance_helpers
 open State_account
 open Log_helper
+open Test_tez.Ez_tez
 
 let fs = Format.asprintf
 
@@ -50,38 +51,6 @@ let default_param_wait, default_unstake_wait =
   let msp = Protocol.Constants_repr.max_slashing_period in
   (dpad, crd + msp)
 
-(** Aliases for tez values *)
-type tez_quantity =
-  | Half
-  | All
-  | All_but_one
-  | Nothing
-  | Max_tez
-  | Amount of Tez.t
-
-let tez_quantity_pp fmt value =
-  let s =
-    match value with
-    | Nothing -> "Zero"
-    | All -> "All"
-    | All_but_one -> "All but 1µꜩ"
-    | Half -> "Half"
-    | Max_tez -> "Maximum"
-    | Amount a -> Format.asprintf "%aꜩ" Tez.pp a
-  in
-  Format.fprintf fmt "%s" s
-
-(* [all] is the amount returned when [qty = All]. If [qty = Half], returns half of that. *)
-let quantity_to_tez all qty =
-  match qty with
-  | Nothing -> Tez.zero
-  | All -> all
-  | All_but_one ->
-      if Tez.(equal all zero) then Tez.zero else Tez.(all -! one_mutez)
-  | Half -> Test_tez.(all /! 2L)
-  | Max_tez -> Tez.max_tez
-  | Amount a -> a
-
 type double_signing_state = {
   culprit : Signature.Public_key_hash.t;
   evidence : Context.t -> Protocol.Alpha_context.packed_operation;
-- 
GitLab


From 56c273685bf06bbff4ac1d63c68a39df1ab15b9b Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 11:58:26 +0100
Subject: [PATCH 07/18] Proto/tests: create dedicated file for module State

---
 .../lib_protocol/test/helpers/state.ml        | 384 +++++++++++++++++
 .../test_adaptive_issuance_roundtrip.ml       | 399 +-----------------
 2 files changed, 389 insertions(+), 394 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/helpers/state.ml

diff --git a/src/proto_alpha/lib_protocol/test/helpers/state.ml b/src/proto_alpha/lib_protocol/test/helpers/state.ml
new file mode 100644
index 000000000000..936b5344e2f2
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/helpers/state.ml
@@ -0,0 +1,384 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+open Adaptive_issuance_helpers
+open State_account
+open Log_helper
+
+type double_signing_state = {
+  culprit : Signature.Public_key_hash.t;
+  evidence : Context.t -> Protocol.Alpha_context.packed_operation;
+  denounced : bool;
+  misbehaviour : Protocol.Misbehaviour_repr.t;
+}
+
+(** Type of the state *)
+type t = {
+  account_map : account_map;
+  total_supply : Tez.t;
+  constants : Protocol.Alpha_context.Constants.Parametric.t;
+  param_requests : (string * staking_parameters * int) list;
+  activate_ai : bool;
+  baking_policy : Block.baker_policy option;
+  last_level_rewards : Protocol.Alpha_context.Raw_level.t;
+  snapshot_balances : (string * balance) list String.Map.t;
+  saved_rate : Q.t option;
+  burn_rewards : bool;
+  pending_operations : Protocol.Alpha_context.packed_operation list;
+  pending_slashes :
+    (Signature.Public_key_hash.t * Protocol.Denunciations_repr.item) list;
+  double_signings : double_signing_state list;
+}
+
+(** Expected number of cycles before staking parameters get applied *)
+let param_wait state = state.constants.delegate_parameters_activation_delay + 1
+
+(** Expected number of cycles before staking unstaked funds get unfrozen *)
+let unstake_wait state =
+  let pc = state.constants.consensus_rights_delay in
+  let msp = Protocol.Constants_repr.max_slashing_period in
+  pc + msp
+
+(** From a name, returns the corresponding account *)
+let find_account (account_name : string) (state : t) : account_state =
+  match String.Map.find account_name state.account_map with
+  | None -> raise Not_found
+  | Some r -> r
+
+let find_account_from_pkh (pkh : Signature.public_key_hash) (state : t) :
+    string * account_state =
+  String.Map.filter
+    (fun _ acc -> Signature.Public_key_hash.equal pkh acc.pkh)
+    state.account_map
+  |> String.Map.choose
+  |> function
+  | None -> raise Not_found
+  | Some (name, acc) -> (name, acc)
+
+let liquid_delegated ~name state =
+  let open Result_syntax in
+  String.Map.fold_e
+    (fun _delegator account acc ->
+      match account.delegate with
+      | Some delegate when not @@ String.equal delegate name -> return acc
+      | None -> return acc
+      | _ -> Tez.(acc +? account.liquid))
+    state.account_map
+    Tez.zero
+
+(** Returns true iff account is a delegate *)
+let is_self_delegate (account_name : string) (state : t) : bool =
+  let acc = find_account account_name state in
+  match acc.delegate with
+  | None -> false
+  | Some del_name -> String.equal del_name account_name
+
+let update_map ?(log_updates = []) ~(f : account_map -> account_map) (state : t)
+    : t =
+  let log_updates = List.sort_uniq String.compare log_updates in
+  let new_state = {state with account_map = f state.account_map} in
+  List.iter
+    (fun x ->
+      log_debug_balance_update x state.account_map new_state.account_map)
+    log_updates ;
+  new_state
+
+let apply_burn amount src_name (state : t) : t =
+  let f = apply_burn amount src_name in
+  let state = update_map ~log_updates:[src_name] ~f state in
+  {state with total_supply = Tez.(state.total_supply -! amount)}
+
+let apply_transfer amount src_name dst_name (state : t) : t =
+  let f = apply_transfer amount src_name dst_name in
+  update_map ~log_updates:[src_name; dst_name] ~f state
+
+let apply_stake amount current_cycle staker_name (state : t) : t =
+  let f =
+    apply_stake
+      amount
+      current_cycle
+      state.constants.consensus_rights_delay
+      staker_name
+  in
+  update_map ~log_updates:[staker_name] ~f state
+
+let apply_unstake cycle amount staker_name (state : t) : t =
+  let f = apply_unstake cycle amount staker_name in
+  update_map ~log_updates:[staker_name] ~f state
+
+let apply_finalize staker_name (state : t) : t =
+  let f = apply_finalize staker_name in
+  update_map ~log_updates:[staker_name] ~f state
+
+let apply_unslashable current_cycle account_name (state : t) : t =
+  let unstake_wait = unstake_wait state in
+  match Cycle.sub current_cycle unstake_wait with
+  | None -> state
+  | Some cycle ->
+      let f = apply_unslashable cycle account_name in
+      update_map ~log_updates:[account_name] ~f state
+
+let apply_unslashable_for_all current_cycle (state : t) : t =
+  let unstake_wait = unstake_wait state in
+  match Cycle.sub current_cycle unstake_wait with
+  | None -> state
+  | Some cycle ->
+      let f = apply_unslashable_for_all cycle in
+      (* no log *)
+      update_map ~f state
+
+let apply_rewards ~(baker : string) block (state : t) : t tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  let {last_level_rewards; total_supply; constants = _; _} = state in
+  let*? current_level = Context.get_level (B block) in
+  let current_cycle = Block.current_cycle block in
+  (* We assume one block per minute *)
+  let* rewards_per_block = Context.get_issuance_per_minute (B block) in
+  if Tez.(rewards_per_block = zero) then return state
+  else
+    let delta_time =
+      Protocol.Alpha_context.Raw_level.diff current_level last_level_rewards
+      |> Int64.of_int32
+    in
+    let {parameters = _; pkh; _} = find_account baker state in
+    let delta_rewards = Test_tez.(rewards_per_block *! delta_time) in
+    if delta_time = 1L then
+      Log.info ~color:tez_color "+%aꜩ" Tez.pp rewards_per_block
+    else assert false ;
+    let* to_liquid =
+      portion_of_rewards_to_liquid_for_cycle
+        ?policy:state.baking_policy
+        (B block)
+        current_cycle
+        pkh
+        delta_rewards
+    in
+    let to_frozen = Tez.(delta_rewards -! to_liquid) in
+    let state = update_map ~f:(add_liquid_rewards to_liquid baker) state in
+    let state = update_map ~f:(add_frozen_rewards to_frozen baker) state in
+    let*? total_supply = Tez.(total_supply +? delta_rewards) in
+    return {state with last_level_rewards = current_level; total_supply}
+
+let apply_slashing
+    ( culprit,
+      Protocol.Denunciations_repr.{rewarded; misbehaviour; operation_hash} )
+    (state : t) : t * Tez.t =
+  let account_map, total_burnt =
+    apply_slashing
+      (culprit, {rewarded; misbehaviour; operation_hash})
+      state.constants
+      state.account_map
+  in
+  (* TODO: add culprit's stakers *)
+  let log_updates =
+    List.map (fun x -> fst @@ find_account_from_pkh x state) [culprit; rewarded]
+  in
+  let state = update_map ~log_updates ~f:(fun _ -> account_map) state in
+  (state, total_burnt)
+
+let apply_all_slashes_at_cycle_end current_cycle (state : t) : t =
+  let to_slash_later, to_slash_now =
+    if
+      not
+        state.constants
+          .Protocol.Alpha_context.Constants.Parametric.adaptive_issuance
+          .ns_enable
+    then ([], state.pending_slashes)
+    else
+      List.partition
+        (fun (_, Protocol.Denunciations_repr.{misbehaviour; _}) ->
+          let cycle =
+            Block.current_cycle_of_level
+              ~blocks_per_cycle:
+                state.constants
+                  .Protocol.Alpha_context.Constants.Parametric.blocks_per_cycle
+              ~current_level:
+                (Protocol.Raw_level_repr.to_int32 misbehaviour.level)
+          in
+          Cycle.(cycle = current_cycle))
+        state.pending_slashes
+  in
+  let state, total_burnt =
+    List.fold_left
+      (fun (acc_state, acc_total) x ->
+        let state, burnt = apply_slashing x acc_state in
+        (state, Tez.(acc_total +! burnt)))
+      (state, Tez.zero)
+      to_slash_now
+  in
+  let total_supply = Tez.(state.total_supply -! total_burnt) in
+  {state with pending_slashes = to_slash_later; total_supply}
+
+(** Given an account name and new account state, updates [state] accordingly
+      Preferably use other specific update functions *)
+let update_account (account_name : string) (value : account_state) (state : t) :
+    t =
+  let account_map = String.Map.add account_name value state.account_map in
+  {state with account_map}
+
+let update_delegate account_name delegate_name_opt state : t =
+  let account = find_account account_name state in
+  update_account account_name {account with delegate = delegate_name_opt} state
+
+let add_pending_operations operations state =
+  {state with pending_operations = state.pending_operations @ operations}
+
+let pop_pending_operations state =
+  ({state with pending_operations = []}, state.pending_operations)
+
+let log_model_autostake name pkh old_cycle op ~optimal amount =
+  Log.debug
+    "Model Autostaking: at end of cycle %a, %s(%a) to reach optimal stake %a \
+     %s %a"
+    Cycle.pp
+    old_cycle
+    name
+    Signature.Public_key_hash.pp
+    pkh
+    Tez.pp
+    optimal
+    op
+    Tez.pp
+    (Tez.of_mutez amount)
+
+let apply_autostake ~name ~old_cycle
+    ({
+       pkh;
+       contract = _;
+       delegate;
+       parameters = _;
+       liquid;
+       bonds = _;
+       frozen_deposits;
+       unstaked_frozen;
+       unstaked_finalizable;
+       staking_delegator_numerator = _;
+       staking_delegate_denominator = _;
+       frozen_rights = _;
+       slashed_cycles = _;
+     } :
+      account_state) state =
+  let open Result_syntax in
+  if Some name <> delegate then (
+    Log.debug
+      "Model Autostaking: %s <> %s, noop@."
+      name
+      (Option.value ~default:"None" delegate) ;
+    return state)
+  else
+    let* current_liquid_delegated = liquid_delegated ~name state in
+    let current_frozen = Frozen_tez.total_current frozen_deposits in
+    let current_unstaked_frozen_delegated =
+      Unstaked_frozen.sum_current unstaked_frozen
+    in
+    let current_unstaked_final_delegated =
+      Unstaked_finalizable.total unstaked_finalizable
+    in
+    let power =
+      Tez.(
+        current_liquid_delegated +! current_frozen
+        +! current_unstaked_frozen_delegated +! current_unstaked_final_delegated
+        |> to_mutez |> Z.of_int64)
+    in
+    let optimal =
+      Tez.of_z
+        (Z.cdiv
+           power
+           (Z.of_int (state.constants.limit_of_delegation_over_baking + 1)))
+    in
+    let autostaked =
+      Int64.(sub (Tez.to_mutez optimal) (Tez.to_mutez current_frozen))
+    in
+    let state = apply_unslashable (Cycle.succ old_cycle) name state in
+    let state = apply_finalize name state in
+    (* stake or unstake *)
+    let new_state =
+      if autostaked > 0L then (
+        log_model_autostake ~optimal name pkh old_cycle "stake" autostaked ;
+        apply_stake
+          Tez.(min liquid (of_mutez autostaked))
+          (Cycle.succ old_cycle)
+          name
+          state)
+      else if autostaked < 0L then (
+        log_model_autostake
+          ~optimal
+          name
+          pkh
+          old_cycle
+          "unstake"
+          (Int64.neg autostaked) ;
+        apply_unstake
+          (Cycle.succ old_cycle)
+          (Test_tez.of_mutez Int64.(neg autostaked))
+          name
+          state)
+      else (
+        log_model_autostake
+          ~optimal
+          name
+          pkh
+          old_cycle
+          "only finalize"
+          autostaked ;
+        state)
+    in
+    return new_state
+
+(** Applies when baking the last block of a cycle *)
+let apply_end_cycle current_cycle block state : t tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  Log.debug ~color:time_color "Ending cycle %a" Cycle.pp current_cycle ;
+  let* launch_cycle_opt =
+    Context.get_adaptive_issuance_launch_cycle (B block)
+  in
+  (* Apply all slashes *)
+  let state = apply_all_slashes_at_cycle_end current_cycle state in
+  (* Sets initial frozen for future cycle *)
+  let state =
+    update_map
+      ~f:
+        (update_frozen_rights_cycle
+           (Cycle.add
+              current_cycle
+              (state.constants.consensus_rights_delay + 1)))
+      state
+  in
+  (* Apply autostaking *)
+  let*? state =
+    if not state.constants.adaptive_issuance.autostaking_enable then Ok state
+    else
+      match launch_cycle_opt with
+      | Some launch_cycle when Cycle.(current_cycle >= launch_cycle) -> Ok state
+      | None | Some _ ->
+          String.Map.fold_e
+            (fun name account state ->
+              apply_autostake ~name ~old_cycle:current_cycle account state)
+            state.account_map
+            state
+  in
+  (* Apply parameter changes *)
+  let state, param_requests =
+    List.fold_left
+      (fun (state, remaining_requests) (name, params, wait) ->
+        if wait > 0 then (state, (name, params, wait - 1) :: remaining_requests)
+        else
+          let src = find_account name state in
+          let state =
+            update_account name {src with parameters = params} state
+          in
+          (state, remaining_requests))
+      (state, [])
+      state.param_requests
+  in
+  return {state with param_requests}
+
+(** Applies when baking the first block of a cycle.
+      Technically nothing special happens, but we need to update the unslashable unstakes
+      since it's done lazily *)
+let apply_new_cycle new_cycle state : t =
+  apply_unslashable_for_all new_cycle state
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index e4249f913932..42cd6d7a4d58 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -51,395 +51,6 @@ let default_param_wait, default_unstake_wait =
   let msp = Protocol.Constants_repr.max_slashing_period in
   (dpad, crd + msp)
 
-type double_signing_state = {
-  culprit : Signature.Public_key_hash.t;
-  evidence : Context.t -> Protocol.Alpha_context.packed_operation;
-  denounced : bool;
-  misbehaviour : Protocol.Misbehaviour_repr.t;
-}
-
-(** Module for the [State.t] type of asserted information about the system during a test. *)
-module State = struct
-  (** Type of the state *)
-  type t = {
-    account_map : account_map;
-    total_supply : Tez.t;
-    constants : Protocol.Alpha_context.Constants.Parametric.t;
-    param_requests : (string * staking_parameters * int) list;
-    activate_ai : bool;
-    baking_policy : Block.baker_policy option;
-    last_level_rewards : Protocol.Alpha_context.Raw_level.t;
-    snapshot_balances : (string * balance) list String.Map.t;
-    saved_rate : Q.t option;
-    burn_rewards : bool;
-    pending_operations : Protocol.Alpha_context.packed_operation list;
-    pending_slashes :
-      (Signature.Public_key_hash.t * Protocol.Denunciations_repr.item) list;
-    double_signings : double_signing_state list;
-  }
-
-  (** Expected number of cycles before staking parameters get applied *)
-  let param_wait state =
-    state.constants.delegate_parameters_activation_delay + 1
-
-  (** Expected number of cycles before staking unstaked funds get unfrozen *)
-  let unstake_wait state =
-    let pc = state.constants.consensus_rights_delay in
-    let msp = Protocol.Constants_repr.max_slashing_period in
-    pc + msp
-
-  (** From a name, returns the corresponding account *)
-  let find_account (account_name : string) (state : t) : account_state =
-    match String.Map.find account_name state.account_map with
-    | None -> raise Not_found
-    | Some r -> r
-
-  let find_account_from_pkh (pkh : Signature.public_key_hash) (state : t) :
-      string * account_state =
-    String.Map.filter
-      (fun _ acc -> Signature.Public_key_hash.equal pkh acc.pkh)
-      state.account_map
-    |> String.Map.choose
-    |> function
-    | None -> raise Not_found
-    | Some (name, acc) -> (name, acc)
-
-  let liquid_delegated ~name state =
-    let open Result_syntax in
-    String.Map.fold_e
-      (fun _delegator account acc ->
-        match account.delegate with
-        | Some delegate when not @@ String.equal delegate name -> return acc
-        | None -> return acc
-        | _ -> Tez.(acc +? account.liquid))
-      state.account_map
-      Tez.zero
-
-  (** Returns true iff account is a delegate *)
-  let is_self_delegate (account_name : string) (state : t) : bool =
-    let acc = find_account account_name state in
-    match acc.delegate with
-    | None -> false
-    | Some del_name -> String.equal del_name account_name
-
-  let update_map ?(log_updates = []) ~(f : account_map -> account_map)
-      (state : t) : t =
-    let log_updates = List.sort_uniq String.compare log_updates in
-    let new_state = {state with account_map = f state.account_map} in
-    List.iter
-      (fun x ->
-        log_debug_balance_update x state.account_map new_state.account_map)
-      log_updates ;
-    new_state
-
-  let apply_burn amount src_name (state : t) : t =
-    let f = apply_burn amount src_name in
-    let state = update_map ~log_updates:[src_name] ~f state in
-    {state with total_supply = Tez.(state.total_supply -! amount)}
-
-  let apply_transfer amount src_name dst_name (state : t) : t =
-    let f = apply_transfer amount src_name dst_name in
-    update_map ~log_updates:[src_name; dst_name] ~f state
-
-  let apply_stake amount current_cycle staker_name (state : t) : t =
-    let f =
-      apply_stake
-        amount
-        current_cycle
-        state.constants.consensus_rights_delay
-        staker_name
-    in
-    update_map ~log_updates:[staker_name] ~f state
-
-  let apply_unstake cycle amount staker_name (state : t) : t =
-    let f = apply_unstake cycle amount staker_name in
-    update_map ~log_updates:[staker_name] ~f state
-
-  let apply_finalize staker_name (state : t) : t =
-    let f = apply_finalize staker_name in
-    update_map ~log_updates:[staker_name] ~f state
-
-  let apply_unslashable current_cycle account_name (state : t) : t =
-    let unstake_wait = unstake_wait state in
-    match Cycle.sub current_cycle unstake_wait with
-    | None -> state
-    | Some cycle ->
-        let f = apply_unslashable cycle account_name in
-        update_map ~log_updates:[account_name] ~f state
-
-  let apply_unslashable_for_all current_cycle (state : t) : t =
-    let unstake_wait = unstake_wait state in
-    match Cycle.sub current_cycle unstake_wait with
-    | None -> state
-    | Some cycle ->
-        let f = apply_unslashable_for_all cycle in
-        (* no log *)
-        update_map ~f state
-
-  let apply_rewards ~(baker : string) block (state : t) : t tzresult Lwt.t =
-    let open Lwt_result_syntax in
-    let {last_level_rewards; total_supply; constants = _; _} = state in
-    let*? current_level = Context.get_level (B block) in
-    let current_cycle = Block.current_cycle block in
-    (* We assume one block per minute *)
-    let* rewards_per_block = Context.get_issuance_per_minute (B block) in
-    if Tez.(rewards_per_block = zero) then return state
-    else
-      let delta_time =
-        Protocol.Alpha_context.Raw_level.diff current_level last_level_rewards
-        |> Int64.of_int32
-      in
-      let {parameters = _; pkh; _} = find_account baker state in
-      let delta_rewards = Test_tez.(rewards_per_block *! delta_time) in
-      if delta_time = 1L then
-        Log.info ~color:tez_color "+%aꜩ" Tez.pp rewards_per_block
-      else assert false ;
-      let* to_liquid =
-        portion_of_rewards_to_liquid_for_cycle
-          ?policy:state.baking_policy
-          (B block)
-          current_cycle
-          pkh
-          delta_rewards
-      in
-      let to_frozen = Tez.(delta_rewards -! to_liquid) in
-      let state = update_map ~f:(add_liquid_rewards to_liquid baker) state in
-      let state = update_map ~f:(add_frozen_rewards to_frozen baker) state in
-      let*? total_supply = Tez.(total_supply +? delta_rewards) in
-      return {state with last_level_rewards = current_level; total_supply}
-
-  let apply_slashing
-      ( culprit,
-        Protocol.Denunciations_repr.{rewarded; misbehaviour; operation_hash} )
-      (state : t) : t * Tez.t =
-    let account_map, total_burnt =
-      apply_slashing
-        (culprit, {rewarded; misbehaviour; operation_hash})
-        state.constants
-        state.account_map
-    in
-    (* TODO: add culprit's stakers *)
-    let log_updates =
-      List.map
-        (fun x -> fst @@ find_account_from_pkh x state)
-        [culprit; rewarded]
-    in
-    let state = update_map ~log_updates ~f:(fun _ -> account_map) state in
-    (state, total_burnt)
-
-  let apply_all_slashes_at_cycle_end current_cycle (state : t) : t =
-    let to_slash_later, to_slash_now =
-      if
-        not
-          state.constants
-            .Protocol.Alpha_context.Constants.Parametric.adaptive_issuance
-            .ns_enable
-      then ([], state.pending_slashes)
-      else
-        List.partition
-          (fun (_, Protocol.Denunciations_repr.{misbehaviour; _}) ->
-            let cycle =
-              Block.current_cycle_of_level
-                ~blocks_per_cycle:
-                  state.constants
-                    .Protocol.Alpha_context.Constants.Parametric
-                     .blocks_per_cycle
-                ~current_level:
-                  (Protocol.Raw_level_repr.to_int32 misbehaviour.level)
-            in
-            Cycle.(cycle = current_cycle))
-          state.pending_slashes
-    in
-    let state, total_burnt =
-      List.fold_left
-        (fun (acc_state, acc_total) x ->
-          let state, burnt = apply_slashing x acc_state in
-          (state, Tez.(acc_total +! burnt)))
-        (state, Tez.zero)
-        to_slash_now
-    in
-    let total_supply = Tez.(state.total_supply -! total_burnt) in
-    {state with pending_slashes = to_slash_later; total_supply}
-
-  (** Given an account name and new account state, updates [state] accordingly
-      Preferably use other specific update functions *)
-  let update_account (account_name : string) (value : account_state) (state : t)
-      : t =
-    let account_map = String.Map.add account_name value state.account_map in
-    {state with account_map}
-
-  let update_delegate account_name delegate_name_opt state : t =
-    let account = find_account account_name state in
-    update_account
-      account_name
-      {account with delegate = delegate_name_opt}
-      state
-
-  let add_pending_operations operations state =
-    {state with pending_operations = state.pending_operations @ operations}
-
-  let pop_pending_operations state =
-    ({state with pending_operations = []}, state.pending_operations)
-
-  let log_model_autostake name pkh old_cycle op ~optimal amount =
-    Log.debug
-      "Model Autostaking: at end of cycle %a, %s(%a) to reach optimal stake %a \
-       %s %a"
-      Cycle.pp
-      old_cycle
-      name
-      Signature.Public_key_hash.pp
-      pkh
-      Tez.pp
-      optimal
-      op
-      Tez.pp
-      (Tez.of_mutez amount)
-
-  let apply_autostake ~name ~old_cycle
-      ({
-         pkh;
-         contract = _;
-         delegate;
-         parameters = _;
-         liquid;
-         bonds = _;
-         frozen_deposits;
-         unstaked_frozen;
-         unstaked_finalizable;
-         staking_delegator_numerator = _;
-         staking_delegate_denominator = _;
-         frozen_rights = _;
-         slashed_cycles = _;
-       } :
-        account_state) state =
-    let open Result_syntax in
-    if Some name <> delegate then (
-      Log.debug
-        "Model Autostaking: %s <> %s, noop@."
-        name
-        (Option.value ~default:"None" delegate) ;
-      return state)
-    else
-      let* current_liquid_delegated = liquid_delegated ~name state in
-      let current_frozen = Frozen_tez.total_current frozen_deposits in
-      let current_unstaked_frozen_delegated =
-        Unstaked_frozen.sum_current unstaked_frozen
-      in
-      let current_unstaked_final_delegated =
-        Unstaked_finalizable.total unstaked_finalizable
-      in
-      let power =
-        Tez.(
-          current_liquid_delegated +! current_frozen
-          +! current_unstaked_frozen_delegated
-          +! current_unstaked_final_delegated
-          |> to_mutez |> Z.of_int64)
-      in
-      let optimal =
-        Tez.of_z
-          (Z.cdiv
-             power
-             (Z.of_int (state.constants.limit_of_delegation_over_baking + 1)))
-      in
-      let autostaked =
-        Int64.(sub (Tez.to_mutez optimal) (Tez.to_mutez current_frozen))
-      in
-      let state = apply_unslashable (Cycle.succ old_cycle) name state in
-      let state = apply_finalize name state in
-      (* stake or unstake *)
-      let new_state =
-        if autostaked > 0L then (
-          log_model_autostake ~optimal name pkh old_cycle "stake" autostaked ;
-          apply_stake
-            Tez.(min liquid (of_mutez autostaked))
-            (Cycle.succ old_cycle)
-            name
-            state)
-        else if autostaked < 0L then (
-          log_model_autostake
-            ~optimal
-            name
-            pkh
-            old_cycle
-            "unstake"
-            (Int64.neg autostaked) ;
-          apply_unstake
-            (Cycle.succ old_cycle)
-            (Test_tez.of_mutez Int64.(neg autostaked))
-            name
-            state)
-        else (
-          log_model_autostake
-            ~optimal
-            name
-            pkh
-            old_cycle
-            "only finalize"
-            autostaked ;
-          state)
-      in
-      return new_state
-
-  (** Applies when baking the last block of a cycle *)
-  let apply_end_cycle current_cycle block state : t tzresult Lwt.t =
-    let open Lwt_result_syntax in
-    Log.debug ~color:time_color "Ending cycle %a" Cycle.pp current_cycle ;
-    let* launch_cycle_opt =
-      Context.get_adaptive_issuance_launch_cycle (B block)
-    in
-    (* Apply all slashes *)
-    let state = apply_all_slashes_at_cycle_end current_cycle state in
-    (* Sets initial frozen for future cycle *)
-    let state =
-      update_map
-        ~f:
-          (update_frozen_rights_cycle
-             (Cycle.add
-                current_cycle
-                (state.constants.consensus_rights_delay + 1)))
-        state
-    in
-    (* Apply autostaking *)
-    let*? state =
-      if not state.constants.adaptive_issuance.autostaking_enable then Ok state
-      else
-        match launch_cycle_opt with
-        | Some launch_cycle when Cycle.(current_cycle >= launch_cycle) ->
-            Ok state
-        | None | Some _ ->
-            String.Map.fold_e
-              (fun name account state ->
-                apply_autostake ~name ~old_cycle:current_cycle account state)
-              state.account_map
-              state
-    in
-    (* Apply parameter changes *)
-    let state, param_requests =
-      List.fold_left
-        (fun (state, remaining_requests) (name, params, wait) ->
-          if wait > 0 then
-            (state, (name, params, wait - 1) :: remaining_requests)
-          else
-            let src = find_account name state in
-            let state =
-              update_account name {src with parameters = params} state
-            in
-            (state, remaining_requests))
-        (state, [])
-        state.param_requests
-    in
-    return {state with param_requests}
-
-  (** Applies when baking the first block of a cycle.
-      Technically nothing special happens, but we need to update the unslashable unstakes
-      since it's done lazily *)
-  let apply_new_cycle new_cycle state : t =
-    apply_unslashable_for_all new_cycle state
-
-  (* end module State *)
-end
-
 (* ======== Scenarios ======== *)
 
 (** Usual threaded state for the tests. Contains the current block, pending operations
@@ -1236,7 +847,7 @@ let double_bake_ delegate_name (block, state) =
     Slashing_helpers.Misbehaviour_repr.from_duplicate_block main_branch
   in
   let dss =
-    {culprit = delegate.pkh; denounced = false; evidence; misbehaviour}
+    {State.culprit = delegate.pkh; denounced = false; evidence; misbehaviour}
   in
   let state =
     {state with double_signings = dss :: state.State.double_signings}
@@ -1287,7 +898,7 @@ let double_attest_op ?other_bakers ~op ~op_evidence ~kind delegate_name
   let evidence = op_evidence attestation_a attestation_b in
   let dss =
     {
-      culprit = delegate.pkh;
+      State.culprit = delegate.pkh;
       denounced = false;
       evidence;
       misbehaviour =
@@ -1350,7 +961,7 @@ let get_pending_slashed_pct_for_delegate (block, state) delegate =
   aux 0 state.State.pending_slashes
 
 let update_state_denunciation (block, state)
-    {culprit; denounced; evidence = _; misbehaviour} =
+    {State.culprit; denounced; evidence = _; misbehaviour} =
   let open Lwt_result_syntax in
   if denounced then
     (* If the double signing has already been denounced, a second denunciation should fail *)
@@ -1423,11 +1034,11 @@ let update_state_denunciation (block, state)
       in
       return (state, true)
 
-let make_denunciations_ ?(filter = fun {denounced; _} -> not denounced)
+let make_denunciations_ ?(filter = fun {State.denounced; _} -> not denounced)
     (block, state) =
   let open Lwt_result_syntax in
   let* () = check_pending_slashings ~loc:__LOC__ (block, state) in
-  let make_op state ({evidence; _} as dss) =
+  let make_op state ({State.evidence; _} as dss) =
     if filter dss then
       let* state, denounced = update_state_denunciation (block, state) dss in
       return (Some (evidence (B block), {dss with denounced}, state))
-- 
GitLab


From ae37b3cf1ddd6b2fc577ec9125a5b01daad77063 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 13:26:41 +0100
Subject: [PATCH 08/18] Proto/tests: move dsl logic in specific file

---
 manifest/main.ml                              |   5 +
 opam/octez-protocol-alpha-libs.opam           |   2 +-
 .../lib_protocol/test/helpers/dune            |   5 +
 .../lib_protocol/test/helpers/scenario_dsl.ml | 159 +++++++++++++++++
 .../test_adaptive_issuance_roundtrip.ml       | 162 +-----------------
 5 files changed, 175 insertions(+), 158 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml

diff --git a/manifest/main.ml b/manifest/main.ml
index 8b587d054941..d1e0e5ba3162 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -6207,6 +6207,11 @@ let hash = Protocol.hash
              Some (tezt_core_lib |> open_ |> open_ ~m:"Base")
             else None)
             |> if_some;
+            (if N.(number >= 019) then Some alcotezt else None) |> if_some;
+            (if N.(number >= 019) then Some tezt_lib else None) |> if_some;
+            (if N.(number >= 019) then Some (octez_base_test_helpers |> open_)
+            else None)
+            |> if_some;
             qcheck_alcotest;
             octez_test_helpers;
             octez_base |> open_ ~m:"TzPervasives"
diff --git a/opam/octez-protocol-alpha-libs.opam b/opam/octez-protocol-alpha-libs.opam
index d71995f4b77d..3f654a0561db 100644
--- a/opam/octez-protocol-alpha-libs.opam
+++ b/opam/octez-protocol-alpha-libs.opam
@@ -16,6 +16,7 @@ depends: [
   "octez-shell-libs"
   "uri" { >= "3.1.0" }
   "tezt" { >= "4.0.0" & < "5.0.0" }
+  "octez-alcotezt"
   "qcheck-alcotest" { >= "0.20" }
   "octez-proto-libs"
   "octez-version"
@@ -29,7 +30,6 @@ depends: [
   "tezos-dac-client-lib"
   "octez-injector"
   "octez-l2-libs"
-  "octez-alcotezt" {with-test}
   "tezos-dac-node-lib" {with-test}
 ]
 build: [
diff --git a/src/proto_alpha/lib_protocol/test/helpers/dune b/src/proto_alpha/lib_protocol/test/helpers/dune
index e4dbe087d751..44f497de504e 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/dune
+++ b/src/proto_alpha/lib_protocol/test/helpers/dune
@@ -7,6 +7,9 @@
  (instrumentation (backend bisect_ppx))
  (libraries
   tezt.core
+  octez-alcotezt
+  tezt
+  octez-libs.base-test-helpers
   qcheck-alcotest
   octez-libs.test-helpers
   octez-libs.base
@@ -25,6 +28,8 @@
   (:standard)
   -open Tezt_core
   -open Tezt_core.Base
+  -open Octez_alcotezt
+  -open Tezos_base_test_helpers
   -open Tezos_base.TzPervasives
   -open Tezos_base.TzPervasives.Error_monad.Legacy_monad_globals
   -open Tezos_micheline
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml
new file mode 100644
index 000000000000..f87962cf52f3
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml
@@ -0,0 +1,159 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+open Log_helper
+
+(** A scenario is a succession of actions. We define a branching path as a way to create multiple tests
+    from the same point. This allows easy compositionality of behaviors with minimal code sharing.
+    The [Tag] allows to give meaningful identifiers to the branches. It is good practice to tag each
+    case in a branch (it's not necessary, but since test names must be unique, at most one branch can
+    remain unnamed, and even then it can create conflicting names.)
+ *)
+type ('input, 'output) scenarios =
+  | Action : ('input -> 'output tzresult Lwt.t) -> ('input, 'output) scenarios
+  | Empty : ('t, 't) scenarios
+  | Concat : (('a, 'b) scenarios * ('b, 'c) scenarios) -> ('a, 'c) scenarios
+  | Branch : (('a, 'b) scenarios * ('a, 'b) scenarios) -> ('a, 'b) scenarios
+  | Tag : (* Name for test branch *) string -> ('t, 't) scenarios
+  | Slow : (* If in scenario branch, makes the test `Slow *)
+      ('t, 't) scenarios
+
+(** Unfolded scenario type *)
+type ('input, 'output) single_scenario =
+  | End_scenario : ('t, 't) single_scenario
+  | Cons :
+      (('input -> 't tzresult Lwt.t) * ('t, 'output) single_scenario)
+      -> ('input, 'output) single_scenario
+
+let rec cat_ss :
+    type a b c.
+    (a, b) single_scenario -> (b, c) single_scenario -> (a, c) single_scenario =
+ fun a b ->
+  match a with End_scenario -> b | Cons (act, a') -> Cons (act, cat_ss a' b)
+
+let combine f l1 l2 =
+  List.map (fun a -> List.map (fun b -> f a b) l2) l1 |> List.flatten
+
+let rec unfold_scenarios :
+    type input output.
+    (input, output) scenarios ->
+    ((input, output) single_scenario * string list * bool) list = function
+  | Slow -> [(End_scenario, [], true)]
+  | Tag s -> [(End_scenario, [s], false)]
+  | Empty -> [(End_scenario, [], false)]
+  | Action a -> [(Cons (a, End_scenario), [], false)]
+  | Branch (left, right) -> unfold_scenarios left @ unfold_scenarios right
+  | Concat (left, right) ->
+      let l = unfold_scenarios left in
+      let r = unfold_scenarios right in
+      combine
+        (fun (sl, tl, bl) (sr, tr, br) -> (cat_ss sl sr, tl @ tr, bl || br))
+        l
+        r
+
+let rec run_scenario :
+    type input output.
+    (input, output) single_scenario -> input -> output tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  fun scenario input ->
+    match scenario with
+    | End_scenario -> return input
+    | Cons (action, next) ->
+        let* result = action input in
+        run_scenario next result
+
+let unfolded_to_test :
+    (unit, unit) single_scenario * string list * bool ->
+    unit Alcotest_lwt.test_case =
+ fun (s, name, b) ->
+  let speed = if b then `Slow else `Quick in
+  let name =
+    match name with
+    | [] -> ""
+    | [n] -> n
+    | title :: tags ->
+        (* We chose to separate all tags with a comma, and use the head tag as a title for the test *)
+        title ^ ": " ^ String.concat ", " tags
+  in
+  Tztest.tztest name speed (run_scenario s)
+
+(** Useful aliases and operators *)
+
+(* Aliases for [Empty]. Can be used as first component of a scenario instead of a tag if its not needed. *)
+let noop = Empty
+
+let no_tag = Empty
+
+let concat :
+    type a b c. (a, b) scenarios -> (b, c) scenarios -> (a, c) scenarios =
+ fun a b ->
+  match (a, b) with
+  | Empty, Empty -> Empty
+  | _, Empty -> a
+  | Empty, _ -> b
+  | _ -> Concat (a, b)
+
+let branch : type a b. (a, b) scenarios -> (a, b) scenarios -> (a, b) scenarios
+    =
+ fun a b -> match (a, b) with Empty, Empty -> Empty | _ -> Branch (a, b)
+
+(** Continuation connector: execute a then b *)
+let ( --> ) a b = concat a b
+
+(** Branching connector: creates two tests with different execution paths *)
+let ( |+ ) a b = branch a b
+
+let list_to_branch (list : (string * 'a) list) : (unit, 'a) scenarios =
+  match list with
+  | [] ->
+      Stdlib.failwith
+        (Format.asprintf
+           "%s: Cannot build scenarios from\n  empty list"
+           __LOC__)
+  | (tag, h) :: t ->
+      List.fold_left
+        (fun scenarios (tag, elt) ->
+          scenarios |+ Tag tag --> Action (fun () -> return elt))
+        (Tag tag --> Action (fun () -> return h))
+        t
+
+(** Ends the test. Dump the state, returns [unit] *)
+let end_test : ('a, unit) scenarios =
+  let open Lwt_result_syntax in
+  Action
+    (fun _ ->
+      Log.info ~color:begin_end_color "-- End test --" ;
+      return_unit)
+
+(** Transforms scenarios into Alcotest tests *)
+let tests_of_scenarios :
+    (string * (unit, 't) scenarios) list -> unit Alcotest_lwt.test_case list =
+ fun scenarios ->
+  List.map (fun (s, x) -> Tag s --> x --> end_test) scenarios |> function
+  | [] -> []
+  | a :: t ->
+      List.fold_left ( |+ ) a t |> unfold_scenarios |> List.map unfolded_to_test
+
+(** Arbitrary execution *)
+let exec f = Action f
+
+(** Execute a function that does not modify the block, only the state *)
+let exec_state f =
+  let open Lwt_result_syntax in
+  Action
+    (fun ((block, _state) as input) ->
+      let* state = f input in
+      return (block, state))
+
+(** Execute a function that does not modify neither the block nor the state.
+    Usually used for checks/asserts *)
+let exec_unit f =
+  let open Lwt_result_syntax in
+  Action
+    (fun input ->
+      let* () = f input in
+      return input)
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 42cd6d7a4d58..263c2283b863 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -35,6 +35,11 @@ open Adaptive_issuance_helpers
 open State_account
 open Log_helper
 open Test_tez.Ez_tez
+open Scenario_dsl
+
+(** Usual threaded state for the tests. Contains the current block, pending operations
+    and the known [State.t] *)
+type t = Block.t * State.t
 
 let fs = Format.asprintf
 
@@ -51,163 +56,6 @@ let default_param_wait, default_unstake_wait =
   let msp = Protocol.Constants_repr.max_slashing_period in
   (dpad, crd + msp)
 
-(* ======== Scenarios ======== *)
-
-(** Usual threaded state for the tests. Contains the current block, pending operations
-    and the known [State.t] *)
-type t = Block.t * State.t
-
-(** A scenario is a succession of actions. We define a branching path as a way to create multiple tests
-    from the same point. This allows easy compositionality of behaviors with minimal code sharing.
-    The [Tag] allows to give meaningful identifiers to the branches. It is good practice to tag each
-    case in a branch (it's not necessary, but since test names must be unique, at most one branch can
-    remain unnamed, and even then it can create conflicting names.)
- *)
-type ('input, 'output) scenarios =
-  | Action : ('input -> 'output tzresult Lwt.t) -> ('input, 'output) scenarios
-  | Empty : ('t, 't) scenarios
-  | Concat : (('a, 'b) scenarios * ('b, 'c) scenarios) -> ('a, 'c) scenarios
-  | Branch : (('a, 'b) scenarios * ('a, 'b) scenarios) -> ('a, 'b) scenarios
-  | Tag : (* Name for test branch *) string -> ('t, 't) scenarios
-  | Slow : (* If in scenario branch, makes the test `Slow *)
-      ('t, 't) scenarios
-
-(** Unfolded scenario type *)
-type ('input, 'output) single_scenario =
-  | End_scenario : ('t, 't) single_scenario
-  | Cons :
-      (('input -> 't tzresult Lwt.t) * ('t, 'output) single_scenario)
-      -> ('input, 'output) single_scenario
-
-let rec cat_ss :
-    type a b c.
-    (a, b) single_scenario -> (b, c) single_scenario -> (a, c) single_scenario =
- fun a b ->
-  match a with End_scenario -> b | Cons (act, a') -> Cons (act, cat_ss a' b)
-
-let combine f l1 l2 =
-  List.map (fun a -> List.map (fun b -> f a b) l2) l1 |> List.flatten
-
-let rec unfold_scenarios :
-    type input output.
-    (input, output) scenarios ->
-    ((input, output) single_scenario * string list * bool) list = function
-  | Slow -> [(End_scenario, [], true)]
-  | Tag s -> [(End_scenario, [s], false)]
-  | Empty -> [(End_scenario, [], false)]
-  | Action a -> [(Cons (a, End_scenario), [], false)]
-  | Branch (left, right) -> unfold_scenarios left @ unfold_scenarios right
-  | Concat (left, right) ->
-      let l = unfold_scenarios left in
-      let r = unfold_scenarios right in
-      combine
-        (fun (sl, tl, bl) (sr, tr, br) -> (cat_ss sl sr, tl @ tr, bl || br))
-        l
-        r
-
-let rec run_scenario :
-    type input output.
-    (input, output) single_scenario -> input -> output tzresult Lwt.t =
-  let open Lwt_result_syntax in
-  fun scenario input ->
-    match scenario with
-    | End_scenario -> return input
-    | Cons (action, next) ->
-        let* result = action input in
-        run_scenario next result
-
-let unfolded_to_test :
-    (unit, unit) single_scenario * string list * bool ->
-    unit Alcotest_lwt.test_case =
- fun (s, name, b) ->
-  let speed = if b then `Slow else `Quick in
-  let name =
-    match name with
-    | [] -> ""
-    | [n] -> n
-    | title :: tags ->
-        (* We chose to separate all tags with a comma, and use the head tag as a title for the test *)
-        title ^ ": " ^ String.concat ", " tags
-  in
-  Tztest.tztest name speed (run_scenario s)
-
-(** Useful aliases and operators *)
-
-(* Aliases for [Empty]. Can be used as first component of a scenario instead of a tag if its not needed. *)
-let noop = Empty
-
-let no_tag = Empty
-
-let concat :
-    type a b c. (a, b) scenarios -> (b, c) scenarios -> (a, c) scenarios =
- fun a b ->
-  match (a, b) with
-  | Empty, Empty -> Empty
-  | _, Empty -> a
-  | Empty, _ -> b
-  | _ -> Concat (a, b)
-
-let branch : type a b. (a, b) scenarios -> (a, b) scenarios -> (a, b) scenarios
-    =
- fun a b -> match (a, b) with Empty, Empty -> Empty | _ -> Branch (a, b)
-
-(** Continuation connector: execute a then b *)
-let ( --> ) a b = concat a b
-
-(** Branching connector: creates two tests with different execution paths *)
-let ( |+ ) a b = branch a b
-
-let list_to_branch (list : (string * 'a) list) : (unit, 'a) scenarios =
-  match list with
-  | [] ->
-      Stdlib.failwith
-        (Format.asprintf
-           "%s: Cannot build scenarios from\n  empty list"
-           __LOC__)
-  | (tag, h) :: t ->
-      List.fold_left
-        (fun scenarios (tag, elt) ->
-          scenarios |+ Tag tag --> Action (fun () -> return elt))
-        (Tag tag --> Action (fun () -> return h))
-        t
-
-(** Ends the test. Dump the state, returns [unit] *)
-let end_test : ('a, unit) scenarios =
-  let open Lwt_result_syntax in
-  Action
-    (fun _ ->
-      Log.info ~color:begin_end_color "-- End test --" ;
-      return_unit)
-
-(** Transforms scenarios into Alcotest tests *)
-let tests_of_scenarios :
-    (string * (unit, 't) scenarios) list -> unit Alcotest_lwt.test_case list =
- fun scenarios ->
-  List.map (fun (s, x) -> Tag s --> x --> end_test) scenarios |> function
-  | [] -> []
-  | a :: t ->
-      List.fold_left ( |+ ) a t |> unfold_scenarios |> List.map unfolded_to_test
-
-(** Arbitrary execution *)
-let exec f = Action f
-
-(** Execute a function that does not modify the block, only the state *)
-let exec_state f =
-  let open Lwt_result_syntax in
-  Action
-    (fun ((block, _state) as input) ->
-      let* state = f input in
-      return (block, state))
-
-(** Execute a function that does not modify neither the block nor the state.
-    Usually used for checks/asserts *)
-let exec_unit f =
-  let open Lwt_result_syntax in
-  Action
-    (fun input ->
-      let* () = f input in
-      return input)
-
 (* ======== Baking ======== *)
 
 (** After baking and applying rewards in state *)
-- 
GitLab


From 535d65b42a2c407344bf532ea0a0fd583775b260 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 13:38:23 +0100
Subject: [PATCH 09/18] Proto/tests: move scenario functions to dedicated files

---
 .../test/helpers/scenario_base.ml             |  607 ++++++++++
 .../lib_protocol/test/helpers/scenario_op.ml  |  452 +++++++
 .../test_adaptive_issuance_roundtrip.ml       | 1038 +----------------
 3 files changed, 1061 insertions(+), 1036 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
 create mode 100644 src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml

diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
new file mode 100644
index 000000000000..94abe05397aa
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
@@ -0,0 +1,607 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+open State_account
+open State
+open Scenario_dsl
+open Log_helper
+open Adaptive_issuance_helpers
+
+(** Returns when the number of bootstrap accounts created by [Context.init_n n] is not equal to [n] *)
+type error += Inconsistent_number_of_bootstrap_accounts
+
+(** For [assert_failure], when expected error does not match the actual error. *)
+type error += Unexpected_error
+
+(** Usual threaded state for the tests. Contains the current block, pending operations
+    and the known [State.t] *)
+type t = Block.t * State.t
+
+(* ======== Baking ======== *)
+
+(** After baking and applying rewards in state *)
+let check_all_balances block state : unit tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  let State.{account_map; total_supply; _} = state in
+  let* actual_total_supply = Context.get_total_supply (B block) in
+  let*! r1 =
+    String.Map.fold_s
+      (fun name account acc ->
+        log_debug_balance name account_map ;
+        let* () = log_debug_rpc_balance name (Implicit account.pkh) block in
+        let*! r =
+          assert_balance_check ~loc:__LOC__ (B block) name account_map
+        in
+        join_errors r acc)
+      account_map
+      Result.return_unit
+  in
+  let*! r2 =
+    Assert.equal
+      ~loc:__LOC__
+      Tez.equal
+      "Total supplies do not match"
+      Tez.pp
+      actual_total_supply
+      total_supply
+  in
+  join_errors r1 r2
+
+let check_issuance_rpc block : unit tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  (* We assume one block per minute *)
+  let* rewards_per_block = Context.get_issuance_per_minute (B block) in
+  let* total_supply = Context.get_total_supply (B block) in
+  let* expected_issuance = Context.get_ai_expected_issuance (B block) in
+  let* () =
+    match expected_issuance with
+    | ei :: _ ->
+        (* We assume only the fixed portion is issued *)
+        Assert.equal_tez
+          ~loc:__LOC__
+          rewards_per_block
+          ei.baking_reward_fixed_portion
+    | _ -> failwith "expected_issuance rpc: unexpected value"
+  in
+  let* yearly_rate = Context.get_ai_current_yearly_rate (B block) in
+  let* yearly_rate_exact = Context.get_ai_current_yearly_rate_exact (B block) in
+  let yr = float_of_string yearly_rate in
+  let yre = Q.to_float yearly_rate_exact in
+  (* Precision for yearly rate is 0.001 *)
+  let* () =
+    Assert.equal
+      ~loc:__LOC__
+      (fun x y -> Float.(abs (x -. y) <= 0.001))
+      "Yearly rate (float)"
+      Format.pp_print_float
+      yr
+      yre
+  in
+  (* Divided by 525_600 minutes per year, x100 because rpc returns a pct *)
+  let issuance_from_rate =
+    Tez.(
+      mul_q total_supply Q.(div yearly_rate_exact ~$525_600_00)
+      |> of_q ~round:`Down)
+  in
+  let* () =
+    Assert.equal
+      ~loc:__LOC__
+      Tez.equal
+      "Issuance"
+      Tez.pp
+      rewards_per_block
+      issuance_from_rate
+  in
+  return_unit
+
+(** Bake a block, with the given baker and the given operations. *)
+let bake ?baker : t -> t tzresult Lwt.t =
+ fun (block, state) ->
+  let open Lwt_result_wrap_syntax in
+  let policy =
+    match baker with
+    | None -> state.baking_policy
+    | Some baker ->
+        let {pkh; _} =
+          try State.find_account baker state
+          with Not_found ->
+            Log.info
+              ~color:warning_color
+              "Invalid baker: %s not found. Aborting"
+              baker ;
+            assert false
+        in
+        Some (Block.By_account pkh)
+  in
+  let* baker, _, _, _ = Block.get_next_baker ?policy block in
+  let baker_name, {contract = baker_contract; _} =
+    State.find_account_from_pkh baker state
+  in
+  Log.info
+    ~color:time_color
+    "Baking level %d with %s"
+    (Int32.to_int (Int32.succ Block.(block.header.shell.level)))
+    baker_name ;
+  let current_cycle = Block.current_cycle block in
+  let adaptive_issuance_vote =
+    if state.activate_ai then
+      Protocol.Alpha_context.Per_block_votes.Per_block_vote_on
+    else Per_block_vote_pass
+  in
+  let* () = check_issuance_rpc block in
+  let state, operations = State.pop_pending_operations state in
+  let* block, state =
+    let* block', _metadata =
+      Block.bake_with_metadata ?policy ~adaptive_issuance_vote ~operations block
+    in
+    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, _ =
+        Protocol.Alpha_context.Token.transfer
+          ctxt
+          (`Contract baker_contract)
+          `Burned
+          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 state = State.apply_burn block_rewards baker_name state in
+      return (block, state)
+    else return (block', state)
+  in
+  let* state = State.apply_rewards ~baker:baker_name block state in
+  (* First block of a new cycle *)
+  let new_current_cycle = Block.current_cycle block in
+  let* state =
+    if Protocol.Alpha_context.Cycle.(current_cycle = new_current_cycle) then
+      return state
+    else (
+      Log.info
+        ~color:time_color
+        "Cycle %d"
+        (Protocol.Alpha_context.Cycle.to_int32 new_current_cycle |> Int32.to_int) ;
+      return @@ State.apply_new_cycle new_current_cycle state)
+  in
+  (* Dawn of a new cycle *)
+  let* state =
+    if not (Block.last_block_of_cycle block) then return state
+    else State.apply_end_cycle current_cycle block state
+  in
+  let* () = check_all_balances block state in
+  return (block, state)
+
+(** Bake until a cycle is reached, using [bake] instead of [Block.bake]
+    Should be slower because checks balances at the end of every block (avoidable in some cases) *)
+let bake_until_next_cycle : t -> t tzresult Lwt.t =
+ fun (init_block, init_state) ->
+  let open Lwt_result_syntax in
+  let current_cycle = Block.current_cycle init_block in
+  let rec step (old_block, old_state) =
+    let step_cycle = Block.current_cycle old_block in
+    if Protocol.Alpha_context.Cycle.(step_cycle > current_cycle) then
+      return (old_block, old_state)
+    else
+      let* new_block, new_state = bake (old_block, old_state) in
+      step (new_block, new_state)
+  in
+  step (init_block, init_state)
+
+(* ======== State updates ======== *)
+
+(** Sets the de facto baker for all future blocks *)
+let set_baker baker : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_block, state) ->
+      let {pkh; _} = State.find_account baker state in
+      return {state with State.baking_policy = Some (Block.By_account pkh)})
+
+(** Exclude a list of delegates from baking *)
+let exclude_bakers bakers : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_block, state) ->
+      let bakers_pkh =
+        List.map (fun baker -> (State.find_account baker state).pkh) bakers
+      in
+      return
+        {state with State.baking_policy = Some (Block.Excluding bakers_pkh)})
+
+(** Unsets the baking policy, it returns to default ([By_round 0]) *)
+let unset_baking_policy : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_block, state) ->
+      return {state with State.baking_policy = None})
+
+(** Creates a snapshot of the current balances for the given account names.
+    Can be used to check that balances at point A and B in the execution of a test
+    are the same (either nothing happened, or a succession of actions resulted in
+    getting the same values as before *)
+let snapshot_balances snap_name names_list : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_block, state) ->
+      Log.debug
+        ~color:low_debug_color
+        "Snapshoting balances as \"%s\""
+        snap_name ;
+      let balances =
+        List.map
+          (fun name -> (name, balance_of_account name state.State.account_map))
+          names_list
+      in
+      let snapshot_balances =
+        String.Map.add snap_name balances state.snapshot_balances
+      in
+      return {state with snapshot_balances})
+
+(** Check balances against a previously defined snapshot *)
+let check_snapshot_balances
+    ?(f =
+      fun ~name ~old_balance ~new_balance ->
+        assert_balance_equal ~loc:__LOC__ name old_balance new_balance)
+    snap_name : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_unit (fun (_block, state) ->
+      Log.debug
+        ~color:low_debug_color
+        "Checking evolution of balances between \"%s\" and now"
+        snap_name ;
+      let snapshot_balances =
+        String.Map.find snap_name state.State.snapshot_balances
+      in
+      match snapshot_balances with
+      | None ->
+          Log.debug
+            ~color:warning_color
+            "\"%s\" snapshot not found..."
+            snap_name ;
+          return_unit
+      | Some snapshot_balances ->
+          let* () =
+            List.iter_es
+              (fun (name, old_balance) ->
+                let new_balance =
+                  balance_of_account name state.State.account_map
+                in
+                f ~name ~old_balance ~new_balance)
+              snapshot_balances
+          in
+          return_unit)
+
+(** Save the current issuance rate for future use *)
+let save_current_rate : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (block, state) ->
+      let* rate = Context.get_ai_current_yearly_rate_exact (B block) in
+      return {state with State.saved_rate = Some rate})
+
+(** Check that [f saved_rate current_rate] is true. [f] is typically a comparison function *)
+let check_rate_evolution (f : Q.t -> Q.t -> bool) : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_unit (fun (block, state) ->
+      let* new_rate = Context.get_ai_current_yearly_rate_exact (B block) in
+      let previous_rate = state.State.saved_rate in
+      match previous_rate with
+      | None -> failwith "check_rate_evolution: no rate previously saved"
+      | Some previous_rate ->
+          if f previous_rate new_rate then return_unit
+          else
+            failwith
+              "check_rate_evolution: assertion failed@.previous rate: %a@.new \
+               rate: %a"
+              Q.pp_print
+              previous_rate
+              Q.pp_print
+              new_rate)
+
+(* ======== Operations ======== *)
+
+(** Bake a single block *)
+let next_block =
+  exec (fun input ->
+      Log.info ~color:action_color "[Next block]" ;
+      bake input)
+
+(** Bake a single block with a specific baker *)
+let next_block_with_baker baker =
+  exec (fun input ->
+      Log.info ~color:action_color "[Next block (baker %s)]" baker ;
+      bake ~baker input)
+
+(** Bake until the end of a cycle *)
+let next_cycle =
+  exec (fun input ->
+      Log.info ~color:action_color "[Next cycle]" ;
+      bake_until_next_cycle input)
+
+(** Executes an operation: f should return a new state and a list of operations, which are then applied *)
+let exec_op f =
+  let open Lwt_result_syntax in
+  Action
+    (fun ((block, _state) as input) ->
+      let* state, ops = f input in
+      let state = State.add_pending_operations ops state in
+      return (block, state))
+  --> next_block
+
+(* ======== Definition of basic actions ======== *)
+
+(** Initialize the test, given some initial parameters *)
+let begin_test ~activate_ai ?(burn_rewards = false) ?(ns_enable_fork = false)
+    ?(constants : Protocol.Alpha_context.Constants.Parametric.t option)
+    ?(constants_list :
+       (string * Protocol.Alpha_context.Constants.Parametric.t) list option)
+    delegates_name_list : (unit, t) scenarios =
+  let f ns_enable =
+    (match (constants, constants_list) with
+    | None, None -> Stdlib.failwith "No constants provided to begin_test"
+    | Some _, Some _ ->
+        Stdlib.failwith
+          "You cannot provide ~constants and ~constants_list to begin_test"
+    | None, Some constants_list -> list_to_branch constants_list
+    | Some constants, None -> Action (fun () -> return constants))
+    --> exec (fun (constants : Protocol.Alpha_context.Constants.Parametric.t) ->
+            let open Lwt_result_syntax in
+            Log.info ~color:begin_end_color "-- Begin test --" ;
+            let bootstrap = "__bootstrap__" in
+            let delegates_name_list = bootstrap :: delegates_name_list in
+            (* Override threshold value if activate *)
+            let constants =
+              if activate_ai then (
+                Log.info ~color:event_color "Setting ai threshold to 0" ;
+                {
+                  constants with
+                  adaptive_issuance =
+                    {
+                      constants.adaptive_issuance with
+                      launch_ema_threshold = 0l;
+                      activation_vote_enable = true;
+                      ns_enable;
+                    };
+                })
+              else constants
+            in
+            let n = List.length delegates_name_list in
+            let* block, delegates = Context.init_with_constants_n constants n in
+            let*? init_level = Context.get_level (B block) in
+            let init_staked = Tez.of_mutez 200_000_000_000L in
+            let*? account_map =
+              List.fold_left2
+                ~when_different_lengths:
+                  [Inconsistent_number_of_bootstrap_accounts]
+                (fun account_map name contract ->
+                  let liquid =
+                    Tez.(Account.default_initial_balance -! init_staked)
+                  in
+                  let frozen_deposits = Frozen_tez.init init_staked name name in
+                  let frozen_rights =
+                    List.fold_left
+                      (fun map cycle -> CycleMap.add cycle init_staked map)
+                      CycleMap.empty
+                      Cycle.(
+                        root ---> add root constants.consensus_rights_delay)
+                  in
+                  let pkh = Context.Contract.pkh contract in
+                  let account =
+                    init_account
+                      ~delegate:name
+                      ~pkh
+                      ~contract
+                      ~parameters:default_params
+                      ~liquid
+                      ~frozen_deposits
+                      ~frozen_rights
+                      ()
+                  in
+                  let account_map = String.Map.add name account account_map in
+                  let balance, total_balance =
+                    balance_and_total_balance_of_account name account_map
+                  in
+                  Log.debug
+                    "Initial balance for %s:\n%a"
+                    name
+                    balance_pp
+                    balance ;
+                  Log.debug "Initial total balance: %a" Tez.pp total_balance ;
+                  account_map)
+                String.Map.empty
+                delegates_name_list
+                delegates
+            in
+            let* total_supply = Context.get_total_supply (B block) in
+            let state =
+              State.
+                {
+                  account_map;
+                  total_supply;
+                  constants;
+                  param_requests = [];
+                  activate_ai;
+                  baking_policy = None;
+                  last_level_rewards = init_level;
+                  snapshot_balances = String.Map.empty;
+                  saved_rate = None;
+                  burn_rewards;
+                  pending_operations = [];
+                  pending_slashes = [];
+                  double_signings = [];
+                }
+            in
+            let* () = check_all_balances block state in
+            return (block, state))
+  in
+  if ns_enable_fork then
+    Tag "ns_enable = true" --> f true |+ Tag "ns_enable = false" --> f false
+  else f false
+
+(* ======== Misc functions ========*)
+
+let check_failure_aux ?expected_error :
+    ('a -> 'b tzresult Lwt.t) -> 'a -> 'a tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  fun f input ->
+    Log.info ~color:assert_block_color "Entering failing scenario..." ;
+    let*! output = f input in
+    match output with
+    | Ok _ -> failwith "Unexpected success"
+    | Error e -> (
+        match expected_error with
+        | None ->
+            Log.info ~color:assert_block_color "Rollback" ;
+            return input
+        | Some exp_e ->
+            let exp_e = exp_e input in
+            if e = exp_e then (
+              Log.info ~color:assert_block_color "Rollback" ;
+              return input)
+            else (
+              Log.info
+                ~color:Log.Color.FG.red
+                "Unexpected error:@.%a@.Expected:@.%a@."
+                (Format.pp_print_list pp)
+                e
+                (Format.pp_print_list pp)
+                exp_e ;
+              tzfail Unexpected_error))
+
+let check_fail_and_rollback ?expected_error :
+    ('a, 'b) single_scenario -> 'a -> 'a tzresult Lwt.t =
+ fun sc input -> check_failure_aux ?expected_error (run_scenario sc) input
+
+(** Useful function to test expected failures: runs the given branch until it fails,
+    then rollbacks to before execution. Fails if the given branch Succeeds *)
+let assert_failure ?expected_error : ('a, 'b) scenarios -> ('a, 'a) scenarios =
+ fun scenarios ->
+  match unfold_scenarios scenarios with
+  | [] -> Empty
+  | [(sc, _, _)] -> exec (check_fail_and_rollback ?expected_error sc)
+  | _ ->
+      exec (fun _ ->
+          failwith "Error: assert_failure used with branching scenario")
+
+(** Loop *)
+let rec loop n : ('a, 'a) scenarios -> ('a, 'a) scenarios =
+ fun scenario ->
+  (* If branching scenarios with k branches, returns a scenario with k^n branches *)
+  if n = 0 then Empty
+  else if n = 1 then scenario
+  else loop (n - 1) scenario --> scenario
+
+let rec loop_action n : ('a -> 'a tzresult Lwt.t) -> ('a, 'a) scenarios =
+ fun f ->
+  if n = 0 then Empty
+  else if n = 1 then exec f
+  else loop_action (n - 1) f --> exec f
+
+(** Check a specific balance field for a specific account is equal to a specific amount *)
+let check_balance_field src_name field amount : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  let check = Assert.equal_tez ~loc:__LOC__ amount in
+  let check' a = check (Partial_tez.to_tez ~round:`Down a) in
+  exec_state (fun (block, state) ->
+      let src = State.find_account src_name state in
+      let src_balance, src_total =
+        balance_and_total_balance_of_account src_name state.account_map
+      in
+      let* rpc_balance, rpc_total =
+        get_balance_from_context (B block) src.contract
+      in
+      let* () =
+        match field with
+        | `Liquid ->
+            let* () = check rpc_balance.liquid_b in
+            check src_balance.liquid_b
+        | `Bonds ->
+            let* () = check rpc_balance.bonds_b in
+            check src_balance.bonds_b
+        | `Staked ->
+            let* () = check' rpc_balance.staked_b in
+            check' src_balance.staked_b
+        | `Unstaked_frozen_total ->
+            let* () = check rpc_balance.unstaked_frozen_b in
+            check src_balance.unstaked_frozen_b
+        | `Unstaked_finalizable ->
+            let* () = check rpc_balance.unstaked_finalizable_b in
+            check src_balance.unstaked_finalizable_b
+        | `Total ->
+            let* () = check rpc_total in
+            check src_total
+      in
+      return state)
+
+(** Waiting functions *)
+let rec wait_n_cycles n =
+  if n <= 0 then noop
+  else if n = 1 then next_cycle
+  else wait_n_cycles (n - 1) --> next_cycle
+
+let rec wait_n_blocks n =
+  if n <= 0 then noop
+  else if n = 1 then next_block
+  else wait_n_blocks (n - 1) --> next_block
+
+(** Wait until we are in a cycle satisfying the given condition.
+    Fails if AI_activation is requested and AI is not set to be activated in the future. *)
+let wait_cycle condition =
+  exec (fun (block, state) ->
+      let open Lwt_result_syntax in
+      let rec stopper condition =
+        match condition with
+        | `AI_activation ->
+            if state.State.activate_ai then
+              let* launch_cycle = get_launch_cycle ~loc:__LOC__ block in
+              return
+              @@ ( (fun block _state ->
+                     let current_cycle = Block.current_cycle block in
+                     Cycle.(current_cycle >= launch_cycle)),
+                   "AI activation",
+                   "AI activated" )
+            else assert false
+        | `delegate_parameters_activation ->
+            let init_cycle = Block.current_cycle block in
+            let cycles_to_wait =
+              state.constants.delegate_parameters_activation_delay
+            in
+            return
+            @@ ( (fun block _state ->
+                   Cycle.(
+                     Block.current_cycle block >= add init_cycle cycles_to_wait)),
+                 "delegate parameters activation",
+                 "delegate parameters activated" )
+        | `And (cond1, cond2) ->
+            let* stop1, to1, done1 = stopper cond1 in
+            let* stop2, to2, done2 = stopper cond2 in
+            return
+            @@ ( (fun block state -> stop1 block state && stop2 block state),
+                 to1 ^ " and " ^ to2,
+                 done1 ^ " and " ^ done2 )
+      in
+      let* stopper, to_, done_ = stopper condition in
+      Log.info ~color:time_color "Fast forward to %s" to_ ;
+      let* output =
+        let rec bake_while (block, state) =
+          if stopper block state then return (block, state)
+          else
+            let* input = bake_until_next_cycle (block, state) in
+            bake_while input
+        in
+        bake_while (block, state)
+      in
+      Log.info ~color:event_color "%s" done_ ;
+      return output)
+
+(** Wait until AI activates.
+    Fails if AI is not set to be activated in the future. *)
+let wait_ai_activation = wait_cycle `AI_activation
+
+(** wait delegate_parameters_activation_delay cycles  *)
+let wait_delegate_parameters_activation =
+  wait_cycle `delegate_parameters_activation
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
new file mode 100644
index 000000000000..a01910139061
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
@@ -0,0 +1,452 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+open Log_helper
+open State_account
+open Adaptive_issuance_helpers
+open Scenario_dsl
+open Scenario_base
+open Test_tez.Ez_tez
+
+(** Set delegate parameters for the given delegate *)
+let set_delegate_params delegate_name parameters : (t, t) scenarios =
+  exec_op (fun (block, state) ->
+      let open Lwt_result_syntax in
+      (* Simple example of action_atom definition: *)
+      let delegate = State.find_account delegate_name state in
+      Log.info
+        ~color:action_color
+        "[Set delegate parameters for \"%s\"]"
+        delegate_name ;
+      (* Define the operation *)
+      let* operation =
+        set_delegate_parameters (B block) delegate.contract ~parameters
+      in
+      (* Update state *)
+      let wait = state.constants.delegate_parameters_activation_delay - 1 in
+      let state =
+        {
+          state with
+          param_requests =
+            (delegate_name, parameters, wait) :: state.param_requests;
+        }
+      in
+      (* Return both *)
+      return (state, [operation]))
+
+(** Add a new account with the given name *)
+let add_account name : (t, t) scenarios =
+  let open Lwt_result_syntax in
+  exec_state (fun (_block, state) ->
+      Log.info ~color:action_color "[Add account \"%s\"]" name ;
+      let new_account = Account.new_account () in
+      let pkh = new_account.pkh in
+      let contract = Protocol.Alpha_context.Contract.Implicit pkh in
+      let account_state =
+        init_account ~pkh ~contract ~parameters:default_params ()
+      in
+      let state = State.update_account name account_state state in
+      return state)
+
+(** Reveal operation *)
+let reveal name : (t, t) scenarios =
+  exec_op (fun (block, state) ->
+      let open Lwt_result_syntax in
+      let account = State.find_account name state in
+      Log.info ~color:action_color "[Reveal \"%s\"]" name ;
+      let* acc = Account.find account.pkh in
+      let* operation =
+        Op.revelation ~fee:Protocol.Alpha_context.Tez.zero (B block) acc.pk
+      in
+      return (state, [operation]))
+
+(** Transfer from src to dst *)
+let transfer src_name dst_name amount : (t, t) scenarios =
+  exec_op (fun (block, state) ->
+      let open Lwt_result_syntax in
+      let src = State.find_account src_name state in
+      let dst = State.find_account dst_name state in
+      let amount = quantity_to_tez src.liquid amount in
+      Log.info
+        ~color:action_color
+        "[Transfer \"%s\" -> \"%s\" (%aꜩ)]"
+        src_name
+        dst_name
+        Tez.pp
+        amount ;
+      let* operation =
+        Op.transaction ~fee:Tez.zero (B block) src.contract dst.contract amount
+      in
+      let state = State.apply_transfer amount src_name dst_name state in
+      return (state, [operation]))
+
+(** Set delegate for src. If [delegate_name_opt = None], then unset current delegate *)
+let set_delegate src_name delegate_name_opt : (t, t) scenarios =
+  exec_op (fun (block, state) ->
+      let open Lwt_result_syntax in
+      let src = State.find_account src_name state in
+      let delegate_pkh_opt =
+        match delegate_name_opt with
+        | None ->
+            Log.info ~color:action_color "[Unset delegate of \"%s\"]" src_name ;
+            None
+        | Some delegate_name ->
+            let delegate = State.find_account delegate_name state in
+            Log.info
+              ~color:action_color
+              "[Set delegate \"%s\" for \"%s\"]"
+              delegate_name
+              src_name ;
+            Some delegate.pkh
+      in
+      let cycle = Block.current_cycle block in
+      let* operation =
+        Op.delegation ~fee:Tez.zero (B block) src.contract delegate_pkh_opt
+      in
+      let balance = balance_of_account src_name state.account_map in
+      let state =
+        if Q.(equal balance.staked_b zero) then state
+        else
+          let state = State.apply_unstake cycle Tez.max_tez src_name state in
+          (* Changing delegate applies finalize if unstake happened *)
+          State.apply_finalize src_name state
+      in
+      let state = State.update_delegate src_name delegate_name_opt state in
+      return (state, [operation]))
+
+(** Stake operation *)
+let stake src_name stake_value : (t, t) scenarios =
+  exec_op (fun (block, state) ->
+      let open Lwt_result_syntax in
+      let src = State.find_account src_name state in
+      Log.info
+        ~color:action_color
+        "[Stake for \"%s\" (%a)]"
+        src_name
+        tez_quantity_pp
+        stake_value ;
+      (* Stake applies finalize *before* the stake *)
+      let state = State.apply_finalize src_name state in
+      let amount = quantity_to_tez src.liquid stake_value in
+      let current_cycle = Block.current_cycle block in
+      let* operation = stake (B block) src.contract amount in
+      let state = State.apply_stake amount current_cycle src_name state in
+      return (state, [operation]))
+
+(** unstake operation *)
+let unstake src_name unstake_value : (t, t) scenarios =
+  exec_op (fun (block, state) ->
+      let open Lwt_result_syntax in
+      let src = State.find_account src_name state in
+      Log.info
+        ~color:action_color
+        "[Unstake for \"%s\" (%a)]"
+        src_name
+        tez_quantity_pp
+        unstake_value ;
+      let stake_balance =
+        (balance_of_account src_name state.account_map).staked_b
+        |> Partial_tez.to_tez ~round:`Down
+      in
+      let amount = quantity_to_tez stake_balance unstake_value in
+      let* operation = unstake (B block) src.contract amount in
+      let cycle = Block.current_cycle block in
+      let balance = balance_of_account src_name state.account_map in
+      let state =
+        if Q.(equal balance.staked_b zero) then state
+        else
+          let state = State.apply_unstake cycle amount src_name state in
+          State.apply_finalize src_name state
+      in
+      return (state, [operation]))
+
+(** finalize unstake operation *)
+let finalize_unstake src_name : (t, t) scenarios =
+  exec_op (fun (block, state) ->
+      let open Lwt_result_syntax in
+      let src = State.find_account src_name state in
+      Log.info ~color:action_color "[Finalize_unstake for \"%s\"]" src_name ;
+      let* operation = finalize_unstake (B block) src.contract in
+      let state = State.apply_finalize src_name state in
+      return (state, [operation]))
+
+(* ======== Slashing ======== *)
+
+let check_pending_slashings ~loc (block, state) : unit tzresult Lwt.t =
+  let open Lwt_result_syntax in
+  let* denunciations_rpc = Context.get_denunciations (B block) in
+  Slashing_helpers.Full_denunciation.check_same_lists_any_order
+    ~loc
+    denunciations_rpc
+    state.State.pending_slashes
+
+(** Double attestation helpers *)
+let order_attestations ~correct_order op1 op2 =
+  let oph1 = Protocol.Alpha_context.Operation.hash op1 in
+  let oph2 = Protocol.Alpha_context.Operation.hash op2 in
+  let c = Operation_hash.compare oph1 oph2 in
+  if correct_order then if c < 0 then (op1, op2) else (op2, op1)
+  else if c < 0 then (op2, op1)
+  else (op1, op2)
+
+let op_double_attestation ?(correct_order = true) op1 op2 ctxt =
+  let e1, e2 = order_attestations ~correct_order op1 op2 in
+  Op.double_attestation ctxt e1 e2
+
+let op_double_preattestation ?(correct_order = true) op1 op2 ctxt =
+  let e1, e2 = order_attestations ~correct_order op1 op2 in
+  Op.double_preattestation ctxt e1 e2
+
+let order_block_hashes ~correct_order bh1 bh2 =
+  let hash1 = Protocol.Alpha_context.Block_header.hash bh1 in
+  let hash2 = Protocol.Alpha_context.Block_header.hash bh2 in
+  let c = Block_hash.compare hash1 hash2 in
+  if correct_order then if c < 0 then (bh1, bh2) else (bh2, bh1)
+  else if c < 0 then (bh2, bh1)
+  else (bh1, bh2)
+
+let op_double_baking ?(correct_order = true) bh1 bh2 ctxt =
+  let bh1, bh2 = order_block_hashes ~correct_order bh1 bh2 in
+  Op.double_baking ctxt bh1 bh2
+
+let double_bake_ delegate_name (block, state) =
+  let open Lwt_result_syntax in
+  Log.info ~color:event_color "Double baking with %s" delegate_name ;
+  let delegate = State.find_account delegate_name state in
+  let* operation =
+    Adaptive_issuance_helpers.unstake (B block) delegate.contract Tez.one_mutez
+  in
+  let* forked_block =
+    Block.bake ~policy:(By_account delegate.pkh) ~operation block
+  in
+  (* includes pending operations *)
+  let* main_branch, state = bake ~baker:delegate_name (block, state) in
+  let evidence = op_double_baking main_branch.header forked_block.header in
+  let*? misbehaviour =
+    Slashing_helpers.Misbehaviour_repr.from_duplicate_block main_branch
+  in
+  let dss =
+    {State.culprit = delegate.pkh; denounced = false; evidence; misbehaviour}
+  in
+  let state =
+    {state with double_signings = dss :: state.State.double_signings}
+  in
+  return (main_branch, state)
+
+(* Note: advances one block *)
+let double_bake delegate_name : (t, t) scenarios =
+  exec (double_bake_ delegate_name)
+
+(* [other_bakers] can be used to force using specific bakers to avoid
+   reusing forbidden ones *)
+let double_attest_op ?other_bakers ~op ~op_evidence ~kind delegate_name
+    (block, state) =
+  let open Lwt_result_syntax in
+  Log.info
+    ~color:event_color
+    "Double %s with %s"
+    (match kind with
+    | Protocol.Misbehaviour_repr.Double_preattesting -> "preattesting"
+    | Double_attesting -> "attesting"
+    | Double_baking -> assert false)
+    delegate_name ;
+  let delegate = State.find_account delegate_name state in
+  let* baker, _, _, _ =
+    Block.get_next_baker ?policy:state.baking_policy block
+  in
+  let* other_baker1, other_baker2 =
+    match other_bakers with
+    | Some (ob1, ob2) ->
+        let ob1 = (State.find_account ob1 state).pkh in
+        let ob2 = (State.find_account ob2 state).pkh in
+        return (ob1, ob2)
+    | None -> Context.get_first_different_bakers (B block)
+  in
+  let other_baker =
+    if not (Signature.Public_key_hash.equal baker other_baker2) then
+      other_baker2
+    else other_baker1
+  in
+  let* forked_block = Block.bake ~policy:(By_account other_baker) block in
+  let* forked_block = Block.bake ?policy:state.baking_policy forked_block in
+  (* includes pending operations *)
+  let* block, state = bake (block, state) in
+  let* main_branch, state = bake (block, state) in
+  let* attestation_a = op ~delegate:delegate.pkh forked_block in
+  let* attestation_b = op ~delegate:delegate.pkh main_branch in
+  let evidence = op_evidence attestation_a attestation_b in
+  let dss =
+    {
+      State.culprit = delegate.pkh;
+      denounced = false;
+      evidence;
+      misbehaviour =
+        Slashing_helpers.Misbehaviour_repr.from_duplicate_operation
+          attestation_a;
+    }
+  in
+  let state =
+    {state with double_signings = dss :: state.State.double_signings}
+  in
+  return (main_branch, state)
+
+let double_attest_ =
+  double_attest_op
+    ~op:(fun ~delegate block -> Op.raw_attestation ~delegate block)
+    ~op_evidence:op_double_attestation
+    ~kind:Double_attesting
+
+(* Note: advances two blocks *)
+let double_attest ?other_bakers delegate_name : (t, t) scenarios =
+  exec (double_attest_ ?other_bakers delegate_name)
+
+let double_preattest_ =
+  double_attest_op
+    ~op:(fun ~delegate block -> Op.raw_preattestation ~delegate block)
+    ~op_evidence:op_double_preattestation
+    ~kind:Double_preattesting
+
+(* Note: advances two blocks *)
+let double_preattest ?other_bakers delegate_name : (t, t) scenarios =
+  exec (double_preattest_ ?other_bakers delegate_name)
+
+let cycle_from_level blocks_per_cycle level =
+  let current_cycle = Int32.div level blocks_per_cycle in
+  let current_cycle = Cycle.add Cycle.root (Int32.to_int current_cycle) in
+  current_cycle
+
+let pct_from_kind (block : Block.t) = function
+  | Protocol.Misbehaviour_repr.Double_baking ->
+      Protocol.Percentage.to_q
+        block.constants.percentage_of_frozen_deposits_slashed_per_double_baking
+      |> Q.(mul (100 // 1))
+      |> Q.to_int
+  | Double_attesting | Double_preattesting ->
+      Protocol.Percentage.to_q
+        block.constants
+          .percentage_of_frozen_deposits_slashed_per_double_attestation
+      |> Q.(mul (100 // 1))
+      |> Q.to_int
+
+let get_pending_slashed_pct_for_delegate (block, state) delegate =
+  let rec aux r = function
+    | [] -> r
+    | (culprit, {Protocol.Denunciations_repr.misbehaviour; _}) :: t ->
+        if Signature.Public_key_hash.equal delegate culprit then
+          let new_r = r + pct_from_kind block misbehaviour.kind in
+          if new_r >= 100 then 100 else aux new_r t
+        else aux r t
+  in
+  aux 0 state.State.pending_slashes
+
+let update_state_denunciation (block, state)
+    {State.culprit; denounced; evidence = _; misbehaviour} =
+  let open Lwt_result_syntax in
+  if denounced then
+    (* If the double signing has already been denounced, a second denunciation should fail *)
+    return (state, denounced)
+  else
+    let*? block_level = Context.get_level (B block) in
+    let next_level =
+      Protocol.Alpha_context.Raw_level.(to_int32 @@ succ block_level)
+    in
+    let inclusion_cycle =
+      cycle_from_level block.constants.blocks_per_cycle next_level
+    in
+    let ds_level = Protocol.Raw_level_repr.to_int32 misbehaviour.level in
+    let ds_cycle = cycle_from_level block.constants.blocks_per_cycle ds_level in
+    if Cycle.(ds_cycle > inclusion_cycle) then
+      (* The denunciation is trying to be included too early *)
+      return (state, denounced)
+    else if
+      Cycle.(
+        add ds_cycle Protocol.Constants_repr.max_slashing_period
+        <= inclusion_cycle)
+    then
+      (* The denunciation is too late and gets refused. *)
+      return (state, denounced)
+    else if get_pending_slashed_pct_for_delegate (block, state) culprit >= 100
+    then
+      (* Culprit has been slashed too much, a denunciation is not added to the list.
+         TODO: is the double signing treated as included, or can it be included in the
+         following cycle? *)
+      return (state, denounced)
+    else
+      (* for simplicity's sake (lol), the block producer and the payload producer are the same
+         We also assume that the current state baking policy will be used for the next block *)
+      let* rewarded, _, _, _ =
+        Block.get_next_baker ?policy:state.baking_policy block
+      in
+      let culprit_name, culprit_account =
+        State.find_account_from_pkh culprit state
+      in
+      let state =
+        State.update_account
+          culprit_name
+          {
+            culprit_account with
+            slashed_cycles = inclusion_cycle :: culprit_account.slashed_cycles;
+          }
+          state
+      in
+      let new_pending_slash =
+        ( culprit,
+          {
+            Protocol.Denunciations_repr.rewarded;
+            misbehaviour;
+            operation_hash = Operation_hash.zero;
+            (* unused *)
+          } )
+      in
+      (* TODO: better log... *)
+      Log.info
+        ~color:event_color
+        "Including denunciation (misbehaviour cycle %a)"
+        Cycle.pp
+        ds_cycle ;
+      let state =
+        State.
+          {
+            state with
+            pending_slashes = new_pending_slash :: state.pending_slashes;
+          }
+      in
+      return (state, true)
+
+let make_denunciations_ ?(filter = fun {State.denounced; _} -> not denounced)
+    (block, state) =
+  let open Lwt_result_syntax in
+  let* () = check_pending_slashings ~loc:__LOC__ (block, state) in
+  let make_op state ({State.evidence; _} as dss) =
+    if filter dss then
+      let* state, denounced = update_state_denunciation (block, state) dss in
+      return (Some (evidence (B block), {dss with denounced}, state))
+    else return None
+  in
+  let rec make_op_list dss_list state r_op r_dss =
+    match dss_list with
+    | d :: t -> (
+        let* new_op = make_op state d in
+        match new_op with
+        | None -> make_op_list t state r_op (d :: r_dss)
+        | Some (op, p_dss, new_state) ->
+            make_op_list t new_state (op :: r_op) (p_dss :: r_dss))
+    | [] -> return @@ (state, List.rev r_op, List.rev r_dss)
+  in
+  let* state, operations, double_signings =
+    make_op_list state.double_signings state [] []
+  in
+  let state = {state with double_signings} in
+  return (state, operations)
+
+(* Important note: do not change the baking policy behaviour once denunciations are made,
+   until the operations are included in a block (by default the next block) *)
+let make_denunciations ?filter () = exec_op (make_denunciations_ ?filter)
+
+(** Create an account and give an initial balance funded by [source] *)
+let add_account_with_funds name source amount =
+  add_account name --> transfer source name amount --> reveal name
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 263c2283b863..a1a89f919db5 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -36,19 +36,11 @@ open State_account
 open Log_helper
 open Test_tez.Ez_tez
 open Scenario_dsl
-
-(** Usual threaded state for the tests. Contains the current block, pending operations
-    and the known [State.t] *)
-type t = Block.t * State.t
+open Scenario_base
+open Scenario_op
 
 let fs = Format.asprintf
 
-(** Returns when the number of bootstrap accounts created by [Context.init_n n] is not equal to [n] *)
-type error += Inconsistent_number_of_bootstrap_accounts
-
-(** For [assert_failure], when expected error does not match the actual error. *)
-type error += Unexpected_error
-
 let default_param_wait, default_unstake_wait =
   let constants = Default_parameters.constants_test in
   let crd = constants.consensus_rights_delay in
@@ -56,1032 +48,6 @@ let default_param_wait, default_unstake_wait =
   let msp = Protocol.Constants_repr.max_slashing_period in
   (dpad, crd + msp)
 
-(* ======== Baking ======== *)
-
-(** After baking and applying rewards in state *)
-let check_all_balances block state : unit tzresult Lwt.t =
-  let open Lwt_result_syntax in
-  let State.{account_map; total_supply; _} = state in
-  let* actual_total_supply = Context.get_total_supply (B block) in
-  let*! r1 =
-    String.Map.fold_s
-      (fun name account acc ->
-        log_debug_balance name account_map ;
-        let* () = log_debug_rpc_balance name (Implicit account.pkh) block in
-        let*! r =
-          assert_balance_check ~loc:__LOC__ (B block) name account_map
-        in
-        join_errors r acc)
-      account_map
-      Result.return_unit
-  in
-  let*! r2 =
-    Assert.equal
-      ~loc:__LOC__
-      Tez.equal
-      "Total supplies do not match"
-      Tez.pp
-      actual_total_supply
-      total_supply
-  in
-  join_errors r1 r2
-
-let check_issuance_rpc block : unit tzresult Lwt.t =
-  let open Lwt_result_syntax in
-  (* We assume one block per minute *)
-  let* rewards_per_block = Context.get_issuance_per_minute (B block) in
-  let* total_supply = Context.get_total_supply (B block) in
-  let* expected_issuance = Context.get_ai_expected_issuance (B block) in
-  let* () =
-    match expected_issuance with
-    | ei :: _ ->
-        (* We assume only the fixed portion is issued *)
-        Assert.equal_tez
-          ~loc:__LOC__
-          rewards_per_block
-          ei.baking_reward_fixed_portion
-    | _ -> failwith "expected_issuance rpc: unexpected value"
-  in
-  let* yearly_rate = Context.get_ai_current_yearly_rate (B block) in
-  let* yearly_rate_exact = Context.get_ai_current_yearly_rate_exact (B block) in
-  let yr = float_of_string yearly_rate in
-  let yre = Q.to_float yearly_rate_exact in
-  (* Precision for yearly rate is 0.001 *)
-  let* () =
-    Assert.equal
-      ~loc:__LOC__
-      (fun x y -> Float.(abs (x -. y) <= 0.001))
-      "Yearly rate (float)"
-      Format.pp_print_float
-      yr
-      yre
-  in
-  (* Divided by 525_600 minutes per year, x100 because rpc returns a pct *)
-  let issuance_from_rate =
-    Tez.(
-      mul_q total_supply Q.(div yearly_rate_exact ~$525_600_00)
-      |> of_q ~round:`Down)
-  in
-  let* () =
-    Assert.equal
-      ~loc:__LOC__
-      Tez.equal
-      "Issuance"
-      Tez.pp
-      rewards_per_block
-      issuance_from_rate
-  in
-  return_unit
-
-(** Bake a block, with the given baker and the given operations. *)
-let bake ?baker : t -> t tzresult Lwt.t =
- fun (block, state) ->
-  let open Lwt_result_wrap_syntax in
-  let policy =
-    match baker with
-    | None -> state.baking_policy
-    | Some baker ->
-        let {pkh; _} =
-          try State.find_account baker state
-          with Not_found ->
-            Log.info
-              ~color:warning_color
-              "Invalid baker: %s not found. Aborting"
-              baker ;
-            assert false
-        in
-        Some (Block.By_account pkh)
-  in
-  let* baker, _, _, _ = Block.get_next_baker ?policy block in
-  let baker_name, {contract = baker_contract; _} =
-    State.find_account_from_pkh baker state
-  in
-  Log.info
-    ~color:time_color
-    "Baking level %d with %s"
-    (Int32.to_int (Int32.succ Block.(block.header.shell.level)))
-    baker_name ;
-  let current_cycle = Block.current_cycle block in
-  let adaptive_issuance_vote =
-    if state.activate_ai then
-      Protocol.Alpha_context.Per_block_votes.Per_block_vote_on
-    else Per_block_vote_pass
-  in
-  let* () = check_issuance_rpc block in
-  let state, operations = State.pop_pending_operations state in
-  let* block, state =
-    let* block', _metadata =
-      Block.bake_with_metadata ?policy ~adaptive_issuance_vote ~operations block
-    in
-    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, _ =
-        Protocol.Alpha_context.Token.transfer
-          ctxt
-          (`Contract baker_contract)
-          `Burned
-          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 state = State.apply_burn block_rewards baker_name state in
-      return (block, state)
-    else return (block', state)
-  in
-  let* state = State.apply_rewards ~baker:baker_name block state in
-  (* First block of a new cycle *)
-  let new_current_cycle = Block.current_cycle block in
-  let* state =
-    if Protocol.Alpha_context.Cycle.(current_cycle = new_current_cycle) then
-      return state
-    else (
-      Log.info
-        ~color:time_color
-        "Cycle %d"
-        (Protocol.Alpha_context.Cycle.to_int32 new_current_cycle |> Int32.to_int) ;
-      return @@ State.apply_new_cycle new_current_cycle state)
-  in
-  (* Dawn of a new cycle *)
-  let* state =
-    if not (Block.last_block_of_cycle block) then return state
-    else State.apply_end_cycle current_cycle block state
-  in
-  let* () = check_all_balances block state in
-  return (block, state)
-
-(** Bake until a cycle is reached, using [bake] instead of [Block.bake]
-    Should be slower because checks balances at the end of every block (avoidable in some cases) *)
-let bake_until_next_cycle : t -> t tzresult Lwt.t =
- fun (init_block, init_state) ->
-  let open Lwt_result_syntax in
-  let current_cycle = Block.current_cycle init_block in
-  let rec step (old_block, old_state) =
-    let step_cycle = Block.current_cycle old_block in
-    if Protocol.Alpha_context.Cycle.(step_cycle > current_cycle) then
-      return (old_block, old_state)
-    else
-      let* new_block, new_state = bake (old_block, old_state) in
-      step (new_block, new_state)
-  in
-  step (init_block, init_state)
-
-(* ======== State updates ======== *)
-
-(** Sets the de facto baker for all future blocks *)
-let set_baker baker : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_state (fun (_block, state) ->
-      let {pkh; _} = State.find_account baker state in
-      return {state with State.baking_policy = Some (Block.By_account pkh)})
-
-(** Exclude a list of delegates from baking *)
-let exclude_bakers bakers : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_state (fun (_block, state) ->
-      let bakers_pkh =
-        List.map (fun baker -> (State.find_account baker state).pkh) bakers
-      in
-      return
-        {state with State.baking_policy = Some (Block.Excluding bakers_pkh)})
-
-(** Unsets the baking policy, it returns to default ([By_round 0]) *)
-let unset_baking_policy : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_state (fun (_block, state) ->
-      return {state with State.baking_policy = None})
-
-(** Creates a snapshot of the current balances for the given account names.
-    Can be used to check that balances at point A and B in the execution of a test
-    are the same (either nothing happened, or a succession of actions resulted in
-    getting the same values as before *)
-let snapshot_balances snap_name names_list : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_state (fun (_block, state) ->
-      Log.debug
-        ~color:low_debug_color
-        "Snapshoting balances as \"%s\""
-        snap_name ;
-      let balances =
-        List.map
-          (fun name -> (name, balance_of_account name state.State.account_map))
-          names_list
-      in
-      let snapshot_balances =
-        String.Map.add snap_name balances state.snapshot_balances
-      in
-      return {state with snapshot_balances})
-
-(** Check balances against a previously defined snapshot *)
-let check_snapshot_balances
-    ?(f =
-      fun ~name ~old_balance ~new_balance ->
-        assert_balance_equal ~loc:__LOC__ name old_balance new_balance)
-    snap_name : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_unit (fun (_block, state) ->
-      Log.debug
-        ~color:low_debug_color
-        "Checking evolution of balances between \"%s\" and now"
-        snap_name ;
-      let snapshot_balances =
-        String.Map.find snap_name state.State.snapshot_balances
-      in
-      match snapshot_balances with
-      | None ->
-          Log.debug
-            ~color:warning_color
-            "\"%s\" snapshot not found..."
-            snap_name ;
-          return_unit
-      | Some snapshot_balances ->
-          let* () =
-            List.iter_es
-              (fun (name, old_balance) ->
-                let new_balance =
-                  balance_of_account name state.State.account_map
-                in
-                f ~name ~old_balance ~new_balance)
-              snapshot_balances
-          in
-          return_unit)
-
-(** Save the current issuance rate for future use *)
-let save_current_rate : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_state (fun (block, state) ->
-      let* rate = Context.get_ai_current_yearly_rate_exact (B block) in
-      return {state with State.saved_rate = Some rate})
-
-(** Check that [f saved_rate current_rate] is true. [f] is typically a comparison function *)
-let check_rate_evolution (f : Q.t -> Q.t -> bool) : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_unit (fun (block, state) ->
-      let* new_rate = Context.get_ai_current_yearly_rate_exact (B block) in
-      let previous_rate = state.State.saved_rate in
-      match previous_rate with
-      | None -> failwith "check_rate_evolution: no rate previously saved"
-      | Some previous_rate ->
-          if f previous_rate new_rate then return_unit
-          else
-            failwith
-              "check_rate_evolution: assertion failed@.previous rate: %a@.new \
-               rate: %a"
-              Q.pp_print
-              previous_rate
-              Q.pp_print
-              new_rate)
-
-(* ======== Operations ======== *)
-
-(** Bake a single block *)
-let next_block =
-  exec (fun input ->
-      Log.info ~color:action_color "[Next block]" ;
-      bake input)
-
-(** Bake a single block with a specific baker *)
-let next_block_with_baker baker =
-  exec (fun input ->
-      Log.info ~color:action_color "[Next block (baker %s)]" baker ;
-      bake ~baker input)
-
-(** Bake until the end of a cycle *)
-let next_cycle =
-  exec (fun input ->
-      Log.info ~color:action_color "[Next cycle]" ;
-      bake_until_next_cycle input)
-
-(** Executes an operation: f should return a new state and a list of operations, which are then applied *)
-let exec_op f =
-  let open Lwt_result_syntax in
-  Action
-    (fun ((block, _state) as input) ->
-      let* state, ops = f input in
-      let state = State.add_pending_operations ops state in
-      return (block, state))
-  --> next_block
-
-(* ======== Definition of basic actions ======== *)
-
-(** Initialize the test, given some initial parameters *)
-let begin_test ~activate_ai ?(burn_rewards = false) ?(ns_enable_fork = false)
-    ?(constants : Protocol.Alpha_context.Constants.Parametric.t option)
-    ?(constants_list :
-       (string * Protocol.Alpha_context.Constants.Parametric.t) list option)
-    delegates_name_list : (unit, t) scenarios =
-  let f ns_enable =
-    (match (constants, constants_list) with
-    | None, None -> Stdlib.failwith "No constants provided to begin_test"
-    | Some _, Some _ ->
-        Stdlib.failwith
-          "You cannot provide ~constants and ~constants_list to begin_test"
-    | None, Some constants_list -> list_to_branch constants_list
-    | Some constants, None -> Action (fun () -> return constants))
-    --> exec (fun (constants : Protocol.Alpha_context.Constants.Parametric.t) ->
-            let open Lwt_result_syntax in
-            Log.info ~color:begin_end_color "-- Begin test --" ;
-            let bootstrap = "__bootstrap__" in
-            let delegates_name_list = bootstrap :: delegates_name_list in
-            (* Override threshold value if activate *)
-            let constants =
-              if activate_ai then (
-                Log.info ~color:event_color "Setting ai threshold to 0" ;
-                {
-                  constants with
-                  adaptive_issuance =
-                    {
-                      constants.adaptive_issuance with
-                      launch_ema_threshold = 0l;
-                      activation_vote_enable = true;
-                      ns_enable;
-                    };
-                })
-              else constants
-            in
-            let n = List.length delegates_name_list in
-            let* block, delegates = Context.init_with_constants_n constants n in
-            let*? init_level = Context.get_level (B block) in
-            let init_staked = Tez.of_mutez 200_000_000_000L in
-            let*? account_map =
-              List.fold_left2
-                ~when_different_lengths:
-                  [Inconsistent_number_of_bootstrap_accounts]
-                (fun account_map name contract ->
-                  let liquid =
-                    Tez.(Account.default_initial_balance -! init_staked)
-                  in
-                  let frozen_deposits = Frozen_tez.init init_staked name name in
-                  let frozen_rights =
-                    List.fold_left
-                      (fun map cycle -> CycleMap.add cycle init_staked map)
-                      CycleMap.empty
-                      Cycle.(
-                        root ---> add root constants.consensus_rights_delay)
-                  in
-                  let pkh = Context.Contract.pkh contract in
-                  let account =
-                    init_account
-                      ~delegate:name
-                      ~pkh
-                      ~contract
-                      ~parameters:default_params
-                      ~liquid
-                      ~frozen_deposits
-                      ~frozen_rights
-                      ()
-                  in
-                  let account_map = String.Map.add name account account_map in
-                  let balance, total_balance =
-                    balance_and_total_balance_of_account name account_map
-                  in
-                  Log.debug
-                    "Initial balance for %s:\n%a"
-                    name
-                    balance_pp
-                    balance ;
-                  Log.debug "Initial total balance: %a" Tez.pp total_balance ;
-                  account_map)
-                String.Map.empty
-                delegates_name_list
-                delegates
-            in
-            let* total_supply = Context.get_total_supply (B block) in
-            let state =
-              State.
-                {
-                  account_map;
-                  total_supply;
-                  constants;
-                  param_requests = [];
-                  activate_ai;
-                  baking_policy = None;
-                  last_level_rewards = init_level;
-                  snapshot_balances = String.Map.empty;
-                  saved_rate = None;
-                  burn_rewards;
-                  pending_operations = [];
-                  pending_slashes = [];
-                  double_signings = [];
-                }
-            in
-            let* () = check_all_balances block state in
-            return (block, state))
-  in
-  if ns_enable_fork then
-    Tag "ns_enable = true" --> f true |+ Tag "ns_enable = false" --> f false
-  else f false
-
-(** Set delegate parameters for the given delegate *)
-let set_delegate_params delegate_name parameters : (t, t) scenarios =
-  exec_op (fun (block, state) ->
-      let open Lwt_result_syntax in
-      (* Simple example of action_atom definition: *)
-      let delegate = State.find_account delegate_name state in
-      Log.info
-        ~color:action_color
-        "[Set delegate parameters for \"%s\"]"
-        delegate_name ;
-      (* Define the operation *)
-      let* operation =
-        set_delegate_parameters (B block) delegate.contract ~parameters
-      in
-      (* Update state *)
-      let wait = state.constants.delegate_parameters_activation_delay - 1 in
-      let state =
-        {
-          state with
-          param_requests =
-            (delegate_name, parameters, wait) :: state.param_requests;
-        }
-      in
-      (* Return both *)
-      return (state, [operation]))
-
-(** Add a new account with the given name *)
-let add_account name : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  exec_state (fun (_block, state) ->
-      Log.info ~color:action_color "[Add account \"%s\"]" name ;
-      let new_account = Account.new_account () in
-      let pkh = new_account.pkh in
-      let contract = Protocol.Alpha_context.Contract.Implicit pkh in
-      let account_state =
-        init_account ~pkh ~contract ~parameters:default_params ()
-      in
-      let state = State.update_account name account_state state in
-      return state)
-
-(** Reveal operation *)
-let reveal name : (t, t) scenarios =
-  exec_op (fun (block, state) ->
-      let open Lwt_result_syntax in
-      let account = State.find_account name state in
-      Log.info ~color:action_color "[Reveal \"%s\"]" name ;
-      let* acc = Account.find account.pkh in
-      let* operation =
-        Op.revelation ~fee:Protocol.Alpha_context.Tez.zero (B block) acc.pk
-      in
-      return (state, [operation]))
-
-(** Transfer from src to dst *)
-let transfer src_name dst_name amount : (t, t) scenarios =
-  exec_op (fun (block, state) ->
-      let open Lwt_result_syntax in
-      let src = State.find_account src_name state in
-      let dst = State.find_account dst_name state in
-      let amount = quantity_to_tez src.liquid amount in
-      Log.info
-        ~color:action_color
-        "[Transfer \"%s\" -> \"%s\" (%aꜩ)]"
-        src_name
-        dst_name
-        Tez.pp
-        amount ;
-      let* operation =
-        Op.transaction ~fee:Tez.zero (B block) src.contract dst.contract amount
-      in
-      let state = State.apply_transfer amount src_name dst_name state in
-      return (state, [operation]))
-
-(** Set delegate for src. If [delegate_name_opt = None], then unset current delegate *)
-let set_delegate src_name delegate_name_opt : (t, t) scenarios =
-  exec_op (fun (block, state) ->
-      let open Lwt_result_syntax in
-      let src = State.find_account src_name state in
-      let delegate_pkh_opt =
-        match delegate_name_opt with
-        | None ->
-            Log.info ~color:action_color "[Unset delegate of \"%s\"]" src_name ;
-            None
-        | Some delegate_name ->
-            let delegate = State.find_account delegate_name state in
-            Log.info
-              ~color:action_color
-              "[Set delegate \"%s\" for \"%s\"]"
-              delegate_name
-              src_name ;
-            Some delegate.pkh
-      in
-      let cycle = Block.current_cycle block in
-      let* operation =
-        Op.delegation ~fee:Tez.zero (B block) src.contract delegate_pkh_opt
-      in
-      let balance = balance_of_account src_name state.account_map in
-      let state =
-        if Q.(equal balance.staked_b zero) then state
-        else
-          let state = State.apply_unstake cycle Tez.max_tez src_name state in
-          (* Changing delegate applies finalize if unstake happened *)
-          State.apply_finalize src_name state
-      in
-      let state = State.update_delegate src_name delegate_name_opt state in
-      return (state, [operation]))
-
-(** Stake operation *)
-let stake src_name stake_value : (t, t) scenarios =
-  exec_op (fun (block, state) ->
-      let open Lwt_result_syntax in
-      let src = State.find_account src_name state in
-      Log.info
-        ~color:action_color
-        "[Stake for \"%s\" (%a)]"
-        src_name
-        tez_quantity_pp
-        stake_value ;
-      (* Stake applies finalize *before* the stake *)
-      let state = State.apply_finalize src_name state in
-      let amount = quantity_to_tez src.liquid stake_value in
-      let current_cycle = Block.current_cycle block in
-      let* operation = stake (B block) src.contract amount in
-      let state = State.apply_stake amount current_cycle src_name state in
-      return (state, [operation]))
-
-(** unstake operation *)
-let unstake src_name unstake_value : (t, t) scenarios =
-  exec_op (fun (block, state) ->
-      let open Lwt_result_syntax in
-      let src = State.find_account src_name state in
-      Log.info
-        ~color:action_color
-        "[Unstake for \"%s\" (%a)]"
-        src_name
-        tez_quantity_pp
-        unstake_value ;
-      let stake_balance =
-        (balance_of_account src_name state.account_map).staked_b
-        |> Partial_tez.to_tez ~round:`Down
-      in
-      let amount = quantity_to_tez stake_balance unstake_value in
-      let* operation = unstake (B block) src.contract amount in
-      let cycle = Block.current_cycle block in
-      let balance = balance_of_account src_name state.account_map in
-      let state =
-        if Q.(equal balance.staked_b zero) then state
-        else
-          let state = State.apply_unstake cycle amount src_name state in
-          State.apply_finalize src_name state
-      in
-      return (state, [operation]))
-
-(** finalize unstake operation *)
-let finalize_unstake src_name : (t, t) scenarios =
-  exec_op (fun (block, state) ->
-      let open Lwt_result_syntax in
-      let src = State.find_account src_name state in
-      Log.info ~color:action_color "[Finalize_unstake for \"%s\"]" src_name ;
-      let* operation = finalize_unstake (B block) src.contract in
-      let state = State.apply_finalize src_name state in
-      return (state, [operation]))
-
-(* ======== Slashing ======== *)
-
-let check_pending_slashings ~loc (block, state) : unit tzresult Lwt.t =
-  let open Lwt_result_syntax in
-  let* denunciations_rpc = Context.get_denunciations (B block) in
-  Slashing_helpers.Full_denunciation.check_same_lists_any_order
-    ~loc
-    denunciations_rpc
-    state.State.pending_slashes
-
-(** Double attestation helpers *)
-let order_attestations ~correct_order op1 op2 =
-  let oph1 = Protocol.Alpha_context.Operation.hash op1 in
-  let oph2 = Protocol.Alpha_context.Operation.hash op2 in
-  let c = Operation_hash.compare oph1 oph2 in
-  if correct_order then if c < 0 then (op1, op2) else (op2, op1)
-  else if c < 0 then (op2, op1)
-  else (op1, op2)
-
-let op_double_attestation ?(correct_order = true) op1 op2 ctxt =
-  let e1, e2 = order_attestations ~correct_order op1 op2 in
-  Op.double_attestation ctxt e1 e2
-
-let op_double_preattestation ?(correct_order = true) op1 op2 ctxt =
-  let e1, e2 = order_attestations ~correct_order op1 op2 in
-  Op.double_preattestation ctxt e1 e2
-
-let order_block_hashes ~correct_order bh1 bh2 =
-  let hash1 = Protocol.Alpha_context.Block_header.hash bh1 in
-  let hash2 = Protocol.Alpha_context.Block_header.hash bh2 in
-  let c = Block_hash.compare hash1 hash2 in
-  if correct_order then if c < 0 then (bh1, bh2) else (bh2, bh1)
-  else if c < 0 then (bh2, bh1)
-  else (bh1, bh2)
-
-let op_double_baking ?(correct_order = true) bh1 bh2 ctxt =
-  let bh1, bh2 = order_block_hashes ~correct_order bh1 bh2 in
-  Op.double_baking ctxt bh1 bh2
-
-let double_bake_ delegate_name (block, state) =
-  let open Lwt_result_syntax in
-  Log.info ~color:event_color "Double baking with %s" delegate_name ;
-  let delegate = State.find_account delegate_name state in
-  let* operation =
-    Adaptive_issuance_helpers.unstake (B block) delegate.contract Tez.one_mutez
-  in
-  let* forked_block =
-    Block.bake ~policy:(By_account delegate.pkh) ~operation block
-  in
-  (* includes pending operations *)
-  let* main_branch, state = bake ~baker:delegate_name (block, state) in
-  let evidence = op_double_baking main_branch.header forked_block.header in
-  let*? misbehaviour =
-    Slashing_helpers.Misbehaviour_repr.from_duplicate_block main_branch
-  in
-  let dss =
-    {State.culprit = delegate.pkh; denounced = false; evidence; misbehaviour}
-  in
-  let state =
-    {state with double_signings = dss :: state.State.double_signings}
-  in
-  return (main_branch, state)
-
-(* Note: advances one block *)
-let double_bake delegate_name : (t, t) scenarios =
-  exec (double_bake_ delegate_name)
-
-(* [other_bakers] can be used to force using specific bakers to avoid
-   reusing forbidden ones *)
-let double_attest_op ?other_bakers ~op ~op_evidence ~kind delegate_name
-    (block, state) =
-  let open Lwt_result_syntax in
-  Log.info
-    ~color:event_color
-    "Double %s with %s"
-    (match kind with
-    | Protocol.Misbehaviour_repr.Double_preattesting -> "preattesting"
-    | Double_attesting -> "attesting"
-    | Double_baking -> assert false)
-    delegate_name ;
-  let delegate = State.find_account delegate_name state in
-  let* baker, _, _, _ =
-    Block.get_next_baker ?policy:state.baking_policy block
-  in
-  let* other_baker1, other_baker2 =
-    match other_bakers with
-    | Some (ob1, ob2) ->
-        let ob1 = (State.find_account ob1 state).pkh in
-        let ob2 = (State.find_account ob2 state).pkh in
-        return (ob1, ob2)
-    | None -> Context.get_first_different_bakers (B block)
-  in
-  let other_baker =
-    if not (Signature.Public_key_hash.equal baker other_baker2) then
-      other_baker2
-    else other_baker1
-  in
-  let* forked_block = Block.bake ~policy:(By_account other_baker) block in
-  let* forked_block = Block.bake ?policy:state.baking_policy forked_block in
-  (* includes pending operations *)
-  let* block, state = bake (block, state) in
-  let* main_branch, state = bake (block, state) in
-  let* attestation_a = op ~delegate:delegate.pkh forked_block in
-  let* attestation_b = op ~delegate:delegate.pkh main_branch in
-  let evidence = op_evidence attestation_a attestation_b in
-  let dss =
-    {
-      State.culprit = delegate.pkh;
-      denounced = false;
-      evidence;
-      misbehaviour =
-        Slashing_helpers.Misbehaviour_repr.from_duplicate_operation
-          attestation_a;
-    }
-  in
-  let state =
-    {state with double_signings = dss :: state.State.double_signings}
-  in
-  return (main_branch, state)
-
-let double_attest_ =
-  double_attest_op
-    ~op:(fun ~delegate block -> Op.raw_attestation ~delegate block)
-    ~op_evidence:op_double_attestation
-    ~kind:Double_attesting
-
-(* Note: advances two blocks *)
-let double_attest ?other_bakers delegate_name : (t, t) scenarios =
-  exec (double_attest_ ?other_bakers delegate_name)
-
-let double_preattest_ =
-  double_attest_op
-    ~op:(fun ~delegate block -> Op.raw_preattestation ~delegate block)
-    ~op_evidence:op_double_preattestation
-    ~kind:Double_preattesting
-
-(* Note: advances two blocks *)
-let double_preattest ?other_bakers delegate_name : (t, t) scenarios =
-  exec (double_preattest_ ?other_bakers delegate_name)
-
-let cycle_from_level blocks_per_cycle level =
-  let current_cycle = Int32.div level blocks_per_cycle in
-  let current_cycle = Cycle.add Cycle.root (Int32.to_int current_cycle) in
-  current_cycle
-
-let pct_from_kind (block : Block.t) = function
-  | Protocol.Misbehaviour_repr.Double_baking ->
-      Protocol.Percentage.to_q
-        block.constants.percentage_of_frozen_deposits_slashed_per_double_baking
-      |> Q.(mul (100 // 1))
-      |> Q.to_int
-  | Double_attesting | Double_preattesting ->
-      Protocol.Percentage.to_q
-        block.constants
-          .percentage_of_frozen_deposits_slashed_per_double_attestation
-      |> Q.(mul (100 // 1))
-      |> Q.to_int
-
-let get_pending_slashed_pct_for_delegate (block, state) delegate =
-  let rec aux r = function
-    | [] -> r
-    | (culprit, {Protocol.Denunciations_repr.misbehaviour; _}) :: t ->
-        if Signature.Public_key_hash.equal delegate culprit then
-          let new_r = r + pct_from_kind block misbehaviour.kind in
-          if new_r >= 100 then 100 else aux new_r t
-        else aux r t
-  in
-  aux 0 state.State.pending_slashes
-
-let update_state_denunciation (block, state)
-    {State.culprit; denounced; evidence = _; misbehaviour} =
-  let open Lwt_result_syntax in
-  if denounced then
-    (* If the double signing has already been denounced, a second denunciation should fail *)
-    return (state, denounced)
-  else
-    let*? block_level = Context.get_level (B block) in
-    let next_level =
-      Protocol.Alpha_context.Raw_level.(to_int32 @@ succ block_level)
-    in
-    let inclusion_cycle =
-      cycle_from_level block.constants.blocks_per_cycle next_level
-    in
-    let ds_level = Protocol.Raw_level_repr.to_int32 misbehaviour.level in
-    let ds_cycle = cycle_from_level block.constants.blocks_per_cycle ds_level in
-    if Cycle.(ds_cycle > inclusion_cycle) then
-      (* The denunciation is trying to be included too early *)
-      return (state, denounced)
-    else if
-      Cycle.(
-        add ds_cycle Protocol.Constants_repr.max_slashing_period
-        <= inclusion_cycle)
-    then
-      (* The denunciation is too late and gets refused. *)
-      return (state, denounced)
-    else if get_pending_slashed_pct_for_delegate (block, state) culprit >= 100
-    then
-      (* Culprit has been slashed too much, a denunciation is not added to the list.
-         TODO: is the double signing treated as included, or can it be included in the
-         following cycle? *)
-      return (state, denounced)
-    else
-      (* for simplicity's sake (lol), the block producer and the payload producer are the same
-         We also assume that the current state baking policy will be used for the next block *)
-      let* rewarded, _, _, _ =
-        Block.get_next_baker ?policy:state.baking_policy block
-      in
-      let culprit_name, culprit_account =
-        State.find_account_from_pkh culprit state
-      in
-      let state =
-        State.update_account
-          culprit_name
-          {
-            culprit_account with
-            slashed_cycles = inclusion_cycle :: culprit_account.slashed_cycles;
-          }
-          state
-      in
-      let new_pending_slash =
-        ( culprit,
-          {
-            Protocol.Denunciations_repr.rewarded;
-            misbehaviour;
-            operation_hash = Operation_hash.zero;
-            (* unused *)
-          } )
-      in
-      (* TODO: better log... *)
-      Log.info
-        ~color:event_color
-        "Including denunciation (misbehaviour cycle %a)"
-        Cycle.pp
-        ds_cycle ;
-      let state =
-        State.
-          {
-            state with
-            pending_slashes = new_pending_slash :: state.pending_slashes;
-          }
-      in
-      return (state, true)
-
-let make_denunciations_ ?(filter = fun {State.denounced; _} -> not denounced)
-    (block, state) =
-  let open Lwt_result_syntax in
-  let* () = check_pending_slashings ~loc:__LOC__ (block, state) in
-  let make_op state ({State.evidence; _} as dss) =
-    if filter dss then
-      let* state, denounced = update_state_denunciation (block, state) dss in
-      return (Some (evidence (B block), {dss with denounced}, state))
-    else return None
-  in
-  let rec make_op_list dss_list state r_op r_dss =
-    match dss_list with
-    | d :: t -> (
-        let* new_op = make_op state d in
-        match new_op with
-        | None -> make_op_list t state r_op (d :: r_dss)
-        | Some (op, p_dss, new_state) ->
-            make_op_list t new_state (op :: r_op) (p_dss :: r_dss))
-    | [] -> return @@ (state, List.rev r_op, List.rev r_dss)
-  in
-  let* state, operations, double_signings =
-    make_op_list state.double_signings state [] []
-  in
-  let state = {state with double_signings} in
-  return (state, operations)
-
-(* Important note: do not change the baking policy behaviour once denunciations are made,
-   until the operations are included in a block (by default the next block) *)
-let make_denunciations ?filter () = exec_op (make_denunciations_ ?filter)
-
-(* ======== Misc functions ========*)
-
-let check_failure_aux ?expected_error :
-    ('a -> 'b tzresult Lwt.t) -> 'a -> 'a tzresult Lwt.t =
-  let open Lwt_result_syntax in
-  fun f input ->
-    Log.info ~color:assert_block_color "Entering failing scenario..." ;
-    let*! output = f input in
-    match output with
-    | Ok _ -> failwith "Unexpected success"
-    | Error e -> (
-        match expected_error with
-        | None ->
-            Log.info ~color:assert_block_color "Rollback" ;
-            return input
-        | Some exp_e ->
-            let exp_e = exp_e input in
-            if e = exp_e then (
-              Log.info ~color:assert_block_color "Rollback" ;
-              return input)
-            else (
-              Log.info
-                ~color:Log.Color.FG.red
-                "Unexpected error:@.%a@.Expected:@.%a@."
-                (Format.pp_print_list pp)
-                e
-                (Format.pp_print_list pp)
-                exp_e ;
-              tzfail Unexpected_error))
-
-let check_fail_and_rollback ?expected_error :
-    ('a, 'b) single_scenario -> 'a -> 'a tzresult Lwt.t =
- fun sc input -> check_failure_aux ?expected_error (run_scenario sc) input
-
-(** Useful function to test expected failures: runs the given branch until it fails,
-    then rollbacks to before execution. Fails if the given branch Succeeds *)
-let assert_failure ?expected_error : ('a, 'b) scenarios -> ('a, 'a) scenarios =
- fun scenarios ->
-  match unfold_scenarios scenarios with
-  | [] -> Empty
-  | [(sc, _, _)] -> exec (check_fail_and_rollback ?expected_error sc)
-  | _ ->
-      exec (fun _ ->
-          failwith "Error: assert_failure used with branching scenario")
-
-(** Loop *)
-let rec loop n : ('a, 'a) scenarios -> ('a, 'a) scenarios =
- fun scenario ->
-  (* If branching scenarios with k branches, returns a scenario with k^n branches *)
-  if n = 0 then Empty
-  else if n = 1 then scenario
-  else loop (n - 1) scenario --> scenario
-
-let rec loop_action n : ('a -> 'a tzresult Lwt.t) -> ('a, 'a) scenarios =
- fun f ->
-  if n = 0 then Empty
-  else if n = 1 then exec f
-  else loop_action (n - 1) f --> exec f
-
-(** Check a specific balance field for a specific account is equal to a specific amount *)
-let check_balance_field src_name field amount : (t, t) scenarios =
-  let open Lwt_result_syntax in
-  let check = Assert.equal_tez ~loc:__LOC__ amount in
-  let check' a = check (Partial_tez.to_tez ~round:`Down a) in
-  exec_state (fun (block, state) ->
-      let src = State.find_account src_name state in
-      let src_balance, src_total =
-        balance_and_total_balance_of_account src_name state.account_map
-      in
-      let* rpc_balance, rpc_total =
-        get_balance_from_context (B block) src.contract
-      in
-      let* () =
-        match field with
-        | `Liquid ->
-            let* () = check rpc_balance.liquid_b in
-            check src_balance.liquid_b
-        | `Bonds ->
-            let* () = check rpc_balance.bonds_b in
-            check src_balance.bonds_b
-        | `Staked ->
-            let* () = check' rpc_balance.staked_b in
-            check' src_balance.staked_b
-        | `Unstaked_frozen_total ->
-            let* () = check rpc_balance.unstaked_frozen_b in
-            check src_balance.unstaked_frozen_b
-        | `Unstaked_finalizable ->
-            let* () = check rpc_balance.unstaked_finalizable_b in
-            check src_balance.unstaked_finalizable_b
-        | `Total ->
-            let* () = check rpc_total in
-            check src_total
-      in
-      return state)
-
-(** Waiting functions *)
-let rec wait_n_cycles n =
-  if n <= 0 then noop
-  else if n = 1 then next_cycle
-  else wait_n_cycles (n - 1) --> next_cycle
-
-let rec wait_n_blocks n =
-  if n <= 0 then noop
-  else if n = 1 then next_block
-  else wait_n_blocks (n - 1) --> next_block
-
-(** Wait until we are in a cycle satifying the given condition.
-    Fails if AI_activation is requested and AI is not set to be activated in the future. *)
-let wait_cycle condition =
-  exec (fun (block, state) ->
-      let open Lwt_result_syntax in
-      let rec stopper condition =
-        match condition with
-        | `AI_activation ->
-            if state.State.activate_ai then
-              let* launch_cycle = get_launch_cycle ~loc:__LOC__ block in
-              return
-              @@ ( (fun block _state ->
-                     let current_cycle = Block.current_cycle block in
-                     Cycle.(current_cycle >= launch_cycle)),
-                   "AI activation",
-                   "AI activated" )
-            else assert false
-        | `delegate_parameters_activation ->
-            let init_cycle = Block.current_cycle block in
-            let cycles_to_wait =
-              state.constants.delegate_parameters_activation_delay
-            in
-            return
-            @@ ( (fun block _state ->
-                   Cycle.(
-                     Block.current_cycle block >= add init_cycle cycles_to_wait)),
-                 "delegate parameters activation",
-                 "delegate parameters activated" )
-        | `And (cond1, cond2) ->
-            let* stop1, to1, done1 = stopper cond1 in
-            let* stop2, to2, done2 = stopper cond2 in
-            return
-            @@ ( (fun block state -> stop1 block state && stop2 block state),
-                 to1 ^ " and " ^ to2,
-                 done1 ^ " and " ^ done2 )
-      in
-      let* stopper, to_, done_ = stopper condition in
-      Log.info ~color:time_color "Fast forward to %s" to_ ;
-      let* output =
-        let rec bake_while (block, state) =
-          if stopper block state then return (block, state)
-          else
-            let* input = bake_until_next_cycle (block, state) in
-            bake_while input
-        in
-        bake_while (block, state)
-      in
-      Log.info ~color:event_color "%s" done_ ;
-      return output)
-
-(** Wait until AI activates.
-    Fails if AI is not set to be activated in the future. *)
-let wait_ai_activation = wait_cycle `AI_activation
-
-(** wait delegate_parameters_activation_delay cycles  *)
-let wait_delegate_parameters_activation =
-  wait_cycle `delegate_parameters_activation
-
-(** Create an account and give an initial balance funded by [source] *)
-let add_account_with_funds name source amount =
-  add_account name --> transfer source name amount --> reveal name
-
-(* ======== Scenarios ======== *)
-
 let test_expected_error =
   assert_failure
     ~expected_error:(fun _ -> [Exn (Failure "")])
-- 
GitLab


From 7e963db692a2d3ba1f4df2464137a9c807d81c25 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 13:48:27 +0100
Subject: [PATCH 10/18] Proto/tests: move basic scenarios to dedicated file

---
 manifest/main.ml                              |   1 +
 .../lib_protocol/test/integration/dune        |   1 +
 .../test_adaptive_issuance_roundtrip.ml       | 122 +--------------
 .../test/integration/test_scenario_base.ml    | 144 ++++++++++++++++++
 4 files changed, 148 insertions(+), 120 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml

diff --git a/manifest/main.ml b/manifest/main.ml
index d1e0e5ba3162..b33c6053b20f 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -5421,6 +5421,7 @@ end = struct
             ("test_frozen_bonds", true);
             ("test_adaptive_issuance_launch", N.(number >= 018));
             ("test_adaptive_issuance_roundtrip", N.(number >= 018));
+            ("test_scenario_base", N.(number >= 019));
             ("test_liquidity_baking", true);
             ("test_storage_functions", true);
             ("test_storage", true);
diff --git a/src/proto_alpha/lib_protocol/test/integration/dune b/src/proto_alpha/lib_protocol/test/integration/dune
index 4aabd1ffd5eb..c4de24b22af3 100644
--- a/src/proto_alpha/lib_protocol/test/integration/dune
+++ b/src/proto_alpha/lib_protocol/test/integration/dune
@@ -33,6 +33,7 @@
   test_frozen_bonds
   test_adaptive_issuance_launch
   test_adaptive_issuance_roundtrip
+  test_scenario_base
   test_liquidity_baking
   test_storage_functions
   test_storage
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index a1a89f919db5..26baeb9fbebd 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -38,121 +38,10 @@ open Test_tez.Ez_tez
 open Scenario_dsl
 open Scenario_base
 open Scenario_op
+open Test_scenario_base
 
 let fs = Format.asprintf
 
-let default_param_wait, default_unstake_wait =
-  let constants = Default_parameters.constants_test in
-  let crd = constants.consensus_rights_delay in
-  let dpad = constants.delegate_parameters_activation_delay in
-  let msp = Protocol.Constants_repr.max_slashing_period in
-  (dpad, crd + msp)
-
-let test_expected_error =
-  assert_failure
-    ~expected_error:(fun _ -> [Exn (Failure "")])
-    (exec (fun _ -> failwith ""))
-  --> assert_failure
-        ~expected_error:(fun _ -> [Unexpected_error])
-        (assert_failure
-           ~expected_error:(fun _ ->
-             [Inconsistent_number_of_bootstrap_accounts])
-           (exec (fun _ -> failwith "")))
-
-let init_constants ?reward_per_block ?(deactivate_dynamic = false)
-    ?blocks_per_cycle ?delegate_parameters_activation_delay ~autostaking_enable
-    () =
-  let reward_per_block = Option.value ~default:0L reward_per_block in
-  let base_total_issued_per_minute = Tez.of_mutez reward_per_block in
-  let default_constants = Default_parameters.constants_test in
-  (* default for tests: 12 *)
-  let blocks_per_cycle =
-    Option.value ~default:default_constants.blocks_per_cycle blocks_per_cycle
-  in
-  let delegate_parameters_activation_delay =
-    Option.value
-      ~default:default_constants.delegate_parameters_activation_delay
-      delegate_parameters_activation_delay
-  in
-  let issuance_weights =
-    Protocol.Alpha_context.Constants.Parametric.
-      {
-        base_total_issued_per_minute;
-        baking_reward_fixed_portion_weight = 1;
-        baking_reward_bonus_weight = 0;
-        attesting_reward_weight = 0;
-        seed_nonce_revelation_tip_weight = 0;
-        vdf_revelation_tip_weight = 0;
-      }
-  in
-  let liquidity_baking_subsidy = Tez.zero in
-  let minimal_block_delay = Protocol.Alpha_context.Period.one_minute in
-  let cost_per_byte = Tez.zero in
-  let consensus_threshold = 0 in
-  let adaptive_issuance = default_constants.adaptive_issuance in
-  let adaptive_rewards_params =
-    if deactivate_dynamic then
-      {
-        adaptive_issuance.adaptive_rewards_params with
-        max_bonus =
-          Protocol.Issuance_bonus_repr.max_bonus_parameter_of_Q_exn Q.zero;
-      }
-    else adaptive_issuance.adaptive_rewards_params
-  in
-  let adaptive_issuance =
-    {adaptive_issuance with adaptive_rewards_params; autostaking_enable}
-  in
-  {
-    default_constants with
-    delegate_parameters_activation_delay;
-    consensus_threshold;
-    issuance_weights;
-    minimal_block_delay;
-    cost_per_byte;
-    adaptive_issuance;
-    blocks_per_cycle;
-    liquidity_baking_subsidy;
-  }
-
-(** Initialization of scenarios with 3 cases:
-     - AI activated, staker = delegate
-     - AI activated, staker != delegate
-     - AI not activated (and staker = delegate)
-    Any scenario that begins with this will be triplicated.
- *)
-let init_scenario ?(force_ai = true) ?reward_per_block () =
-  let constants =
-    init_constants ?reward_per_block ~autostaking_enable:false ()
-  in
-  let init_params =
-    {limit_of_staking_over_baking = Q.one; edge_of_baking_over_staking = Q.one}
-  in
-  let begin_test ~activate_ai ~self_stake =
-    let name = if self_stake then "staker" else "delegate" in
-    begin_test ~activate_ai ~constants [name]
-    --> set_delegate_params name init_params
-    --> set_baker "__bootstrap__"
-  in
-  let ai_activated =
-    Tag "AI activated"
-    --> (Tag "self stake" --> begin_test ~activate_ai:true ~self_stake:true
-        |+ Tag "external stake"
-           --> begin_test ~activate_ai:true ~self_stake:false
-           --> add_account_with_funds
-                 "staker"
-                 "delegate"
-                 (Amount (Tez.of_mutez 2_000_000_000_000L))
-           --> set_delegate "staker" (Some "delegate"))
-    --> wait_ai_activation
-  in
-
-  let ai_deactivated =
-    Tag "AI deactivated, self stake"
-    --> begin_test ~activate_ai:false ~self_stake:true
-  in
-  (if force_ai then ai_activated else ai_activated |+ ai_deactivated)
-  --> next_block
-
 module Roundtrip = struct
   let stake_init =
     stake "staker" Half
@@ -1163,14 +1052,7 @@ module Slashing = struct
        ]
 end
 
-let tests =
-  let open Lwt_result_syntax in
-  (tests_of_scenarios
-  @@ [
-       ("Test expected error in assert failure", test_expected_error);
-       ("Test init", init_scenario () --> Action (fun _ -> return_unit));
-     ])
-  @ Roundtrip.tests @ Rewards.tests @ Autostaking.tests @ Slashing.tests
+let tests = Roundtrip.tests @ Rewards.tests @ Autostaking.tests @ Slashing.tests
 
 let () =
   Alcotest_lwt.run
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml
new file mode 100644
index 000000000000..2245bb53a04a
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml
@@ -0,0 +1,144 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Testing
+    -------
+    Component:    Scenario, State
+    Invocation:   dune exec src/proto_alpha/lib_protocol/test/integration/main.exe \
+                   -- --file test_scenario_base.ml
+    Subject:      Test basic functionality of the scenario framework.
+*)
+
+open Adaptive_issuance_helpers
+open State_account
+open Test_tez.Ez_tez
+open Scenario_dsl
+open Scenario_base
+open Scenario_op
+
+let default_param_wait, default_unstake_wait =
+  let constants = Default_parameters.constants_test in
+  let crd = constants.consensus_rights_delay in
+  let dpad = constants.delegate_parameters_activation_delay in
+  let msp = Protocol.Constants_repr.max_slashing_period in
+  (dpad, crd + msp)
+
+let test_expected_error =
+  assert_failure
+    ~expected_error:(fun _ -> [Exn (Failure "")])
+    (exec (fun _ -> failwith ""))
+  --> assert_failure
+        ~expected_error:(fun _ -> [Unexpected_error])
+        (assert_failure
+           ~expected_error:(fun _ ->
+             [Inconsistent_number_of_bootstrap_accounts])
+           (exec (fun _ -> failwith "")))
+
+let init_constants ?reward_per_block ?(deactivate_dynamic = false)
+    ?blocks_per_cycle ?delegate_parameters_activation_delay ~autostaking_enable
+    () =
+  let reward_per_block = Option.value ~default:0L reward_per_block in
+  let base_total_issued_per_minute = Tez.of_mutez reward_per_block in
+  let default_constants = Default_parameters.constants_test in
+  (* default for tests: 12 *)
+  let blocks_per_cycle =
+    Option.value ~default:default_constants.blocks_per_cycle blocks_per_cycle
+  in
+  let delegate_parameters_activation_delay =
+    Option.value
+      ~default:default_constants.delegate_parameters_activation_delay
+      delegate_parameters_activation_delay
+  in
+  let issuance_weights =
+    Protocol.Alpha_context.Constants.Parametric.
+      {
+        base_total_issued_per_minute;
+        baking_reward_fixed_portion_weight = 1;
+        baking_reward_bonus_weight = 0;
+        attesting_reward_weight = 0;
+        seed_nonce_revelation_tip_weight = 0;
+        vdf_revelation_tip_weight = 0;
+      }
+  in
+  let liquidity_baking_subsidy = Tez.zero in
+  let minimal_block_delay = Protocol.Alpha_context.Period.one_minute in
+  let cost_per_byte = Tez.zero in
+  let consensus_threshold = 0 in
+  let adaptive_issuance = default_constants.adaptive_issuance in
+  let adaptive_rewards_params =
+    if deactivate_dynamic then
+      {
+        adaptive_issuance.adaptive_rewards_params with
+        max_bonus =
+          Protocol.Issuance_bonus_repr.max_bonus_parameter_of_Q_exn Q.zero;
+      }
+    else adaptive_issuance.adaptive_rewards_params
+  in
+  let adaptive_issuance =
+    {adaptive_issuance with adaptive_rewards_params; autostaking_enable}
+  in
+  {
+    default_constants with
+    delegate_parameters_activation_delay;
+    consensus_threshold;
+    issuance_weights;
+    minimal_block_delay;
+    cost_per_byte;
+    adaptive_issuance;
+    blocks_per_cycle;
+    liquidity_baking_subsidy;
+  }
+
+(** Initialization of scenarios with 3 cases:
+     - AI activated, staker = delegate
+     - AI activated, staker != delegate
+     - AI not activated (and staker = delegate)
+    Any scenario that begins with this will be triplicated.
+ *)
+let init_scenario ?(force_ai = true) ?reward_per_block () =
+  let constants =
+    init_constants ?reward_per_block ~autostaking_enable:false ()
+  in
+  let init_params =
+    {limit_of_staking_over_baking = Q.one; edge_of_baking_over_staking = Q.one}
+  in
+  let begin_test ~activate_ai ~self_stake =
+    let name = if self_stake then "staker" else "delegate" in
+    begin_test ~activate_ai ~constants [name]
+    --> set_delegate_params name init_params
+    --> set_baker "__bootstrap__"
+  in
+  let ai_activated =
+    Tag "AI activated"
+    --> (Tag "self stake" --> begin_test ~activate_ai:true ~self_stake:true
+        |+ Tag "external stake"
+           --> begin_test ~activate_ai:true ~self_stake:false
+           --> add_account_with_funds
+                 "staker"
+                 "delegate"
+                 (Amount (Tez.of_mutez 2_000_000_000_000L))
+           --> set_delegate "staker" (Some "delegate"))
+    --> wait_ai_activation
+  in
+
+  let ai_deactivated =
+    Tag "AI deactivated, self stake"
+    --> begin_test ~activate_ai:false ~self_stake:true
+  in
+  (if force_ai then ai_activated else ai_activated |+ ai_deactivated)
+  --> next_block
+
+let tests =
+  tests_of_scenarios
+  @@ [
+       ("Test expected error in assert failure", test_expected_error);
+       ("Test init", init_scenario () --> Action (fun _ -> return_unit));
+     ]
+
+let () =
+  Alcotest_lwt.run ~__FILE__ Protocol.name [("protocol scenario base", tests)]
+  |> Lwt_main.run
-- 
GitLab


From 49711769e72896baa32621c0e5967f1b8fdca8ba Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 13:53:46 +0100
Subject: [PATCH 11/18] Proto/tests: move stake tests to dedicated file

---
 manifest/main.ml                              |   1 +
 .../lib_protocol/test/integration/dune        |   1 +
 .../test_adaptive_issuance_roundtrip.ml       | 284 +----------------
 .../test/integration/test_scenario_stake.ml   | 295 ++++++++++++++++++
 4 files changed, 298 insertions(+), 283 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml

diff --git a/manifest/main.ml b/manifest/main.ml
index b33c6053b20f..d720c46da3b9 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -5422,6 +5422,7 @@ end = struct
             ("test_adaptive_issuance_launch", N.(number >= 018));
             ("test_adaptive_issuance_roundtrip", N.(number >= 018));
             ("test_scenario_base", N.(number >= 019));
+            ("test_scenario_stake", N.(number >= 019));
             ("test_liquidity_baking", true);
             ("test_storage_functions", true);
             ("test_storage", true);
diff --git a/src/proto_alpha/lib_protocol/test/integration/dune b/src/proto_alpha/lib_protocol/test/integration/dune
index c4de24b22af3..b535ead71eaa 100644
--- a/src/proto_alpha/lib_protocol/test/integration/dune
+++ b/src/proto_alpha/lib_protocol/test/integration/dune
@@ -34,6 +34,7 @@
   test_adaptive_issuance_launch
   test_adaptive_issuance_roundtrip
   test_scenario_base
+  test_scenario_stake
   test_liquidity_baking
   test_storage_functions
   test_storage
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 26baeb9fbebd..2d3c7b5cb4af 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -42,288 +42,6 @@ open Test_scenario_base
 
 let fs = Format.asprintf
 
-module Roundtrip = struct
-  let stake_init =
-    stake "staker" Half
-    --> (Tag "no wait after stake" --> Empty
-        |+ Tag "wait after stake" --> wait_n_cycles 2)
-
-  let wait_for_unfreeze_and_check wait =
-    snapshot_balances "wait snap" ["staker"]
-    --> wait_n_cycles (wait - 1)
-    (* Balance didn't change yet, but will change next cycle *)
-    --> check_snapshot_balances "wait snap"
-    --> next_cycle
-    --> assert_failure (check_snapshot_balances "wait snap")
-
-  let finalize staker =
-    assert_failure (check_balance_field staker `Unstaked_finalizable Tez.zero)
-    --> finalize_unstake staker
-    --> check_balance_field staker `Unstaked_finalizable Tez.zero
-
-  let simple_roundtrip =
-    stake_init
-    --> (Tag "full unstake" --> unstake "staker" All
-        |+ Tag "half unstake" --> unstake "staker" Half)
-    --> wait_for_unfreeze_and_check default_unstake_wait
-    --> finalize "staker" --> next_cycle
-
-  let double_roundtrip =
-    stake_init --> unstake "staker" Half
-    --> (Tag "half then full unstake" --> wait_n_cycles 2
-         --> unstake "staker" All
-        |+ Tag "half then half unstake" --> wait_n_cycles 2
-           --> unstake "staker" Half)
-    --> wait_for_unfreeze_and_check (default_unstake_wait - 2)
-    --> wait_for_unfreeze_and_check 2
-    --> finalize "staker" --> next_cycle
-
-  let shorter_roundtrip_for_baker =
-    let constants = init_constants ~autostaking_enable:false () in
-    let amount = Amount (Tez.of_mutez 333_000_000_000L) in
-    let consensus_rights_delay = constants.consensus_rights_delay in
-    begin_test ~activate_ai:true ~constants ["delegate"]
-    --> next_block --> wait_ai_activation
-    --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
-    --> next_cycle
-    --> snapshot_balances "init" ["delegate"]
-    --> unstake "delegate" amount
-    --> List.fold_left
-          (fun acc i -> acc |+ Tag (fs "wait %i cycles" i) --> wait_n_cycles i)
-          (Tag "wait 0 cycles" --> Empty)
-          (Stdlib.List.init (consensus_rights_delay + 1) (fun i -> i + 1))
-    --> stake "delegate" amount
-    --> check_snapshot_balances "init"
-
-  let status_quo_rountrip =
-    let full_amount = Tez.of_mutez 10_000_000L in
-    let amount_1 = Tez.of_mutez 2_999_999L in
-    let amount_2 = Tez.of_mutez 7_000_001L in
-    snapshot_balances "init" ["staker"]
-    --> stake "staker" (Amount full_amount)
-    --> next_cycle
-    --> (Tag "1 unstake" --> unstake "staker" (Amount full_amount)
-        |+ Tag "2 unstakes"
-           --> unstake "staker" (Amount amount_1)
-           --> next_cycle
-           --> unstake "staker" (Amount amount_2))
-    --> wait_n_cycles default_unstake_wait
-    --> finalize "staker"
-    --> check_snapshot_balances "init"
-
-  let scenario_finalize =
-    no_tag --> stake "staker" Half --> next_cycle --> unstake "staker" Half
-    --> wait_n_cycles (default_unstake_wait + 2)
-    --> assert_failure
-          (check_balance_field "staker" `Unstaked_finalizable Tez.zero)
-    --> (Tag "finalize with finalize" --> finalize_unstake "staker"
-        |+ Tag "finalize with stake" --> stake "staker" (Amount Tez.one_mutez)
-        |+ Tag "finalize with unstake"
-           --> unstake "staker" (Amount Tez.one_mutez))
-    --> check_balance_field "staker" `Unstaked_finalizable Tez.zero
-
-  (* Finalize does not go through when unstake does nothing *)
-  (* Todo: there might be other cases... like changing delegates *)
-  let scenario_not_finalize =
-    no_tag --> stake "staker" Half --> next_cycle --> unstake "staker" All
-    --> wait_n_cycles (default_unstake_wait + 2)
-    --> assert_failure
-          (check_balance_field "staker" `Unstaked_finalizable Tez.zero)
-    --> snapshot_balances "not finalize" ["staker"]
-    --> (Tag "no finalize with unstake if staked = 0"
-        --> unstake "staker" (Amount Tez.one_mutez))
-    --> assert_failure
-          (check_balance_field "staker" `Unstaked_finalizable Tez.zero)
-    --> check_snapshot_balances "not finalize"
-
-  (* TODO: there's probably more... *)
-  let scenario_forbidden_operations =
-    let open Lwt_result_syntax in
-    let fail_if_staker_is_self_delegate staker =
-      exec (fun ((_, state) as input) ->
-          if State.(is_self_delegate staker state) then
-            failwith "_self_delegate_exit_"
-          else return input)
-    in
-    no_tag
-    (* Staking everything works for self delegates, but not for delegated accounts *)
-    --> assert_failure
-          (fail_if_staker_is_self_delegate "staker" --> stake "staker" All)
-    (* stake is always forbidden when amount is zero *)
-    --> assert_failure (stake "staker" Nothing)
-    (* One cannot stake more that one has *)
-    --> assert_failure (stake "staker" Max_tez)
-    (* unstake is actually authorized for amount 0, but does nothing (doesn't even finalize if possible) *)
-    --> unstake "staker" Nothing
-
-  let full_balance_in_finalizable =
-    add_account_with_funds "dummy" "staker" (Amount (Tez.of_mutez 10_000_000L))
-    --> stake "staker" All_but_one --> next_cycle --> unstake "staker" All
-    --> wait_n_cycles (default_unstake_wait + 2)
-    (* At this point, almost all the balance (but one mutez) of the stake is in finalizable *)
-    (* Staking is possible, but not transfer *)
-    --> assert_failure
-          (transfer "staker" "dummy" (Amount (Tez.of_mutez 10_000_000L)))
-    --> stake "staker" (Amount (Tez.of_mutez 10_000_000L))
-    (* After the stake, transfer is possible again because the funds were finalized *)
-    --> transfer "staker" "dummy" (Amount (Tez.of_mutez 10_000_000L))
-
-  (* Stress test: what happens if someone were to stake and unstake every cycle? *)
-  let odd_behavior =
-    let one_cycle =
-      no_tag --> stake "staker" Half --> unstake "staker" Half --> next_cycle
-    in
-    loop 20 one_cycle
-
-  let change_delegate =
-    let constants = init_constants ~autostaking_enable:false () in
-    let init_params =
-      {
-        limit_of_staking_over_baking = Q.one;
-        edge_of_baking_over_staking = Q.one;
-      }
-    in
-    begin_test ~activate_ai:true ~constants ["delegate1"; "delegate2"]
-    --> set_delegate_params "delegate1" init_params
-    --> set_delegate_params "delegate2" init_params
-    --> add_account_with_funds
-          "staker"
-          "delegate1"
-          (Amount (Tez.of_mutez 2_000_000_000_000L))
-    --> set_delegate "staker" (Some "delegate1")
-    --> wait_ai_activation --> next_cycle --> stake "staker" Half --> next_cycle
-    --> set_delegate "staker" (Some "delegate2")
-    --> next_cycle
-    --> assert_failure (stake "staker" Half)
-    --> wait_n_cycles (default_unstake_wait + 1)
-    --> stake "staker" Half
-
-  let unset_delegate =
-    let constants = init_constants ~autostaking_enable:false () in
-    let init_params =
-      {
-        limit_of_staking_over_baking = Q.one;
-        edge_of_baking_over_staking = Q.one;
-      }
-    in
-    begin_test ~activate_ai:true ~constants ["delegate"]
-    --> set_delegate_params "delegate" init_params
-    --> add_account_with_funds
-          "staker"
-          "delegate"
-          (Amount (Tez.of_mutez 2_000_000_000_000L))
-    --> add_account_with_funds
-          "dummy"
-          "delegate"
-          (Amount (Tez.of_mutez 2_000_000L))
-    --> set_delegate "staker" (Some "delegate")
-    --> wait_ai_activation --> next_cycle --> stake "staker" Half
-    --> unstake "staker" All --> next_cycle --> set_delegate "staker" None
-    --> next_cycle
-    --> transfer "staker" "dummy" All
-    (* staker has an empty liquid balance, but still has unstaked frozen tokens,
-       so it doesn't get deactivated *)
-    --> wait_n_cycles (default_unstake_wait + 1)
-    --> finalize_unstake "staker"
-
-  let forbid_costaking =
-    let default_constants =
-      ("default protocol constants", init_constants ~autostaking_enable:false ())
-    in
-    let small_delegate_parameter_constants =
-      ( "small delegate parameters delay",
-        init_constants
-          ~delegate_parameters_activation_delay:0
-          ~autostaking_enable:false
-          () )
-    in
-    let large_delegate_parameter_constants =
-      ( "large delegate parameters delay",
-        init_constants
-          ~delegate_parameters_activation_delay:10
-          ~autostaking_enable:false
-          () )
-    in
-    let init_params =
-      {
-        limit_of_staking_over_baking = Q.one;
-        edge_of_baking_over_staking = Q.one;
-      }
-    in
-    let no_costake_params =
-      {
-        limit_of_staking_over_baking = Q.zero;
-        edge_of_baking_over_staking = Q.one;
-      }
-    in
-    let amount = Amount (Tez.of_mutez 1_000_000L) in
-    (* init *)
-    begin_test
-      ~activate_ai:true
-      ~constants_list:
-        [
-          default_constants;
-          small_delegate_parameter_constants;
-          large_delegate_parameter_constants;
-        ]
-      ["delegate"]
-    --> set_delegate_params "delegate" init_params
-    --> add_account_with_funds
-          "staker"
-          "delegate"
-          (Amount (Tez.of_mutez 2_000_000_000_000L))
-    --> set_delegate "staker" (Some "delegate")
-    --> wait_cycle (`And (`AI_activation, `delegate_parameters_activation))
-    --> next_cycle
-    (* try stake in normal conditions *)
-    --> stake "staker" amount
-    (* Change delegate parameters to forbid staking *)
-    --> set_delegate_params "delegate" no_costake_params
-    (* The changes are not immediate *)
-    --> stake "staker" amount
-    (* The parameters change is applied exactly
-       [delegate_parameters_activation_delay] after the request *)
-    --> wait_delegate_parameters_activation
-    (* Not yet... *)
-    --> stake "staker" amount
-    --> next_cycle
-    (* External staking is now forbidden *)
-    --> assert_failure (stake "staker" amount)
-    (* Can still self-stake *)
-    --> stake "delegate" amount
-    (* Can still unstake *)
-    --> unstake "staker" Half
-    --> wait_n_cycles (default_unstake_wait + 1)
-    --> finalize_unstake "staker"
-    (* Can authorize stake again *)
-    --> set_delegate_params "delegate" init_params
-    --> wait_delegate_parameters_activation
-    (* Not yet... *)
-    --> assert_failure (stake "staker" amount)
-    --> next_cycle
-    (* Now possible *)
-    --> stake "staker" amount
-
-  let tests =
-    tests_of_scenarios
-    @@ [
-         ("Test simple roundtrip", init_scenario () --> simple_roundtrip);
-         ("Test double roundtrip", init_scenario () --> double_roundtrip);
-         ("Test preserved balance", init_scenario () --> status_quo_rountrip);
-         ("Test finalize", init_scenario () --> scenario_finalize);
-         ("Test no finalize", init_scenario () --> scenario_not_finalize);
-         ( "Test forbidden operations",
-           init_scenario () --> scenario_forbidden_operations );
-         ( "Test full balance in finalizable",
-           init_scenario () --> full_balance_in_finalizable );
-         ("Test stake unstake every cycle", init_scenario () --> odd_behavior);
-         ("Test change delegate", change_delegate);
-         ("Test unset delegate", unset_delegate);
-         ("Test forbid costake", forbid_costaking);
-         ("Test stake from unstake", shorter_roundtrip_for_baker);
-       ]
-end
-
 module Rewards = struct
   let test_wait_with_rewards =
     let constants =
@@ -1052,7 +770,7 @@ module Slashing = struct
        ]
 end
 
-let tests = Roundtrip.tests @ Rewards.tests @ Autostaking.tests @ Slashing.tests
+let tests = Rewards.tests @ Autostaking.tests @ Slashing.tests
 
 let () =
   Alcotest_lwt.run
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml
new file mode 100644
index 000000000000..b9cc68dd70d5
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml
@@ -0,0 +1,295 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Testing
+    -------
+    Component:    Adaptive Issuance, Staking
+    Invocation:   dune exec src/proto_alpha/lib_protocol/test/integration/main.exe \
+                   -- --file test_scenario_stake.ml
+    Subject:      Test staking operations in the protocol.
+*)
+
+open Adaptive_issuance_helpers
+open State_account
+open Test_tez.Ez_tez
+open Scenario_dsl
+open Scenario_base
+open Scenario_op
+open Test_scenario_base
+
+let fs = Format.asprintf
+
+let stake_init =
+  stake "staker" Half
+  --> (Tag "no wait after stake" --> Empty
+      |+ Tag "wait after stake" --> wait_n_cycles 2)
+
+let wait_for_unfreeze_and_check wait =
+  snapshot_balances "wait snap" ["staker"]
+  --> wait_n_cycles (wait - 1)
+  (* Balance didn't change yet, but will change next cycle *)
+  --> check_snapshot_balances "wait snap"
+  --> next_cycle
+  --> assert_failure (check_snapshot_balances "wait snap")
+
+let finalize staker =
+  assert_failure (check_balance_field staker `Unstaked_finalizable Tez.zero)
+  --> finalize_unstake staker
+  --> check_balance_field staker `Unstaked_finalizable Tez.zero
+
+let simple_roundtrip =
+  stake_init
+  --> (Tag "full unstake" --> unstake "staker" All
+      |+ Tag "half unstake" --> unstake "staker" Half)
+  --> wait_for_unfreeze_and_check default_unstake_wait
+  --> finalize "staker" --> next_cycle
+
+let double_roundtrip =
+  stake_init --> unstake "staker" Half
+  --> (Tag "half then full unstake" --> wait_n_cycles 2 --> unstake "staker" All
+      |+ Tag "half then half unstake" --> wait_n_cycles 2
+         --> unstake "staker" Half)
+  --> wait_for_unfreeze_and_check (default_unstake_wait - 2)
+  --> wait_for_unfreeze_and_check 2
+  --> finalize "staker" --> next_cycle
+
+let shorter_roundtrip_for_baker =
+  let constants = init_constants ~autostaking_enable:false () in
+  let amount = Amount (Tez.of_mutez 333_000_000_000L) in
+  let consensus_rights_delay = constants.consensus_rights_delay in
+  begin_test ~activate_ai:true ~constants ["delegate"]
+  --> next_block --> wait_ai_activation
+  --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
+  --> next_cycle
+  --> snapshot_balances "init" ["delegate"]
+  --> unstake "delegate" amount
+  --> List.fold_left
+        (fun acc i -> acc |+ Tag (fs "wait %i cycles" i) --> wait_n_cycles i)
+        (Tag "wait 0 cycles" --> Empty)
+        (Stdlib.List.init (consensus_rights_delay + 1) (fun i -> i + 1))
+  --> stake "delegate" amount
+  --> check_snapshot_balances "init"
+
+let status_quo_rountrip =
+  let full_amount = Tez.of_mutez 10_000_000L in
+  let amount_1 = Tez.of_mutez 2_999_999L in
+  let amount_2 = Tez.of_mutez 7_000_001L in
+  snapshot_balances "init" ["staker"]
+  --> stake "staker" (Amount full_amount)
+  --> next_cycle
+  --> (Tag "1 unstake" --> unstake "staker" (Amount full_amount)
+      |+ Tag "2 unstakes"
+         --> unstake "staker" (Amount amount_1)
+         --> next_cycle
+         --> unstake "staker" (Amount amount_2))
+  --> wait_n_cycles default_unstake_wait
+  --> finalize "staker"
+  --> check_snapshot_balances "init"
+
+let scenario_finalize =
+  no_tag --> stake "staker" Half --> next_cycle --> unstake "staker" Half
+  --> wait_n_cycles (default_unstake_wait + 2)
+  --> assert_failure
+        (check_balance_field "staker" `Unstaked_finalizable Tez.zero)
+  --> (Tag "finalize with finalize" --> finalize_unstake "staker"
+      |+ Tag "finalize with stake" --> stake "staker" (Amount Tez.one_mutez)
+      |+ Tag "finalize with unstake" --> unstake "staker" (Amount Tez.one_mutez)
+      )
+  --> check_balance_field "staker" `Unstaked_finalizable Tez.zero
+
+(* Finalize does not go through when unstake does nothing *)
+(* Todo: there might be other cases... like changing delegates *)
+let scenario_not_finalize =
+  no_tag --> stake "staker" Half --> next_cycle --> unstake "staker" All
+  --> wait_n_cycles (default_unstake_wait + 2)
+  --> assert_failure
+        (check_balance_field "staker" `Unstaked_finalizable Tez.zero)
+  --> snapshot_balances "not finalize" ["staker"]
+  --> (Tag "no finalize with unstake if staked = 0"
+      --> unstake "staker" (Amount Tez.one_mutez))
+  --> assert_failure
+        (check_balance_field "staker" `Unstaked_finalizable Tez.zero)
+  --> check_snapshot_balances "not finalize"
+
+(* TODO: there's probably more... *)
+let scenario_forbidden_operations =
+  let open Lwt_result_syntax in
+  let fail_if_staker_is_self_delegate staker =
+    exec (fun ((_, state) as input) ->
+        if State.(is_self_delegate staker state) then
+          failwith "_self_delegate_exit_"
+        else return input)
+  in
+  no_tag
+  (* Staking everything works for self delegates, but not for delegated accounts *)
+  --> assert_failure
+        (fail_if_staker_is_self_delegate "staker" --> stake "staker" All)
+  (* stake is always forbidden when amount is zero *)
+  --> assert_failure (stake "staker" Nothing)
+  (* One cannot stake more that one has *)
+  --> assert_failure (stake "staker" Max_tez)
+  (* unstake is actually authorized for amount 0, but does nothing (doesn't even finalize if possible) *)
+  --> unstake "staker" Nothing
+
+let full_balance_in_finalizable =
+  add_account_with_funds "dummy" "staker" (Amount (Tez.of_mutez 10_000_000L))
+  --> stake "staker" All_but_one --> next_cycle --> unstake "staker" All
+  --> wait_n_cycles (default_unstake_wait + 2)
+  (* At this point, almost all the balance (but one mutez) of the stake is in finalizable *)
+  (* Staking is possible, but not transfer *)
+  --> assert_failure
+        (transfer "staker" "dummy" (Amount (Tez.of_mutez 10_000_000L)))
+  --> stake "staker" (Amount (Tez.of_mutez 10_000_000L))
+  (* After the stake, transfer is possible again because the funds were finalized *)
+  --> transfer "staker" "dummy" (Amount (Tez.of_mutez 10_000_000L))
+
+(* Stress test: what happens if someone were to stake and unstake every cycle? *)
+let odd_behavior =
+  let one_cycle =
+    no_tag --> stake "staker" Half --> unstake "staker" Half --> next_cycle
+  in
+  loop 20 one_cycle
+
+let change_delegate =
+  let constants = init_constants ~autostaking_enable:false () in
+  let init_params =
+    {limit_of_staking_over_baking = Q.one; edge_of_baking_over_staking = Q.one}
+  in
+  begin_test ~activate_ai:true ~constants ["delegate1"; "delegate2"]
+  --> set_delegate_params "delegate1" init_params
+  --> set_delegate_params "delegate2" init_params
+  --> add_account_with_funds
+        "staker"
+        "delegate1"
+        (Amount (Tez.of_mutez 2_000_000_000_000L))
+  --> set_delegate "staker" (Some "delegate1")
+  --> wait_ai_activation --> next_cycle --> stake "staker" Half --> next_cycle
+  --> set_delegate "staker" (Some "delegate2")
+  --> next_cycle
+  --> assert_failure (stake "staker" Half)
+  --> wait_n_cycles (default_unstake_wait + 1)
+  --> stake "staker" Half
+
+let unset_delegate =
+  let constants = init_constants ~autostaking_enable:false () in
+  let init_params =
+    {limit_of_staking_over_baking = Q.one; edge_of_baking_over_staking = Q.one}
+  in
+  begin_test ~activate_ai:true ~constants ["delegate"]
+  --> set_delegate_params "delegate" init_params
+  --> add_account_with_funds
+        "staker"
+        "delegate"
+        (Amount (Tez.of_mutez 2_000_000_000_000L))
+  --> add_account_with_funds
+        "dummy"
+        "delegate"
+        (Amount (Tez.of_mutez 2_000_000L))
+  --> set_delegate "staker" (Some "delegate")
+  --> wait_ai_activation --> next_cycle --> stake "staker" Half
+  --> unstake "staker" All --> next_cycle --> set_delegate "staker" None
+  --> next_cycle
+  --> transfer "staker" "dummy" All
+  (* staker has an empty liquid balance, but still has unstaked frozen tokens,
+     so it doesn't get deactivated *)
+  --> wait_n_cycles (default_unstake_wait + 1)
+  --> finalize_unstake "staker"
+
+let forbid_costaking =
+  let default_constants =
+    ("default protocol constants", init_constants ~autostaking_enable:false ())
+  in
+  let small_delegate_parameter_constants =
+    ( "small delegate parameters delay",
+      init_constants
+        ~delegate_parameters_activation_delay:0
+        ~autostaking_enable:false
+        () )
+  in
+  let large_delegate_parameter_constants =
+    ( "large delegate parameters delay",
+      init_constants
+        ~delegate_parameters_activation_delay:10
+        ~autostaking_enable:false
+        () )
+  in
+  let init_params =
+    {limit_of_staking_over_baking = Q.one; edge_of_baking_over_staking = Q.one}
+  in
+  let no_costake_params =
+    {limit_of_staking_over_baking = Q.zero; edge_of_baking_over_staking = Q.one}
+  in
+  let amount = Amount (Tez.of_mutez 1_000_000L) in
+  (* init *)
+  begin_test
+    ~activate_ai:true
+    ~constants_list:
+      [
+        default_constants;
+        small_delegate_parameter_constants;
+        large_delegate_parameter_constants;
+      ]
+    ["delegate"]
+  --> set_delegate_params "delegate" init_params
+  --> add_account_with_funds
+        "staker"
+        "delegate"
+        (Amount (Tez.of_mutez 2_000_000_000_000L))
+  --> set_delegate "staker" (Some "delegate")
+  --> wait_cycle (`And (`AI_activation, `delegate_parameters_activation))
+  --> next_cycle
+  (* try stake in normal conditions *)
+  --> stake "staker" amount
+  (* Change delegate parameters to forbid staking *)
+  --> set_delegate_params "delegate" no_costake_params
+  (* The changes are not immediate *)
+  --> stake "staker" amount
+  (* The parameters change is applied exactly
+     [delegate_parameters_activation_delay] after the request *)
+  --> wait_delegate_parameters_activation
+  (* Not yet... *)
+  --> stake "staker" amount
+  --> next_cycle
+  (* External staking is now forbidden *)
+  --> assert_failure (stake "staker" amount)
+  (* Can still self-stake *)
+  --> stake "delegate" amount
+  (* Can still unstake *)
+  --> unstake "staker" Half
+  --> wait_n_cycles (default_unstake_wait + 1)
+  --> finalize_unstake "staker"
+  (* Can authorize stake again *)
+  --> set_delegate_params "delegate" init_params
+  --> wait_delegate_parameters_activation
+  (* Not yet... *)
+  --> assert_failure (stake "staker" amount)
+  --> next_cycle
+  (* Now possible *)
+  --> stake "staker" amount
+
+let tests =
+  tests_of_scenarios
+  @@ [
+       ("Test simple roundtrip", init_scenario () --> simple_roundtrip);
+       ("Test double roundtrip", init_scenario () --> double_roundtrip);
+       ("Test preserved balance", init_scenario () --> status_quo_rountrip);
+       ("Test finalize", init_scenario () --> scenario_finalize);
+       ("Test no finalize", init_scenario () --> scenario_not_finalize);
+       ( "Test forbidden operations",
+         init_scenario () --> scenario_forbidden_operations );
+       ( "Test full balance in finalizable",
+         init_scenario () --> full_balance_in_finalizable );
+       ("Test stake unstake every cycle", init_scenario () --> odd_behavior);
+       ("Test change delegate", change_delegate);
+       ("Test unset delegate", unset_delegate);
+       ("Test forbid costake", forbid_costaking);
+       ("Test stake from unstake", shorter_roundtrip_for_baker);
+     ]
+
+let () =
+  Alcotest_lwt.run ~__FILE__ Protocol.name [("protocol stake unstake", tests)]
+  |> Lwt_main.run
-- 
GitLab


From b1e8209d0dcddc124968ab2f867f6595de11f489 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 13:56:18 +0100
Subject: [PATCH 12/18] Proto/tests: move reward tests in dedicated file

---
 manifest/main.ml                              |   1 +
 .../lib_protocol/test/integration/dune        |   1 +
 .../test_adaptive_issuance_roundtrip.ml       | 144 +---------------
 .../test/integration/test_scenario_rewards.ml | 160 ++++++++++++++++++
 4 files changed, 163 insertions(+), 143 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml

diff --git a/manifest/main.ml b/manifest/main.ml
index d720c46da3b9..1d53513a0536 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -5423,6 +5423,7 @@ end = struct
             ("test_adaptive_issuance_roundtrip", N.(number >= 018));
             ("test_scenario_base", N.(number >= 019));
             ("test_scenario_stake", N.(number >= 019));
+            ("test_scenario_rewards", N.(number >= 019));
             ("test_liquidity_baking", true);
             ("test_storage_functions", true);
             ("test_storage", true);
diff --git a/src/proto_alpha/lib_protocol/test/integration/dune b/src/proto_alpha/lib_protocol/test/integration/dune
index b535ead71eaa..fae17d1e541b 100644
--- a/src/proto_alpha/lib_protocol/test/integration/dune
+++ b/src/proto_alpha/lib_protocol/test/integration/dune
@@ -35,6 +35,7 @@
   test_adaptive_issuance_roundtrip
   test_scenario_base
   test_scenario_stake
+  test_scenario_rewards
   test_liquidity_baking
   test_storage_functions
   test_storage
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 2d3c7b5cb4af..56c8900a5883 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -42,148 +42,6 @@ open Test_scenario_base
 
 let fs = Format.asprintf
 
-module Rewards = struct
-  let test_wait_with_rewards =
-    let constants =
-      init_constants
-        ~reward_per_block:1_000_000_000L
-        ~autostaking_enable:false
-        ()
-    in
-    let set_edge pct =
-      let params =
-        {
-          limit_of_staking_over_baking = Q.one;
-          edge_of_baking_over_staking = Q.of_float pct;
-        }
-      in
-      set_delegate_params "delegate" params
-    in
-    begin_test ~activate_ai:true ~constants ["delegate"; "faucet"]
-    --> set_baker "faucet"
-    --> (Tag "edge = 0" --> set_edge 0.
-        |+ Tag "edge = 0.24" --> set_edge 0.24
-        |+ Tag "edge = 0.11..." --> set_edge 0.1111111111
-        |+ Tag "edge = 1" --> set_edge 1.)
-    --> add_account_with_funds
-          "staker1"
-          "faucet"
-          (Amount (Tez.of_mutez 2_000_000_000L))
-    --> add_account_with_funds
-          "staker2"
-          "faucet"
-          (Amount (Tez.of_mutez 2_000_000_000L))
-    --> add_account_with_funds
-          "staker3"
-          "faucet"
-          (Amount (Tez.of_mutez 2_000_000_000L))
-    --> set_delegate "staker1" (Some "delegate")
-    --> set_delegate "staker2" (Some "delegate")
-    --> set_delegate "staker3" (Some "delegate")
-    --> set_baker "delegate"
-    --> (Tag "block step" --> wait_n_blocks 200
-        |+ Tag "cycle step" --> wait_n_cycles 20
-        |+ Tag "wait AI activation" --> next_block --> wait_ai_activation
-           --> (Tag "no staker" --> Empty
-               |+ Tag "one staker"
-                  --> stake "staker1" (Amount (Tez.of_mutez 450_000_111L))
-               |+ Tag "two stakers"
-                  --> stake "staker1" (Amount (Tez.of_mutez 444_000_111L))
-                  --> stake "staker2" (Amount (Tez.of_mutez 333_001_987L))
-                  --> set_baker "delegate"
-               |+ Tag "three stakers"
-                  --> stake "staker1" (Amount (Tez.of_mutez 444_000_111L))
-                  --> stake "staker2" (Amount (Tez.of_mutez 333_001_987L))
-                  --> stake "staker3" (Amount (Tez.of_mutez 123_456_788L)))
-           --> (Tag "block step" --> wait_n_blocks 100
-               |+ Tag "cycle step" --> wait_n_cycles 10))
-    --> Tag "staker 1 unstakes half..." --> unstake "staker1" Half
-    --> (Tag "block step" --> wait_n_blocks 100
-        |+ Tag "cycle step" --> wait_n_cycles 10)
-
-  let test_ai_curve_activation_time =
-    let constants =
-      init_constants
-        ~reward_per_block:1_000_000_000L
-        ~deactivate_dynamic:true
-        ~autostaking_enable:false
-        ()
-    in
-    let pc = constants.consensus_rights_delay in
-    begin_test ~activate_ai:true ~burn_rewards:true ~constants [""]
-    --> next_block --> save_current_rate (* before AI rate *)
-    --> wait_ai_activation
-    (* Rate remains unchanged right after AI activation, we must wait [pc + 1] cycles *)
-    --> check_rate_evolution Q.equal
-    --> wait_n_cycles pc
-    --> check_rate_evolution Q.equal
-    --> next_cycle
-    (* The new rate should be active now. With the chosen constants, it should be lower.
-       We go from 1000tz per day to (at most) 5% of 4_000_000tz per year *)
-    --> check_rate_evolution Q.gt
-
-  let test_static =
-    let constants =
-      init_constants
-        ~reward_per_block:1_000_000_000L
-        ~deactivate_dynamic:true
-        ~autostaking_enable:false
-        ()
-    in
-    let rate_var_lag = constants.consensus_rights_delay in
-    let init_params =
-      {
-        limit_of_staking_over_baking = Q.one;
-        edge_of_baking_over_staking = Q.one;
-      }
-    in
-    let delta = Amount (Tez.of_mutez 20_000_000_000L) in
-    let cycle_stake =
-      save_current_rate --> stake "delegate" delta --> next_cycle
-      --> check_rate_evolution Q.gt
-    in
-    let cycle_unstake =
-      save_current_rate --> unstake "delegate" delta --> next_cycle
-      --> check_rate_evolution Q.lt
-    in
-    let cycle_stable =
-      save_current_rate --> next_cycle --> check_rate_evolution Q.equal
-    in
-    begin_test ~activate_ai:true ~burn_rewards:true ~constants ["delegate"]
-    --> set_delegate_params "delegate" init_params
-    --> save_current_rate --> wait_ai_activation
-    (* We stake about 50% of the total supply *)
-    --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
-    --> stake "__bootstrap__" (Amount (Tez.of_mutez 1_800_000_000_000L))
-    --> (Tag "increase stake, decrease rate" --> next_cycle
-         --> loop rate_var_lag (stake "delegate" delta --> next_cycle)
-         --> loop 10 cycle_stake
-        |+ Tag "decrease stake, increase rate" --> next_cycle
-           --> loop rate_var_lag (unstake "delegate" delta --> next_cycle)
-           --> loop 10 cycle_unstake
-        |+ Tag "stable stake, stable rate" --> next_cycle
-           --> wait_n_cycles rate_var_lag --> loop 10 cycle_stable
-        |+ Tag "test timing" --> wait_n_cycles rate_var_lag
-           --> check_rate_evolution Q.equal
-           --> next_cycle --> check_rate_evolution Q.gt --> save_current_rate
-           --> (Tag "increase stake" --> stake "delegate" delta
-                --> wait_n_cycles rate_var_lag
-                --> check_rate_evolution Q.equal
-                --> next_cycle --> check_rate_evolution Q.gt
-               |+ Tag "decrease stake" --> unstake "delegate" delta
-                  --> wait_n_cycles rate_var_lag
-                  --> check_rate_evolution Q.equal
-                  --> next_cycle --> check_rate_evolution Q.lt))
-
-  let tests =
-    tests_of_scenarios
-    @@ [
-         ("Test wait with rewards", test_wait_with_rewards);
-         ("Test ai curve activation time", test_ai_curve_activation_time);
-         (* ("Test static rate", test_static); *)
-       ]
-end
-
 module Autostaking = struct
   let assert_balance_evolution ~loc ~for_accounts ~part ~name ~old_balance
       ~new_balance compare =
@@ -770,7 +628,7 @@ module Slashing = struct
        ]
 end
 
-let tests = Rewards.tests @ Autostaking.tests @ Slashing.tests
+let tests = Autostaking.tests @ Slashing.tests
 
 let () =
   Alcotest_lwt.run
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml
new file mode 100644
index 000000000000..d3dcb6d3e23f
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml
@@ -0,0 +1,160 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Testing
+    -------
+    Component:    Adaptive Issuance, Rewards
+    Invocation:   dune exec src/proto_alpha/lib_protocol/test/integration/main.exe \
+                   -- --file test_scenario_rewards.ml
+    Subject:      Test rewards issuance in the protocol.
+*)
+
+open Adaptive_issuance_helpers
+open State_account
+open Test_tez.Ez_tez
+open Scenario_dsl
+open Scenario_base
+open Scenario_op
+open Test_scenario_base
+
+let test_wait_with_rewards =
+  let constants =
+    init_constants ~reward_per_block:1_000_000_000L ~autostaking_enable:false ()
+  in
+  let set_edge pct =
+    let params =
+      {
+        limit_of_staking_over_baking = Q.one;
+        edge_of_baking_over_staking = Q.of_float pct;
+      }
+    in
+    set_delegate_params "delegate" params
+  in
+  begin_test ~activate_ai:true ~constants ["delegate"; "faucet"]
+  --> set_baker "faucet"
+  --> (Tag "edge = 0" --> set_edge 0.
+      |+ Tag "edge = 0.24" --> set_edge 0.24
+      |+ Tag "edge = 0.11..." --> set_edge 0.1111111111
+      |+ Tag "edge = 1" --> set_edge 1.)
+  --> add_account_with_funds
+        "staker1"
+        "faucet"
+        (Amount (Tez.of_mutez 2_000_000_000L))
+  --> add_account_with_funds
+        "staker2"
+        "faucet"
+        (Amount (Tez.of_mutez 2_000_000_000L))
+  --> add_account_with_funds
+        "staker3"
+        "faucet"
+        (Amount (Tez.of_mutez 2_000_000_000L))
+  --> set_delegate "staker1" (Some "delegate")
+  --> set_delegate "staker2" (Some "delegate")
+  --> set_delegate "staker3" (Some "delegate")
+  --> set_baker "delegate"
+  --> (Tag "block step" --> wait_n_blocks 200
+      |+ Tag "cycle step" --> wait_n_cycles 20
+      |+ Tag "wait AI activation" --> next_block --> wait_ai_activation
+         --> (Tag "no staker" --> Empty
+             |+ Tag "one staker"
+                --> stake "staker1" (Amount (Tez.of_mutez 450_000_111L))
+             |+ Tag "two stakers"
+                --> stake "staker1" (Amount (Tez.of_mutez 444_000_111L))
+                --> stake "staker2" (Amount (Tez.of_mutez 333_001_987L))
+                --> set_baker "delegate"
+             |+ Tag "three stakers"
+                --> stake "staker1" (Amount (Tez.of_mutez 444_000_111L))
+                --> stake "staker2" (Amount (Tez.of_mutez 333_001_987L))
+                --> stake "staker3" (Amount (Tez.of_mutez 123_456_788L)))
+         --> (Tag "block step" --> wait_n_blocks 100
+             |+ Tag "cycle step" --> wait_n_cycles 10))
+  --> Tag "staker 1 unstakes half..." --> unstake "staker1" Half
+  --> (Tag "block step" --> wait_n_blocks 100
+      |+ Tag "cycle step" --> wait_n_cycles 10)
+
+let test_ai_curve_activation_time =
+  let constants =
+    init_constants
+      ~reward_per_block:1_000_000_000L
+      ~deactivate_dynamic:true
+      ~autostaking_enable:false
+      ()
+  in
+  let pc = constants.consensus_rights_delay in
+  begin_test ~activate_ai:true ~burn_rewards:true ~constants [""]
+  --> next_block --> save_current_rate (* before AI rate *)
+  --> wait_ai_activation
+  (* Rate remains unchanged right after AI activation, we must wait [pc + 1] cycles *)
+  --> check_rate_evolution Q.equal
+  --> wait_n_cycles pc
+  --> check_rate_evolution Q.equal
+  --> next_cycle
+  (* The new rate should be active now. With the chosen constants, it should be lower.
+     We go from 1000tz per day to (at most) 5% of 4_000_000tz per year *)
+  --> check_rate_evolution Q.gt
+
+let test_static =
+  let constants =
+    init_constants
+      ~reward_per_block:1_000_000_000L
+      ~deactivate_dynamic:true
+      ~autostaking_enable:false
+      ()
+  in
+  let rate_var_lag = constants.consensus_rights_delay in
+  let init_params =
+    {limit_of_staking_over_baking = Q.one; edge_of_baking_over_staking = Q.one}
+  in
+  let delta = Amount (Tez.of_mutez 20_000_000_000L) in
+  let cycle_stake =
+    save_current_rate --> stake "delegate" delta --> next_cycle
+    --> check_rate_evolution Q.gt
+  in
+  let cycle_unstake =
+    save_current_rate --> unstake "delegate" delta --> next_cycle
+    --> check_rate_evolution Q.lt
+  in
+  let cycle_stable =
+    save_current_rate --> next_cycle --> check_rate_evolution Q.equal
+  in
+  begin_test ~activate_ai:true ~burn_rewards:true ~constants ["delegate"]
+  --> set_delegate_params "delegate" init_params
+  --> save_current_rate --> wait_ai_activation
+  (* We stake about 50% of the total supply *)
+  --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
+  --> stake "__bootstrap__" (Amount (Tez.of_mutez 1_800_000_000_000L))
+  --> (Tag "increase stake, decrease rate" --> next_cycle
+       --> loop rate_var_lag (stake "delegate" delta --> next_cycle)
+       --> loop 10 cycle_stake
+      |+ Tag "decrease stake, increase rate" --> next_cycle
+         --> loop rate_var_lag (unstake "delegate" delta --> next_cycle)
+         --> loop 10 cycle_unstake
+      |+ Tag "stable stake, stable rate" --> next_cycle
+         --> wait_n_cycles rate_var_lag --> loop 10 cycle_stable
+      |+ Tag "test timing" --> wait_n_cycles rate_var_lag
+         --> check_rate_evolution Q.equal
+         --> next_cycle --> check_rate_evolution Q.gt --> save_current_rate
+         --> (Tag "increase stake" --> stake "delegate" delta
+              --> wait_n_cycles rate_var_lag
+              --> check_rate_evolution Q.equal
+              --> next_cycle --> check_rate_evolution Q.gt
+             |+ Tag "decrease stake" --> unstake "delegate" delta
+                --> wait_n_cycles rate_var_lag
+                --> check_rate_evolution Q.equal
+                --> next_cycle --> check_rate_evolution Q.lt))
+
+let tests =
+  tests_of_scenarios
+  @@ [
+       ("Test wait with rewards", test_wait_with_rewards);
+       ("Test ai curve activation time", test_ai_curve_activation_time);
+       (* ("Test static rate", test_static); *)
+     ]
+
+let () =
+  Alcotest_lwt.run ~__FILE__ Protocol.name [("protocol rewards", tests)]
+  |> Lwt_main.run
-- 
GitLab


From a7cfabf005cc1c935fe8eb3b3c91e97446de4ca3 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 13:58:51 +0100
Subject: [PATCH 13/18] Proto/tests: move autostaking tests in dedicated file

---
 manifest/main.ml                              |   1 +
 .../lib_protocol/test/integration/dune        |   1 +
 .../test_adaptive_issuance_roundtrip.ml       | 168 +---------------
 .../integration/test_scenario_autostaking.ml  | 190 ++++++++++++++++++
 4 files changed, 193 insertions(+), 167 deletions(-)
 create mode 100644 src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml

diff --git a/manifest/main.ml b/manifest/main.ml
index 1d53513a0536..8e1bf561b649 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -5424,6 +5424,7 @@ end = struct
             ("test_scenario_base", N.(number >= 019));
             ("test_scenario_stake", N.(number >= 019));
             ("test_scenario_rewards", N.(number >= 019));
+            ("test_scenario_autostaking", N.(number >= 019));
             ("test_liquidity_baking", true);
             ("test_storage_functions", true);
             ("test_storage", true);
diff --git a/src/proto_alpha/lib_protocol/test/integration/dune b/src/proto_alpha/lib_protocol/test/integration/dune
index fae17d1e541b..df5f72490b91 100644
--- a/src/proto_alpha/lib_protocol/test/integration/dune
+++ b/src/proto_alpha/lib_protocol/test/integration/dune
@@ -36,6 +36,7 @@
   test_scenario_base
   test_scenario_stake
   test_scenario_rewards
+  test_scenario_autostaking
   test_liquidity_baking
   test_storage_functions
   test_storage
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
index 56c8900a5883..d123109a343e 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
@@ -42,172 +42,6 @@ open Test_scenario_base
 
 let fs = Format.asprintf
 
-module Autostaking = struct
-  let assert_balance_evolution ~loc ~for_accounts ~part ~name ~old_balance
-      ~new_balance compare =
-    let open Lwt_result_syntax in
-    let old_b, new_b =
-      match part with
-      | `liquid ->
-          ( Q.of_int64 @@ Tez.to_mutez old_balance.liquid_b,
-            Q.of_int64 @@ Tez.to_mutez new_balance.liquid_b )
-      | `staked -> (old_balance.staked_b, new_balance.staked_b)
-      | `unstaked_frozen ->
-          ( Q.of_int64 @@ Tez.to_mutez old_balance.unstaked_frozen_b,
-            Q.of_int64 @@ Tez.to_mutez new_balance.unstaked_frozen_b )
-      | `unstaked_finalizable ->
-          ( Q.of_int64 @@ Tez.to_mutez old_balance.unstaked_finalizable_b,
-            Q.of_int64 @@ Tez.to_mutez new_balance.unstaked_finalizable_b )
-    in
-    if List.mem ~equal:String.equal name for_accounts then
-      if compare new_b old_b then return_unit
-      else (
-        Log.debug ~color:warning_color "Balances changes failed:@." ;
-        Log.debug "@[<v 2>Old Balance@ %a@]@." balance_pp old_balance ;
-        Log.debug "@[<v 2>New Balance@ %a@]@." balance_pp new_balance ;
-        failwith "%s Unexpected stake evolution for %s" loc name)
-    else raise Not_found
-
-  let delegate = "delegate"
-
-  and delegator1 = "delegator1"
-
-  and delegator2 = "delegator2"
-
-  let setup ~activate_ai =
-    let constants = init_constants ~autostaking_enable:true () in
-    begin_test ~activate_ai ~constants [delegate]
-    --> add_account_with_funds
-          delegator1
-          "__bootstrap__"
-          (Amount (Tez.of_mutez 2_000_000_000L))
-    --> add_account_with_funds
-          delegator2
-          "__bootstrap__"
-          (Amount (Tez.of_mutez 2_000_000_000L))
-    --> next_cycle
-    --> (if activate_ai then wait_ai_activation else next_cycle)
-    --> snapshot_balances "before delegation" [delegate]
-    --> set_delegate delegator1 (Some delegate)
-    --> check_snapshot_balances "before delegation"
-    --> next_cycle
-
-  let test_autostaking =
-    Tag "No Ai" --> setup ~activate_ai:false
-    --> check_snapshot_balances
-          ~f:
-            (assert_balance_evolution
-               ~loc:__LOC__
-               ~for_accounts:[delegate]
-               ~part:`staked
-               Q.gt)
-          "before delegation"
-    --> snapshot_balances "before second delegation" [delegate]
-    --> (Tag "increase delegation"
-         --> set_delegate delegator2 (Some delegate)
-         --> next_cycle
-         --> check_snapshot_balances
-               ~f:
-                 (assert_balance_evolution
-                    ~loc:__LOC__
-                    ~for_accounts:[delegate]
-                    ~part:`staked
-                    Q.gt)
-               "before second delegation"
-        |+ Tag "constant delegation"
-           --> snapshot_balances "after stake change" [delegate]
-           --> wait_n_cycles 8
-           --> check_snapshot_balances "after stake change"
-        |+ Tag "decrease delegation"
-           --> set_delegate delegator1 None
-           --> next_cycle
-           --> check_snapshot_balances
-                 ~f:
-                   (assert_balance_evolution
-                      ~loc:__LOC__
-                      ~for_accounts:[delegate]
-                      ~part:`staked
-                      Q.lt)
-                 "before second delegation"
-           --> check_snapshot_balances
-                 ~f:
-                   (assert_balance_evolution
-                      ~loc:__LOC__
-                      ~for_accounts:[delegate]
-                      ~part:`unstaked_frozen
-                      Q.gt)
-                 "before second delegation"
-           --> snapshot_balances "after unstake" [delegate]
-           --> next_cycle
-           --> check_snapshot_balances "after unstake"
-           --> wait_n_cycles 4
-           --> check_snapshot_balances
-                 ~f:
-                   (assert_balance_evolution
-                      ~loc:__LOC__
-                      ~for_accounts:[delegate]
-                      ~part:`unstaked_frozen
-                      Q.lt)
-                 "after unstake"
-           (* finalizable are auto-finalize immediately  *)
-           --> check_snapshot_balances
-                 ~f:
-                   (assert_balance_evolution
-                      ~loc:__LOC__
-                      ~for_accounts:[delegate]
-                      ~part:`liquid
-                      Q.lt)
-                 "before finalisation")
-    |+ Tag "Yes AI" --> setup ~activate_ai:true
-       --> check_snapshot_balances "before delegation"
-
-  let test_overdelegation =
-    (* This test assumes that all delegate accounts created in [begin_test]
-       begin with 4M tz, with 5% staked *)
-    let constants = init_constants ~autostaking_enable:true () in
-    begin_test
-      ~activate_ai:false
-      ~constants
-      ["delegate"; "faucet1"; "faucet2"; "faucet3"]
-    --> add_account_with_funds
-          "delegator_to_fund"
-          "delegate"
-          (Amount (Tez.of_mutez 3_600_000_000_000L))
-    (* Delegate has 200k staked and 200k liquid *)
-    --> set_delegate "delegator_to_fund" (Some "delegate")
-    (* Delegate stake will not change at the end of cycle: same stake *)
-    --> next_cycle
-    --> check_balance_field "delegate" `Staked (Tez.of_mutez 200_000_000_000L)
-    --> transfer
-          "faucet1"
-          "delegator_to_fund"
-          (Amount (Tez.of_mutez 3_600_000_000_000L))
-    (* Delegate is not overdelegated, but will need to freeze 180k *)
-    --> next_cycle
-    --> check_balance_field "delegate" `Staked (Tez.of_mutez 380_000_000_000L)
-    --> transfer
-          "faucet2"
-          "delegator_to_fund"
-          (Amount (Tez.of_mutez 3_600_000_000_000L))
-    (* Delegate is now overdelegated, it will freeze 100% *)
-    --> next_cycle
-    --> check_balance_field "delegate" `Staked (Tez.of_mutez 400_000_000_000L)
-    --> transfer
-          "faucet3"
-          "delegator_to_fund"
-          (Amount (Tez.of_mutez 3_600_000_000_000L))
-    (* Delegate is overmegadelegated *)
-    --> next_cycle
-    --> check_balance_field "delegate" `Staked (Tez.of_mutez 400_000_000_000L)
-
-  let tests =
-    tests_of_scenarios
-      [
-        ("Test auto-staking", test_autostaking);
-        ("Test auto-staking with overdelegation", test_overdelegation);
-      ]
-end
-
 module Slashing = struct
   let test_simple_slash =
     let constants = init_constants ~autostaking_enable:false () in
@@ -628,7 +462,7 @@ module Slashing = struct
        ]
 end
 
-let tests = Autostaking.tests @ Slashing.tests
+let tests = Slashing.tests
 
 let () =
   Alcotest_lwt.run
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml
new file mode 100644
index 000000000000..e9b2901f0650
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml
@@ -0,0 +1,190 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Testing
+    -------
+    Component:    Adaptive Issuance, Autostaking
+    Invocation:   dune exec src/proto_alpha/lib_protocol/test/integration/main.exe \
+                   -- --file test_scenario_autostaking.ml
+    Subject:      Test autostaking in the protocol.
+*)
+
+open State_account
+open Test_tez.Ez_tez
+open Scenario_dsl
+open Scenario_base
+open Scenario_op
+open Test_scenario_base
+open Log_helper
+
+let assert_balance_evolution ~loc ~for_accounts ~part ~name ~old_balance
+    ~new_balance compare =
+  let open Lwt_result_syntax in
+  let old_b, new_b =
+    match part with
+    | `liquid ->
+        ( Q.of_int64 @@ Tez.to_mutez old_balance.liquid_b,
+          Q.of_int64 @@ Tez.to_mutez new_balance.liquid_b )
+    | `staked -> (old_balance.staked_b, new_balance.staked_b)
+    | `unstaked_frozen ->
+        ( Q.of_int64 @@ Tez.to_mutez old_balance.unstaked_frozen_b,
+          Q.of_int64 @@ Tez.to_mutez new_balance.unstaked_frozen_b )
+    | `unstaked_finalizable ->
+        ( Q.of_int64 @@ Tez.to_mutez old_balance.unstaked_finalizable_b,
+          Q.of_int64 @@ Tez.to_mutez new_balance.unstaked_finalizable_b )
+  in
+  if List.mem ~equal:String.equal name for_accounts then
+    if compare new_b old_b then return_unit
+    else (
+      Log.debug ~color:warning_color "Balances changes failed:@." ;
+      Log.debug "@[<v 2>Old Balance@ %a@]@." balance_pp old_balance ;
+      Log.debug "@[<v 2>New Balance@ %a@]@." balance_pp new_balance ;
+      failwith "%s Unexpected stake evolution for %s" loc name)
+  else raise Not_found
+
+let delegate = "delegate"
+
+and delegator1 = "delegator1"
+
+and delegator2 = "delegator2"
+
+let setup ~activate_ai =
+  let constants = init_constants ~autostaking_enable:true () in
+  begin_test ~activate_ai ~constants [delegate]
+  --> add_account_with_funds
+        delegator1
+        "__bootstrap__"
+        (Amount (Tez.of_mutez 2_000_000_000L))
+  --> add_account_with_funds
+        delegator2
+        "__bootstrap__"
+        (Amount (Tez.of_mutez 2_000_000_000L))
+  --> next_cycle
+  --> (if activate_ai then wait_ai_activation else next_cycle)
+  --> snapshot_balances "before delegation" [delegate]
+  --> set_delegate delegator1 (Some delegate)
+  --> check_snapshot_balances "before delegation"
+  --> next_cycle
+
+let test_autostaking =
+  Tag "No Ai" --> setup ~activate_ai:false
+  --> check_snapshot_balances
+        ~f:
+          (assert_balance_evolution
+             ~loc:__LOC__
+             ~for_accounts:[delegate]
+             ~part:`staked
+             Q.gt)
+        "before delegation"
+  --> snapshot_balances "before second delegation" [delegate]
+  --> (Tag "increase delegation"
+       --> set_delegate delegator2 (Some delegate)
+       --> next_cycle
+       --> check_snapshot_balances
+             ~f:
+               (assert_balance_evolution
+                  ~loc:__LOC__
+                  ~for_accounts:[delegate]
+                  ~part:`staked
+                  Q.gt)
+             "before second delegation"
+      |+ Tag "constant delegation"
+         --> snapshot_balances "after stake change" [delegate]
+         --> wait_n_cycles 8
+         --> check_snapshot_balances "after stake change"
+      |+ Tag "decrease delegation"
+         --> set_delegate delegator1 None
+         --> next_cycle
+         --> check_snapshot_balances
+               ~f:
+                 (assert_balance_evolution
+                    ~loc:__LOC__
+                    ~for_accounts:[delegate]
+                    ~part:`staked
+                    Q.lt)
+               "before second delegation"
+         --> check_snapshot_balances
+               ~f:
+                 (assert_balance_evolution
+                    ~loc:__LOC__
+                    ~for_accounts:[delegate]
+                    ~part:`unstaked_frozen
+                    Q.gt)
+               "before second delegation"
+         --> snapshot_balances "after unstake" [delegate]
+         --> next_cycle
+         --> check_snapshot_balances "after unstake"
+         --> wait_n_cycles 4
+         --> check_snapshot_balances
+               ~f:
+                 (assert_balance_evolution
+                    ~loc:__LOC__
+                    ~for_accounts:[delegate]
+                    ~part:`unstaked_frozen
+                    Q.lt)
+               "after unstake"
+         (* finalizable are auto-finalize immediately  *)
+         --> check_snapshot_balances
+               ~f:
+                 (assert_balance_evolution
+                    ~loc:__LOC__
+                    ~for_accounts:[delegate]
+                    ~part:`liquid
+                    Q.lt)
+               "before finalisation")
+  |+ Tag "Yes AI" --> setup ~activate_ai:true
+     --> check_snapshot_balances "before delegation"
+
+let test_overdelegation =
+  (* This test assumes that all delegate accounts created in [begin_test]
+     begin with 4M tz, with 5% staked *)
+  let constants = init_constants ~autostaking_enable:true () in
+  begin_test
+    ~activate_ai:false
+    ~constants
+    ["delegate"; "faucet1"; "faucet2"; "faucet3"]
+  --> add_account_with_funds
+        "delegator_to_fund"
+        "delegate"
+        (Amount (Tez.of_mutez 3_600_000_000_000L))
+  (* Delegate has 200k staked and 200k liquid *)
+  --> set_delegate "delegator_to_fund" (Some "delegate")
+  (* Delegate stake will not change at the end of cycle: same stake *)
+  --> next_cycle
+  --> check_balance_field "delegate" `Staked (Tez.of_mutez 200_000_000_000L)
+  --> transfer
+        "faucet1"
+        "delegator_to_fund"
+        (Amount (Tez.of_mutez 3_600_000_000_000L))
+  (* Delegate is not overdelegated, but will need to freeze 180k *)
+  --> next_cycle
+  --> check_balance_field "delegate" `Staked (Tez.of_mutez 380_000_000_000L)
+  --> transfer
+        "faucet2"
+        "delegator_to_fund"
+        (Amount (Tez.of_mutez 3_600_000_000_000L))
+  (* Delegate is now overdelegated, it will freeze 100% *)
+  --> next_cycle
+  --> check_balance_field "delegate" `Staked (Tez.of_mutez 400_000_000_000L)
+  --> transfer
+        "faucet3"
+        "delegator_to_fund"
+        (Amount (Tez.of_mutez 3_600_000_000_000L))
+  (* Delegate is overmegadelegated *)
+  --> next_cycle
+  --> check_balance_field "delegate" `Staked (Tez.of_mutez 400_000_000_000L)
+
+let tests =
+  tests_of_scenarios
+    [
+      ("Test auto-staking", test_autostaking);
+      ("Test auto-staking with overdelegation", test_overdelegation);
+    ]
+
+let () =
+  Alcotest_lwt.run ~__FILE__ Protocol.name [("protocol autostaking", tests)]
+  |> Lwt_main.run
-- 
GitLab


From 192b95caaf4b7661f3253b2cd95c3bf7505d91db Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Tue, 20 Feb 2024 14:04:17 +0100
Subject: [PATCH 14/18] Proto/tests: move slashing tests in dedicated file

---
 manifest/main.ml                              |   3 +-
 .../lib_protocol/test/integration/dune        |   2 +-
 .../test_adaptive_issuance_roundtrip.ml       | 472 ------------------
 .../integration/test_scenario_slashing.ml     | 452 +++++++++++++++++
 4 files changed, 455 insertions(+), 474 deletions(-)
 delete mode 100644 src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
 create mode 100644 src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml

diff --git a/manifest/main.ml b/manifest/main.ml
index 8e1bf561b649..710b4048a4e2 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -5420,11 +5420,12 @@ end = struct
             ("test_constants", true);
             ("test_frozen_bonds", true);
             ("test_adaptive_issuance_launch", N.(number >= 018));
-            ("test_adaptive_issuance_roundtrip", N.(number >= 018));
+            ("test_adaptive_issuance_roundtrip", N.(number == 018));
             ("test_scenario_base", N.(number >= 019));
             ("test_scenario_stake", N.(number >= 019));
             ("test_scenario_rewards", N.(number >= 019));
             ("test_scenario_autostaking", N.(number >= 019));
+            ("test_scenario_slashing", N.(number >= 019));
             ("test_liquidity_baking", true);
             ("test_storage_functions", true);
             ("test_storage", true);
diff --git a/src/proto_alpha/lib_protocol/test/integration/dune b/src/proto_alpha/lib_protocol/test/integration/dune
index df5f72490b91..a315fb786dae 100644
--- a/src/proto_alpha/lib_protocol/test/integration/dune
+++ b/src/proto_alpha/lib_protocol/test/integration/dune
@@ -32,11 +32,11 @@
   test_constants
   test_frozen_bonds
   test_adaptive_issuance_launch
-  test_adaptive_issuance_roundtrip
   test_scenario_base
   test_scenario_stake
   test_scenario_rewards
   test_scenario_autostaking
+  test_scenario_slashing
   test_liquidity_baking
   test_storage_functions
   test_storage
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
deleted file mode 100644
index d123109a343e..000000000000
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_roundtrip.ml
+++ /dev/null
@@ -1,472 +0,0 @@
-(*****************************************************************************)
-(*                                                                           *)
-(* Open Source License                                                       *)
-(* Copyright (c) 2023 Nomadic Labs <contact@nomadic-labs.com>                *)
-(*                                                                           *)
-(* Permission is hereby granted, free of charge, to any person obtaining a   *)
-(* copy of this software and associated documentation files (the "Software"),*)
-(* to deal in the Software without restriction, including without limitation *)
-(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
-(* and/or sell copies of the Software, and to permit persons to whom the     *)
-(* Software is furnished to do so, subject to the following conditions:      *)
-(*                                                                           *)
-(* The above copyright notice and this permission notice shall be included   *)
-(* in all copies or substantial portions of the Software.                    *)
-(*                                                                           *)
-(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
-(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
-(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
-(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
-(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
-(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
-(* DEALINGS IN THE SOFTWARE.                                                 *)
-(*                                                                           *)
-(*****************************************************************************)
-
-(** Testing
-    -------
-    Component:    Adaptive Issuance, launch vote
-    Invocation:   dune exec src/proto_alpha/lib_protocol/test/integration/main.exe \
-                   -- --file test_adaptive_issuance_roundtrip.ml
-    Subject:      Test staking stability under Adaptive Issuance.
-*)
-
-open Adaptive_issuance_helpers
-open State_account
-open Log_helper
-open Test_tez.Ez_tez
-open Scenario_dsl
-open Scenario_base
-open Scenario_op
-open Test_scenario_base
-
-let fs = Format.asprintf
-
-module Slashing = struct
-  let test_simple_slash =
-    let constants = init_constants ~autostaking_enable:false () in
-    let any_slash delegate =
-      Tag "double baking" --> double_bake delegate
-      |+ Tag "double attesting"
-         --> double_attest ~other_bakers:("bootstrap2", "bootstrap3") delegate
-      |+ Tag "double preattesting"
-         --> double_preattest
-               ~other_bakers:("bootstrap2", "bootstrap3")
-               delegate
-    in
-    begin_test
-      ~activate_ai:true
-      ~ns_enable_fork:true
-      ~constants
-      ["delegate"; "bootstrap1"; "bootstrap2"; "bootstrap3"]
-    --> (Tag "No AI" --> next_cycle
-        |+ Tag "Yes AI" --> next_block --> wait_ai_activation)
-    --> any_slash "delegate"
-    --> snapshot_balances "before slash" ["delegate"]
-    --> ((Tag "denounce same cycle"
-          --> make_denunciations ()
-              (* delegate can be forbidden in this case, so we set another baker *)
-          --> exclude_bakers ["delegate"]
-         |+ Tag "denounce next cycle" --> next_cycle --> make_denunciations ()
-            (* delegate can be forbidden in this case, so we set another baker *)
-            --> exclude_bakers ["delegate"])
-         --> (Empty
-             |+ Tag "another slash" --> any_slash "bootstrap1"
-                --> make_denunciations ()
-                (* bootstrap1 can be forbidden in this case, so we set another baker *)
-                --> exclude_bakers ["delegate"; "bootstrap1"])
-         --> check_snapshot_balances "before slash"
-         --> exec_unit (check_pending_slashings ~loc:__LOC__)
-         --> next_cycle
-         --> assert_failure
-               (exec_unit (fun (_block, state) ->
-                    if state.State.constants.adaptive_issuance.ns_enable then
-                      failwith "ns_enable = true: slash not applied yet"
-                    else return_unit)
-               --> check_snapshot_balances "before slash")
-         --> exec_unit (check_pending_slashings ~loc:__LOC__)
-         --> next_cycle
-        |+ Tag "denounce too late" --> next_cycle --> next_cycle
-           --> assert_failure
-                 ~expected_error:(fun (_block, state) ->
-                   let ds = state.State.double_signings in
-                   let ds = match ds with [a] -> a | _ -> assert false in
-                   let level =
-                     Protocol.Alpha_context.Raw_level.Internal_for_tests
-                     .from_repr
-                       ds.misbehaviour.level
-                   in
-                   let last_cycle =
-                     Cycle.add
-                       (Block.current_cycle_of_level
-                          ~blocks_per_cycle:
-                            state.State.constants.blocks_per_cycle
-                          ~current_level:
-                            (Protocol.Raw_level_repr.to_int32
-                               ds.misbehaviour.level))
-                       Protocol.Constants_repr.max_slashing_period
-                   in
-                   let (kind : Protocol.Alpha_context.Misbehaviour.kind) =
-                     (* This conversion would not be needed if
-                        Misbehaviour_repr.kind were moved to a
-                        separate file that doesn't have under/over
-                        Alpha_context versions. *)
-                     match ds.misbehaviour.kind with
-                     | Double_baking -> Double_baking
-                     | Double_attesting -> Double_attesting
-                     | Double_preattesting -> Double_preattesting
-                   in
-                   [
-                     Environment.Ecoproto_error
-                       (Protocol.Validate_errors.Anonymous.Outdated_denunciation
-                          {kind; level; last_cycle});
-                   ])
-                 (make_denunciations ())
-           --> check_snapshot_balances "before slash")
-
-  let check_is_forbidden baker = assert_failure (next_block_with_baker baker)
-
-  let check_is_not_forbidden baker =
-    let open Lwt_result_syntax in
-    exec (fun ((block, state) as input) ->
-        let baker = State.find_account baker state in
-        let*! _ = Block.bake ~policy:(By_account baker.pkh) block in
-        return input)
-
-  let test_delegate_forbidden =
-    let constants =
-      init_constants ~blocks_per_cycle:30l ~autostaking_enable:false ()
-    in
-    begin_test
-      ~activate_ai:false
-      ~ns_enable_fork:true
-      ~constants
-      ["delegate"; "bootstrap1"; "bootstrap2"]
-    --> set_baker "bootstrap1"
-    --> (Tag "Many double bakes"
-         --> loop_action 14 (double_bake_ "delegate")
-         --> (Tag "14 double bakes are not enough to forbid a delegate"
-              (*  7*14 = 98 *)
-              --> make_denunciations ()
-              --> check_is_not_forbidden "delegate"
-             |+ Tag "15 double bakes is one too many"
-                (*  7*15 = 105 > 100 *)
-                --> double_bake "delegate"
-                --> make_denunciations ()
-                --> check_is_forbidden "delegate")
-        |+ Tag "Is forbidden after first denunciation"
-           --> double_attest "delegate"
-           --> (Tag "very early first denounce" --> make_denunciations ()
-               --> (Tag "in same cycle" --> Empty
-                   |+ Tag "next cycle" --> next_cycle)
-               --> check_is_forbidden "delegate")
-        |+ Tag "Is unforbidden after 7 cycles" --> double_attest "delegate"
-           --> make_denunciations ()
-           --> exclude_bakers ["delegate"]
-           --> check_is_forbidden "delegate"
-           --> stake "delegate" Half
-           --> check_is_not_forbidden "delegate"
-        |+ Tag
-             "Two double attestations, in consecutive cycles, denounce out of \
-              order" --> double_attest "delegate" --> next_cycle
-           --> double_attest "delegate"
-           --> make_denunciations
-                 ~filter:(fun {denounced; misbehaviour = {level; _}; _} ->
-                   (not denounced)
-                   && Protocol.Raw_level_repr.to_int32 level > 10l)
-                 ()
-           --> make_denunciations
-                 ~filter:(fun {denounced; misbehaviour = {level; _}; _} ->
-                   (not denounced)
-                   && Protocol.Raw_level_repr.to_int32 level <= 10l)
-                 ()
-           --> check_is_forbidden "delegate")
-
-  let test_slash_unstake =
-    let constants = init_constants ~autostaking_enable:false () in
-    begin_test
-      ~activate_ai:false
-      ~ns_enable_fork:true
-      ~constants
-      ["delegate"; "bootstrap1"; "bootstrap2"]
-    --> set_baker "bootstrap1" --> next_cycle --> unstake "delegate" Half
-    --> next_cycle --> double_bake "delegate" --> make_denunciations ()
-    --> (Empty |+ Tag "unstake twice" --> unstake "delegate" Half)
-    --> wait_n_cycles 5
-    --> finalize_unstake "delegate"
-
-  let test_slash_monotonous_stake =
-    let scenario ~offending_op ~op ~early_d =
-      let constants =
-        init_constants ~blocks_per_cycle:16l ~autostaking_enable:false ()
-      in
-      begin_test
-        ~activate_ai:false
-        ~ns_enable_fork:true
-        ~constants
-        ["delegate"; "bootstrap1"]
-      --> next_cycle
-      --> loop
-            6
-            (op "delegate" (Amount (Tez.of_mutez 1_000_000_000L)) --> next_cycle)
-      --> offending_op "delegate"
-      --> (op "delegate" (Amount (Tez.of_mutez 1_000_000_000L))
-          --> loop
-                2
-                (op "delegate" (Amount (Tez.of_mutez 1_000_000_000L))
-                -->
-                if early_d then
-                  make_denunciations ()
-                  --> exclude_bakers ["delegate"]
-                  --> next_block
-                else offending_op "delegate" --> next_block))
-    in
-    Tag "slashes with increasing stake"
-    --> (Tag "denounce early"
-         --> (Tag "Double Bake"
-              --> scenario ~offending_op:double_bake ~op:stake ~early_d:true
-             |+ Tag "Double attest"
-                --> scenario ~offending_op:double_attest ~op:stake ~early_d:true
-             )
-        |+ Tag "denounce late"
-           --> (Tag "Double Bake"
-                --> scenario ~offending_op:double_bake ~op:stake ~early_d:false
-               |+ Tag "Double attest"
-                  --> scenario
-                        ~offending_op:double_attest
-                        ~op:stake
-                        ~early_d:false)
-           --> make_denunciations ())
-    |+ Tag "slashes with decreasing stake"
-       --> (Tag "Double Bake"
-            --> scenario ~offending_op:double_bake ~op:unstake ~early_d:true
-           |+ Tag "Double attest"
-              --> scenario ~offending_op:double_attest ~op:unstake ~early_d:true
-           )
-    |+ Tag "denounce late"
-       --> (Tag "Double Bake"
-            --> scenario ~offending_op:double_bake ~op:unstake ~early_d:false
-           |+ Tag "Double attest"
-              --> scenario
-                    ~offending_op:double_attest
-                    ~op:unstake
-                    ~early_d:false)
-       --> make_denunciations ()
-
-  let test_slash_timing =
-    let constants =
-      init_constants ~blocks_per_cycle:8l ~autostaking_enable:false ()
-    in
-    begin_test ~activate_ai:false ~ns_enable_fork:true ~constants ["delegate"]
-    --> next_cycle
-    --> (Tag "stake" --> stake "delegate" Half
-        |+ Tag "unstake" --> unstake "delegate" Half)
-    --> (Tag "with a first slash" --> double_bake "delegate"
-         --> make_denunciations ()
-        |+ Tag "without another slash" --> Empty)
-    --> List.fold_left
-          (fun acc i ->
-            acc |+ Tag (string_of_int i ^ " cycles lag") --> wait_n_cycles i)
-          Empty
-          [3; 4; 5; 6]
-    --> double_bake "delegate" --> make_denunciations () --> next_cycle
-
-  let init_scenario_with_delegators delegate_name faucet_name delegators_list =
-    let constants = init_constants ~autostaking_enable:false () in
-    let rec init_delegators = function
-      | [] -> Empty
-      | (delegator, amount) :: t ->
-          add_account_with_funds
-            delegator
-            faucet_name
-            (Amount (Tez.of_mutez amount))
-          --> set_delegate delegator (Some delegate_name)
-          --> init_delegators t
-    in
-    let init_params =
-      {
-        limit_of_staking_over_baking = Q.one;
-        edge_of_baking_over_staking = Q.one;
-      }
-    in
-    begin_test
-      ~activate_ai:true
-      ~ns_enable_fork:true
-      ~constants
-      [delegate_name; faucet_name]
-    --> set_baker faucet_name
-    --> set_delegate_params "delegate" init_params
-    --> init_delegators delegators_list
-    --> next_block --> wait_ai_activation
-
-  let test_many_slashes =
-    let rec stake_unstake_for = function
-      | [] -> Empty
-      | staker :: t ->
-          stake staker Half --> unstake staker Half --> stake_unstake_for t
-    in
-    let slash delegate = double_bake delegate --> make_denunciations () in
-    Tag "double bake"
-    --> (Tag "solo delegate"
-        --> init_scenario_with_delegators
-              "delegate"
-              "faucet"
-              [("delegator", 1_234_567_891L)]
-        --> loop
-              10
-              (stake_unstake_for ["delegate"]
-              --> slash "delegate" --> next_cycle))
-  (* |+ Tag "delegate with one staker"
-        --> init_scenario_with_delegators
-              "delegate"
-              "faucet"
-              [("staker", 1_234_356_891L)]
-        --> loop
-              10
-              (stake_unstake_for ["delegate"; "staker"]
-              --> slash "delegate" --> next_cycle)
-     |+ Tag "delegate with three stakers"
-        --> init_scenario_with_delegators
-              "delegate"
-              "faucet"
-              [
-                ("staker1", 1_234_356_891L);
-                ("staker2", 1_234_356_890L);
-                ("staker3", 1_723_333_111L);
-              ]
-        --> loop
-              10
-              (stake_unstake_for
-                 ["delegate"; "staker1"; "staker2"; "staker3"]
-              --> slash "delegate" --> next_cycle))*)
-
-  let test_no_shortcut_for_cheaters =
-    let constants = init_constants ~autostaking_enable:false () in
-    let amount = Amount (Tez.of_mutez 333_000_000_000L) in
-    let consensus_rights_delay = constants.consensus_rights_delay in
-    begin_test
-      ~activate_ai:true
-      ~ns_enable_fork:false
-      ~constants
-      ["delegate"; "bootstrap1"]
-    --> next_block --> wait_ai_activation
-    --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
-    --> next_cycle --> double_bake "delegate" --> make_denunciations ()
-    --> set_baker "bootstrap1" (* exclude_bakers ["delegate"] *)
-    --> next_cycle
-    --> snapshot_balances "init" ["delegate"]
-    --> unstake "delegate" amount
-    --> (List.fold_left
-           (fun acc i -> acc |+ Tag (fs "wait %i cycles" i) --> wait_n_cycles i)
-           (Tag "wait 0 cycles" --> Empty)
-           (Stdlib.List.init (consensus_rights_delay - 1) (fun i -> i + 1))
-         --> stake "delegate" amount
-         --> assert_failure (check_snapshot_balances "init")
-        |+ Tag "wait enough cycles (consensus_rights_delay + 1)"
-           --> wait_n_cycles (consensus_rights_delay + 1)
-           --> stake "delegate" amount
-           --> check_snapshot_balances "init")
-
-  let test_slash_correct_amount_after_stake_from_unstake =
-    let constants = init_constants ~autostaking_enable:false () in
-    let amount_to_unstake = Amount (Tez.of_mutez 200_000_000_000L) in
-    let amount_to_restake = Amount (Tez.of_mutez 100_000_000_000L) in
-    let amount_expected_in_unstake_after_slash = Tez.of_mutez 50_000_000_000L in
-    let consensus_rights_delay = constants.consensus_rights_delay in
-    begin_test
-      ~activate_ai:true
-      ~ns_enable_fork:false
-      ~constants
-      ["delegate"; "bootstrap1"]
-    --> next_block --> wait_ai_activation
-    --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
-    --> next_cycle
-    --> unstake "delegate" amount_to_unstake
-    --> stake "delegate" amount_to_restake
-    --> List.fold_left
-          (fun acc i -> acc |+ Tag (fs "wait %i cycles" i) --> wait_n_cycles i)
-          (Tag "wait 0 cycles" --> Empty)
-          (Stdlib.List.init (consensus_rights_delay - 2) (fun i -> i + 1))
-    --> double_attest "delegate" --> make_denunciations ()
-    --> exclude_bakers ["delegate"]
-    --> next_cycle
-    --> check_balance_field
-          "delegate"
-          `Unstaked_frozen_total
-          amount_expected_in_unstake_after_slash
-
-  (* Test a non-zero request finalizes for a non-zero amount if it hasn't been slashed 100% *)
-  let test_mini_slash =
-    let constants = init_constants ~autostaking_enable:false () in
-    (Tag "Yes AI"
-     --> begin_test
-           ~activate_ai:true
-           ~ns_enable_fork:false
-           ~constants
-           ["delegate"; "baker"]
-     --> next_block --> wait_ai_activation
-    |+ Tag "No AI"
-       --> begin_test
-             ~activate_ai:false
-             ~ns_enable_fork:false
-             ~constants
-             ["delegate"; "baker"])
-    --> unstake "delegate" (Amount Tez.one_mutez)
-    --> set_baker "baker" --> next_cycle
-    --> (Tag "5% slash" --> double_bake "delegate" --> make_denunciations ()
-        |+ Tag "95% slash" --> next_cycle --> double_attest "delegate"
-           --> loop 9 (double_bake "delegate")
-           --> make_denunciations ())
-    (* Wait two cycles because of ns_enable *)
-    --> next_cycle
-    --> next_cycle
-    --> check_balance_field "delegate" `Unstaked_frozen_total Tez.zero
-    --> wait_n_cycles (constants.consensus_rights_delay + 1)
-
-  let test_slash_rounding =
-    let constants = init_constants ~autostaking_enable:false () in
-    begin_test
-      ~activate_ai:true
-      ~ns_enable_fork:true
-      ~constants
-      ["delegate"; "baker"]
-    --> set_baker "baker" --> next_block --> wait_ai_activation
-    --> unstake "delegate" (Amount (Tez.of_mutez 2L))
-    --> next_cycle --> double_bake "delegate" --> double_bake "delegate"
-    --> make_denunciations () --> wait_n_cycles 7
-    --> finalize_unstake "delegate"
-
-  (* TODO #6645: reactivate tests *)
-  let tests =
-    tests_of_scenarios
-    @@ [
-         ("Test simple slashing", test_simple_slash);
-         ("Test slashed is forbidden", test_delegate_forbidden);
-         ("Test slash with unstake", test_slash_unstake);
-         (* TODO: make sure this test passes with blocks_per_cycle:8l
-            https://gitlab.com/tezos/tezos/-/issues/6904 *)
-         ("Test slashes with simple varying stake", test_slash_monotonous_stake);
-         (* This test has been deactivated following the changes of the
-            forbidding mechanism that now forbids delegates right after the
-            first denunciation, it should be fixed and reactivated
-            https://gitlab.com/tezos/tezos/-/issues/6904 *)
-         (* ( "Test multiple slashes with multiple stakes/unstakes", *)
-         (*   test_many_slashes ); *)
-         (* ("Test slash timing", test_slash_timing); *)
-         ( "Test stake from unstake deactivated when slashed",
-           test_no_shortcut_for_cheaters );
-         ( "Test stake from unstake reduce initial amount",
-           test_slash_correct_amount_after_stake_from_unstake );
-         ("Test unstake 1 mutez then slash", test_mini_slash);
-         ("Test slash rounding", test_slash_rounding);
-       ]
-end
-
-let tests = Slashing.tests
-
-let () =
-  Alcotest_lwt.run
-    ~__FILE__
-    Protocol.name
-    [("adaptive issuance roundtrip", tests)]
-  |> Lwt_main.run
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml
new file mode 100644
index 000000000000..2343ac1f6632
--- /dev/null
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml
@@ -0,0 +1,452 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2023 Nomadic Labs <contact@nomadic-labs.com>                *)
+(*                                                                           *)
+(* Permission is hereby granted, free of charge, to any person obtaining a   *)
+(* copy of this software and associated documentation files (the "Software"),*)
+(* to deal in the Software without restriction, including without limitation *)
+(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
+(* and/or sell copies of the Software, and to permit persons to whom the     *)
+(* Software is furnished to do so, subject to the following conditions:      *)
+(*                                                                           *)
+(* The above copyright notice and this permission notice shall be included   *)
+(* in all copies or substantial portions of the Software.                    *)
+(*                                                                           *)
+(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
+(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
+(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
+(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
+(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
+(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
+(* DEALINGS IN THE SOFTWARE.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Testing
+    -------
+    Component:    Adaptive Issuance, Slashing
+    Invocation:   dune exec src/proto_alpha/lib_protocol/test/integration/main.exe \
+                   -- --file test_scenario_slashing.ml
+    Subject:      Test slashing scenarios in the protocol.
+*)
+
+open Adaptive_issuance_helpers
+open State_account
+open Test_tez.Ez_tez
+open Scenario_dsl
+open Scenario_base
+open Scenario_op
+open Test_scenario_base
+
+let fs = Format.asprintf
+
+let test_simple_slash =
+  let constants = init_constants ~autostaking_enable:false () in
+  let any_slash delegate =
+    Tag "double baking" --> double_bake delegate
+    |+ Tag "double attesting"
+       --> double_attest ~other_bakers:("bootstrap2", "bootstrap3") delegate
+    |+ Tag "double preattesting"
+       --> double_preattest ~other_bakers:("bootstrap2", "bootstrap3") delegate
+  in
+  begin_test
+    ~activate_ai:true
+    ~ns_enable_fork:true
+    ~constants
+    ["delegate"; "bootstrap1"; "bootstrap2"; "bootstrap3"]
+  --> (Tag "No AI" --> next_cycle
+      |+ Tag "Yes AI" --> next_block --> wait_ai_activation)
+  --> any_slash "delegate"
+  --> snapshot_balances "before slash" ["delegate"]
+  --> ((Tag "denounce same cycle"
+        --> make_denunciations ()
+            (* delegate can be forbidden in this case, so we set another baker *)
+        --> exclude_bakers ["delegate"]
+       |+ Tag "denounce next cycle" --> next_cycle --> make_denunciations ()
+          (* delegate can be forbidden in this case, so we set another baker *)
+          --> exclude_bakers ["delegate"])
+       --> (Empty
+           |+ Tag "another slash" --> any_slash "bootstrap1"
+              --> make_denunciations ()
+              (* bootstrap1 can be forbidden in this case, so we set another baker *)
+              --> exclude_bakers ["delegate"; "bootstrap1"])
+       --> check_snapshot_balances "before slash"
+       --> exec_unit (check_pending_slashings ~loc:__LOC__)
+       --> next_cycle
+       --> assert_failure
+             (exec_unit (fun (_block, state) ->
+                  if state.State.constants.adaptive_issuance.ns_enable then
+                    failwith "ns_enable = true: slash not applied yet"
+                  else return_unit)
+             --> check_snapshot_balances "before slash")
+       --> exec_unit (check_pending_slashings ~loc:__LOC__)
+       --> next_cycle
+      |+ Tag "denounce too late" --> next_cycle --> next_cycle
+         --> assert_failure
+               ~expected_error:(fun (_block, state) ->
+                 let ds = state.State.double_signings in
+                 let ds = match ds with [a] -> a | _ -> assert false in
+                 let level =
+                   Protocol.Alpha_context.Raw_level.Internal_for_tests.from_repr
+                     ds.misbehaviour.level
+                 in
+                 let last_cycle =
+                   Cycle.add
+                     (Block.current_cycle_of_level
+                        ~blocks_per_cycle:state.State.constants.blocks_per_cycle
+                        ~current_level:
+                          (Protocol.Raw_level_repr.to_int32
+                             ds.misbehaviour.level))
+                     Protocol.Constants_repr.max_slashing_period
+                 in
+                 let (kind : Protocol.Alpha_context.Misbehaviour.kind) =
+                   (* This conversion would not be needed if
+                      Misbehaviour_repr.kind were moved to a
+                      separate file that doesn't have under/over
+                      Alpha_context versions. *)
+                   match ds.misbehaviour.kind with
+                   | Double_baking -> Double_baking
+                   | Double_attesting -> Double_attesting
+                   | Double_preattesting -> Double_preattesting
+                 in
+                 [
+                   Environment.Ecoproto_error
+                     (Protocol.Validate_errors.Anonymous.Outdated_denunciation
+                        {kind; level; last_cycle});
+                 ])
+               (make_denunciations ())
+         --> check_snapshot_balances "before slash")
+
+let check_is_forbidden baker = assert_failure (next_block_with_baker baker)
+
+let check_is_not_forbidden baker =
+  let open Lwt_result_syntax in
+  exec (fun ((block, state) as input) ->
+      let baker = State.find_account baker state in
+      let*! _ = Block.bake ~policy:(By_account baker.pkh) block in
+      return input)
+
+let test_delegate_forbidden =
+  let constants =
+    init_constants ~blocks_per_cycle:30l ~autostaking_enable:false ()
+  in
+  begin_test
+    ~activate_ai:false
+    ~ns_enable_fork:true
+    ~constants
+    ["delegate"; "bootstrap1"; "bootstrap2"]
+  --> set_baker "bootstrap1"
+  --> (Tag "Many double bakes"
+       --> loop_action 14 (double_bake_ "delegate")
+       --> (Tag "14 double bakes are not enough to forbid a delegate"
+            (*  7*14 = 98 *)
+            --> make_denunciations ()
+            --> check_is_not_forbidden "delegate"
+           |+ Tag "15 double bakes is one too many"
+              (*  7*15 = 105 > 100 *)
+              --> double_bake "delegate"
+              --> make_denunciations ()
+              --> check_is_forbidden "delegate")
+      |+ Tag "Is forbidden after first denunciation"
+         --> double_attest "delegate"
+         --> (Tag "very early first denounce" --> make_denunciations ()
+             --> (Tag "in same cycle" --> Empty
+                 |+ Tag "next cycle" --> next_cycle)
+             --> check_is_forbidden "delegate")
+      |+ Tag "Is unforbidden after 7 cycles" --> double_attest "delegate"
+         --> make_denunciations ()
+         --> exclude_bakers ["delegate"]
+         --> check_is_forbidden "delegate"
+         --> stake "delegate" Half
+         --> check_is_not_forbidden "delegate"
+      |+ Tag
+           "Two double attestations, in consecutive cycles, denounce out of \
+            order" --> double_attest "delegate" --> next_cycle
+         --> double_attest "delegate"
+         --> make_denunciations
+               ~filter:(fun {denounced; misbehaviour = {level; _}; _} ->
+                 (not denounced) && Protocol.Raw_level_repr.to_int32 level > 10l)
+               ()
+         --> make_denunciations
+               ~filter:(fun {denounced; misbehaviour = {level; _}; _} ->
+                 (not denounced)
+                 && Protocol.Raw_level_repr.to_int32 level <= 10l)
+               ()
+         --> check_is_forbidden "delegate")
+
+let test_slash_unstake =
+  let constants = init_constants ~autostaking_enable:false () in
+  begin_test
+    ~activate_ai:false
+    ~ns_enable_fork:true
+    ~constants
+    ["delegate"; "bootstrap1"; "bootstrap2"]
+  --> set_baker "bootstrap1" --> next_cycle --> unstake "delegate" Half
+  --> next_cycle --> double_bake "delegate" --> make_denunciations ()
+  --> (Empty |+ Tag "unstake twice" --> unstake "delegate" Half)
+  --> wait_n_cycles 5
+  --> finalize_unstake "delegate"
+
+let test_slash_monotonous_stake =
+  let scenario ~offending_op ~op ~early_d =
+    let constants =
+      init_constants ~blocks_per_cycle:16l ~autostaking_enable:false ()
+    in
+    begin_test
+      ~activate_ai:false
+      ~ns_enable_fork:true
+      ~constants
+      ["delegate"; "bootstrap1"]
+    --> next_cycle
+    --> loop
+          6
+          (op "delegate" (Amount (Tez.of_mutez 1_000_000_000L)) --> next_cycle)
+    --> offending_op "delegate"
+    --> (op "delegate" (Amount (Tez.of_mutez 1_000_000_000L))
+        --> loop
+              2
+              (op "delegate" (Amount (Tez.of_mutez 1_000_000_000L))
+              -->
+              if early_d then
+                make_denunciations ()
+                --> exclude_bakers ["delegate"]
+                --> next_block
+              else offending_op "delegate" --> next_block))
+  in
+  Tag "slashes with increasing stake"
+  --> (Tag "denounce early"
+       --> (Tag "Double Bake"
+            --> scenario ~offending_op:double_bake ~op:stake ~early_d:true
+           |+ Tag "Double attest"
+              --> scenario ~offending_op:double_attest ~op:stake ~early_d:true)
+      |+ Tag "denounce late"
+         --> (Tag "Double Bake"
+              --> scenario ~offending_op:double_bake ~op:stake ~early_d:false
+             |+ Tag "Double attest"
+                --> scenario
+                      ~offending_op:double_attest
+                      ~op:stake
+                      ~early_d:false)
+         --> make_denunciations ())
+  |+ Tag "slashes with decreasing stake"
+     --> (Tag "Double Bake"
+          --> scenario ~offending_op:double_bake ~op:unstake ~early_d:true
+         |+ Tag "Double attest"
+            --> scenario ~offending_op:double_attest ~op:unstake ~early_d:true)
+  |+ Tag "denounce late"
+     --> (Tag "Double Bake"
+          --> scenario ~offending_op:double_bake ~op:unstake ~early_d:false
+         |+ Tag "Double attest"
+            --> scenario ~offending_op:double_attest ~op:unstake ~early_d:false
+         )
+     --> make_denunciations ()
+
+let test_slash_timing =
+  let constants =
+    init_constants ~blocks_per_cycle:8l ~autostaking_enable:false ()
+  in
+  begin_test ~activate_ai:false ~ns_enable_fork:true ~constants ["delegate"]
+  --> next_cycle
+  --> (Tag "stake" --> stake "delegate" Half
+      |+ Tag "unstake" --> unstake "delegate" Half)
+  --> (Tag "with a first slash" --> double_bake "delegate"
+       --> make_denunciations ()
+      |+ Tag "without another slash" --> Empty)
+  --> List.fold_left
+        (fun acc i ->
+          acc |+ Tag (string_of_int i ^ " cycles lag") --> wait_n_cycles i)
+        Empty
+        [3; 4; 5; 6]
+  --> double_bake "delegate" --> make_denunciations () --> next_cycle
+
+let init_scenario_with_delegators delegate_name faucet_name delegators_list =
+  let constants = init_constants ~autostaking_enable:false () in
+  let rec init_delegators = function
+    | [] -> Empty
+    | (delegator, amount) :: t ->
+        add_account_with_funds
+          delegator
+          faucet_name
+          (Amount (Tez.of_mutez amount))
+        --> set_delegate delegator (Some delegate_name)
+        --> init_delegators t
+  in
+  let init_params =
+    {limit_of_staking_over_baking = Q.one; edge_of_baking_over_staking = Q.one}
+  in
+  begin_test
+    ~activate_ai:true
+    ~ns_enable_fork:true
+    ~constants
+    [delegate_name; faucet_name]
+  --> set_baker faucet_name
+  --> set_delegate_params "delegate" init_params
+  --> init_delegators delegators_list
+  --> next_block --> wait_ai_activation
+
+let test_many_slashes =
+  let rec stake_unstake_for = function
+    | [] -> Empty
+    | staker :: t ->
+        stake staker Half --> unstake staker Half --> stake_unstake_for t
+  in
+  let slash delegate = double_bake delegate --> make_denunciations () in
+  Tag "double bake"
+  --> (Tag "solo delegate"
+      --> init_scenario_with_delegators
+            "delegate"
+            "faucet"
+            [("delegator", 1_234_567_891L)]
+      --> loop
+            10
+            (stake_unstake_for ["delegate"] --> slash "delegate" --> next_cycle)
+      )
+(* |+ Tag "delegate with one staker"
+      --> init_scenario_with_delegators
+            "delegate"
+            "faucet"
+            [("staker", 1_234_356_891L)]
+      --> loop
+            10
+            (stake_unstake_for ["delegate"; "staker"]
+            --> slash "delegate" --> next_cycle)
+   |+ Tag "delegate with three stakers"
+      --> init_scenario_with_delegators
+            "delegate"
+            "faucet"
+            [
+              ("staker1", 1_234_356_891L);
+              ("staker2", 1_234_356_890L);
+              ("staker3", 1_723_333_111L);
+            ]
+      --> loop
+            10
+            (stake_unstake_for
+               ["delegate"; "staker1"; "staker2"; "staker3"]
+            --> slash "delegate" --> next_cycle))*)
+
+let test_no_shortcut_for_cheaters =
+  let constants = init_constants ~autostaking_enable:false () in
+  let amount = Amount (Tez.of_mutez 333_000_000_000L) in
+  let consensus_rights_delay = constants.consensus_rights_delay in
+  begin_test
+    ~activate_ai:true
+    ~ns_enable_fork:false
+    ~constants
+    ["delegate"; "bootstrap1"]
+  --> next_block --> wait_ai_activation
+  --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
+  --> next_cycle --> double_bake "delegate" --> make_denunciations ()
+  --> set_baker "bootstrap1" (* exclude_bakers ["delegate"] *)
+  --> next_cycle
+  --> snapshot_balances "init" ["delegate"]
+  --> unstake "delegate" amount
+  --> (List.fold_left
+         (fun acc i -> acc |+ Tag (fs "wait %i cycles" i) --> wait_n_cycles i)
+         (Tag "wait 0 cycles" --> Empty)
+         (Stdlib.List.init (consensus_rights_delay - 1) (fun i -> i + 1))
+       --> stake "delegate" amount
+       --> assert_failure (check_snapshot_balances "init")
+      |+ Tag "wait enough cycles (consensus_rights_delay + 1)"
+         --> wait_n_cycles (consensus_rights_delay + 1)
+         --> stake "delegate" amount
+         --> check_snapshot_balances "init")
+
+let test_slash_correct_amount_after_stake_from_unstake =
+  let constants = init_constants ~autostaking_enable:false () in
+  let amount_to_unstake = Amount (Tez.of_mutez 200_000_000_000L) in
+  let amount_to_restake = Amount (Tez.of_mutez 100_000_000_000L) in
+  let amount_expected_in_unstake_after_slash = Tez.of_mutez 50_000_000_000L in
+  let consensus_rights_delay = constants.consensus_rights_delay in
+  begin_test
+    ~activate_ai:true
+    ~ns_enable_fork:false
+    ~constants
+    ["delegate"; "bootstrap1"]
+  --> next_block --> wait_ai_activation
+  --> stake "delegate" (Amount (Tez.of_mutez 1_800_000_000_000L))
+  --> next_cycle
+  --> unstake "delegate" amount_to_unstake
+  --> stake "delegate" amount_to_restake
+  --> List.fold_left
+        (fun acc i -> acc |+ Tag (fs "wait %i cycles" i) --> wait_n_cycles i)
+        (Tag "wait 0 cycles" --> Empty)
+        (Stdlib.List.init (consensus_rights_delay - 2) (fun i -> i + 1))
+  --> double_attest "delegate" --> make_denunciations ()
+  --> exclude_bakers ["delegate"]
+  --> next_cycle
+  --> check_balance_field
+        "delegate"
+        `Unstaked_frozen_total
+        amount_expected_in_unstake_after_slash
+
+(* Test a non-zero request finalizes for a non-zero amount if it hasn't been slashed 100% *)
+let test_mini_slash =
+  let constants = init_constants ~autostaking_enable:false () in
+  (Tag "Yes AI"
+   --> begin_test
+         ~activate_ai:true
+         ~ns_enable_fork:false
+         ~constants
+         ["delegate"; "baker"]
+   --> next_block --> wait_ai_activation
+  |+ Tag "No AI"
+     --> begin_test
+           ~activate_ai:false
+           ~ns_enable_fork:false
+           ~constants
+           ["delegate"; "baker"])
+  --> unstake "delegate" (Amount Tez.one_mutez)
+  --> set_baker "baker" --> next_cycle
+  --> (Tag "5% slash" --> double_bake "delegate" --> make_denunciations ()
+      |+ Tag "95% slash" --> next_cycle --> double_attest "delegate"
+         --> loop 9 (double_bake "delegate")
+         --> make_denunciations ())
+  (* Wait two cycles because of ns_enable *)
+  --> next_cycle
+  --> next_cycle
+  --> check_balance_field "delegate" `Unstaked_frozen_total Tez.zero
+  --> wait_n_cycles (constants.consensus_rights_delay + 1)
+
+let test_slash_rounding =
+  let constants = init_constants ~autostaking_enable:false () in
+  begin_test
+    ~activate_ai:true
+    ~ns_enable_fork:true
+    ~constants
+    ["delegate"; "baker"]
+  --> set_baker "baker" --> next_block --> wait_ai_activation
+  --> unstake "delegate" (Amount (Tez.of_mutez 2L))
+  --> next_cycle --> double_bake "delegate" --> double_bake "delegate"
+  --> make_denunciations () --> wait_n_cycles 7
+  --> finalize_unstake "delegate"
+
+(* TODO #6645: reactivate tests *)
+let tests =
+  tests_of_scenarios
+  @@ [
+       ("Test simple slashing", test_simple_slash);
+       ("Test slashed is forbidden", test_delegate_forbidden);
+       ("Test slash with unstake", test_slash_unstake);
+       (* TODO: make sure this test passes with blocks_per_cycle:8l
+          https://gitlab.com/tezos/tezos/-/issues/6904 *)
+       ("Test slashes with simple varying stake", test_slash_monotonous_stake);
+       (* This test has been deactivated following the changes of the
+          forbidding mechanism that now forbids delegates right after the
+          first denunciation, it should be fixed and reactivated
+          https://gitlab.com/tezos/tezos/-/issues/6904 *)
+       (* ( "Test multiple slashes with multiple stakes/unstakes", *)
+       (*   test_many_slashes ); *)
+       (* ("Test slash timing", test_slash_timing); *)
+       ( "Test stake from unstake deactivated when slashed",
+         test_no_shortcut_for_cheaters );
+       ( "Test stake from unstake reduce initial amount",
+         test_slash_correct_amount_after_stake_from_unstake );
+       ("Test unstake 1 mutez then slash", test_mini_slash);
+       ("Test slash rounding", test_slash_rounding);
+     ]
+
+let () =
+  Alcotest_lwt.run ~__FILE__ Protocol.name [("protocol slashing", tests)]
+  |> Lwt_main.run
-- 
GitLab


From 0817f6cb8ca42761f4ef6726f0f7d45b91cf86c6 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Wed, 21 Feb 2024 11:05:33 +0100
Subject: [PATCH 15/18] Snoop/tests: fix regression tests

---
 src/lib_benchmark/format.ml | 13 +++++++++++++
 1 file changed, 13 insertions(+)
 create mode 100644 src/lib_benchmark/format.ml

diff --git a/src/lib_benchmark/format.ml b/src/lib_benchmark/format.ml
new file mode 100644
index 000000000000..310366d2a83e
--- /dev/null
+++ b/src/lib_benchmark/format.ml
@@ -0,0 +1,13 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* SPDX-License-Identifier: MIT                                              *)
+(* Copyright (c) 2024 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Stdlib.Format
+
+let err_formatter = Stdlib.Format.formatter_of_out_channel Stdlib.stderr
+
+let eprintf (fmt : ('a, formatter, unit) format) : 'a =
+  Stdlib.Format.fprintf err_formatter fmt
-- 
GitLab


From 150433d52ab57961678e53c2fcf9266a09683d64 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Wed, 21 Feb 2024 15:15:23 +0100
Subject: [PATCH 16/18] Proto/tests: rename Test_tez -> Tez_helpers and
 Log_helper+s

---
 .../test/helpers/adaptive_issuance_helpers.ml | 18 +++----
 .../lib_protocol/test/helpers/context.ml      |  2 +-
 .../test/helpers/contract_helpers.ml          |  4 +-
 .../helpers/{log_helper.ml => log_helpers.ml} |  0
 .../lib_protocol/test/helpers/op.ml           |  2 +-
 .../test/helpers/sapling_helpers.ml           |  4 +-
 .../test/helpers/scenario_base.ml             |  2 +-
 .../lib_protocol/test/helpers/scenario_dsl.ml |  2 +-
 .../lib_protocol/test/helpers/scenario_op.ml  |  4 +-
 .../lib_protocol/test/helpers/state.ml        |  6 +--
 .../test/helpers/state_account.ml             |  4 +-
 .../helpers/{test_tez.ml => tez_helpers.ml}   |  0
 .../helpers/{test_tez.mli => tez_helpers.mli} |  0
 .../lib_protocol/test/helpers/transfers.ml    |  2 +-
 .../test/integration/consensus/test_baking.ml | 14 +++---
 .../consensus/test_consensus_key.ml           |  2 +-
 .../consensus/test_deactivation.ml            |  2 +-
 .../integration/consensus/test_delegation.ml  |  5 +-
 .../consensus/test_double_attestation.ml      | 22 +++++----
 .../consensus/test_double_baking.ml           | 22 +++++----
 .../consensus/test_double_preattestation.ml   | 10 ++--
 .../consensus/test_frozen_deposits.ml         | 48 +++++++++----------
 .../consensus/test_participation.ml           |  5 +-
 .../test/integration/consensus/test_seed.ml   | 10 ++--
 .../test/integration/gas/test_gas_levels.ml   |  2 +-
 .../michelson/test_contract_event.ml          |  6 +--
 .../integration/michelson/test_sapling.ml     | 18 +++----
 .../michelson/test_ticket_accounting.ml       |  2 +-
 .../michelson/test_ticket_operations_diff.ml  |  2 +-
 .../integration/operations/test_activation.ml |  4 +-
 .../operations/test_combined_operations.ml    | 26 +++++-----
 .../operations/test_origination.ml            |  2 +-
 .../operations/test_paid_storage_increase.ml  |  6 +--
 .../integration/operations/test_reveal.ml     |  2 +-
 .../integration/operations/test_transfer.ml   |  2 +-
 .../integration/operations/test_voting.ml     | 10 ++--
 .../integration/operations/test_zk_rollup.ml  |  3 +-
 .../test_adaptive_issuance_launch.ml          |  6 +--
 .../test/integration/test_constants.ml        |  2 +-
 .../test/integration/test_frozen_bonds.ml     |  2 +-
 .../test/integration/test_liquidity_baking.ml |  2 +-
 .../integration/test_scenario_autostaking.ml  |  4 +-
 .../test/integration/test_scenario_base.ml    |  2 +-
 .../test/integration/test_scenario_rewards.ml |  2 +-
 .../integration/test_scenario_slashing.ml     |  2 +-
 .../test/integration/test_scenario_stake.ml   |  2 +-
 .../test/integration/test_token.ml            |  2 +-
 .../validate/manager_operation_helpers.ml     |  2 +-
 .../validate/test_validation_batch.ml         |  2 +-
 .../lib_protocol/test/pbt/test_tez_repr.ml    |  2 +-
 .../test/unit/test_adaptive_issuance.ml       |  2 +-
 51 files changed, 161 insertions(+), 148 deletions(-)
 rename src/proto_alpha/lib_protocol/test/helpers/{log_helper.ml => log_helpers.ml} (100%)
 rename src/proto_alpha/lib_protocol/test/helpers/{test_tez.ml => tez_helpers.ml} (100%)
 rename src/proto_alpha/lib_protocol/test/helpers/{test_tez.mli => tez_helpers.mli} (100%)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
index d51c3af22ec4..5220c6ef9f62 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/adaptive_issuance_helpers.ml
@@ -55,7 +55,7 @@ let stake ctxt contract amount =
   Op.transaction
     ctxt
     ~entrypoint:Protocol.Alpha_context.Entrypoint.stake
-    ~fee:Test_tez.zero
+    ~fee:Tez_helpers.zero
     contract
     contract
     amount
@@ -81,25 +81,25 @@ let set_delegate_parameters ctxt delegate
     ctxt
     ~entrypoint
     ~parameters
-    ~fee:Test_tez.zero
+    ~fee:Tez_helpers.zero
     delegate
     delegate
-    Test_tez.zero
+    Tez_helpers.zero
 
 let unstake ctxt contract amount =
   Op.transaction
     ctxt
     ~entrypoint:Protocol.Alpha_context.Entrypoint.unstake
-    ~fee:Test_tez.zero
+    ~fee:Tez_helpers.zero
     contract
     contract
     amount
 
-let finalize_unstake ctxt ?(amount = Test_tez.zero) contract =
+let finalize_unstake ctxt ?(amount = Tez_helpers.zero) contract =
   Op.transaction
     ctxt
     ~entrypoint:Protocol.Alpha_context.Entrypoint.finalize_unstake
-    ~fee:Test_tez.zero
+    ~fee:Tez_helpers.zero
     contract
     contract
     amount
@@ -110,7 +110,7 @@ let portion_of_rewards_to_liquid_for_cycle ?policy ctxt cycle pkh rewards =
     Context.Delegate.stake_for_cycle ?policy ctxt cycle pkh
   in
   let portion =
-    Test_tez.(ratio weighted_delegated (frozen +! weighted_delegated))
+    Tez_helpers.(ratio weighted_delegated (frozen +! weighted_delegated))
   in
-  let to_liquid = Test_tez.mul_q rewards portion in
-  return (Test_tez.of_q ~round:`Down to_liquid)
+  let to_liquid = Tez_helpers.mul_q rewards portion in
+  return (Tez_helpers.of_q ~round:`Down to_liquid)
diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml
index a5f8122cbe84..12d314d5e741 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/context.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml
@@ -266,7 +266,7 @@ let get_bonus_reward ctxt ~attesting_power =
       ~reward_kind:Baking_reward_bonus_per_slot
   in
   let multiplier = max 0 (attesting_power - consensus_threshold) in
-  return Test_tez.(baking_reward_bonus_per_slot *! Int64.of_int multiplier)
+  return Tez_helpers.(baking_reward_bonus_per_slot *! Int64.of_int multiplier)
 
 let get_attesting_reward ctxt ~expected_attesting_power =
   let open Lwt_result_wrap_syntax in
diff --git a/src/proto_alpha/lib_protocol/test/helpers/contract_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/contract_helpers.ml
index 32043ee302b7..1e6974cf1c70 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/contract_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/contract_helpers.ml
@@ -53,7 +53,7 @@ let originate_contract_hash file storage src b baker =
   let open Lwt_result_syntax in
   let script = load_script ~storage file in
   let* operation, dst =
-    Op.contract_origination_hash (B b) src ~fee:(Test_tez.of_int 10) ~script
+    Op.contract_origination_hash (B b) src ~fee:(Tez_helpers.of_int 10) ~script
   in
   let* incr =
     Incremental.begin_construction ~policy:Block.(By_account baker) b
@@ -136,7 +136,7 @@ let originate_contract_from_string_hash ~script ~storage ~source_contract ~baker
     Op.contract_origination_hash
       (B block)
       source_contract
-      ~fee:(Test_tez.of_int 10)
+      ~fee:(Tez_helpers.of_int 10)
       ~script
   in
   let* incr =
diff --git a/src/proto_alpha/lib_protocol/test/helpers/log_helper.ml b/src/proto_alpha/lib_protocol/test/helpers/log_helpers.ml
similarity index 100%
rename from src/proto_alpha/lib_protocol/test/helpers/log_helper.ml
rename to src/proto_alpha/lib_protocol/test/helpers/log_helpers.ml
diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml
index c5273bd4213a..7a625f8c4bc8 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/op.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml
@@ -795,7 +795,7 @@ let dummy_script =
       storage = lazy_expr (strip_locations (Prim ((), D_Unit, [], [])));
     }
 
-let dummy_script_cost = Test_tez.of_mutez 9_500L
+let dummy_script_cost = Tez_helpers.of_mutez 9_500L
 
 let transfer_ticket ?force_reveal ?counter ?fee ?gas_limit ?storage_limit ctxt
     ~(source : Contract.t) ~contents ~ty ~ticketer ~amount ~destination
diff --git a/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml
index 5e058258d5e1..25100ebcb406 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml
@@ -417,9 +417,9 @@ module Interpreter_helpers = struct
   let transac_and_sync ~memo_size block parameters amount src dst baker =
     let open Lwt_result_syntax in
     let amount_tez =
-      Test_tez.(Alpha_context.Tez.one_mutez *! Int64.of_int amount)
+      Tez_helpers.(Alpha_context.Tez.one_mutez *! Int64.of_int amount)
     in
-    let fee = Test_tez.of_int 10 in
+    let fee = Tez_helpers.of_int 10 in
     let* operation =
       Op.transaction
         ~gas_limit:Max
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 94abe05397aa..d49ff3c10402 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
@@ -8,7 +8,7 @@
 open State_account
 open State
 open Scenario_dsl
-open Log_helper
+open Log_helpers
 open Adaptive_issuance_helpers
 
 (** Returns when the number of bootstrap accounts created by [Context.init_n n] is not equal to [n] *)
diff --git a/src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml b/src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml
index f87962cf52f3..efaa8c6986f4 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_dsl.ml
@@ -5,7 +5,7 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-open Log_helper
+open Log_helpers
 
 (** A scenario is a succession of actions. We define a branching path as a way to create multiple tests
     from the same point. This allows easy compositionality of behaviors with minimal code sharing.
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 a01910139061..845650124b2e 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
@@ -5,12 +5,12 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-open Log_helper
+open Log_helpers
 open State_account
 open Adaptive_issuance_helpers
 open Scenario_dsl
 open Scenario_base
-open Test_tez.Ez_tez
+open Tez_helpers.Ez_tez
 
 (** Set delegate parameters for the given delegate *)
 let set_delegate_params delegate_name parameters : (t, t) scenarios =
diff --git a/src/proto_alpha/lib_protocol/test/helpers/state.ml b/src/proto_alpha/lib_protocol/test/helpers/state.ml
index 936b5344e2f2..911d3b8249b2 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/state.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/state.ml
@@ -7,7 +7,7 @@
 
 open Adaptive_issuance_helpers
 open State_account
-open Log_helper
+open Log_helpers
 
 type double_signing_state = {
   culprit : Signature.Public_key_hash.t;
@@ -145,7 +145,7 @@ let apply_rewards ~(baker : string) block (state : t) : t tzresult Lwt.t =
       |> Int64.of_int32
     in
     let {parameters = _; pkh; _} = find_account baker state in
-    let delta_rewards = Test_tez.(rewards_per_block *! delta_time) in
+    let delta_rewards = Tez_helpers.(rewards_per_block *! delta_time) in
     if delta_time = 1L then
       Log.info ~color:tez_color "+%aꜩ" Tez.pp rewards_per_block
     else assert false ;
@@ -314,7 +314,7 @@ let apply_autostake ~name ~old_cycle
           (Int64.neg autostaked) ;
         apply_unstake
           (Cycle.succ old_cycle)
-          (Test_tez.of_mutez Int64.(neg autostaked))
+          (Tez_helpers.of_mutez Int64.(neg autostaked))
           name
           state)
       else (
diff --git a/src/proto_alpha/lib_protocol/test/helpers/state_account.ml b/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
index bca86c1c4443..543add894537 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/state_account.ml
@@ -9,8 +9,8 @@ open Adaptive_issuance_helpers
 module Cycle = Protocol.Alpha_context.Cycle
 
 module Tez = struct
-  include Test_tez
-  include Test_tez.Compare
+  include Tez_helpers
+  include Tez_helpers.Compare
 end
 
 let join_errors e1 e2 =
diff --git a/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml b/src/proto_alpha/lib_protocol/test/helpers/tez_helpers.ml
similarity index 100%
rename from src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
rename to src/proto_alpha/lib_protocol/test/helpers/tez_helpers.ml
diff --git a/src/proto_alpha/lib_protocol/test/helpers/test_tez.mli b/src/proto_alpha/lib_protocol/test/helpers/tez_helpers.mli
similarity index 100%
rename from src/proto_alpha/lib_protocol/test/helpers/test_tez.mli
rename to src/proto_alpha/lib_protocol/test/helpers/tez_helpers.mli
diff --git a/src/proto_alpha/lib_protocol/test/helpers/transfers.ml b/src/proto_alpha/lib_protocol/test/helpers/transfers.ml
index f04fab9a7c8e..864b70be878a 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/transfers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/transfers.ml
@@ -25,7 +25,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 let transfer_and_check_balances ?(with_burn = false) ~loc b ?(fee = Tez.zero)
     ?expect_apply_failure src dst amount =
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml
index 889f54887657..1cffd34a84ca 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml
@@ -118,7 +118,7 @@ let test_voting_power_cache () =
     assert_voting_power ~loc:__LOC__ initial_voting_power_at_genesis genesis
   in
   let rewards_after_one_voting_period =
-    Test_tez.(baking_reward *! Int64.pred (blocks_per_voting_periods 1))
+    Tez_helpers.(baking_reward *! Int64.pred (blocks_per_voting_periods 1))
   in
   let expected_delta_voting_power_after_one_voting_period =
     Tez.to_mutez rewards_after_one_voting_period
@@ -138,7 +138,7 @@ let test_voting_power_cache () =
       block
   in
   let rewards_after_two_voting_periods =
-    Test_tez.(baking_reward *! Int64.pred (blocks_per_voting_periods 2))
+    Tez_helpers.(baking_reward *! Int64.pred (blocks_per_voting_periods 2))
   in
   let expected_delta_voting_power_after_two_voting_periods =
     Tez.to_mutez rewards_after_two_voting_periods
@@ -167,7 +167,7 @@ let test_basic_baking_reward () =
     Context.Delegate.current_frozen_deposits (B b) baker_pkh
   in
   let* br = Context.get_baking_reward_fixed_portion (B b) in
-  let open Test_tez in
+  let open Tez_helpers in
   let expected_initial_balance = bal +! frozen_deposit -! br in
   Assert.equal_tez
     ~loc:__LOC__
@@ -249,7 +249,7 @@ let test_rewards_block_and_payload_producer () =
      block producer, in our case, [baker_b2]. [baker_b2] gets the baking reward
      plus the fee for the transaction [tx]. *)
   let expected_balance =
-    let open Test_tez in
+    let open Tez_helpers in
     Account.default_initial_balance -! frozen_deposit +! baking_reward
     +! bonus_reward +! reward_for_b1 +! fee
   in
@@ -291,7 +291,7 @@ let test_rewards_block_and_payload_producer () =
     else Tez.zero
   in
   let expected_balance =
-    let open Test_tez in
+    let open Tez_helpers in
     Account.default_initial_balance +! baking_reward -! frozen_deposit
     +! reward_for_b1 +! fee
   in
@@ -309,7 +309,7 @@ let test_rewards_block_and_payload_producer () =
     else Tez.zero
   in
   let expected_balance' =
-    let open Test_tez in
+    let open Tez_helpers in
     Account.default_initial_balance +! bonus_reward +! reward_for_b1'
     -! frozen_deposits'
   in
@@ -349,7 +349,7 @@ let test_enough_active_stake_to_bake ~has_active_stake () =
       Context.Delegate.current_frozen_deposits (B b1) pkh1
     in
     let expected_bal =
-      Test_tez.(
+      Tez_helpers.(
         Tez.of_mutez_exn initial_bal1
         +! baking_reward_fixed_portion -! frozen_deposit)
     in
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_consensus_key.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_consensus_key.ml
index bb80ffdd5de6..3ad5669cbaf8 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_consensus_key.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_consensus_key.ml
@@ -178,7 +178,7 @@ let test_drain_delegate ~low_balance ~exclude_ck ~ck_delegates () =
       in
       let expected_final_balance =
         if exclude_ck then Tez.zero
-        else Tez.(max one) Test_tez.(delegate_balance /! 100L)
+        else Tez.(max one) Tez_helpers.(delegate_balance /! 100L)
       in
       drain_delegate
         ~policy
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_deactivation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_deactivation.ml
index 6ed7a0b5c937..39c48411cc93 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_deactivation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_deactivation.ml
@@ -36,7 +36,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 (** Check that [Delegate.staking_balance] is the same as [Delegate.full_balance]
    (this is not true in general, but in these tests it is because they only deal
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml
index dc53a2aa8a56..08fc71a00728 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml
@@ -38,7 +38,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 (*****************************************************************************)
 (* Bootstrap contracts
@@ -425,7 +425,8 @@ let tests_bootstrap_contracts =
     Tztest.tztest
       "bootstrap manager can be delegate (init origination, large fee)"
       `Quick
-      (delegate_to_bootstrap_by_origination ~fee:(Test_tez.of_int 10_000_000));
+      (delegate_to_bootstrap_by_origination
+         ~fee:(Tez_helpers.of_int 10_000_000));
     Tztest.tztest
       "originated bootstrap contract can be undelegated"
       `Quick
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml
index 13ffbdeaca06..a3611b5c13d8 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_attestation.ml
@@ -166,14 +166,16 @@ let test_valid_double_attestation_evidence () =
   let* frozen_deposits_after =
     Context.Delegate.current_frozen_deposits (B blk_eoc) delegate
   in
-  let frozen_deposits_after = Test_tez.(frozen_deposits_after -! autostaked) in
+  let frozen_deposits_after =
+    Tez_helpers.(frozen_deposits_after -! autostaked)
+  in
   let one_minus_p =
     Percentage.neg
       constants.percentage_of_frozen_deposits_slashed_per_double_attestation
   in
   let {Q.num; den} = Percentage.to_q one_minus_p in
   let expected_frozen_deposits_after =
-    Test_tez.(frozen_deposits_before *! Z.to_int64 num /! Z.to_int64 den)
+    Tez_helpers.(frozen_deposits_before *! Z.to_int64 num /! Z.to_int64 den)
   in
   let* () =
     Assert.equal_tez
@@ -195,12 +197,12 @@ let test_valid_double_attestation_evidence () =
       (Int64.of_int
          constants.adaptive_issuance.global_limit_of_staking_over_baking)
   in
-  let evidence_reward = Test_tez.(frozen_deposits_after /! divider) in
-  let expected_reward = Test_tez.(baking_reward +! evidence_reward) in
+  let evidence_reward = Tez_helpers.(frozen_deposits_after /! divider) in
+  let expected_reward = Tez_helpers.(baking_reward +! evidence_reward) in
   let* full_balance_with_rewards =
     Context.Delegate.full_balance (B blk_eoc) baker
   in
-  let real_reward = Test_tez.(full_balance_with_rewards -! full_balance) in
+  let real_reward = Tez_helpers.(full_balance_with_rewards -! full_balance) in
   Assert.equal_tez ~loc:__LOC__ expected_reward real_reward
 
 (** Check that a double (pre)attestation evidence with equivalent
@@ -346,7 +348,9 @@ let test_two_double_attestation_evidences_leadsto_no_bake () =
   let* frozen_deposits_after =
     Context.Delegate.current_frozen_deposits (B b) delegate
   in
-  let frozen_deposits_after = Test_tez.(frozen_deposits_after -! autostaked) in
+  let frozen_deposits_after =
+    Tez_helpers.(frozen_deposits_after -! autostaked)
+  in
   let* base_reward = Context.get_baking_reward_fixed_portion (B genesis) in
   let* to_liquid =
     Adaptive_issuance_helpers.portion_of_rewards_to_liquid_for_cycle
@@ -360,7 +364,7 @@ let test_two_double_attestation_evidences_leadsto_no_bake () =
      that's left *)
   Assert.equal_tez
     ~loc:__LOC__
-    Test_tez.(base_reward -! to_liquid)
+    Tez_helpers.(base_reward -! to_liquid)
     frozen_deposits_after
 
 (** Say a delegate double-attests twice in a cycle,
@@ -733,7 +737,7 @@ let test_freeze_more_with_low_balance =
         (B genesis)
         (Contract.Implicit account1)
         (Contract.Implicit account2)
-        Test_tez.(info1.full_balance -! info1.frozen_deposits)
+        Tez_helpers.(info1.full_balance -! info1.frozen_deposits)
     in
     let* b2 =
       Block.bake ~policy:(Block.By_account account2) genesis ~operations:[op]
@@ -786,7 +790,7 @@ let test_freeze_more_with_low_balance =
     in
     let {Q.num; den} = Percentage.to_q one_minus_slash_percentage in
     let expected_frozen_deposits_after =
-      Test_tez.(info2.frozen_deposits *! Z.to_int64 num /! Z.to_int64 den)
+      Tez_helpers.(info2.frozen_deposits *! Z.to_int64 num /! Z.to_int64 den)
     in
     let* () =
       Assert.equal_tez
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml
index 86255a92aecd..c94ba9562ad6 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml
@@ -127,7 +127,7 @@ let test_valid_double_baking_evidence () =
   let autostaked = Block.autostaked baker1 end_cycle_metadata in
   let Q.{num; den} = Percentage.to_q p in
   let expected_frozen_deposits_after =
-    Test_tez.(
+    Tez_helpers.(
       frozen_deposits_before
       -! (initial_frozen_deposits_before *! Z.to_int64 num /! Z.to_int64 den)
       +! autostaked)
@@ -210,7 +210,7 @@ let test_valid_double_baking_followed_by_double_attesting () =
   let p = Percentage.add_bounded p_de p_db in
   let Q.{num; den} = Percentage.to_q p in
   let expected_frozen_deposits_after =
-    Test_tez.(
+    Tez_helpers.(
       frozen_deposits_before
       -! (initial_frozen_deposits_before *! Z.to_int64 num /! Z.to_int64 den)
       +! autostaked)
@@ -291,7 +291,7 @@ let test_valid_double_attesting_followed_by_double_baking () =
   let p = Percentage.add_bounded p_de p_db in
   let Q.{num; den} = Percentage.to_q p in
   let expected_frozen_deposits_after =
-    Test_tez.(
+    Tez_helpers.(
       frozen_deposits_before
       -! (initial_frozen_deposits_before *! Z.to_int64 num /! Z.to_int64 den)
       +! autostaked)
@@ -370,7 +370,7 @@ let test_payload_producer_gets_evidence_rewards () =
     Context.Delegate.full_balance (B b') baker2
   in
   let real_reward_right_after =
-    Test_tez.(full_balance_with_rewards_right_after -! full_balance)
+    Tez_helpers.(full_balance_with_rewards_right_after -! full_balance)
   in
   let* () =
     Assert.equal_tez
@@ -391,7 +391,7 @@ let test_payload_producer_gets_evidence_rewards () =
   in
   let Q.{num; den} = Percentage.to_q p in
   let expected_frozen_deposits_after =
-    Test_tez.(
+    Tez_helpers.(
       frozen_deposits_before
       -! (initial_frozen_deposits_before *! Z.to_int64 num /! Z.to_int64 den)
       +! autostaked)
@@ -404,7 +404,8 @@ let test_payload_producer_gets_evidence_rewards () =
       expected_frozen_deposits_after
   in
   let slashed_amount =
-    Test_tez.(frozen_deposits_before -! (frozen_deposits_after -! autostaked))
+    Tez_helpers.(
+      frozen_deposits_before -! (frozen_deposits_after -! autostaked))
   in
   (* [baker2] included the double baking evidence in [b_with_evidence]
      and so it receives the reward for the evidence included in [b']
@@ -415,18 +416,19 @@ let test_payload_producer_gets_evidence_rewards () =
       (Int64.of_int
          c.parametric.adaptive_issuance.global_limit_of_staking_over_baking)
   in
-  let evidence_reward = Test_tez.(slashed_amount /! divider) in
+  let evidence_reward = Tez_helpers.(slashed_amount /! divider) in
   let baked_blocks =
     Int64.of_int
       (Int32.to_int b'.header.shell.level - Int32.to_int b1.header.shell.level)
   in
   let expected_reward =
-    Test_tez.((baking_reward_fixed_portion *! baked_blocks) +! evidence_reward)
+    Tez_helpers.(
+      (baking_reward_fixed_portion *! baked_blocks) +! evidence_reward)
   in
   let* full_balance_with_rewards =
     Context.Delegate.full_balance (B b') baker2
   in
-  let real_reward = Test_tez.(full_balance_with_rewards -! full_balance) in
+  let real_reward = Tez_helpers.(full_balance_with_rewards -! full_balance) in
   let* () = Assert.equal_tez ~loc:__LOC__ expected_reward real_reward in
   (* [baker1] did not produce the payload, it does not receive the reward for the
      evidence *)
@@ -435,7 +437,7 @@ let test_payload_producer_gets_evidence_rewards () =
   Assert.equal_tez
     ~loc:__LOC__
     full_balance_at_b'
-    Test_tez.(full_balance_at_b1 -! slashed_amount)
+    Tez_helpers.(full_balance_at_b1 -! slashed_amount)
 
 (****************************************************************)
 (*  The following test scenarios are supposed to raise errors.  *)
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml
index 1d8343bec74e..8ec6076fbcea 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_preattestation.ml
@@ -152,11 +152,11 @@ end = struct
     let* bal_good = Context.Delegate.full_balance (B bgood) d1 in
     let* bal_bad = Context.Delegate.full_balance (B bbad) d1 in
     (* the diff of the two balances in normal and in denunciation cases *)
-    let diff_end_bal = Test_tez.(bal_good -! bal_bad) in
+    let diff_end_bal = Tez_helpers.(bal_good -! bal_bad) in
     (* amount lost due to denunciation *)
     let Q.{num; den} = Percentage.to_q p in
     let lost_deposit =
-      Test_tez.(frozen_deposit *! Z.to_int64 num /! Z.to_int64 den)
+      Tez_helpers.(frozen_deposit *! Z.to_int64 num /! Z.to_int64 den)
     in
     (* some of the lost deposits (depending on staking constants) will be earned by the baker *)
     let divider =
@@ -166,11 +166,11 @@ end = struct
            constants.parametric.adaptive_issuance
              .global_limit_of_staking_over_baking)
     in
-    let denun_reward = Test_tez.(lost_deposit /! divider) in
+    let denun_reward = Tez_helpers.(lost_deposit /! divider) in
     (* if the baker is the attester, he'll only loose half of the deposits *)
     let expected_attester_loss =
       if Signature.Public_key_hash.equal baker d1 then
-        Test_tez.(lost_deposit -! denun_reward)
+        Tez_helpers.(lost_deposit -! denun_reward)
       else lost_deposit
     in
     let* () =
@@ -188,7 +188,7 @@ end = struct
       if Signature.Public_key_hash.equal baker d1 then (bal_good, bal_bad)
       else (bal_bad, bal_good)
     in
-    let diff_baker = Test_tez.(high -! low) in
+    let diff_baker = Tez_helpers.(high -! low) in
     (* the baker has either earnt or lost (in case baker = d1) half of burnt
        attestation deposits *)
     let* () = Assert.equal_tez ~loc:__LOC__ denun_reward diff_baker in
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml
index 594b17134a07..cd481759de22 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml
@@ -33,7 +33,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 let constants =
   {
@@ -87,7 +87,7 @@ let test_invariants () =
     Assert.equal_tez
       ~loc:__LOC__
       full_balance
-      Test_tez.(spendable_balance +! frozen_deposits)
+      Tez_helpers.(spendable_balance +! frozen_deposits)
   in
   (* to see how delegation plays a role, let's delegate to account1;
      N.B. account2 represents a delegate so it cannot delegate to account1; this is
@@ -126,16 +126,16 @@ let test_invariants () =
     Assert.equal_tez
       ~loc:__LOC__
       new_staking_balance
-      Test_tez.(new_full_balance +! new_account_balance)
+      Tez_helpers.(new_full_balance +! new_account_balance)
   in
   let* () =
     Assert.equal_tez
       ~loc:__LOC__
       new_full_balance
-      Test_tez.(new_spendable_balance +! new_frozen_deposits)
+      Tez_helpers.(new_spendable_balance +! new_frozen_deposits)
   in
   let expected_new_frozen_deposits =
-    Test_tez.(
+    Tez_helpers.(
       (* in this particular example, if we follow the calculation of the active
          stake, it is precisely the new_staking_balance *)
       new_staking_balance
@@ -196,9 +196,9 @@ let test_limit_with_overdelegation () =
   let* initial_staking_balance' =
     Context.Delegate.staking_balance (B genesis) account2
   in
-  let amount = Test_tez.(initial_staking_balance *! 8L /! 10L) in
-  let amount' = Test_tez.(initial_staking_balance' *! 8L /! 10L) in
-  let limit = Test_tez.(initial_staking_balance *! 15L /! 100L) in
+  let amount = Tez_helpers.(initial_staking_balance *! 8L /! 10L) in
+  let amount' = Tez_helpers.(initial_staking_balance' *! 8L /! 10L) in
+  let limit = Tez_helpers.(initial_staking_balance *! 15L /! 100L) in
   let new_account = (Account.new_account ()).pkh in
   let new_contract = Contract.Implicit new_account in
   let* transfer1 =
@@ -209,7 +209,7 @@ let test_limit_with_overdelegation () =
   in
   let* b = Block.bake ~operations:[transfer1; transfer2] genesis in
   let expected_new_staking_balance =
-    Test_tez.(initial_staking_balance -! amount)
+    Tez_helpers.(initial_staking_balance -! amount)
   in
   let* new_staking_balance = Context.Delegate.staking_balance (B b) account1 in
   let* () =
@@ -219,7 +219,7 @@ let test_limit_with_overdelegation () =
       expected_new_staking_balance
   in
   let expected_new_staking_balance' =
-    Test_tez.(initial_staking_balance' -! amount')
+    Tez_helpers.(initial_staking_balance' -! amount')
   in
   let* new_staking_balance' = Context.Delegate.staking_balance (B b) account2 in
   let* () =
@@ -401,7 +401,7 @@ let test_set_limit balance_percentage () =
   let* () = Assert.equal_tez ~loc:__LOC__ frozen_deposits expected_deposits in
   (* set deposits limit to balance_percentage out of the balance *)
   let limit =
-    Test_tez.(full_balance *! Int64.of_int balance_percentage /! 100L)
+    Tez_helpers.(full_balance *! Int64.of_int balance_percentage /! 100L)
   in
   let* operation = Op.set_deposits_limit (B genesis) contract1 (Some limit) in
   let* b = Block.bake ~policy:(By_account account2) ~operation b in
@@ -537,7 +537,7 @@ let test_deposits_after_stake_removal () =
   in
   (* Move half the account1's balance to account2 *)
   let* full_balance = Context.Delegate.full_balance (B genesis) account1 in
-  let half_balance = Test_tez.(full_balance /! 2L) in
+  let half_balance = Tez_helpers.(full_balance /! 2L) in
   let* operation =
     Op.transaction (B genesis) contract1 contract2 half_balance
   in
@@ -556,7 +556,7 @@ let test_deposits_after_stake_removal () =
   in
   (* Bake a cycle. *)
   let expected_new_frozen_deposits_2 =
-    Test_tez.(initial_frozen_deposits_2 *! 3L /! 2L)
+    Tez_helpers.(initial_frozen_deposits_2 *! 3L /! 2L)
   in
   let* b = Block.bake_until_cycle_end b in
   let* frozen_deposits_2 =
@@ -697,7 +697,7 @@ let test_frozen_deposits_with_delegation () =
   let* b = Block.bake ~operation:transfer genesis in
   let* new_staking_balance = Context.Delegate.staking_balance (B b) account2 in
   let expected_new_staking_balance =
-    Test_tez.(initial_staking_balance -! delegated_amount)
+    Tez_helpers.(initial_staking_balance -! delegated_amount)
   in
   let* () =
     Assert.equal_tez
@@ -710,7 +710,7 @@ let test_frozen_deposits_with_delegation () =
   in
   let* b = Block.bake ~operation:delegation b in
   let expected_new_staking_balance =
-    Test_tez.(initial_staking_balance +! delegated_amount)
+    Tez_helpers.(initial_staking_balance +! delegated_amount)
   in
   let* new_staking_balance = Context.Delegate.staking_balance (B b) account1 in
   let* () =
@@ -722,7 +722,7 @@ let test_frozen_deposits_with_delegation () =
   (* Bake one cycle. *)
   let* b = Block.bake_until_cycle_end b in
   let expected_new_frozen_deposits =
-    Test_tez.(
+    Tez_helpers.(
       initial_frozen_deposits
       +! delegated_amount
          /! Int64.of_int (constants.limit_of_delegation_over_baking + 1))
@@ -788,7 +788,7 @@ let test_frozen_deposits_with_overdelegation () =
   in
   let* b = Block.bake ~operations:[transfer1; transfer2] genesis in
   let expected_new_staking_balance =
-    Test_tez.(initial_staking_balance -! amount)
+    Tez_helpers.(initial_staking_balance -! amount)
   in
   let* new_staking_balance = Context.Delegate.staking_balance (B b) account1 in
   let* () =
@@ -798,7 +798,7 @@ let test_frozen_deposits_with_overdelegation () =
       expected_new_staking_balance
   in
   let expected_new_staking_balance' =
-    Test_tez.(initial_staking_balance' -! amount')
+    Tez_helpers.(initial_staking_balance' -! amount')
   in
   let* new_staking_balance' = Context.Delegate.staking_balance (B b) account2 in
   let* () =
@@ -813,7 +813,7 @@ let test_frozen_deposits_with_overdelegation () =
   let* b = Block.bake ~operation:delegation b in
   let* new_staking_balance = Context.Delegate.staking_balance (B b) account1 in
   let expected_new_staking_balance =
-    Test_tez.(initial_frozen_deposits +! amount +! amount')
+    Tez_helpers.(initial_frozen_deposits +! amount +! amount')
   in
   let* () =
     Assert.equal_tez
@@ -884,9 +884,9 @@ let test_set_limit_with_overdelegation () =
   let* initial_staking_balance' =
     Context.Delegate.staking_balance (B genesis) account2
   in
-  let amount = Test_tez.(initial_staking_balance *! 8L /! 10L) in
-  let amount' = Test_tez.(initial_staking_balance' *! 8L /! 10L) in
-  let limit = Test_tez.(initial_staking_balance *! 15L /! 100L) in
+  let amount = Tez_helpers.(initial_staking_balance *! 8L /! 10L) in
+  let amount' = Tez_helpers.(initial_staking_balance' *! 8L /! 10L) in
+  let limit = Tez_helpers.(initial_staking_balance *! 15L /! 100L) in
   let new_account = (Account.new_account ()).pkh in
   let new_contract = Contract.Implicit new_account in
   let* transfer1 =
@@ -899,7 +899,7 @@ let test_set_limit_with_overdelegation () =
   let* set_deposits = Op.set_deposits_limit (B b) contract1 (Some limit) in
   let* b = Block.bake ~operation:set_deposits b in
   let expected_new_staking_balance =
-    Test_tez.(initial_staking_balance -! amount)
+    Tez_helpers.(initial_staking_balance -! amount)
   in
   let* new_staking_balance = Context.Delegate.staking_balance (B b) account1 in
   let* () =
@@ -909,7 +909,7 @@ let test_set_limit_with_overdelegation () =
       expected_new_staking_balance
   in
   let expected_new_staking_balance' =
-    Test_tez.(initial_staking_balance' -! amount')
+    Tez_helpers.(initial_staking_balance' -! amount')
   in
   let* new_staking_balance' = Context.Delegate.staking_balance (B b) account2 in
   let* () =
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_participation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_participation.ml
index c781aa02b7f8..941f165903e6 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_participation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_participation.ml
@@ -142,7 +142,7 @@ let test_participation ~sufficient_participation () =
       del2
       attesting_rewards
   in
-  let attesting_rewards = Test_tez.to_mutez attesting_rewards in
+  let attesting_rewards = Tez_helpers.to_mutez attesting_rewards in
   let expected_bal2_at_b =
     Int64.(sub (add bal2_at_pred_b attesting_rewards) autostaked)
   in
@@ -175,7 +175,8 @@ let test_participation_rpc () =
       ~reward_kind:Attesting_reward_per_slot
   in
   let expected_attesting_rewards =
-    Test_tez.(attesting_reward_per_slot *! Int64.of_int expected_cycle_activity)
+    Tez_helpers.(
+      attesting_reward_per_slot *! Int64.of_int expected_cycle_activity)
   in
   let* b1 = Block.bake ~policy:(By_account del1) b0 in
   let* _, _, _ =
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml
index 384bd40f0dc4..f4064fe62aed 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml
@@ -228,7 +228,9 @@ let test_revelation_early_wrong_right_twice () =
       pkh
       baking_reward_fixed_portion
   in
-  let reward_to_liquid = Test_tez.(baking_reward_to_liquid +! tip_to_liquid) in
+  let reward_to_liquid =
+    Tez_helpers.(baking_reward_to_liquid +! tip_to_liquid)
+  in
 
   let* () =
     balance_was_credited ~loc:__LOC__ (B b) baker baker_bal reward_to_liquid
@@ -457,7 +459,9 @@ let test_early_incorrect_unverified_correct_already_vdf () =
       pkh
       baking_reward_fixed_portion
   in
-  let reward_to_liquid = Test_tez.(tip_to_liquid +! baking_reward_to_liquid) in
+  let reward_to_liquid =
+    Tez_helpers.(tip_to_liquid +! baking_reward_to_liquid)
+  in
   let* () =
     balance_was_credited ~loc:__LOC__ (B b) baker baker_bal reward_to_liquid
   in
@@ -554,7 +558,7 @@ let test_early_incorrect_unverified_correct_already_vdf () =
           baking_reward_fixed_portion
       in
       let reward_to_liquid =
-        Test_tez.(tip_to_liquid +! baking_reward_to_liquid)
+        Tez_helpers.(tip_to_liquid +! baking_reward_to_liquid)
       in
       let* () =
         balance_was_credited ~loc:__LOC__ (B b) baker baker_bal reward_to_liquid
diff --git a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml
index 54ee6f5d98dd..4f8a3e7ba1ce 100644
--- a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml
@@ -558,7 +558,7 @@ let test_emptying_account_gas () =
   let bootstrap_pkh = Context.Contract.pkh bootstrap in
   let {Account.pkh; pk; _} = Account.new_account () in
   let contract = Contract.Implicit pkh in
-  let amount = Test_tez.of_int 10 in
+  let amount = Tez_helpers.of_int 10 in
   let* op1 = Op.transaction (B b) bootstrap contract amount in
   let* b = Block.bake ~operation:op1 b in
   let* op2 = Op.revelation ~fee:Tez.zero (B b) pk in
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml
index b0bbb7493183..792f4d6f5416 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml
@@ -51,7 +51,7 @@ let originate_contract file storage src b =
     Alpha_context.Script.{code = lazy_expr code; storage = lazy_expr storage}
   in
   let* operation, dst =
-    Op.contract_origination (B b) src ~fee:(Test_tez.of_int 10) ~script
+    Op.contract_origination (B b) src ~fee:(Tez_helpers.of_int 10) ~script
   in
   let* incr = Incremental.begin_construction b in
   let* incr = Incremental.add_operation incr operation in
@@ -65,10 +65,10 @@ let contract_test () =
   let open Lwt_result_syntax in
   let* b, src = Context.init1 ~consensus_threshold:0 () in
   let* dst, b = originate_contract (path // "contracts/emit.tz") "Unit" src b in
-  let fee = Test_tez.of_int 10 in
+  let fee = Tez_helpers.of_int 10 in
   let parameters = Script.unit_parameter in
   let* operation =
-    Op.transaction ~fee ~parameters (B b) src dst (Test_tez.of_int 0)
+    Op.transaction ~fee ~parameters (B b) src dst (Tez_helpers.of_int 0)
   in
   let* incr = Incremental.begin_construction b in
   let* incr = Incremental.add_operation incr operation in
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
index 618d90b25042..f1865ea26c60 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
@@ -739,8 +739,8 @@ module Interpreter_tests = struct
     let* balance_after_shield = Context.Contract.balance (B b4) src1 in
     let diff_due_to_shield =
       Int64.sub
-        (Test_tez.to_mutez balance_after_shield)
-        (Test_tez.to_mutez balance_before_shield)
+        (Tez_helpers.to_mutez balance_after_shield)
+        (Tez_helpers.to_mutez balance_before_shield)
     in
     (* The balance after shield is obtained from the balance before shield by
        the shield specific update. *)
@@ -790,7 +790,7 @@ module Interpreter_tests = struct
     in
     (* Here we fail by doing the same transaction again*)
     let* incr = Incremental.begin_construction b in
-    let fee = Test_tez.of_int 10 in
+    let fee = Tez_helpers.of_int 10 in
     let dst = Alpha_context.Contract.Originated dst in
     let* operation =
       Op.transaction ~gas_limit:Max ~fee (B b) src0 dst Tez.zero ~parameters
@@ -826,7 +826,7 @@ module Interpreter_tests = struct
       Alpha_context.Script.(lazy_expr (Expr.from_string string))
     in
     let* incr = Incremental.begin_construction b in
-    let fee = Test_tez.of_int 10 in
+    let fee = Tez_helpers.of_int 10 in
     let* operation =
       Op.transaction ~gas_limit:Max ~fee (B b) src0 dst Tez.zero ~parameters
     in
@@ -995,8 +995,8 @@ module Interpreter_tests = struct
         ~offset_nullifier:0L
         ()
     in
-    let fee = Test_tez.of_int 10 in
-    let*? amount_tez = Test_tez.(one_mutez *? Int64.of_int 15) in
+    let fee = Tez_helpers.of_int 10 in
+    let*? amount_tez = Tez_helpers.(one_mutez *? Int64.of_int 15) in
     let* operation1 =
       Op.transaction
         ~gas_limit:High
@@ -1112,7 +1112,7 @@ module Interpreter_tests = struct
     let* operation =
       Op.transaction
         ~gas_limit:Max
-        ~fee:(Test_tez.of_int 10)
+        ~fee:(Tez_helpers.of_int 10)
         (B b)
         src
         dst
@@ -1158,7 +1158,7 @@ module Interpreter_tests = struct
     let parameters_2 =
       Alpha_context.Script.(lazy_expr (Expr.from_string str_2))
     in
-    let fee = Test_tez.of_int 10 in
+    let fee = Tez_helpers.of_int 10 in
     let cdst = Contract.Originated dst in
     let* operation =
       Op.transaction
@@ -1251,7 +1251,7 @@ module Interpreter_tests = struct
     let parameters =
       Alpha_context.Script.(lazy_expr (Expr.from_string string))
     in
-    let fee = Test_tez.of_int 10 in
+    let fee = Tez_helpers.of_int 10 in
     let dst = Contract.Originated dst in
     let* operation =
       Op.transaction ~gas_limit:Max ~fee (B b) src dst Tez.zero ~parameters
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
index bf398d0443f7..b03a0bde08af 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
@@ -318,7 +318,7 @@ let originate_script block ~script ~storage ~sender ~baker ~forges_tickets =
     Op.contract_origination_hash
       (B block)
       sender
-      ~fee:(Test_tez.of_int 10)
+      ~fee:(Tez_helpers.of_int 10)
       ~script
   in
   let* incr =
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index 6fc319f718d4..cfcdbf874e47 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -220,7 +220,7 @@ let originate block ~script ~storage ~sender ~baker ~forges_tickets =
     Op.contract_origination_hash
       (B block)
       sender
-      ~fee:(Test_tez.of_int 10)
+      ~fee:(Tez_helpers.of_int 10)
       ~script
   in
   let* incr =
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_activation.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_activation.ml
index c51fc307600c..d8dbe9d76aa3 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_activation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_activation.ml
@@ -43,7 +43,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 (* Generated commitments and secrets  *)
 
@@ -426,7 +426,7 @@ let test_activation_and_transfer () =
   let* operation = Op.activation (B blk) account activation_code in
   let* blk = Block.bake ~operation blk in
   let* amount = Context.Contract.balance (B blk) bootstrap_contract in
-  let half_amount = Test_tez.(amount /! 2L) in
+  let half_amount = Tez_helpers.(amount /! 2L) in
   let* activated_amount_before =
     Context.Contract.balance (B blk) first_contract
   in
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_combined_operations.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_combined_operations.ml
index d4c4081cce89..4a2e06cc13ef 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_combined_operations.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_combined_operations.ml
@@ -45,7 +45,7 @@
 open Protocol
 open Alpha_context
 
-let ten_tez = Test_tez.of_int 10
+let ten_tez = Tez_helpers.of_int 10
 
 let gas_limit = Op.Custom_gas (Alpha_context.Gas.Arith.integral_of_int_exn 3000)
 
@@ -72,7 +72,7 @@ let test_multiple_transfers () =
       (I inc)
       c1
       c1_old_balance
-      (Test_tez.of_int 10)
+      (Tez_helpers.of_int 10)
   in
   let* () =
     Assert.balance_was_credited
@@ -80,7 +80,7 @@ let test_multiple_transfers () =
       (I inc)
       c2
       c2_old_balance
-      (Test_tez.of_int 10)
+      (Tez_helpers.of_int 10)
   in
   return_unit
 
@@ -103,7 +103,7 @@ let test_multiple_origination_and_delegation () =
           ~counter:(Manager_counter.Internal_for_tests.of_int i)
           ~fee:Tez.zero
           ~script:Op.dummy_script
-          ~credit:(Test_tez.of_int 10)
+          ~credit:(Tez_helpers.of_int 10)
           (B blk)
           c1)
       (1 -- n)
@@ -148,21 +148,21 @@ let test_multiple_origination_and_delegation () =
   in
   (* Previous balance - (Credit (n * 10tz) + Origination cost (n tz)) *)
   let*? origination_burn =
-    Test_tez.(cost_per_byte *? Int64.of_int origination_size)
+    Tez_helpers.(cost_per_byte *? Int64.of_int origination_size)
   in
   let*? origination_total_cost =
-    Test_tez.(origination_burn *? Int64.of_int n)
+    Tez_helpers.(origination_burn *? Int64.of_int n)
   in
-  let*? t = Test_tez.( *? ) Op.dummy_script_cost 10L in
-  let*? t = Test_tez.( +? ) (Test_tez.of_int (10 * n)) t in
-  let*? total_cost = Test_tez.( +? ) origination_total_cost t in
+  let*? t = Tez_helpers.( *? ) Op.dummy_script_cost 10L in
+  let*? t = Tez_helpers.( +? ) (Tez_helpers.of_int (10 * n)) t in
+  let*? total_cost = Tez_helpers.( +? ) origination_total_cost t in
   let* () =
     Assert.balance_was_debited ~loc:__LOC__ (I inc) c1 c1_old_balance total_cost
   in
   List.iter_es
     (fun c ->
       let c = Contract.Originated c in
-      Assert.balance_is ~loc:__LOC__ (I inc) c (Test_tez.of_int 10))
+      Assert.balance_is ~loc:__LOC__ (I inc) c (Tez_helpers.of_int 10))
     new_contracts
 
 let expect_apply_failure =
@@ -185,7 +185,7 @@ let test_failing_operation_in_the_middle () =
   let* blk, (c1, c2) = Context.init2 () in
   let* op1 = Op.transaction ~gas_limit ~fee:Tez.zero (B blk) c1 c2 Tez.one in
   let* op2 =
-    Op.transaction ~gas_limit ~fee:Tez.zero (B blk) c1 c2 Test_tez.max_tez
+    Op.transaction ~gas_limit ~fee:Tez.zero (B blk) c1 c2 Tez_helpers.max_tez
   in
   let* op3 = Op.transaction ~gas_limit ~fee:Tez.zero (B blk) c1 c2 Tez.one in
   let operations = [op1; op2; op3] in
@@ -232,7 +232,7 @@ let test_failing_operation_in_the_middle_with_fees () =
   let open Lwt_result_syntax in
   let* blk, (c1, c2) = Context.init2 () in
   let* op1 = Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one in
-  let* op2 = Op.transaction ~fee:Tez.one (B blk) c1 c2 Test_tez.max_tez in
+  let* op2 = Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez_helpers.max_tez in
   let* op3 = Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one in
   let operations = [op1; op2; op3] in
   let* operation = Op.combine_operations ~source:c1 (B blk) operations in
@@ -274,7 +274,7 @@ let test_failing_operation_in_the_middle_with_fees () =
       (I inc)
       c1
       c1_old_balance
-      (Test_tez.of_int 3)
+      (Tez_helpers.of_int 3)
   in
   let* () = Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance in
   return_unit
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_origination.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_origination.ml
index f7d50f6d5899..9807dac88273 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_origination.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_origination.ml
@@ -33,7 +33,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 let ten_tez = of_int 10
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_paid_storage_increase.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_paid_storage_increase.ml
index 6b954620aa21..92504b02cb56 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_paid_storage_increase.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_paid_storage_increase.ml
@@ -34,7 +34,7 @@
 open Protocol
 open Alpha_context
 
-let ten_tez = Test_tez.of_int 10
+let ten_tez = Tez_helpers.of_int 10
 
 let dummy_script =
   "{parameter unit; storage unit; code { CAR ; NIL operation ; PAIR }}"
@@ -80,7 +80,7 @@ let test_balances ~amount =
   (* check that after the block has been baked, the source was debited of all
      the burned tez *)
   let* {parametric = {cost_per_byte; _}; _} = Context.get_constants (I inc) in
-  let burned_tez = Test_tez.(cost_per_byte *! Z.to_int64 amount) in
+  let burned_tez = Tez_helpers.(cost_per_byte *! Z.to_int64 amount) in
   let* () =
     Assert.balance_was_debited
       ~loc:__LOC__
@@ -144,7 +144,7 @@ let test_no_tez_to_pay () =
     Z.div (Z.of_int 2_000_000) (Z.of_int64 (Tez.to_mutez cost_per_byte))
   in
   let* balance = Context.Contract.balance (I inc) source in
-  let*? tez_to_substract = Test_tez.(balance -? Tez.one) in
+  let*? tez_to_substract = Tez_helpers.(balance -? Tez.one) in
   let* op =
     Op.transaction (I inc) ~fee:Tez.zero source receiver tez_to_substract
   in
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_reveal.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_reveal.ml
index fa2a3230e342..f265b00d96a3 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_reveal.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_reveal.ml
@@ -35,7 +35,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 let ten_tez = of_int 10
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_transfer.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_transfer.ml
index 0bd992e3ce35..54270fd9f882 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_transfer.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_transfer.ml
@@ -33,7 +33,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 open Transfers
 
 (*********************************************************************)
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml
index 52ece63a2fe5..6f4d76e6a317 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml
@@ -970,11 +970,11 @@ let test_supermajority_in_proposal there_is_a_winner () =
       minimal_stake
   in
   let*? bal3 =
-    if there_is_a_winner then Test_tez.( *? ) minimal_stake 3L
+    if there_is_a_winner then Tez_helpers.( *? ) minimal_stake 3L
     else
       let open Result_syntax in
-      let* t = Test_tez.( *? ) minimal_stake 2L in
-      Test_tez.( +? ) (Test_tez.of_mutez initial_balance) t
+      let* t = Tez_helpers.( *? ) minimal_stake 2L in
+      Tez_helpers.( +? ) (Tez_helpers.of_mutez initial_balance) t
   in
   let* op3 =
     Op.transaction
@@ -1039,7 +1039,7 @@ let test_quorum_in_proposal has_quorum () =
     else Int64.(sub (of_int32 min_proposal_quorum) 10L)
   in
   let bal =
-    Int64.(div (mul total_tokens quorum) 100_00L) |> Test_tez.of_mutez
+    Int64.(div (mul total_tokens quorum) 100_00L) |> Tez_helpers.of_mutez
   in
   let* op2 = Op.transaction (B b) del2 del1 bal in
   let* b = Block.bake ~policy ~operation:op2 b in
@@ -1251,7 +1251,7 @@ let test_voting_power_updated_each_voting_period () =
   let baker2 = Context.Contract.pkh con2 in
   let baker3 = Context.Contract.pkh con3 in
   (* Retrieve balance of con1 *)
-  let open Test_tez in
+  let open Tez_helpers in
   let* balance1 = Context.Contract.balance (B genesis) con1 in
   let* frozen_deposits1 =
     Context.Delegate.current_frozen_deposits (B genesis) baker1
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_zk_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_zk_rollup.ml
index e47ca8364603..d0ff24aaa30c 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_zk_rollup.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_zk_rollup.ml
@@ -149,7 +149,8 @@ let test_origination_fees () =
     + Data_encoding.Binary.length Zk_rollup.pending_list_encoding init_pl
   in
   let expected_fees =
-    Test_tez.(constants.parametric.cost_per_byte *! Int64.of_int expected_size)
+    Tez_helpers.(
+      constants.parametric.cost_per_byte *! Int64.of_int expected_size)
   in
   let* operation, _rollup =
     Op.zk_rollup_origination
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml
index c86f39a1e23c..3c51de4d159b 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_adaptive_issuance_launch.ml
@@ -132,11 +132,11 @@ let test_launch threshold expected_vote_duration () =
         autostaking_enable = false;
       }
     in
-    let cost_per_byte = Test_tez.zero in
+    let cost_per_byte = Tez_helpers.zero in
     let issuance_weights =
       {
         Default_parameters.constants_test.issuance_weights with
-        base_total_issued_per_minute = Test_tez.zero;
+        base_total_issued_per_minute = Tez_helpers.zero;
       }
     in
     let consensus_threshold = 0 in
@@ -471,7 +471,7 @@ let test_launch_without_vote () =
     let issuance_weights =
       {
         Default_parameters.constants_test.issuance_weights with
-        base_total_issued_per_minute = Test_tez.zero;
+        base_total_issued_per_minute = Tez_helpers.zero;
       }
     in
     let adaptive_issuance =
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_constants.ml b/src/proto_alpha/lib_protocol/test/integration/test_constants.ml
index 6f975bada710..373953603b35 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_constants.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_constants.ml
@@ -32,7 +32,7 @@
     Subject:    the consistency of parametric constants
  *)
 
-open Test_tez
+open Tez_helpers
 
 let test_sc_rollup_constants_consistency () =
   let open Protocol.Alpha_context in
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml b/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml
index 2b7198c05acc..33f816bd16ac 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml
@@ -33,7 +33,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 let big_random_amount () =
   match Tez.of_mutez (Int64.add 100_000L (Random.int64 1_000_000L)) with
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml b/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml
index f6b0d23d6895..dc2658788c12 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_liquidity_baking.ml
@@ -34,7 +34,7 @@
 
 open Liquidity_baking_machine
 open Protocol
-open Test_tez
+open Tez_helpers
 
 let generate_init_state () =
   let open Lwt_result_syntax in
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml
index e9b2901f0650..8c6ce71b2798 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_autostaking.ml
@@ -14,12 +14,12 @@
 *)
 
 open State_account
-open Test_tez.Ez_tez
+open Tez_helpers.Ez_tez
 open Scenario_dsl
 open Scenario_base
 open Scenario_op
 open Test_scenario_base
-open Log_helper
+open Log_helpers
 
 let assert_balance_evolution ~loc ~for_accounts ~part ~name ~old_balance
     ~new_balance compare =
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml
index 2245bb53a04a..9d0248d64af9 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_base.ml
@@ -15,7 +15,7 @@
 
 open Adaptive_issuance_helpers
 open State_account
-open Test_tez.Ez_tez
+open Tez_helpers.Ez_tez
 open Scenario_dsl
 open Scenario_base
 open Scenario_op
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml
index d3dcb6d3e23f..d25e1fc65b69 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_rewards.ml
@@ -15,7 +15,7 @@
 
 open Adaptive_issuance_helpers
 open State_account
-open Test_tez.Ez_tez
+open Tez_helpers.Ez_tez
 open Scenario_dsl
 open Scenario_base
 open Scenario_op
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml
index 2343ac1f6632..ff26ffb6a0d4 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_slashing.ml
@@ -33,7 +33,7 @@
 
 open Adaptive_issuance_helpers
 open State_account
-open Test_tez.Ez_tez
+open Tez_helpers.Ez_tez
 open Scenario_dsl
 open Scenario_base
 open Scenario_op
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml b/src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml
index b9cc68dd70d5..74f51dbb8b56 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_scenario_stake.ml
@@ -15,7 +15,7 @@
 
 open Adaptive_issuance_helpers
 open State_account
-open Test_tez.Ez_tez
+open Tez_helpers.Ez_tez
 open Scenario_dsl
 open Scenario_base
 open Scenario_op
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_token.ml b/src/proto_alpha/lib_protocol/test/integration/test_token.ml
index df9fa016adb9..da0eadb42d51 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_token.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_token.ml
@@ -33,7 +33,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 (** Creates a context with a single account. Returns the context and the public
     key hash of the account. *)
diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml b/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml
index c1b7f0d6006a..0668db020eaa 100644
--- a/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml
@@ -25,7 +25,7 @@
 
 open Protocol
 open Alpha_context
-open Test_tez
+open Tez_helpers
 
 (** {2 Constants} *)
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/test_validation_batch.ml b/src/proto_alpha/lib_protocol/test/integration/validate/test_validation_batch.ml
index 7d0c7430b87b..252658ba1ef4 100644
--- a/src/proto_alpha/lib_protocol/test/integration/validate/test_validation_batch.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/validate/test_validation_batch.ml
@@ -385,7 +385,7 @@ let batch_empty_at_end infos kind1 kind2 =
   let source = contract_of (get_source infos) in
   let* counter = Context.Contract.counter (B infos.ctxt.block) source in
   let* init_bal = Context.Contract.balance (B infos.ctxt.block) source in
-  let half_init_bal = Test_tez.(init_bal /! 2L) in
+  let half_init_bal = Tez_helpers.(init_bal /! 2L) in
   let* reveal =
     mk_reveal
       {(operation_req_default K_Reveal) with counter = Some counter}
diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_tez_repr.ml b/src/proto_alpha/lib_protocol/test/pbt/test_tez_repr.ml
index 80fbb2149c9e..91a7a95b1025 100644
--- a/src/proto_alpha/lib_protocol/test/pbt/test_tez_repr.ml
+++ b/src/proto_alpha/lib_protocol/test/pbt/test_tez_repr.ml
@@ -32,7 +32,7 @@
 *)
 
 open Protocol.Alpha_context
-open Test_tez
+open Tez_helpers
 
 let z_mutez_min = Z.zero
 
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_adaptive_issuance.ml b/src/proto_alpha/lib_protocol/test/unit/test_adaptive_issuance.ml
index 23a82c1a994d..66f0af702c71 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_adaptive_issuance.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_adaptive_issuance.ml
@@ -48,7 +48,7 @@ let test_reward_coefficient () =
         csts
         ~reward_kind:Baking_reward_fixed_portion)
   in
-  Assert.equal_tez ~loc:__LOC__ Test_tez.(default *! 4L) default_times_4
+  Assert.equal_tez ~loc:__LOC__ Tez_helpers.(default *! 4L) default_times_4
 
 let test_reward_coeff_ratio () =
   let open Delegate.Rewards.Internal_for_tests in
-- 
GitLab


From 8029724fde25fe4278f87ae454df3f43add8dd07 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Wed, 21 Feb 2024 15:20:38 +0100
Subject: [PATCH 17/18] Proto/tests: add module comments

---
 src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml | 4 ++++
 src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml   | 4 ++++
 2 files changed, 8 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 d49ff3c10402..8121a1ac723b 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml
@@ -5,6 +5,10 @@
 (*                                                                           *)
 (*****************************************************************************)
 
+(** This module gathers the basic operations used in test scenarios. This
+    includes starting a scenario, baking, checking and manipulating the state,
+    and various wait functions *)
+
 open State_account
 open State
 open Scenario_dsl
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 845650124b2e..8c684e882f45 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_op.ml
@@ -5,6 +5,10 @@
 (*                                                                           *)
 (*****************************************************************************)
 
+(** This module gathers many protocol operations in the form of scenarios.
+    This includes (but is not limited to) transfers and such (stake,
+    unstake...), as well as various ways to forge double signings. *)
+
 open Log_helpers
 open State_account
 open Adaptive_issuance_helpers
-- 
GitLab


From 1a61785c6d3136fd5b835d8fd18854ee671285f2 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Thu, 22 Feb 2024 10:34:29 +0100
Subject: [PATCH 18/18] Manifest/Proto/tests: rewrite cleaner if open
 conditions

---
 manifest/main.ml | 13 ++++---------
 1 file changed, 4 insertions(+), 9 deletions(-)

diff --git a/manifest/main.ml b/manifest/main.ml
index 710b4048a4e2..44f0450cebd3 100644
--- a/manifest/main.ml
+++ b/manifest/main.ml
@@ -6208,15 +6208,10 @@ let hash = Protocol.hash
         ~opam_only_deps:[octez_protocol_environment; parameters |> if_some]
         ~deps:
           [
-            (if N.(number >= 019) then
-             Some (tezt_core_lib |> open_ |> open_ ~m:"Base")
-            else None)
-            |> if_some;
-            (if N.(number >= 019) then Some alcotezt else None) |> if_some;
-            (if N.(number >= 019) then Some tezt_lib else None) |> if_some;
-            (if N.(number >= 019) then Some (octez_base_test_helpers |> open_)
-            else None)
-            |> if_some;
+            tezt_core_lib |> if_ N.(number >= 019) |> open_ |> open_ ~m:"Base";
+            alcotezt |> if_ N.(number >= 019);
+            tezt_lib |> if_ N.(number >= 019);
+            octez_base_test_helpers |> if_ N.(number >= 019) |> open_;
             qcheck_alcotest;
             octez_test_helpers;
             octez_base |> open_ ~m:"TzPervasives"
-- 
GitLab