Proto: allow decreasing baking slot durations.

This commit is contained in:
Benjamin Canou 2017-02-24 18:32:30 +01:00 committed by Grégoire Henry
parent de866a0943
commit d0e9d0d584
9 changed files with 48 additions and 39 deletions

View File

@ -46,8 +46,8 @@ module Constants = struct
call_error_service1 cctxt Services.Constants.voting_period_length block () call_error_service1 cctxt Services.Constants.voting_period_length block ()
let time_before_reward cctxt block = let time_before_reward cctxt block =
call_error_service1 cctxt Services.Constants.time_before_reward block () call_error_service1 cctxt Services.Constants.time_before_reward block ()
let time_between_slots cctxt block = let slot_durations cctxt block =
call_error_service1 cctxt Services.Constants.time_between_slots block () call_error_service1 cctxt Services.Constants.slot_durations block ()
let first_free_mining_slot cctxt block = let first_free_mining_slot cctxt block =
call_error_service1 cctxt Services.Constants.first_free_mining_slot block () call_error_service1 cctxt Services.Constants.first_free_mining_slot block ()
let max_signing_slot cctxt block = let max_signing_slot cctxt block =

View File

@ -35,9 +35,9 @@ module Constants : sig
val time_before_reward: val time_before_reward:
Client_commands.context -> Client_commands.context ->
block -> Period.t tzresult Lwt.t block -> Period.t tzresult Lwt.t
val time_between_slots: val slot_durations:
Client_commands.context -> Client_commands.context ->
block -> Period.t tzresult Lwt.t block -> (Period.t list) tzresult Lwt.t
val first_free_mining_slot: val first_free_mining_slot:
Client_commands.context -> Client_commands.context ->
block -> int32 tzresult Lwt.t block -> int32 tzresult Lwt.t

View File

