Alpha: prepare storage for multiple roll snapshots per cycle

src/proto_alpha/lib_protocol/src/roll_storage.ml

@@ -41,8 +41,10 @@ let delegate_pubkey ctxt delegate =
       return pk
 
 let clear_cycle c cycle =
-  Storage.Roll.Last_for_cycle.delete c cycle >>=? fun c ->
-  Storage.Roll.Owner.delete_snapshot c cycle >>= fun c ->
+  Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->
+  Storage.Roll.Snapshot_for_cycle.delete c cycle >>=? fun c ->
+  Storage.Roll.Last_for_snapshot.delete (c, cycle) index >>=? fun c ->
+  Storage.Roll.Owner.delete_snapshot c (cycle, index) >>= fun c ->
   return c
 
 let fold ctxt ~f init =
@@ -60,9 +62,11 @@ let fold ctxt ~f init =
   loop ctxt Roll_repr.first (return init)
 
 let freeze_rolls_for_cycle ctxt cycle =
-  Storage.Roll.Owner.snapshot ctxt cycle >>=? fun ctxt ->
+  let index = 0 in
+  Storage.Roll.Owner.snapshot ctxt (cycle, index) >>=? fun ctxt ->
   Storage.Roll.Next.get ctxt >>=? fun last ->
-  Storage.Roll.Last_for_cycle.init ctxt cycle last
+  Storage.Roll.Snapshot_for_cycle.init ctxt cycle index >>=? fun ctxt ->
+  Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last
 
 (* Roll selection *)
 
@@ -84,15 +88,16 @@ module Random = struct
     Seed_storage.for_cycle c cycle >>=? fun random_seed ->
     let rd = level_random random_seed kind level in
     let sequence = Seed_repr.sequence rd (Int32.of_int offset) in
-    Storage.Roll.Last_for_cycle.get c cycle >>=? fun bound ->
+    Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->
+    Storage.Roll.Last_for_snapshot.get (c, cycle) index >>=? fun bound ->
     let rec loop sequence =
       let roll, sequence = Roll_repr.random sequence ~bound in
-      Storage.Roll.Owner.Snapshot.get_option c (cycle, roll) >>=? function
+      Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll) >>=? function
       | None ->
           loop sequence
       | Some delegate ->
           return delegate in
-    Storage.Roll.Owner.snapshot_exists c cycle >>= fun snapshot_exists ->
+    Storage.Roll.Owner.snapshot_exists c (cycle, index) >>= fun snapshot_exists ->
     fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle) >>=? fun () ->
     loop sequence
 

src/proto_alpha/lib_protocol/src/storage.ml

@@ -9,11 +9,27 @@
 
 open Storage_functors
 
+module Int = struct
+  type t = int
+  let encoding = Data_encoding.uint16
+end
+
 module Int32 = struct
   type t = Int32.t
   let encoding = Data_encoding.int32
 end
 
+module Int_index = struct
+  type t = int
+  let path_length = 1
+  let to_path c l = string_of_int c :: l
+  let of_path = function
+    | [] | _ :: _ :: _ -> None
+    | [ c ] ->
+        try Some (int_of_string c)
+        with _ -> None
+end
+
 module String_index = struct
   type t = string
   let path_length = 1
@@ -166,10 +182,18 @@ module Cycle = struct
       (Cycle_repr.Index)
 
   module Last_roll =
-    Indexed_context.Make_map
-      (struct let name = ["last_roll"] end)
+    Make_indexed_data_storage
+      (Make_subcontext
+         (Indexed_context.Raw_context)
+         (struct let name = ["last_roll"] end))
+      (Int_index)
       (Make_value(Roll_repr))
 
+  module Roll_snapshot =
+    Indexed_context.Make_map
+      (struct let name = ["roll_snapshot"] end)
+      (Make_value(Int))
+
   type unrevealed_nonce = {
     nonce_hash: Nonce_hash.t ;
     delegate: Ed25519.Public_key_hash.t ;
@@ -268,14 +292,32 @@ module Roll = struct
       let unwrap = Contract_repr.is_implicit
     end)
 
+  module Snapshoted_owner_index = struct
+    type t = Cycle_repr.t * int
+    let path_length = Cycle_repr.Index.path_length + 1
+    let to_path (c, n) s =
+      Cycle_repr.Index.to_path c (string_of_int n :: s)
+    let of_path l =
+      match Misc.take Cycle_repr.Index.path_length l with
+      | None | Some (_, ([] | _ :: _ :: _ ))-> None
+      | Some (l1, [l2]) ->
+          match Cycle_repr.Index.of_path l1 with
+          | None -> None
+          | Some c -> begin
+              try Some (c, int_of_string l2)
+              with _ -> None
+            end
+  end
+
   module Owner =
     Make_indexed_data_snapshotable_storage
       (Make_subcontext(Raw_context)(struct let name = ["owner"] end))
-      (Cycle_repr.Index)
+      (Snapshoted_owner_index)
       (Roll_repr.Index)
       (Make_value(Ed25519.Public_key))
 
-  module Last_for_cycle = Cycle.Last_roll
+  module Snapshot_for_cycle = Cycle.Roll_snapshot
+  module Last_for_snapshot = Cycle.Last_roll
 
   let clear = Indexed_context.clear
 

src/proto_alpha/lib_protocol/src/storage.mli

@@ -27,7 +27,7 @@ module Roll : sig
 
   module Owner : Indexed_data_snapshotable_storage
     with type key = Roll_repr.t
-     and type snapshot = Cycle_repr.t
+     and type snapshot = (Cycle_repr.t * int)
      and type value = Ed25519.Public_key.t
      and type t := Raw_context.t
 
@@ -64,12 +64,18 @@ module Roll : sig
      and type value = Tez_repr.t
      and type t := Raw_context.t
 
-  (** Last roll in the snapshoted roll allocation of a given cycle. *)
-  module Last_for_cycle : Indexed_data_storage
+  (** Index of the randomly selected roll snapshot of a given cycle. *)
+  module Snapshot_for_cycle : Indexed_data_storage
     with type key = Cycle_repr.t
-     and type value = Roll_repr.t
+     and type value = int
      and type t := Raw_context.t
 
+  (** Last roll in the snapshoted roll allocation of a given cycle. *)
+  module Last_for_snapshot : Indexed_data_storage
+    with type key = int
+     and type value = Roll_repr.t
+     and type t = Raw_context.t * Cycle_repr.t
+
 end
 
 module Contract : sig