Alpha: Failing test for deactivation

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

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

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

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

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"

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 ;
   ]

src/proto_alpha/lib_protocol/test/rolls.ml

@@ -0,0 +1,100 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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) ;
+]