Alpha: allow to ramp up endorsement and baking security deposits

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -89,6 +89,8 @@ module Fitness = struct
 
 end
 
+module Bootstrap = Bootstrap_storage
+
 module Commitment = struct
   include Commitment_repr
   include Commitment_storage

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -815,6 +815,13 @@ module Commitment : sig
 
 end
 
+module Bootstrap : sig
+
+  val cycle_end:
+    context -> Cycle.t -> context tzresult Lwt.t
+
+end
+
 val prepare_first_block:
   Context.t ->
   level:Int32.t ->

src/proto_alpha/lib_protocol/src/apply.ml

@@ -649,6 +649,7 @@ let may_start_new_cycle ctxt =
       Seed.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed) ->
       Roll.cycle_end ctxt last_cycle >>=? fun ctxt ->
       Delegate.cycle_end ctxt last_cycle unrevealed >>=? fun ctxt ->
+      Bootstrap.cycle_end ctxt last_cycle >>=? fun ctxt ->
       return ctxt
 
 let begin_full_construction ctxt pred_timestamp protocol_data =

src/proto_alpha/lib_protocol/src/bootstrap_storage.ml

@@ -7,7 +7,9 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let init ctxt (account: Parameters_repr.bootstrap_account) =
+open Misc
+
+let init_account ctxt (account: Parameters_repr.bootstrap_account) =
   let public_key_hash = Signature.Public_key.hash account.public_key in
   let contract = Contract_repr.implicit_contract public_key_hash in
   Contract_storage.credit ctxt contract account.amount >>=? fun ctxt ->
@@ -15,5 +17,45 @@ let init ctxt (account: Parameters_repr.bootstrap_account) =
   Delegate_storage.set ctxt contract (Some public_key_hash) >>=? fun ctxt ->
   return ctxt
 
-let init ctxt accounts =
+let init ctxt ?ramp_up_cycles accounts =
-  fold_left_s init ctxt accounts
+  fold_left_s init_account ctxt accounts >>=? fun ctxt ->
+  match ramp_up_cycles with
+  | None -> return ctxt
+  | Some cycles ->
+      (* Store pending ramp ups. *)
+      let constants = Raw_context.constants ctxt in
+      Lwt.return Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles) >>=? fun block_step ->
+      Lwt.return Tez_repr.(constants.endorsement_security_deposit /? Int64.of_int cycles) >>=? fun endorsement_step ->
+      (* Start without security_deposit *)
+      Raw_context.patch_constants ctxt
+        (fun c ->
+           { c with
+             block_security_deposit = Tez_repr.zero ;
+             endorsement_security_deposit = Tez_repr.zero  }) >>= fun ctxt ->
+      fold_left_s
+        (fun ctxt cycle ->
+           Lwt.return Tez_repr.(block_step *? Int64.of_int cycle) >>=? fun block_security_deposit ->
+           Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle) >>=? fun endorsement_security_deposit ->
+           let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
+           Storage.Ramp_up.Security_deposits.init ctxt cycle
+             (block_security_deposit, endorsement_security_deposit))
+        ctxt
+        (1 --> (cycles - 1)) >>=? fun ctxt ->
+      (* Store the final security deposits. *)
+      Storage.Ramp_up.Security_deposits.init ctxt
+        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
+        (constants.block_security_deposit,
+         constants.endorsement_security_deposit) >>=? fun ctxt ->
+      return ctxt
+
+let cycle_end ctxt last_cycle =
+  let next_cycle = Cycle_repr.succ last_cycle in
+  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle >>=? function
+  | None -> return ctxt
+  | Some (block_security_deposit, endorsement_security_deposit) ->
+      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle >>=? fun ctxt ->
+      Raw_context.patch_constants ctxt
+        (fun c ->
+           { c with block_security_deposit ;
+                    endorsement_security_deposit }) >>= fun ctxt ->
+      return ctxt

src/proto_alpha/lib_protocol/src/bootstrap_storage.mli

@@ -9,5 +9,11 @@
 
 val init:
   Raw_context.t ->
+  ?ramp_up_cycles:int ->
   Parameters_repr.bootstrap_account list ->
   Raw_context.t tzresult Lwt.t
+
+val cycle_end:
+  Raw_context.t ->
+  Cycle_repr.t ->
+  Raw_context.t tzresult Lwt.t

src/proto_alpha/lib_protocol/src/init_storage.ml

@@ -15,7 +15,9 @@ let prepare_first_block ctxt ~level ~timestamp ~fitness =
   Roll_storage.init ctxt >>=? fun ctxt ->
   Seed_storage.init ctxt >>=? fun ctxt ->
   Contract_storage.init ctxt >>=? fun ctxt ->
