Alpha: freeze delegation rights (preserved_cycles+1) in advance

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -99,6 +99,8 @@ module Cycle : sig
   val root: cycle
   val succ: cycle -> cycle
   val pred: cycle -> cycle option
+  val add: cycle -> int -> cycle
+  val sub: cycle -> int -> cycle option
   val to_int32: cycle -> int32
 
 end
@@ -370,8 +372,12 @@ end
 
 module Seed : sig
 
-  val compute_for_cycle: context -> Cycle.t -> context tzresult Lwt.t
+  type error +=
-  val clear_cycle: context -> Cycle.t -> context tzresult Lwt.t
+    | Unknown of { oldest : Cycle.t ;
+                   cycle : Cycle.t ;
+                   latest : Cycle.t }
+
+  val cycle_end: context -> Cycle.t -> context tzresult Lwt.t
 
 end
 
@@ -690,8 +696,7 @@ module Roll : sig
 
   val value: context -> Tez.t
 
-  val freeze_rolls_for_cycle: context -> Cycle.t -> context tzresult Lwt.t
+  val cycle_end: context -> Cycle.t -> context tzresult Lwt.t
-  val clear_cycle: context -> Cycle.t -> context tzresult Lwt.t
 
   val baking_rights_owner:
     context -> Level.t -> priority:int -> public_key tzresult Lwt.t

src/proto_alpha/lib_protocol/src/apply.ml

@@ -327,19 +327,8 @@ let may_start_new_cycle ctxt =
   Baking.dawn_of_a_new_cycle ctxt >>=? function
   | None -> return ctxt
   | Some last_cycle ->
-      let new_cycle = Cycle.succ last_cycle in
+      Seed.cycle_end ctxt last_cycle >>=? fun ctxt ->
-      let succ_new_cycle = Cycle.succ new_cycle in
+      Roll.cycle_end ctxt last_cycle >>=? fun ctxt ->
-      begin
-        (* Temporary, the seed needs to be preserve until
-           no denunciation are allowed *)
-        match Cycle.pred last_cycle with
-        | None -> return ctxt
-        | Some pred_last_cycle ->
-            Seed.clear_cycle ctxt pred_last_cycle >>=? fun ctxt ->
-            Roll.clear_cycle ctxt pred_last_cycle
-      end >>=? fun ctxt ->
-      Seed.compute_for_cycle ctxt succ_new_cycle >>=? fun ctxt ->
-      Roll.freeze_rolls_for_cycle ctxt succ_new_cycle >>=? fun ctxt ->
       let timestamp = Timestamp.current ctxt in
       Lwt.return (Timestamp.(timestamp +? (Constants.time_before_reward ctxt)))
       >>=? fun reward_date ->

src/proto_alpha/lib_protocol/src/cycle_repr.ml

@@ -34,6 +34,15 @@ let pred = function
   | 0l -> None
   | i -> Some (Int32.pred i)
 
+let add c i =
+  assert Compare.Int.(i > 0) ;
+  Int32.add c (Int32.of_int i)
+
+let sub c i =
+  assert Compare.Int.(i > 0) ;
+  let r = Int32.sub c (Int32.of_int i) in
+  if Compare.Int32.(r < 0l) then None else Some r
+
 let to_int32 i = i
 
 let of_int32_exn l =

src/proto_alpha/lib_protocol/src/cycle_repr.mli

@@ -16,6 +16,8 @@ val pp: Format.formatter -> cycle -> unit
 
 val root: cycle
 val pred: cycle -> cycle option
+val add: cycle -> int -> cycle
+val sub: cycle -> int -> cycle option
 val succ: cycle -> cycle
 
 val to_int32: cycle -> int32

src/proto_alpha/lib_protocol/src/init_storage.ml

@@ -8,18 +8,15 @@
 (**************************************************************************)
 
 (* This is the genesis protocol: initialise the state *)
