diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index 2815dd8c2..4f9840e75 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -364,3 +364,23 @@ let bake_until_cycle_end ?policy b = let current_level = Int32.rem current_level blocks_per_cycle in let delta = Int32.sub blocks_per_cycle current_level in bake_n ?policy (Int32.to_int delta) b + +let bake_until_n_cycle_end ?policy n b = + Error_monad.fold_left_s + (fun b _ -> bake_until_cycle_end ?policy b) b (1 -- n) + +let bake_until_cycle ?policy cycle (b:t) = + get_constants b >>=? fun Constants.{ parametric = { blocks_per_cycle } } -> + let rec loop (b:t) = + let current_cycle = + let current_level = b.header.shell.level in + let current_cycle = Int32.div current_level blocks_per_cycle in + current_cycle + in + if Int32.equal (Cycle.to_int32 cycle) current_cycle then + return b + else + bake_until_cycle_end ?policy b >>=? fun b -> + loop b + in + loop b diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.mli b/src/proto_alpha/lib_protocol/test/helpers/block.mli index cc756e6bc..5c6fea5ee 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/block.mli @@ -128,3 +128,9 @@ val bake_n : ?policy:baker_policy -> int -> t -> block tzresult Lwt.t (** Given a block [b] at level [l] bakes enough blocks to complete a cycle, that is [blocks_per_cycle - (l % blocks_per_cycle)]. *) val bake_until_cycle_end : ?policy:baker_policy -> t -> t tzresult Lwt.t + +(** Bakes enough blocks to end [n] cycles. *) +val bake_until_n_cycle_end : ?policy:baker_policy -> int -> t -> t tzresult Lwt.t + +(** Bakes enough blocks to reach the cycle. *) +val bake_until_cycle : ?policy:baker_policy -> Cycle.t -> t -> t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml index 2cae7aec8..4d02f0836 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml @@ -131,8 +131,27 @@ module Contract = struct end +module Delegate = struct + + type info = Delegate_services.info = { + balance: Tez.t ; + frozen_balance: Tez.t ; + frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ; + staking_balance: Tez.t ; + delegated_contracts: Contract_hash.t list ; + delegated_balance: Tez.t ; + deactivated: bool ; + grace_period: Cycle.t ; + } + + let info ctxt pkh = + Alpha_services.Delegate.info rpc_ctxt ctxt pkh + +end + let init ?(slow=false) + ?preserved_cycles ?endorsers_per_block ?commitments n = @@ -142,11 +161,13 @@ let init begin if slow then Block.genesis + ?preserved_cycles ?endorsers_per_block ?commitments accounts else Block.genesis + ?preserved_cycles ~blocks_per_cycle:32l ~blocks_per_commitment:4l ~blocks_per_roll_snapshot:8l diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.mli b/src/proto_alpha/lib_protocol/test/helpers/context.mli index 7557976af..04db8b6b8 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/context.mli @@ -44,10 +44,28 @@ module Contract : sig end +module Delegate : sig + + type info = Delegate_services.info = { + balance: Tez.t ; + frozen_balance: Tez.t ; + frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ; + staking_balance: Tez.t ; + delegated_contracts: Contract_hash.t list ; + delegated_balance: Tez.t ; + deactivated: bool ; + grace_period: Cycle.t ; + } + + val info: t -> public_key_hash -> Delegate_services.info tzresult Lwt.t + +end + (** [init n] : returns an initial block with [n] initialized accounts and the associated implicit contracts *) val init: ?slow: bool -> + ?preserved_cycles:int -> ?endorsers_per_block:int -> ?commitments:Commitment_repr.t list -> int -> (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t 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 d133476a9..93296a7f0 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml @@ -20,6 +20,12 @@ module Tez = struct let ( *? ) t1 t2 = (t1 *? t2) |> wrap_error let ( /? ) t1 t2 = (t1 /? t2) |> wrap_error + let ( + ) t1 t2 = + match t1 +? t2 with + | Ok r -> r + | Error r -> + Pervasives.failwith "adding tez" + let of_int x = match Tez.of_mutez (Int64.mul (Int64.of_int x) 1_000_000L) with | None -> invalid_arg "tez_of_int" diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index 7f8ffa959..117353bac 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -17,4 +17,5 @@ let () = "double baking", Double_baking.tests ; "seed", Seed.tests ; "baking", Baking.tests ; + "rolls", Rolls.tests ; ] diff --git a/src/proto_alpha/lib_protocol/test/rolls.ml b/src/proto_alpha/lib_protocol/test/rolls.ml new file mode 100644 index 000000000..8a8fee851 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/rolls.ml @@ -0,0 +1,100 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +let account_pair = function + | [a1; a2] -> (a1, a2) + | _ -> assert false + +let simple_staking_rights () = + Context.init 2 >>=? fun (b,accounts) -> + let (a1, a2) = account_pair accounts in + + Context.Contract.balance (B b) a1 >>=? fun balance -> + Context.Contract.manager (B b) a1 >>=? fun m1 -> + + Context.Delegate.info (B b) m1.pkh >>=? fun info -> + Assert.equal_tez ~loc:__LOC__ balance info.staking_balance + +let simple_staking_rights_after_baking () = + Context.init 2 >>=? fun (b,accounts) -> + let (a1, a2) = account_pair accounts in + + Context.Contract.balance (B b) a1 >>=? fun balance -> + Context.Contract.manager (B b) a1 >>=? fun m1 -> + Context.Contract.manager (B b) a2 >>=? fun m2 -> + + Block.bake_n ~policy:(By_account m2.pkh) 5 b >>=? fun b -> + + Context.Delegate.info (B b) m1.pkh >>=? fun info -> + Assert.equal_tez ~loc:__LOC__ balance info.staking_balance + +let frozen_deposit (info:Context.Delegate.info) = + Cycle.Map.fold (fun _ { Delegate.deposit } acc -> + Test_tez.Tez.(deposit + acc)) + info.frozen_balance_by_cycle Tez.zero + +let check_activate_staking_balance ~loc ~deactivated b (a, (m:Account.t)) = + Context.Delegate.info (B b) m.pkh >>=? fun info -> + Assert.equal_bool ~loc info.deactivated deactivated >>=? fun () -> + Context.Contract.balance (B b) a >>=? fun balance -> + let deposit = frozen_deposit info in + Assert.equal_tez ~loc Test_tez.Tez.(balance + deposit) info.staking_balance + +let run_until_deactivation () = + Context.init ~preserved_cycles:2 2 >>=? fun (b,accounts) -> + let (a1, a2) = account_pair accounts in + + Context.Contract.balance (B b) a1 >>=? fun balance_start -> + Context.Contract.manager (B b) a1 >>=? fun m1 -> + Context.Contract.manager (B b) a2 >>=? fun m2 -> + + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1,m1) >>=? fun () -> + + Context.Delegate.info (B b) m1.pkh >>=? fun info -> + Block.bake_until_cycle ~policy:(By_account m2.pkh) info.grace_period b >>=? fun b -> + + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1,m1) >>=? fun () -> + + Block.bake_until_cycle_end ~policy:(By_account m2.pkh) b >>=? fun b -> + + check_activate_staking_balance ~loc:__LOC__ ~deactivated:true b (a1,m1) >>=? fun () -> + return (b, ((a1, m1), balance_start), (a2, m2)) + +let deactivation_then_bake () = + run_until_deactivation () >>=? + fun (b, ((deactivated_contract, deactivated_account) as deactivated, _start_balance), + (a2, m2)) -> + + Block.bake ~policy:(By_account deactivated_account.pkh) b >>=? fun b -> + + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated + +let deactivation_then_self_delegation () = + run_until_deactivation () >>=? + fun (b, ((deactivated_contract, deactivated_account) as deactivated, start_balance), + (a2, m2)) -> + + Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) >>=? fun self_delegation -> + + Block.bake ~policy:(By_account m2.pkh) b ~operation:self_delegation >>=? fun b -> + + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () -> + Context.Contract.balance (B b) deactivated_contract >>=? fun balance -> + Assert.equal_tez ~loc:__LOC__ start_balance balance + + +let tests = [ + Test.tztest "simple staking rights" `Quick (simple_staking_rights) ; + Test.tztest "simple staking rights after baking" `Quick (simple_staking_rights_after_baking) ; + Test.tztest "deactivation then bake" `Quick (deactivation_then_bake) ; + Test.tztest "deactivation then self delegation" `Quick (deactivation_then_self_delegation) ; +]