@ -35,7 +35,7 @@ type constants = {
cycle_length: int32 ; cycle_length: int32 ;
voting_period_length: int32 ; voting_period_length: int32 ;
time_before_reward: Period_repr.t ; time_before_reward: Period_repr.t ;
time_between_slots: Period_repr.t ; slot_durations: Period_repr.t list ;
first_free_mining_slot: int32 ; first_free_mining_slot: int32 ;
max_signing_slot: int ; max_signing_slot: int ;
instructions_per_transaction: int ; instructions_per_transaction: int ;
@ -49,10 +49,8 @@ let default = {
Period_repr.of_seconds_exn Period_repr.of_seconds_exn
(* One year in seconds *) (* One year in seconds *)
Int64.(mul 365L (mul 24L 3600L)) ; Int64.(mul 365L (mul 24L 3600L)) ;
time_between_slots = slot_durations =
Period_repr.of_seconds_exn List.map Period_repr.of_seconds_exn [ 60L ] ;
(* One minute in seconds *)
10L ;
first_free_mining_slot = 16l ; first_free_mining_slot = 16l ;
max_signing_slot = 15 ; max_signing_slot = 15 ;
instructions_per_transaction = 16 * 1024 ; instructions_per_transaction = 16 * 1024 ;
@ -71,38 +69,37 @@ let constants_encoding =
(* let open Data_encoding in *) (* let open Data_encoding in *)
Data_encoding.conv Data_encoding.conv
(fun c -> (fun c ->
let open Compare in let module Compare_slot_durations = Compare.List (Period_repr) in
let cycle_length = let cycle_length =
opt Int32.(=) opt Compare.Int32.(=)
default.cycle_length c.cycle_length default.cycle_length c.cycle_length
and voting_period_length = and voting_period_length =
opt Int32.(=) opt Compare.Int32.(=)
default.voting_period_length c.voting_period_length default.voting_period_length c.voting_period_length
and time_before_reward = and time_before_reward =
map_option Period_repr.to_seconds @@ map_option Period_repr.to_seconds @@
opt Period_repr.(=) opt Period_repr.(=)
default.time_before_reward c.time_before_reward default.time_before_reward c.time_before_reward
and time_between_slots = and slot_durations =
map_option Period_repr.to_seconds @@ opt Compare_slot_durations.(=)
opt Period_repr.(=) default.slot_durations c.slot_durations
default.time_between_slots c.time_between_slots
and first_free_mining_slot = and first_free_mining_slot =
opt Int32.(=) opt Compare.Int32.(=)
default.first_free_mining_slot c.first_free_mining_slot default.first_free_mining_slot c.first_free_mining_slot
and max_signing_slot = and max_signing_slot =
opt Int.(=) opt Compare.Int.(=)
default.max_signing_slot c.max_signing_slot default.max_signing_slot c.max_signing_slot
and instructions_per_transaction = and instructions_per_transaction =
opt Int.(=) opt Compare.Int.(=)
default.instructions_per_transaction c.instructions_per_transaction default.instructions_per_transaction c.instructions_per_transaction
and proof_of_work_threshold = and proof_of_work_threshold =
opt Int64.(=) opt Compare.Int64.(=)
default.proof_of_work_threshold c.proof_of_work_threshold default.proof_of_work_threshold c.proof_of_work_threshold
in in
( cycle_length, ( cycle_length,
voting_period_length, voting_period_length,
time_before_reward, time_before_reward,
time_between_slots, slot_durations,
first_free_mining_slot, first_free_mining_slot,
max_signing_slot, max_signing_slot,
instructions_per_transaction, instructions_per_transaction,
@ -111,7 +108,7 @@ let constants_encoding =
(fun ( cycle_length, (fun ( cycle_length,
voting_period_length, voting_period_length,
time_before_reward, time_before_reward,
time_between_slots, slot_durations,
first_free_mining_slot, first_free_mining_slot,
max_signing_slot, max_signing_slot,
instructions_per_transaction, instructions_per_transaction,
@ -124,9 +121,9 @@ let constants_encoding =
time_before_reward = time_before_reward =
unopt default.time_before_reward @@ unopt default.time_before_reward @@
map_option Period_repr.of_seconds_exn time_before_reward ; map_option Period_repr.of_seconds_exn time_before_reward ;
time_between_slots = slot_durations =
unopt default.time_between_slots @@ unopt default.slot_durations @@
map_option Period_repr.of_seconds_exn time_between_slots ; slot_durations ;
first_free_mining_slot = first_free_mining_slot =
unopt default.first_free_mining_slot first_free_mining_slot ; unopt default.first_free_mining_slot first_free_mining_slot ;
max_signing_slot = max_signing_slot =
@ -141,7 +138,7 @@ let constants_encoding =
(opt "cycle_length" int32) (opt "cycle_length" int32)
(opt "voting_period_length" int32) (opt "voting_period_length" int32)
(opt "time_before_reward" int64) (opt "time_before_reward" int64)
(opt "time_between_slots" int64) (opt "slot_durations" (list Period_repr.encoding))
(opt "first_free_mining_slot" int32) (opt "first_free_mining_slot" int32)
(opt "max_signing_slot" int31) (opt "max_signing_slot" int31)
(opt "instructions_per_transaction" int31) (opt "instructions_per_transaction" int31)

View File

@ -17,13 +17,25 @@ type error +=
| Cannot_pay_endorsement_bond | Cannot_pay_endorsement_bond
| Bad_slot | Bad_slot
| Bad_delegate | Bad_delegate
| Invalid_slot_durations_constant
let minimal_time c priority = let minimal_time c priority =
Timestamp.get_current c >>=? fun prev_timestamp -> Timestamp.get_current c >>=? fun prev_timestamp ->
let rec cumsum_slot_durations acc durations p =
if Compare.Int32.(=) p 0l then
ok acc
else match durations with
| [] -> Error_monad.error Invalid_slot_durations_constant
| [ last ] ->
Period.mult p last >>? fun period ->
Timestamp.(acc +? period)
| first :: durations ->
Timestamp.(acc +? first) >>? fun acc ->
let p = Int32.pred p in
cumsum_slot_durations acc durations p in
Lwt.return Lwt.return
(Period.mult (Int32.succ priority) (cumsum_slot_durations
(Constants.time_between_slots c)) >>=? fun period -> prev_timestamp (Constants.slot_durations c) priority)
Lwt.return Timestamp.(prev_timestamp +? period)
let check_timestamp c priority timestamp = let check_timestamp c priority timestamp =
minimal_time c priority >>=? fun minimal_time -> minimal_time c priority >>=? fun minimal_time ->

View File

@ -60,12 +60,12 @@ module Constants = struct
describe ~title: "time before reward" Period.encoding) describe ~title: "time before reward" Period.encoding)
RPC.Path.(custom_root / "constants" / "time_before_reward") RPC.Path.(custom_root / "constants" / "time_before_reward")
let time_between_slots custom_root = let slot_durations custom_root =
RPC.service RPC.service
~description: "Time between slots" ~description: "Slot durations"
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "time between slots" Period.encoding) describe ~title: "time between slots" (list Period.encoding))
RPC.Path.(custom_root / "constants" / "time_between_slots") RPC.Path.(custom_root / "constants" / "time_between_slots")
let first_free_mining_slot custom_root = let first_free_mining_slot custom_root =

View File

@ -53,10 +53,10 @@ let time_before_reward ctxt =
let () = register0 Services.Constants.time_before_reward time_before_reward let () = register0 Services.Constants.time_before_reward time_before_reward
let time_between_slots ctxt = let slot_durations ctxt =
return @@ Constants.time_between_slots ctxt return @@ Constants.slot_durations ctxt
let () = register0 Services.Constants.time_between_slots time_between_slots let () = register0 Services.Constants.slot_durations slot_durations
let first_free_mining_slot ctxt = let first_free_mining_slot ctxt =
return @@ Constants.first_free_mining_slot ctxt return @@ Constants.first_free_mining_slot ctxt

View File

@ -56,9 +56,9 @@ module Constants = struct
let time_before_reward c = let time_before_reward c =
let constants = Storage.constants c in let constants = Storage.constants c in
constants.time_before_reward constants.time_before_reward
let time_between_slots c = let slot_durations c =
let constants = Storage.constants c in let constants = Storage.constants c in
constants.time_between_slots constants.slot_durations
let first_free_mining_slot c = let first_free_mining_slot c =
let constants = Storage.constants c in let constants = Storage.constants c in
constants.first_free_mining_slot constants.first_free_mining_slot

View File

@ -181,7 +181,7 @@ module Constants : sig
val cycle_length: context -> int32 val cycle_length: context -> int32
val voting_period_length: context -> int32 val voting_period_length: context -> int32
val time_before_reward: context -> Period.t val time_before_reward: context -> Period.t
val time_between_slots: context -> Period.t val slot_durations: context -> Period.t list
val first_free_mining_slot: context -> int32 val first_free_mining_slot: context -> int32
val max_signing_slot: context -> int val max_signing_slot: context -> int
val instructions_per_transaction: context -> int val instructions_per_transaction: context -> int

View File

@ -1,5 +1,5 @@
{ {
"time_between_slots" : 10, "slot_durations" : [ 10 ; 5 ],
"cycle_length" : 128, "cycle_length" : 128,
"first_free_mining_slot" : 4 "first_free_mining_slot" : 4
} }