balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha/Baking: add minimal fees and wait for late endorsement

Browse Source
This commit is contained in:
Grégoire Henry 2018-11-22 20:37:38 +01:00
parent 56936c7a1e
commit 4b6f471ead
No known key found for this signature in database
GPG Key ID: 50D984F20BD445D2
12 changed files with 310 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin_client/test/test_lib.inc.sh
View File

@ -132,7 +132,7 @@ init_contract_from_file () {
}
bake () {
$client bake for bootstrap1 --max-priority 512 --minimal-timestamp
$client bake for bootstrap1 --max-priority 512 --minimal-timestamp --minimal-fees 0 --minimal-fees-per-byte 0 --minimal-fees-per-gas-unit 0
}
bake_after () {

65
src/proto_alpha/lib_client/client_proto_args.ml
View File

@ -29,7 +29,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_minimal_fees of string
type error += Bad_max_waiting_time of string
type error += Bad_endorsement_delay of string
type error += Bad_preserved_levels of string
@ -61,14 +61,14 @@ let () =
(fun parameter -> Bad_max_priority parameter) ;
register_error_kind
`Permanent
~id:"badFeeThresholdArg"
~title:"Bad -fee-threshold arg"
~id:"badMinimalFeesArg"
~title:"Bad -minimal-fees arg"
~description:("invalid fee threshold in -fee-threshold")
~pp:(fun ppf literal ->
Format.fprintf ppf "invalid fee threshold '%s' in -fee-threshold" literal)
Format.fprintf ppf "invalid minimal fees '%s'" literal)
Data_encoding.(obj1 (req "parameter" string))
(function Bad_fee_threshold parameter -> Some parameter | _ -> None)
(fun parameter -> Bad_fee_threshold parameter) ;
(function Bad_minimal_fees parameter -> Some parameter | _ -> None)
(fun parameter -> Bad_minimal_fees parameter) ;
register_error_kind
`Permanent
~id:"badMaxWaitingTimeArg"
@ -246,30 +246,47 @@ let max_priority_arg =
try return (int_of_string s)
with _ -> fail (Bad_max_priority s)))
let fee_threshold_arg =
let minimal_fees_arg =
arg
~long:"fee-threshold"
~long:"minimal-fees"
~placeholder:"amount"
~doc:"exclude operations with fees lower than this threshold (in tz)"
~doc:"exclude operations with fees lower than this threshold (in tez)"
(parameter (fun _ s ->
match Tez.of_string s with
| Some t -> return t
| None -> fail (Bad_fee_threshold s)))
| None -> fail (Bad_minimal_fees 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"
let minimal_fees_per_gas_unit_arg =
arg
~long:"minimal-fees-per-gas-unit"
~placeholder:"amount"
~doc:"exclude operations with fees per gas lower than this threshold (in tez)"
(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)))
match Tez.of_string s with
| Some t -> return t
| None -> fail (Bad_minimal_fees s)))
let minimal_fees_per_byte_arg =
arg
~long:"minimal-fees-per-byte"
~placeholder:"amount"
~doc:"exclude operations with fees per byte lower than this threshold (in tez)"
(parameter (fun _ s ->
match Tez.of_string s with
| Some t -> return t
| None -> fail (Bad_minimal_fees s)))
let no_waiting_for_endorsements_arg =
switch
~long:"no-waiting-for-late-endorsements"
~doc:"Disable waiting for late endorsements"
()
let await_endorsements_arg =
switch
~long:"await-late-endorsements"
~doc:"Await late endorsements when baking a block"
()
let endorsement_delay_arg =
default_arg
@ -278,7 +295,7 @@ let endorsement_delay_arg =
~doc:"delay before endorsing blocks\n\
Delay between notifications of new blocks from the node and \
production of endorsements for these blocks."
~default:"15"
~default:"5"
(parameter (fun _ s ->
try
let i = int_of_string s in

7
src/proto_alpha/lib_client/client_proto_args.mli
View File

@ -40,8 +40,11 @@ val delegate_arg: (Signature.Public_key_hash.t option, Proto_alpha.full) Clic.ar
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 minimal_fees_arg: (Tez.tez option, Proto_alpha.full) Clic.arg
val minimal_fees_per_gas_unit_arg: (Tez.tez option, Proto_alpha.full) Clic.arg
val minimal_fees_per_byte_arg: (Tez.tez option, Proto_alpha.full) Clic.arg
val no_waiting_for_endorsements_arg: (bool, Proto_alpha.full) Clic.arg
val await_endorsements_arg: (bool, 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

229
src/proto_alpha/lib_delegate/client_baking_forge.ml
View File

@ -40,6 +40,11 @@ let anonymous_index = 2
let managers_index = 3
let default_max_priority = 64
let default_minimal_fees = Tez.zero
let default_minimal_fees_per_gas_unit =
Option.unopt_exn (Failure "bad conversion") (Tez.of_mutez 10L)
let default_minimal_fees_per_byte = Tez.zero
let default_await_endorsements = true
type state = {
genesis: Block_hash.t ;
@ -49,25 +54,33 @@ type state = {
delegates: public_key_hash list ;
(* lazy-initialisation with retry-on-error *)
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 ;
(* Minimal operation fee required to include an operation in a block *)
minimal_fees : Tez.t ;
(* Minimal operation fee per gas required to include an operation in a block *)
minimal_fees_per_gas_unit : Tez.t ;
(* Minimal operation fee per byte required to include an operation in a block *)
minimal_fees_per_byte : Tez.t ;
(* Await endorsements *)
await_endorsements: bool ;
(* truly mutable *)
mutable best_slot: (Time.t * (Client_baking_blocks.block_info * int * public_key_hash)) option ;
}
let create_state
?(fee_threshold = Tez.zero) ~max_waiting_time
genesis context_path index
delegates constants =
?(minimal_fees = default_minimal_fees)
?(minimal_fees_per_gas_unit = default_minimal_fees_per_gas_unit)
?(minimal_fees_per_byte = default_minimal_fees_per_byte)
?(await_endorsements = default_await_endorsements)
genesis context_path index delegates constants =
{ genesis ;
context_path ;
index ;
delegates ;
constants ;
fee_threshold ;
max_waiting_time ;
minimal_fees ;
minimal_fees_per_gas_unit ;
minimal_fees_per_byte ;
await_endorsements ;
best_slot = None ;
}
@ -140,8 +153,7 @@ let inject_block
?force ~chain signed_header operations >>=? fun block_hash ->
return block_hash
type error +=
| Failed_to_preapply of Tezos_base.Operation.t * error list
type error += Failed_to_preapply of Tezos_base.Operation.t * error list
let () =
register_error_kind
@ -179,7 +191,9 @@ let get_manager_operation_gas_and_fee op =
let sort_manager_operations
~max_size
~hard_gas_limit_per_block
~fee_threshold
~minimal_fees
~minimal_fees_per_gas_unit
~minimal_fees_per_byte
(operations : Proto_alpha.operation list) =
let compute_weight op (fee, gas) =
let size = Data_encoding.Binary.length Operation.encoding op in
@ -193,10 +207,23 @@ let sort_manager_operations
filter_map_s
(fun op ->
get_manager_operation_gas_and_fee op >>=? fun (fee, gas) ->
if Tez.(<) fee fee_threshold then
if Tez.(fee < minimal_fees) then
return_none
else
return (Some (op, (compute_weight op (fee, gas))))
let (size, gas, _ratio) as weight = compute_weight op (fee, gas) in
let open Alpha_environment in
let enough_gas_fees =
match Tez.(minimal_fees_per_gas_unit *? Z.to_int64 gas) with
| Ok expected_fees -> Tez.(expected_fees <= fee)
| _ -> false in
let enough_size_fees =
match Tez.(minimal_fees_per_byte *? Int64.of_int size) with
| Ok fee_per_byte -> Tez.(fee_per_byte >= minimal_fees_per_byte)
| Error _ -> false in
if enough_size_fees && enough_gas_fees then
return_some (op, weight)
else
return_none
) operations >>=? fun operations ->
(* We sort by the biggest weight *)
return
@ -255,7 +282,9 @@ let classify_operations
(cctxt : #Proto_alpha.full)
~block
~hard_gas_limit_per_block
~fee_threshold
~minimal_fees
~minimal_fees_per_gas_unit
~minimal_fees_per_byte
(ops: Proto_alpha.operation list) =
Alpha_block_services.live_blocks cctxt ~chain:`Main ~block ()
>>=? fun live_blocks ->
@ -278,7 +307,13 @@ let classify_operations
let manager_operations = t.(managers_index) in
let { Alpha_environment.Updater.max_size } =
List.nth Proto_alpha.Main.validation_passes managers_index in
sort_manager_operations ~max_size ~hard_gas_limit_per_block ~fee_threshold manager_operations
sort_manager_operations
~max_size
~hard_gas_limit_per_block
~minimal_fees
~minimal_fees_per_gas_unit
~minimal_fees_per_byte
manager_operations
>>=? fun ordered_operations ->
(* Greedy heuristic *)
trim_manager_operations ~max_size ~hard_gas_limit_per_block (List.map fst ordered_operations)
@ -430,14 +465,15 @@ let filter_and_apply_operations
let validate_operation inc op =
add_operation inc op >>= function
| Error errs ->
lwt_log_info Tag.DSL.(fun f ->
lwt_debug Tag.DSL.(fun f ->
f "Client-side validation: invalid operation filtered %a\n@[<v 4>%a@]"
-% t event "baking_rejected_invalid_operation"
-% a Operation_hash.Logging.tag (Operation.hash_packed op)
-% a errs_tag errs)
>>= fun () ->
return_none
| Ok inc -> return_some inc
| Ok (resulting_state, _receipt) ->
return_some resulting_state
in
let filter_valid_operations inc ops =
fold_left_s (fun (inc, acc) op ->
@ -493,7 +529,9 @@ let filter_and_apply_operations
filter_valid_operations inc accepted_managers >>=? fun (inc, accepted_managers) ->
filter_map_s (is_valid_endorsement inc) endorsements >>=? fun endorsements ->
(* Endorsements won't fail now *)
fold_left_s add_operation inc endorsements >>=? fun inc ->
fold_left_s (fun inc op ->
add_operation inc op >>=? fun (inc, _receipt) ->
return inc) inc endorsements >>=? fun inc ->
(* Endorsement and double baking/endorsement evidence do not commute:
we apply denunciation operations after endorsements. *)
filter_valid_operations inc evidences >>=? fun (final_inc, evidences) ->
@ -535,7 +573,10 @@ let forge_block
?operations
?(best_effort = operations = None)
?(sort = best_effort)
?(fee_threshold = Tez.zero)
?(minimal_fees = default_minimal_fees)
?(minimal_fees_per_gas_unit = default_minimal_fees_per_gas_unit)
?(minimal_fees_per_byte = default_minimal_fees_per_byte)
?(await_endorsements = default_await_endorsements)
?timestamp
?mempool
?context_path
@ -552,7 +593,14 @@ let forge_block
let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in
Alpha_services.Constants.all cctxt (`Main, block) >>=?
fun Constants.{ parametric = { hard_gas_limit_per_block ; endorsers_per_block } } ->
classify_operations cctxt ~hard_gas_limit_per_block ~block:block ~fee_threshold operations_arg
classify_operations
cctxt
~hard_gas_limit_per_block
~block:block
~minimal_fees
~minimal_fees_per_gas_unit
~minimal_fees_per_byte
operations_arg
>>=? fun (operations, overflowing_ops) ->
(* Ensure that we retain operations up to the quota *)
let quota : Alpha_environment.Updater.quota list = Main.validation_passes in
@ -599,8 +647,10 @@ 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 ;
await_endorsements ;
minimal_fees = default_minimal_fees ;
minimal_fees_per_gas_unit = default_minimal_fees_per_gas_unit ;
minimal_fees_per_byte = default_minimal_fees_per_byte ;
} in
filter_and_apply_operations ~timestamp ~protocol_data state bi (operations, overflowing_ops)
>>=? fun (final_context, validation_result, operations) ->
@ -649,6 +699,59 @@ let shell_prevalidation
return
(Some (bi, priority, shell_header, raw_ops, delegate, seed_nonce_hash))
let filter_outdated_endorsements expected_level ops =
List.filter (function
| { Alpha_context.protocol_data =
Operation_data { contents = Single (Endorsement { level }) }} ->
Raw_level.equal expected_level level
| _ -> true
) ops
let next_baking_delay state priority =
tzforce state.constants >>=? fun { Constants.parametric = { time_between_blocks }} ->
let rec associated_period durations prio =
if List.length durations = 0 then
(* Mimic [Baking.minimal_time] behaviour *)
associated_period [ Period.one_minute ] prio
else
match durations with
| [] -> assert false
| [ last ] ->
Period.to_seconds last
| first :: durations ->
if prio = 0 then
Period.to_seconds first
else
associated_period durations (prio - 1)
in
let span = associated_period time_between_blocks (priority + 1) in
return span
let count_slots_endorsements inc (_timestamp, (head, _priority, _delegate)) operations =
fold_left_s (fun acc -> function
| { Alpha_context.protocol_data =
Operation_data { contents = Single (Endorsement { level }) }} as op
when Raw_level.(level = head.Client_baking_blocks.level) ->
begin
let open Apply_results in
Client_baking_simulator.add_operation inc op >>= function
| Ok (_inc,
Operation_metadata
{ contents = Single_result (Endorsement_result { slots })} ) ->
return (acc + List.length slots)
| Error _ | _ ->
(* We do not handle errors here *)
return acc
end
| _ -> return acc
) 0 operations
let rec filter_limits tnow limits =
match limits with
| [] -> []
| (time, _) :: _ as limits when Time.(tnow < time) -> limits
| _ :: limits -> filter_limits tnow limits
(** [fetch_operations] retrieve the operations present in the
mempool. If no endorsements are present in the initial set, it
waits until [state.max_waiting_time] seconds after its injection range start date. *)
@ -656,7 +759,7 @@ let fetch_operations
(cctxt : #Proto_alpha.full)
~chain
state
(timestamp, (head, _, _delegate))
(timestamp, (head, priority, _delegate) as slot)
=
Alpha_block_services.Mempool.monitor_operations cctxt ~chain
~applied:true ~branch_delayed:true
@ -666,28 +769,36 @@ let fetch_operations
| None -> (* New head received : not supposed to happen. *)
return_none
| Some current_mempool ->
let operations = ref current_mempool in
let head_level = head.Client_baking_blocks.level in
let contains_head_endorsements operations =
List.exists (function
| { Alpha_context.protocol_data =
Operation_data { contents = Single (Endorsement { level }) }} ->
Raw_level.(level = head_level)
| _ -> false
) operations in
(* If the list already contains valid endorsements, we do not
need to wait. *)
if contains_head_endorsements !operations then
return (Some !operations)
let operations = ref (filter_outdated_endorsements head.Client_baking_blocks.level current_mempool) in
Client_baking_simulator.begin_construction ~timestamp state.index head >>=? fun inc ->
count_slots_endorsements inc slot !operations >>=? fun nb_arrived_endorsements ->
tzforce state.constants >>=? fun { Constants.parametric = { endorsers_per_block }} ->
(* If 100% of the endorsements arrived, we don't need to wait *)
if (not state.await_endorsements) || nb_arrived_endorsements = endorsers_per_block then
return_some !operations
else
(* Wait 1/3 of the allocated time *)
let limit_date = Time.add timestamp (Int64.of_int state.max_waiting_time) in
next_baking_delay state priority >>=? fun next_slot_delay ->
let hard_delay = Int64.div next_slot_delay 2L in
(* The time limit is defined as 1/2 of the next baking slot's time *)
let limit_date = Time.add timestamp hard_delay in
(* Time limits :
- We expect all of the endorsements until 1/3 of the time limit has passed ;
- We expect 2/3 of the endorsements until 2/3 of the time limit has passed ;
- We expect 1/3 of the endorsements until the time limit has passed ;
- We bake with what we have when the time limit has been reached.
*)
let limits =
[ (Time.add timestamp (Int64.div hard_delay 3L), endorsers_per_block) ;
(Time.add timestamp (Int64.div (Int64.mul hard_delay 2L) 3L), 2 * endorsers_per_block / 3) ;
(limit_date, endorsers_per_block / 3) ]
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"
-% a timestamp_tag limit_date
-% a timespan_tag (max 0L Time.(diff limit_date (now ())))
) >>= fun () ->
Shell_services.Mempool.request_operations cctxt ~chain () >>=? fun () ->
let timeout = match Client_baking_scheduling.sleep_until limit_date with
| None -> Lwt.return_unit
| Some timeout -> timeout in
@ -699,20 +810,33 @@ let fetch_operations
last_get_event := Some t ;
t
| Some t -> t in
let rec loop () =
let rec loop nb_arrived_endorsements limits =
Lwt.choose [ (timeout >|= fun () -> `Timeout) ;
(get_event () >|= fun e -> `Event e) ; ]
>>= function
| `Event (Some op_list) -> begin
last_get_event := None ;
operations := op_list @ !operations ;
loop () end
count_slots_endorsements inc slot op_list >>=? fun new_endorsements ->
let nb_arrived_endorsements = nb_arrived_endorsements + new_endorsements in
let limits = filter_limits (Time.now ()) limits in
let required =
match limits with
| [] -> 0 (* If we are late, we do not require endorsements *)
| (_time, required) :: _ -> required in
let enough = nb_arrived_endorsements >= required in
if enough then
return_some !operations
else
loop nb_arrived_endorsements limits
end
| `Timeout -> return_some !operations
| `Event None ->
(* New head received : should not happen. *)
(* New head received. Should not happen : let the
caller handle this case. *)
return_none
in
loop ()
loop nb_arrived_endorsements limits
(** Given a delegate baking slot [build_block] constructs a full block
with consistent operations that went through the client-side
@ -751,11 +875,15 @@ let build_block
lwt_log_info Tag.DSL.(fun f ->
f "Received a new head while waiting for operations. Aborting this block."
-% t event "new_head_received") >>= fun () ->
return None
return_none
| Some operations ->
tzforce state.constants >>=? fun Constants.{ parametric = { hard_gas_limit_per_block } } ->
classify_operations cctxt
~hard_gas_limit_per_block ~fee_threshold:state.fee_threshold ~block operations
~hard_gas_limit_per_block
~minimal_fees:state.minimal_fees
~minimal_fees_per_gas_unit:state.minimal_fees_per_gas_unit
~minimal_fees_per_byte:state.minimal_fees_per_byte
~block operations
>>=? fun (operations, overflowing_ops) ->
let next_version =
match Tezos_base.Block_header.get_forced_protocol_upgrade ~level:(Raw_level.to_int32 next_level.Level.level) with
@ -1029,9 +1157,11 @@ let reveal_potential_nonces cctxt new_head =
the [delegates] *)
let create
(cctxt : #Proto_alpha.full)
?fee_threshold
?minimal_fees
?minimal_fees_per_gas_unit
?minimal_fees_per_byte
?await_endorsements
?max_priority
~max_waiting_time
~context_path
delegates
block_stream =
@ -1040,7 +1170,10 @@ let create
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 ->
Client_baking_simulator.check_context_consistency index bi.context >>=? fun () ->
let state = create_state ?fee_threshold ~max_waiting_time genesis_hash context_path index delegates constants in
let state = create_state
?minimal_fees ?minimal_fees_per_gas_unit ?minimal_fees_per_byte
?await_endorsements
genesis_hash context_path index delegates constants in
return state
in

11
src/proto_alpha/lib_delegate/client_baking_forge.mli
View File

@ -71,7 +71,10 @@ val forge_block:
?operations: Operation.packed list ->
?best_effort:bool ->
?sort:bool ->
?fee_threshold:Tez.t ->
?minimal_fees: Tez.t ->
?minimal_fees_per_gas_unit: Tez.t ->
?minimal_fees_per_byte: Tez.t ->
?await_endorsements: bool ->
?timestamp:Time.t ->
?mempool:string ->
?context_path:string ->
@ -103,9 +106,11 @@ val forge_block:
val create:
#Proto_alpha.full ->
?fee_threshold:Tez.t ->
?minimal_fees: Tez.t ->
?minimal_fees_per_gas_unit: Tez.t ->
?minimal_fees_per_byte: Tez.t ->
?await_endorsements: bool ->
?max_priority: int ->
max_waiting_time: int ->
context_path: string ->
public_key_hash list ->
Client_baking_blocks.block_info tzresult Lwt_stream.t ->

14
src/proto_alpha/lib_delegate/client_baking_lib.ml
View File

@ -29,10 +29,13 @@ open Alpha_context
let bake_block
(cctxt : #Proto_alpha.full)
?(chain = `Main)
?fee_threshold
?minimal_fees
?minimal_fees_per_gas_unit
?minimal_fees_per_byte
?(await_endorsements = false)
?force
?max_priority
?(minimal_timestamp=false)
?(minimal_timestamp = false)
?mempool
?context_path
?src_sk
@ -63,9 +66,12 @@ let bake_block
else
None, None in
Client_baking_forge.forge_block cctxt
?timestamp:(if minimal_timestamp then None else Some (Time.now ()))
?fee_threshold
?force
?minimal_fees
?minimal_fees_per_gas_unit
?minimal_fees_per_byte
~await_endorsements
?timestamp:(if minimal_timestamp then None else Some (Time.now ()))
?seed_nonce_hash
?mempool
?context_path

5
src/proto_alpha/lib_delegate/client_baking_lib.mli
View File

@ -30,7 +30,10 @@ open Alpha_context
val bake_block:
#Proto_alpha.full ->
?chain:Chain_services.chain ->
?fee_threshold:Tez.t ->
?minimal_fees: Tez.t ->
?minimal_fees_per_gas_unit: Tez.t ->
?minimal_fees_per_byte: Tez.t ->
?await_endorsements: bool ->
?force:bool ->
?max_priority: int ->
?minimal_timestamp: bool ->

4
src/proto_alpha/lib_delegate/client_baking_simulator.ml
View File

@ -109,8 +109,8 @@ let begin_construction ~timestamp ?protocol_data index predecessor =
}
let add_operation st ( op : Operation.packed ) =
LiftedMain.apply_operation st.state op >>=? fun (state, _) ->
return { st with state ; rev_operations = op :: st.rev_operations }
LiftedMain.apply_operation st.state op >>=? fun (state, receipt) ->
return ({ st with state ; rev_operations = op :: st.rev_operations }, receipt)
let finalize_construction inc =
LiftedMain.finalize_block inc.state

4
src/proto_alpha/lib_delegate/client_baking_simulator.mli
View File

@ -41,6 +41,6 @@ val check_context_consistency : Context.index -> Context_hash.t -> unit tzresult
val begin_construction : timestamp:Time.t -> ?protocol_data: block_header_data -> Context.index -> Client_baking_blocks.block_info -> incremental tzresult Lwt.t
val add_operation : incremental -> Operation.packed -> incremental tzresult Lwt.t
val add_operation : incremental -> Operation.packed -> (incremental * LiftedMain.operation_receipt) tzresult Lwt.t
val finalize_construction : incremental -> (T.validation_result * LiftedMain.block_header_metadata) tzresult Lwt.t
val finalize_construction : incremental -> (T.validation_result * LiftedMain.block_header_metadata) tzresult Lwt.t

18
src/proto_alpha/lib_delegate/client_daemon.ml
View File

@ -33,14 +33,13 @@ let await_bootstrapped_node (cctxt: #Proto_alpha.full) =
module Endorser = struct
let run (cctxt : #Proto_alpha.full) ~delay ?min_date delegates =
let run (cctxt : #Proto_alpha.full) ~delay delegates =
await_bootstrapped_node cctxt >>=? fun _ ->
Client_baking_blocks.monitor_heads
~next_protocols:(Some [Proto_alpha.hash])
cctxt `Main >>=? fun block_stream ->
cctxt#message "Endorser started." >>= fun () ->
Client_baking_endorsement.create cctxt ~delay delegates block_stream >>=? fun () ->
ignore min_date;
return_unit
end
@ -49,11 +48,12 @@ module Baker = struct
let run
(cctxt : #Proto_alpha.full)
?fee_threshold
?minimal_fees
?minimal_fees_per_gas_unit
?minimal_fees_per_byte
?await_endorsements
?max_priority
?min_date
~context_path
~max_waiting_time
delegates =
await_bootstrapped_node cctxt >>=? fun _ ->
Client_baking_blocks.monitor_heads
@ -61,8 +61,12 @@ module Baker = struct
cctxt `Main >>=? fun block_stream ->
cctxt#message "Baker started." >>= fun () ->
Client_baking_forge.create cctxt
?fee_threshold ?max_priority ~max_waiting_time ~context_path delegates block_stream >>=? fun () ->
ignore min_date;
?minimal_fees
?minimal_fees_per_gas_unit
?minimal_fees_per_byte
?await_endorsements
?max_priority
~context_path delegates block_stream >>=? fun () ->
return_unit
end

8
src/proto_alpha/lib_delegate/client_daemon.mli
View File

@ -30,18 +30,18 @@ module Endorser : sig
val run:
#Proto_alpha.full ->
delay: int ->
?min_date: Time.t ->
public_key_hash list -> unit tzresult Lwt.t
end
module Baker : sig
val run:
#Proto_alpha.full ->
?fee_threshold: Tez.tez ->
?minimal_fees: Tez.t ->
?minimal_fees_per_gas_unit: Tez.t ->
?minimal_fees_per_byte: Tez.t ->
?await_endorsements: bool ->
?max_priority: int ->
?min_date: Time.t ->
context_path: string ->
max_waiting_time: int ->
public_key_hash list -> unit tzresult Lwt.t
end

58
src/proto_alpha/lib_delegate/delegate_commands.ml
View File

@ -55,15 +55,32 @@ let delegate_commands () =
let open Clic in
[
command ~group ~desc: "Forge and inject block using the delegate rights."
(args6 max_priority_arg fee_threshold_arg force_switch minimal_timestamp_switch mempool_arg context_path_arg)
(args9
max_priority_arg
minimal_fees_arg
minimal_fees_per_gas_unit_arg
minimal_fees_per_byte_arg
await_endorsements_arg
force_switch
minimal_timestamp_switch
mempool_arg
context_path_arg)
(prefixes [ "bake"; "for" ]
@@ Client_keys.Public_key_hash.source_param
~name:"baker" ~desc: "name of the delegate owning the baking right"
@@ stop)
(fun (max_priority, fee_threshold, force, minimal_timestamp, mempool, context_path) delegate cctxt ->
bake_block cctxt cctxt#block
?fee_threshold ~force ?max_priority ~minimal_timestamp
?mempool ?context_path delegate) ;
(fun (max_priority, minimal_fees,
minimal_fees_per_gas_unit, minimal_fees_per_byte,
await_endorsements, force,
minimal_timestamp, mempool, context_path)
delegate cctxt ->
bake_block cctxt cctxt#block
?minimal_fees
?minimal_fees_per_gas_unit
?minimal_fees_per_byte
~await_endorsements
~force ?max_priority ~minimal_timestamp
?mempool ?context_path delegate) ;
command ~group ~desc: "Forge and inject a seed-nonce revelation operation."
no_options
(prefixes [ "reveal"; "nonce"; "for" ]
@ -93,23 +110,31 @@ let baker_commands () =
in
[
command ~group ~desc: "Launch the baker daemon."
(args3 max_priority_arg fee_threshold_arg max_waiting_time_arg)
(args5
max_priority_arg
minimal_fees_arg
minimal_fees_per_gas_unit_arg
minimal_fees_per_byte_arg
no_waiting_for_endorsements_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, 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)
(fun (max_priority, minimal_fees, minimal_fees_per_gas_unit,
minimal_fees_per_byte, no_waiting_for_endorsements)
node_path delegates cctxt ->
Tezos_signer_backends.Encrypted.decrypt_list
cctxt (List.map fst delegates) >>=? fun () ->
Client_daemon.Baker.run cctxt
?minimal_fees
?minimal_fees_per_gas_unit
?minimal_fees_per_byte
?max_priority
~await_endorsements:(not no_waiting_for_endorsements)
~context_path:(Filename.concat node_path "context")
(List.map snd delegates)
)
]
@ -129,7 +154,6 @@ let endorser_commands () =
cctxt (List.map fst delegates) >>=? fun () ->
Client_daemon.Endorser.run cctxt
~delay:endorsement_delay
~min_date:((Time.add (Time.now ()) (Int64.neg 1800L)))
(List.map snd delegates)
)
]