Verified Commit dfdfdaf0 authored by Vincent Botbol's avatar Vincent Botbol Committed by Grégoire Henry

Alpha/Baker: add a max_waiting_time parameter in the command

parent 3a49a0e7
......@@ -30,6 +30,7 @@ open Clic
type error += Bad_tez_arg of string * string (* Arg_name * value *)
type error += Bad_max_priority of string
type error += Bad_fee_threshold of string
type error += Bad_max_waiting_time of string
type error += Bad_endorsement_delay of string
type error += Bad_preserved_levels of string
......@@ -68,6 +69,16 @@ let () =
Data_encoding.(obj1 (req "parameter" string))
(function Bad_fee_threshold parameter -> Some parameter | _ -> None)
(fun parameter -> Bad_fee_threshold parameter) ;
register_error_kind
`Permanent
~id:"badMaxWaitingTimeArg"
~title:"Bad -max-waiting-time arg"
~description:("invalid duration in -max-waiting-time")
~pp:(fun ppf literal ->
Format.fprintf ppf "Bad argument value for -max-waiting-time. Expected an integer, but given '%s'" literal)
Data_encoding.(obj1 (req "parameter" string))
(function Bad_max_waiting_time parameter -> Some parameter | _ -> None)
(fun parameter -> Bad_max_waiting_time parameter) ;
register_error_kind
`Permanent
~id:"badEndorsementDelayArg"
......@@ -232,6 +243,21 @@ let fee_threshold_arg =
| Some t -> return t
| None -> fail (Bad_fee_threshold s)))
let max_waiting_time_arg =
default_arg
~long:"max-waiting-time"
~placeholder:"seconds"
~doc:"Specify how long the baker is allowed to wait late \
endorsements (if necessary) after its delegate's injection \
date."
~default:"25"
(parameter (fun _ s ->
try
let i = int_of_string s in
fail_when (i < 0) (Bad_max_waiting_time s) >>=? fun () ->
return (int_of_string s)
with _ -> fail (Bad_max_waiting_time s)))
let endorsement_delay_arg =
default_arg
~long:"endorsement-delay"
......
......@@ -40,6 +40,7 @@ val delegatable_switch: (bool, Proto_alpha.full) Clic.arg
val spendable_switch: (bool, Proto_alpha.full) Clic.arg
val max_priority_arg: (int option, Proto_alpha.full) Clic.arg
val fee_threshold_arg: (Tez.tez option, Proto_alpha.full) Clic.arg
val max_waiting_time_arg: (int, Proto_alpha.full) Clic.arg
val force_switch: (bool, Proto_alpha.full) Clic.arg
val minimal_timestamp_switch: (bool, Proto_alpha.full) Clic.arg
val endorsement_delay_arg: (int, Proto_alpha.full) Clic.arg
......
......@@ -50,17 +50,20 @@ type state = {
constants: Constants.t tzlazy ;
(* Minimum operation fee required to include in a block *)
fee_threshold : Tez.t ;
(* Maximum waiting time allowed for late endorsements *)
max_waiting_time : int ;
(* truly mutable *)
mutable best_slot: (Time.t * (Client_baking_blocks.block_info * int * public_key_hash)) option ;
}
let create_state ?(fee_threshold = Tez.zero) genesis context_path index delegates constants =
let create_state ?(fee_threshold = Tez.zero) ~max_waiting_time genesis context_path index delegates constants =
{ genesis ;
context_path ;
index ;
delegates ;
constants ;
fee_threshold ;
max_waiting_time ;
best_slot = None ;
}
......@@ -594,6 +597,7 @@ let forge_block
constants = tzlazy (fun () -> Alpha_services.Constants.all cctxt (`Main, `Head 0)) ;
delegates = [] ;
best_slot = None ;
max_waiting_time = 0 ;
fee_threshold = Tez.zero ;
} in
filter_and_apply_operations ~timestamp ~protocol_data state bi operations
......@@ -645,7 +649,7 @@ let shell_prevalidation
(** [fetch_operations] retrieve the operations present in the
mempool. If no endorsements are present in the initial set, it
waits until half of its injection range time has passed. *)
waits until [state.max_waiting_time] seconds after its injection range start date. *)
let fetch_operations
(cctxt : #Proto_alpha.full)
~chain
......@@ -675,21 +679,8 @@ let fetch_operations
if contains_head_endorsements !operations then
return (Some !operations)
else
(* Retrieve time left *)
tzforce state.constants >>=? fun Constants.{ parametric = { time_between_blocks ; _ } } ->
let rec loop prio = function
| [] -> Period.one_minute
| [ last ] -> last
| first :: durations ->
if prio = 0 then first
else loop (prio - 1) durations
in
(* The "safe" allocated time for injection stops when the next
baker's time begins. *)
let allocated_time = loop (priority + 1) time_between_blocks in
(* Wait 1/3 of the allocated time *)
let timespan = Int64.div (Period.to_seconds allocated_time) 3L in
let limit_date = Time.add timestamp timespan in
let limit_date = Time.add timestamp (Int64.of_int state.max_waiting_time) in
lwt_log_notice Tag.DSL.(fun f ->
f "No endorsements present in the mempool. Waiting until %a (%a) for new operations."
-% t event "waiting_operations"
......@@ -996,6 +987,7 @@ let create
(cctxt : #Proto_alpha.full)
?fee_threshold
?max_priority
~max_waiting_time
~context_path
delegates
block_stream =
......@@ -1003,7 +995,7 @@ let create
let constants =
tzlazy (fun () -> Alpha_services.Constants.all cctxt (`Main, `Hash (bi.Client_baking_blocks.hash, 0))) in
Client_baking_simulator.load_context ~context_path >>= fun index ->
let state = create_state genesis_hash context_path index delegates constants ?fee_threshold in
let state = create_state ?fee_threshold ~max_waiting_time genesis_hash context_path index delegates constants in
return state
in
......
......@@ -105,6 +105,7 @@ val create:
#Proto_alpha.full ->
?fee_threshold:Tez.t ->
?max_priority: int ->
max_waiting_time: int ->
context_path: string ->
public_key_hash list ->
Client_baking_blocks.block_info tzresult Lwt_stream.t ->
......
......@@ -44,13 +44,20 @@ end
module Baker = struct
let run (cctxt : #Proto_alpha.full) ?fee_threshold ?max_priority ?min_date ~context_path delegates =
let run
(cctxt : #Proto_alpha.full)
?fee_threshold
?max_priority
?min_date
~context_path
~max_waiting_time
delegates =
await_bootstrapped_node cctxt >>=? fun _ ->
Client_baking_blocks.monitor_heads
~next_protocols:(Some [Proto_alpha.hash])
cctxt `Main >>=? fun block_stream ->
Client_baking_forge.create cctxt
?fee_threshold ?max_priority ~context_path delegates block_stream >>=? fun () ->
?fee_threshold ?max_priority ~max_waiting_time ~context_path delegates block_stream >>=? fun () ->
ignore min_date;
return_unit
......
......@@ -41,6 +41,7 @@ module Baker : sig
?max_priority: int ->
?min_date: Time.t ->
context_path: string ->
max_waiting_time: int ->
public_key_hash list -> unit tzresult Lwt.t
end
......
......@@ -93,19 +93,20 @@ let baker_commands () =
in
[
command ~group ~desc: "Launch the baker daemon."
(args2 max_priority_arg fee_threshold_arg)
(args3 max_priority_arg fee_threshold_arg max_waiting_time_arg)
(prefixes [ "run" ; "with" ; "local" ; "node" ]
@@ param
~name:"context_path"
~desc:"Path to the node data directory (e.g. $HOME/.tezos-node)"
directory_parameter
@@ seq_of_param Client_keys.Public_key_hash.alias_param)
(fun (max_priority, fee_threshold) node_path delegates cctxt ->
(fun (max_priority, fee_threshold, max_waiting_time) node_path delegates cctxt ->
Tezos_signer_backends.Encrypted.decrypt_list
cctxt (List.map fst delegates) >>=? fun () ->
Client_daemon.Baker.run cctxt
?fee_threshold
?max_priority
~max_waiting_time
~min_date:((Time.add (Time.now ()) (Int64.neg 1800L)))
~context_path:(Filename.concat node_path "context")
(List.map snd delegates)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment