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 9bb65e47cedefe72575d808c0874d3634b919e6a..aa3f40db07c785126752891e92d53149682701c6 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/scenario_base.ml @@ -22,11 +22,13 @@ type error += Unexpected_error and the known [State.t] *) type t = Block.t * State.t -let log ?color s = - let open Lwt_result_syntax in - exec_unit (fun _ -> - Log.info ?color s ; - return_unit) +let log ?(level = Cli.Logs.Info) ?color format = + Format.kasprintf + (fun s -> + exec_unit (fun _ -> + Log.log ~level ?color "%s" s ; + return_unit)) + format (* ======== Baking ======== *) @@ -324,10 +326,12 @@ let next_block_with_baker 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) +let next_cycle_ input = + Log.info ~color:action_color "[Next cycle]" ; + bake_until_next_cycle input + +(** Bake until the end of a cycle *) +let next_cycle = exec next_cycle_ (** Executes an operation: f should return a new state and a list of operations, which are then applied *) let exec_op f = @@ -445,60 +449,108 @@ let rec wait_n_blocks n = else if n = 1 then next_block else wait_n_blocks (n - 1) --> next_block +let wait_cycle_f_es (condition : t -> t -> bool tzresult Lwt.t) : + (t, t) scenarios = + let open Lwt_result_syntax in + exec (fun init_t -> + let rec bake_while t = + let* b = condition init_t t in + if b then return t + else + let* t = next_cycle_ t in + bake_while t + in + bake_while init_t) + +(** Waits until [condition init_t current_t] is fulfilled. + It is checked on the first block of every cycle. If it returns false, + another cycle is baked, until it succeeds. +*) +let wait_cycle_f (condition : t -> t -> bool) : (t, t) scenarios = + let open Lwt_result_syntax in + exec (fun init_t -> + let rec bake_while t = + if condition init_t t then return t + else + let* t = next_cycle_ t in + bake_while t + in + bake_while init_t) + (** 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" ) +let wait_cycle_until condition = + let to_, done_ = + let rec get_names condition = + match condition with + | `AI_activation -> ("AI activation", "AI activated") + | `delegate_parameters_activation -> + ("delegate parameters activation", "delegate parameters activated") + | `And (cond1, cond2) -> + let to1, done1 = get_names cond1 in + let to2, done2 = get_names cond2 in + (to1 ^ " and " ^ to2, done1 ^ " and " ^ done2) + in + get_names condition + in + let condition (init_block, init_state) = + let open Lwt_result_syntax in + let rec stopper condition = + match condition with + | `AI_activation -> + fun (block, _state) -> + if init_state.State.activate_ai then + let* launch_cycle = get_launch_cycle ~loc:__LOC__ init_block in + let current_cycle = Block.current_cycle block in + return Cycle.(current_cycle >= launch_cycle) else assert false - | `delegate_parameters_activation -> - let init_cycle = Block.current_cycle block in + | `delegate_parameters_activation -> + fun (block, _state) -> + let init_cycle = Block.current_cycle init_block in let cycles_to_wait = - state.constants.delegate_parameters_activation_delay + init_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) + Cycle.(Block.current_cycle block >= add init_cycle cycles_to_wait) + | `And (cond1, cond2) -> + let stop1 = stopper cond1 in + let stop2 = stopper cond2 in + fun (block, state) -> + let* b1 = stop1 (block, state) in + let* b2 = stop2 (block, state) in + return (b1 && b2) + in + stopper condition + in + log ~color:time_color "Fast forward to %s" to_ + --> wait_cycle_f_es condition + --> log ~color:event_color "%s" done_ (** Wait until AI activates. Fails if AI is not set to be activated in the future. *) -let wait_ai_activation = wait_cycle `AI_activation +let wait_ai_activation = wait_cycle_until `AI_activation (** wait delegate_parameters_activation_delay cycles *) let wait_delegate_parameters_activation = - wait_cycle `delegate_parameters_activation + wait_cycle_until `delegate_parameters_activation + +let wait_n_cycles_f (n_cycles : t -> int) = + let condition ((init_block, _init_state) as t_init) + ((current_block, _current_state) as _t_current) = + let n = n_cycles t_init in + let init_cycle = Block.current_cycle init_block in + let current_cycle = Block.current_cycle current_block in + Cycle.(current_cycle >= add init_cycle n) + in + wait_cycle_f condition + +let wait_n_cycles_f_es (n_cycles : t -> int tzresult Lwt.t) = + let open Lwt_result_syntax in + let condition ((init_block, _init_state) as t_init) + ((current_block, _current_state) as _t_current) = + let* n = n_cycles t_init in + let init_cycle = Block.current_cycle init_block in + let current_cycle = Block.current_cycle current_block in + return Cycle.(current_cycle >= add init_cycle n) + in + wait_cycle_f_es condition 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 28aff544119cbe299f4df21ab462df68c89cc58c..88567a5502129b6256d652c1ac4980d2f73b6c87 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 @@ -18,13 +18,6 @@ open State_account open Tez_helpers.Ez_tez open Scenario -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 "")]) 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 9cf97ea447feac2cb9cbed816c8637f34a3681b0..805b601b0a0bf548438f9b5a98e206a76d1068c0 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 @@ -74,7 +74,9 @@ let test_wait_with_rewards = |+ Tag "cycle step" --> wait_n_cycles 10) let test_ai_curve_activation_time = - let pc = Default_parameters.constants_test.consensus_rights_delay in + let consensus_rights_delay (_, state) = + state.State.constants.consensus_rights_delay + in init_constants ~reward_per_block:1_000_000_000L ~deactivate_dynamic:true () --> set S.Adaptive_issuance.autostaking_enable false --> activate_ai true @@ -83,7 +85,7 @@ let test_ai_curve_activation_time = --> 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 + --> wait_n_cycles_f consensus_rights_delay --> check_rate_evolution Q.equal --> next_cycle (* The new rate should be active now. With the chosen constants, it should be lower. 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 9e040ca8701697952bc4f4562c44cc94792ceb06..d85ad2ae0fd550b8b03ded5ed2b47a5a5376331b 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 @@ -372,9 +372,6 @@ let test_slash_correct_amount_after_stake_from_unstake = (* Test a non-zero request finalizes for a non-zero amount if it hasn't been slashed 100% *) let test_mini_slash = - let consensus_rights_delay = - Default_parameters.constants_test.consensus_rights_delay - in init_constants () --> set S.Adaptive_issuance.autostaking_enable false --> (Tag "Yes AI" --> activate_ai true @@ -392,7 +389,8 @@ let test_mini_slash = --> next_cycle --> next_cycle --> check_balance_field "delegate" `Unstaked_frozen_total Tez.zero - --> wait_n_cycles (consensus_rights_delay + 1) + --> wait_n_cycles_f (fun (_, state) -> + state.constants.consensus_rights_delay + 1) let test_slash_rounding = init_constants () 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 b9f2dec685367ecfc04ddafafea8139e2b70b439..0d59a03e2b733398d069abf822d29f69f2d6abd4 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 @@ -26,14 +26,23 @@ let stake_init = --> (Tag "no wait after stake" --> Empty |+ Tag "wait after stake" --> wait_n_cycles 2) +let ( -- ) a b x = a x - b + +let ( ++ ) a b x = a x + b + let wait_for_unfreeze_and_check wait = snapshot_balances "wait snap" ["staker"] - --> wait_n_cycles (wait - 1) + --> wait_n_cycles_f (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 unstake_wait (_, state) = + let crd = state.State.constants.consensus_rights_delay in + let msp = Protocol.Constants_repr.max_slashing_period in + crd + msp + let finalize staker = assert_failure (check_balance_field staker `Unstaked_finalizable Tez.zero) --> finalize_unstake staker @@ -43,7 +52,7 @@ 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 + --> wait_for_unfreeze_and_check unstake_wait --> finalize "staker" --> next_cycle let double_roundtrip = @@ -51,8 +60,8 @@ let double_roundtrip = --> (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 + --> wait_for_unfreeze_and_check (unstake_wait -- 2) + --> wait_for_unfreeze_and_check (Fun.const 2) --> finalize "staker" --> next_cycle let shorter_roundtrip_for_baker = @@ -87,13 +96,13 @@ let status_quo_rountrip = --> unstake "staker" (Amount amount_1) --> next_cycle --> unstake "staker" (Amount amount_2)) - --> wait_n_cycles default_unstake_wait + --> wait_n_cycles_f 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) + --> wait_n_cycles_f (unstake_wait ++ 2) --> assert_failure (check_balance_field "staker" `Unstaked_finalizable Tez.zero) --> (Tag "finalize with finalize" --> finalize_unstake "staker" @@ -106,7 +115,7 @@ let scenario_finalize = (* 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) + --> wait_n_cycles_f (unstake_wait ++ 2) --> assert_failure (check_balance_field "staker" `Unstaked_finalizable Tez.zero) --> snapshot_balances "not finalize" ["staker"] @@ -139,7 +148,7 @@ let scenario_forbidden_operations = 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) + --> wait_n_cycles_f (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 @@ -174,7 +183,7 @@ let change_delegate = --> set_delegate "staker" (Some "delegate2") --> next_cycle --> assert_failure (stake "staker" Half) - --> wait_n_cycles (default_unstake_wait + 1) + --> wait_n_cycles_f (unstake_wait ++ 1) --> stake "staker" Half let unset_delegate = @@ -200,7 +209,7 @@ let unset_delegate = --> 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) + --> wait_n_cycles_f (unstake_wait ++ 1) --> finalize_unstake "staker" let forbid_costaking = @@ -228,7 +237,7 @@ let forbid_costaking = "delegate" (Amount (Tez.of_mutez 2_000_000_000_000L)) --> set_delegate "staker" (Some "delegate") - --> wait_cycle (`And (`AI_activation, `delegate_parameters_activation)) + --> wait_cycle_until (`And (`AI_activation, `delegate_parameters_activation)) --> next_cycle (* try stake in normal conditions *) --> stake "staker" amount @@ -248,7 +257,7 @@ let forbid_costaking = --> stake "delegate" amount (* Can still unstake *) --> unstake "staker" Half - --> wait_n_cycles (default_unstake_wait + 1) + --> wait_n_cycles_f (unstake_wait ++ 1) --> finalize_unstake "staker" (* Can authorize stake again *) --> set_delegate_params "delegate" init_params