-  Bootstrap_storage.init ctxt param.bootstrap_accounts >>=? fun ctxt ->
+  Bootstrap_storage.init ctxt
+    ?ramp_up_cycles:param.security_deposit_ramp_up_cycles
+    param.bootstrap_accounts >>=? fun ctxt ->
   Roll_storage.init_first_cycles ctxt >>=? fun ctxt ->
   Vote_storage.init ctxt >>=? fun ctxt ->
   return ctxt

src/proto_alpha/lib_protocol/src/parameters_repr.ml

@@ -16,6 +16,7 @@ type t = {
   bootstrap_accounts : bootstrap_account list ;
   commitments : (Unclaimed_public_key_hash.t * Commitment_repr.t) list ;
   constants : Constants_repr.parametric ;
+  security_deposit_ramp_up_cycles : int option ;
 }
 
 let bootstrap_account_encoding =
@@ -208,15 +209,20 @@ let constants_encoding =
 let encoding =
   let open Data_encoding in
   conv
-    (fun { bootstrap_accounts ; commitments ; constants } ->
+    (fun { bootstrap_accounts ; commitments ; constants ;
-       ((bootstrap_accounts, commitments), constants ))
+           security_deposit_ramp_up_cycles } ->
-    (fun ( (bootstrap_accounts, commitments), constants ) ->
+      ((bootstrap_accounts, commitments, security_deposit_ramp_up_cycles),
-       { bootstrap_accounts ; commitments ; constants })
+       constants))
+    (fun ( (bootstrap_accounts, commitments, security_deposit_ramp_up_cycles),
+           constants) ->
+      { bootstrap_accounts ; commitments ; constants ;
+        security_deposit_ramp_up_cycles})
     (merge_objs
-       (obj2
+       (obj3
           (req "bootstrap_accounts" (list bootstrap_account_encoding))
           (dft "commitments"
              (list (merge_tups
                       (tup1 Unclaimed_public_key_hash.encoding)
-                      Commitment_repr.encoding)) []))
+                      Commitment_repr.encoding)) [])
+          (opt "security_deposit_ramp_up_cycles" int31))
        constants_encoding)

src/proto_alpha/lib_protocol/src/parameters_repr.mli

@@ -16,6 +16,7 @@ type t = {
   bootstrap_accounts : bootstrap_account list ;
   commitments : (Unclaimed_public_key_hash.t * Commitment_repr.t) list ;
   constants : Constants_repr.parametric ;
+  security_deposit_ramp_up_cycles : int option ;
 }
 
 val encoding: t Data_encoding.t

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -228,6 +228,11 @@ let get_constants ctxt =
           failwith "Internal error: cannot parse constants in context."
       | Some constants -> return constants
 
+let patch_constants ctxt f =
+  let constants = f ctxt.constants in
+  set_constants ctxt.context constants >>= fun context ->
+  Lwt.return { ctxt with context ; constants }
+
 let check_inited ctxt =
   Context.get ctxt version_key >>= function
   | None ->

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -61,6 +61,10 @@ val current_fitness: context -> Int64.t
 val set_current_fitness: context -> Int64.t -> t
 
 val constants: context -> Constants_repr.parametric
+val patch_constants:
+  context ->
+  (Constants_repr.parametric -> Constants_repr.parametric) ->
+  context Lwt.t
 val first_level: context -> Raw_level_repr.t
 
 val add_fees: context -> Tez_repr.t -> context tzresult Lwt.t

src/proto_alpha/lib_protocol/src/storage.ml

@@ -427,6 +427,21 @@ module Commitments =
     (Unclaimed_public_key_hash.Index)
     (Make_value(Commitment_repr))
 
+(** Ramp up security deposits... *)
+
+module Ramp_up = struct
+
+  module Security_deposits =
+    Make_indexed_data_storage
+      (Make_subcontext(Raw_context)(struct let name = ["ramp_up"; "deposits"] end))
+      (Cycle_repr.Index)
+      (Make_value(struct
+         type t = Tez_repr.t * Tez_repr.t
+         let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
+       end))
+
+end
+
 (** Resolver *)
 
 let () =

src/proto_alpha/lib_protocol/src/storage.mli

@@ -263,3 +263,15 @@ module Commitments : Indexed_data_storage
   with type key = Unclaimed_public_key_hash.t
    and type value = Commitment_repr.t
    and type t := Raw_context.t
+
+(** Ramp up security deposits... *)
+
+module Ramp_up : sig
+
+  module Security_deposits :
+    Indexed_data_storage
+    with type key = Cycle_repr.t
+     and type value = Tez_repr.t * Tez_repr.t (* baking * endorsement *)
+     and type t := Raw_context.t
+
+end