diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index ed149129b..7d2aa8e00 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/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 - val clear_cycle: context -> Cycle.t -> context tzresult Lwt.t + type error += + | 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 clear_cycle: context -> Cycle.t -> context tzresult Lwt.t + val cycle_end: context -> Cycle.t -> context tzresult Lwt.t val baking_rights_owner: context -> Level.t -> priority:int -> public_key tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 2c45aca89..83f85119f 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/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 - let succ_new_cycle = Cycle.succ new_cycle in - 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 -> + Seed.cycle_end ctxt last_cycle >>=? fun ctxt -> + Roll.cycle_end ctxt last_cycle >>=? fun ctxt -> let timestamp = Timestamp.current ctxt in Lwt.return (Timestamp.(timestamp +? (Constants.time_before_reward ctxt))) >>=? fun reward_date -> diff --git a/src/proto_alpha/lib_protocol/src/cycle_repr.ml b/src/proto_alpha/lib_protocol/src/cycle_repr.ml index 3999cea62..cadd30a90 100644 --- a/src/proto_alpha/lib_protocol/src/cycle_repr.ml +++ b/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 = diff --git a/src/proto_alpha/lib_protocol/src/cycle_repr.mli b/src/proto_alpha/lib_protocol/src/cycle_repr.mli index f580b09ee..724780989 100644 --- a/src/proto_alpha/lib_protocol/src/cycle_repr.mli +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/init_storage.ml b/src/proto_alpha/lib_protocol/src/init_storage.ml index 5be10de98..2ac7840d6 100644 --- a/src/proto_alpha/lib_protocol/src/init_storage.ml +++ b/src/proto_alpha/lib_protocol/src/init_storage.ml @@ -8,18 +8,15 @@ (**************************************************************************) (* This is the genesis protocol: initialise the state *) -let initialize store = - Roll_storage.init store >>=? fun store -> - Seed_storage.init store >>=? fun store -> - Contract_storage.init store >>=? fun store -> - Reward_storage.init store >>=? fun store -> - Bootstrap_storage.init store >>=? fun store -> - Roll_storage.freeze_rolls_for_cycle - store Cycle_repr.root >>=? fun store -> - Roll_storage.freeze_rolls_for_cycle - store Cycle_repr.(succ root) >>=? fun store -> - Vote_storage.init store >>=? fun store -> - return store +let initialize ctxt = + Roll_storage.init ctxt >>=? fun ctxt -> + Seed_storage.init ctxt >>=? fun ctxt -> + Contract_storage.init ctxt >>=? fun ctxt -> + Reward_storage.init ctxt >>=? fun ctxt -> + Bootstrap_storage.init ctxt >>=? fun ctxt -> + Roll_storage.init_first_cycles ctxt >>=? fun ctxt -> + Vote_storage.init ctxt >>=? fun ctxt -> + return ctxt let may_initialize ctxt ~level ~timestamp ~fitness = Raw_context.prepare diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index 5fbce3f14..e7dae6c4e 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/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) diff --git a/src/proto_alpha/lib_protocol/src/roll_storage.ml b/src/proto_alpha/lib_protocol/src/roll_storage.ml index 1cc56a4f1..08482abe7 100644 --- a/src/proto_alpha/lib_protocol/src/roll_storage.ml +++ b/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 = - Storage.Roll.Next.init c Roll_repr.first +let init ctxt = + 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 diff --git a/src/proto_alpha/lib_protocol/src/roll_storage.mli b/src/proto_alpha/lib_protocol/src/roll_storage.mli index 29dd9ad38..b2ba0aa8e 100644 --- a/src/proto_alpha/lib_protocol/src/roll_storage.mli +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/seed_repr.ml b/src/proto_alpha/lib_protocol/src/seed_repr.ml index 7f914b827..d210d7971 100644 --- a/src/proto_alpha/lib_protocol/src/seed_repr.ml +++ b/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_seed_1 = - nonce initial_seed_0 - (MBytes.of_string (String.make Constants_repr.nonce_length '\000')) -let initial_seed_2 = - nonce initial_seed_1 - (MBytes.of_string (String.make Constants_repr.nonce_length '\000')) - +let initial_seeds n = + let rec loop acc elt i = + if Compare.Int.(i = 0) then + List.rev (elt :: acc) + else + loop + (elt :: acc) + (nonce elt + (MBytes.of_string (String.make Constants_repr.nonce_length '\000'))) + (i-1) in + loop [] (B (State_hash.hash_bytes [])) n diff --git a/src/proto_alpha/lib_protocol/src/seed_repr.mli b/src/proto_alpha/lib_protocol/src/seed_repr.mli index 994987c82..99958ea06 100644 --- a/src/proto_alpha/lib_protocol/src/seed_repr.mli +++ b/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_seed_1 : seed -val initial_seed_2 : seed +val initial_seeds : int -> seed list (** {2 Entropy} **************************************************************) diff --git a/src/proto_alpha/lib_protocol/src/seed_storage.ml b/src/proto_alpha/lib_protocol/src/seed_storage.ml index d17270f70..573bfd997 100644 --- a/src/proto_alpha/lib_protocol/src/seed_storage.ml +++ b/src/proto_alpha/lib_protocol/src/seed_storage.ml @@ -7,27 +7,46 @@ (* *) (**************************************************************************) -type error += - | Precomputed_seed - | Invalid_cycle +open Misc -let compute_for_cycle c cycle = - begin - begin - match Cycle_repr.pred cycle with - | None -> fail Precomputed_seed - | Some previous_cycle -> return previous_cycle - end >>=? fun previous_cycle -> - begin - match Cycle_repr.pred previous_cycle with - | None -> fail Precomputed_seed - | Some pprevious_cycle -> - match Cycle_repr.pred pprevious_cycle with - | None -> fail Precomputed_seed - | Some revealed_cycle -> return revealed_cycle - end >>=? fun revealed_cycle -> - begin - let levels = Level_storage.levels_in_cycle c revealed_cycle in +type error += + | Unknown of { oldest : Cycle_repr.t ; + cycle : Cycle_repr.t ; + latest : Cycle_repr.t } (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"seed.unknown_seed" + ~title:"Unknown seed" + ~description:"The requested seed is not available" + ~pp:(fun ppf (oldest, cycle, latest) -> + if Cycle_repr.(cycle < oldest) then + Format.fprintf ppf + "The seed for cycle %a has been cleared from the context \ + \ (oldest known seed is for cycle %a)" + 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 - end >>=? fun (c, seed) -> - Storage.Seed.For_cycle.init c cycle seed >>=? fun c -> - return c - end >>= function - | Error [Precomputed_seed] -> return c - | c -> Lwt.return c + fold_left_s combine (c, seed) levels >>=? fun (c, seed) -> + Storage.Seed.For_cycle.init c cycle seed >>=? fun c -> + return c -let for_cycle c cycle = - (* let current_level = Level_storage.current c in *) - (* let current_cycle = current_level.cycle in *) - (* let next_cycle = (Level_storage.succ c current_level).cycle in *) - (* Temporary, we need to preserve the seed for 5 more cycle. *) - (* fail_unless *) - (* Cycle_repr.(cycle = current_cycle || cycle = next_cycle) *) - (* Invalid_cycle >>=? fun () -> *) - Storage.Seed.For_cycle.get c cycle +let for_cycle ctxt cycle = + let preserved = Constants_storage.preserved_cycles ctxt in + let current_level = Level_storage.current ctxt in + let current_cycle = current_level.cycle in + let latest = Cycle_repr.add current_cycle preserved in + let oldest = + match Cycle_repr.sub current_cycle preserved with + | None -> Cycle_repr.root + | 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 = - Storage.Seed.For_cycle.init c - Cycle_repr.root - Seed_repr.initial_seed_0 >>=? fun c -> - Storage.Seed.For_cycle.init c - Cycle_repr.(succ root) - Seed_repr.initial_seed_1 >>=? fun c -> - Storage.Seed.For_cycle.init c - Cycle_repr.(succ (succ root)) - Seed_repr.initial_seed_2 +let init ctxt = + let preserved = Constants_storage.preserved_cycles ctxt in + List.fold_left2 + (fun ctxt c seed -> + ctxt >>=? fun ctxt -> + let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in + Storage.Seed.For_cycle.init ctxt cycle seed) + (return ctxt) + (0 --> (preserved+1)) + (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 + diff --git a/src/proto_alpha/lib_protocol/src/seed_storage.mli b/src/proto_alpha/lib_protocol/src/seed_storage.mli index acedd4e50..7fd1f5516 100644 --- a/src/proto_alpha/lib_protocol/src/seed_storage.mli +++ b/src/proto_alpha/lib_protocol/src/seed_storage.mli @@ -8,16 +8,15 @@ (**************************************************************************) type error += - | Precomputed_seed - | Invalid_cycle + | Unknown of { oldest : Cycle_repr.t ; + cycle : Cycle_repr.t ; + latest : Cycle_repr.t } (* `Permanent *) val init: Raw_context.t -> Raw_context.t tzresult Lwt.t -val compute_for_cycle: - Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t +val for_cycle: + 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 clear_cycle: +val cycle_end: Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t