-let initialize store =
+let initialize ctxt =
-  Roll_storage.init store >>=? fun store ->
+  Roll_storage.init ctxt >>=? fun ctxt ->
-  Seed_storage.init store >>=? fun store ->
+  Seed_storage.init ctxt >>=? fun ctxt ->
-  Contract_storage.init store >>=? fun store ->
+  Contract_storage.init ctxt >>=? fun ctxt ->
-  Reward_storage.init store >>=? fun store ->
+  Reward_storage.init ctxt >>=? fun ctxt ->
-  Bootstrap_storage.init store >>=? fun store ->
+  Bootstrap_storage.init ctxt >>=? fun ctxt ->
-  Roll_storage.freeze_rolls_for_cycle
+  Roll_storage.init_first_cycles ctxt >>=? fun ctxt ->
-    store Cycle_repr.root >>=? fun store ->
+  Vote_storage.init ctxt >>=? fun ctxt ->
-  Roll_storage.freeze_rolls_for_cycle
+  return ctxt
-    store Cycle_repr.(succ root) >>=? fun store ->
-  Vote_storage.init store >>=? fun store ->
-  return store
 
 let may_initialize ctxt ~level ~timestamp ~fitness =
   Raw_context.prepare

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -55,7 +55,7 @@ let storage_error_encoding =
     case (Tag 1)
       (obj2
          (req "missing_key" (list string))
-         (req "function" (string_enum ["get", `Get ; "set", `Set ; "del", `Del ])))
+         (req "function" (string_enum ["get", `Get ; "set", `Set ; "del", `Del ; "copy", `Copy ])))
       (function Missing_key (key, f) -> Some (key, f) | _ -> None)
       (fun (key, f) -> Missing_key (key, f)) ;
     case (Tag 2)

src/proto_alpha/lib_protocol/src/roll_storage.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Misc
+
 type error +=
   | Consume_roll_change
   | No_roll_for_delegate
@@ -240,5 +242,26 @@ end
 
 let value = Raw_context.roll_value
 
-let init c =
+let init ctxt =
-  Storage.Roll.Next.init c Roll_repr.first
+  Storage.Roll.Next.init ctxt Roll_repr.first
+
+let init_first_cycles ctxt =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  List.fold_left
+    (fun ctxt c ->
+       ctxt >>=? fun ctxt ->
+       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
+       freeze_rolls_for_cycle ctxt cycle)
+    (return ctxt) (0 --> (preserved + 1)) >>=? fun ctxt ->
+  return ctxt
+
+let cycle_end ctxt last_cycle =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  begin
+    match Cycle_repr.sub last_cycle preserved with
+    | None -> return ctxt
+    | Some cleared_cycle ->
+        clear_cycle ctxt cleared_cycle
+  end >>=? fun ctxt ->
+  let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved+2) in
+  freeze_rolls_for_cycle ctxt frozen_roll_cycle

src/proto_alpha/lib_protocol/src/roll_storage.mli

@@ -23,18 +23,15 @@ type error +=
   | Unregistered_delegate of Ed25519.Public_key_hash.t (* `Permanent *)
 
 val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
+val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
 
 val fold :
   Raw_context.t ->
   f:(Roll_repr.roll -> Ed25519.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->
   'a -> 'a tzresult Lwt.t
 
-val freeze_rolls_for_cycle :
-  Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
-
-val clear_cycle :
-  Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
-
 val baking_rights_owner :
   Raw_context.t -> Level_repr.t -> priority:int ->
   Ed25519.Public_key.t tzresult Lwt.t

src/proto_alpha/lib_protocol/src/seed_repr.ml

@@ -97,11 +97,14 @@ let initial_nonce_0 =
 let initial_nonce_hash_0 =
   hash initial_nonce_0
 
-let initial_seed_0 = B (State_hash.hash_bytes [])
+let initial_seeds n =
-let initial_seed_1 =
+  let rec loop acc elt i =
-  nonce initial_seed_0
+    if Compare.Int.(i = 0) then
-    (MBytes.of_string (String.make Constants_repr.nonce_length '\000'))
+      List.rev (elt :: acc)
-let initial_seed_2 =
+    else
-  nonce initial_seed_1
+      loop
-    (MBytes.of_string (String.make Constants_repr.nonce_length '\000'))
+        (elt :: acc)
-
+        (nonce elt
+           (MBytes.of_string (String.make Constants_repr.nonce_length '\000')))
+        (i-1) in
+  loop [] (B (State_hash.hash_bytes [])) n

src/proto_alpha/lib_protocol/src/seed_repr.mli

@@ -43,9 +43,7 @@ val take_int32 : sequence -> int32 -> int32 * sequence
 (** {2 Predefined seeds} *****************************************************)
 
 val empty : seed
-val initial_seed_0 : seed
+val initial_seeds : int -> seed list
-val initial_seed_1 : seed
-val initial_seed_2 : seed
 
 (** {2 Entropy} **************************************************************)
 

src/proto_alpha/lib_protocol/src/seed_storage.ml

@@ -7,27 +7,46 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type error +=
+open Misc
-  | Precomputed_seed
-  | Invalid_cycle
 
-let compute_for_cycle c cycle =
+type error +=
-  begin
+  | Unknown of { oldest : Cycle_repr.t ;
-    begin
+                 cycle : Cycle_repr.t ;
-      match Cycle_repr.pred cycle with
+                 latest : Cycle_repr.t } (* `Permanent *)
-      | None -> fail Precomputed_seed
+
-      | Some previous_cycle -> return previous_cycle
+let () =
-    end >>=? fun previous_cycle ->
+  register_error_kind
-    begin
+    `Permanent
-      match Cycle_repr.pred previous_cycle with
+    ~id:"seed.unknown_seed"
-      | None -> fail Precomputed_seed
+    ~title:"Unknown seed"
-      | Some pprevious_cycle ->
+    ~description:"The requested seed is not available"
-          match Cycle_repr.pred pprevious_cycle with
+    ~pp:(fun ppf (oldest, cycle, latest) ->
-          | None -> fail Precomputed_seed
+        if Cycle_repr.(cycle < oldest) then
-          | Some revealed_cycle -> return revealed_cycle
+          Format.fprintf ppf
-    end >>=? fun revealed_cycle ->
+            "The seed for cycle %a has been cleared from the context \
-    begin
+            \ (oldest known seed is for cycle %a)"
-      let levels = Level_storage.levels_in_cycle c revealed_cycle in
+            Cycle_repr.pp cycle
+            Cycle_repr.pp oldest
+        else
+          Format.fprintf ppf
+            "The seed for cycle %a has not been computed yet \
+            \ (latest known seed is for cycle %a)"
+            Cycle_repr.pp cycle
+            Cycle_repr.pp latest)
+    Data_encoding.(obj3
+                     (req "oldest" Cycle_repr.encoding)
+                     (req "requested" Cycle_repr.encoding)
+                     (req "latest" Cycle_repr.encoding))
+    (function
+      | Unknown { oldest ; cycle ; latest } -> Some (oldest, cycle, latest)
+      | _ -> None)
+    (fun (oldest, cycle, latest) -> Unknown { oldest ; cycle ; latest })
+
+let compute_for_cycle c ~revealed cycle =
+  match Cycle_repr.pred cycle with
+  | None -> assert false (* should not happen *)
+  | Some previous_cycle ->
+      let levels = Level_storage.levels_in_cycle c revealed in
       let combine (c, random_seed) level =
         Storage.Seed.Nonce.get c level >>=? function
         | Revealed nonce ->
@@ -38,34 +57,48 @@ let compute_for_cycle c cycle =
             return (c, random_seed)
       in
       Storage.Seed.For_cycle.get c previous_cycle >>=? fun seed ->
-      fold_left_s combine (c, seed) levels
+      fold_left_s combine (c, seed) levels >>=? fun (c, seed) ->
-    end >>=? fun (c, seed) ->
+      Storage.Seed.For_cycle.init c cycle seed >>=? fun c ->
-    Storage.Seed.For_cycle.init c cycle seed >>=? fun c ->
+      return c
-    return c
-  end >>= function
-  | Error [Precomputed_seed] -> return c
-  | c -> Lwt.return c
 
-let for_cycle c cycle =
+let for_cycle ctxt cycle =
-  (* let current_level = Level_storage.current c in *)
+  let preserved = Constants_storage.preserved_cycles ctxt in
-  (* let current_cycle = current_level.cycle in *)
+  let current_level = Level_storage.current ctxt in
-  (* let next_cycle = (Level_storage.succ c current_level).cycle in *)
+  let current_cycle = current_level.cycle in
-  (* Temporary, we need to preserve the seed for 5 more cycle. *)
+  let latest = Cycle_repr.add current_cycle preserved in
-  (* fail_unless *)
+  let oldest =
-  (* Cycle_repr.(cycle = current_cycle || cycle = next_cycle) *)
+    match Cycle_repr.sub current_cycle preserved with
-  (* Invalid_cycle >>=? fun () -> *)
+    | None -> Cycle_repr.root
-  Storage.Seed.For_cycle.get c cycle
+    | Some oldest -> oldest in
+  fail_unless Cycle_repr.(oldest <= cycle && cycle <= latest)
+    (Unknown { oldest ; cycle ; latest }) >>=? fun () ->
+  Storage.Seed.For_cycle.get ctxt cycle
 
 let clear_cycle c cycle =
   Storage.Seed.For_cycle.delete c cycle
 
-let init c =
+let init ctxt =
-  Storage.Seed.For_cycle.init c
+  let preserved = Constants_storage.preserved_cycles ctxt in
-    Cycle_repr.root
+  List.fold_left2
-    Seed_repr.initial_seed_0 >>=? fun c ->
+    (fun ctxt c seed ->
-  Storage.Seed.For_cycle.init c
+       ctxt >>=? fun ctxt ->
-    Cycle_repr.(succ root)
+       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
-    Seed_repr.initial_seed_1 >>=? fun c ->
+       Storage.Seed.For_cycle.init ctxt cycle seed)
-  Storage.Seed.For_cycle.init c
+    (return ctxt)
-    Cycle_repr.(succ (succ root))
+    (0 --> (preserved+1))
-    Seed_repr.initial_seed_2
+    (Seed_repr.initial_seeds (preserved+1))
+
+let cycle_end ctxt last_cycle =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  begin
+    match Cycle_repr.sub last_cycle preserved with
+    | None -> return ctxt
+    | Some cleared_cycle ->
+        clear_cycle ctxt cleared_cycle
+  end >>=? fun ctxt ->
+  match Cycle_repr.pred last_cycle with
+  | None -> return ctxt
+  | Some revealed ->
+      let inited_seed_cycle = Cycle_repr.add last_cycle (preserved+1) in
+      compute_for_cycle ctxt ~revealed inited_seed_cycle
+

src/proto_alpha/lib_protocol/src/seed_storage.mli

@@ -8,16 +8,15 @@
 (**************************************************************************)
 
 type error +=
-  | Precomputed_seed
+  | Unknown of { oldest : Cycle_repr.t ;
-  | Invalid_cycle
+                 cycle : Cycle_repr.t ;
+                 latest : Cycle_repr.t } (* `Permanent *)
 
 val init:
   Raw_context.t -> Raw_context.t tzresult Lwt.t
 
-val compute_for_cycle:
+val for_cycle:
-  Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
+  Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t
 
-val for_cycle: Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t
+val cycle_end:
-
-val clear_cycle:
   Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t