diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index a109c94a7..9a12444ef 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -13,6 +13,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_endorsement_delay of string let () = @@ -40,6 +41,16 @@ let () = Data_encoding.(obj1 (req "parameter" string)) (function Bad_max_priority parameter -> Some parameter | _ -> None) (fun parameter -> Bad_max_priority parameter) ; + register_error_kind + `Permanent + ~id:"badFeeThresholdArg" + ~title:"Bad -fee-threshold arg" + ~description:("invalid fee threshold in -fee-threshold") + ~pp:(fun ppf literal -> + Format.fprintf ppf "invalid fee threshold '%s' in -fee-threshold" literal) + 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:"badEndorsementDelayArg" @@ -185,6 +196,16 @@ let max_priority_arg = try return (int_of_string s) with _ -> fail (Bad_max_priority s))) +let fee_threshold_arg = + arg + ~long:"fee-threshold" + ~placeholder:"threshold" + ~doc:"exclude operations with fees lower than this threshold (in mutez)" + (parameter (fun _ s -> + match Tez.of_string s with + | Some t -> return t + | None -> fail (Bad_fee_threshold s))) + let endorsement_delay_arg = default_arg ~long:"endorsement-delay" diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index f9c4079e7..c28549773 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -23,6 +23,7 @@ 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 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 diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index 2b99d5ebb..39c8c2dec 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -156,14 +156,18 @@ let get_operation_fee op = Tez.(total_fee +? fee) | _ -> return total_fee) Tez.zero l -let sort_operations_by_fee (operations : Proto_alpha.operation list) = - (* There is no sort_s, so : *) - map_s (fun op -> get_operation_fee op >>=? fun fee -> return (op, fee)) +let sort_operations_by_fee ?(threshold = Tez.zero) (operations : Proto_alpha.operation list) = + filter_map_s + (fun op -> + get_operation_fee op >>=? fun fee -> + if Tez.(<) fee threshold then + return None + else + return (Some (op, fee))) operations >>=? fun operations -> let compare_fee (_, fee1) (_, fee2) = - Tez.compare fee1 fee2 * -1 - in - (* Should we keep operations without fee ? *) + (* NOTE: inverted fee comparison to invert the order of sort *) + Tez.compare fee2 fee1 in return @@ List.map fst (List.sort compare_fee operations) let retain_operations_up_to_quota operations max_quota = @@ -183,7 +187,7 @@ let retain_operations_up_to_quota operations max_quota = | Full ops -> ops in List.rev operations -let classify_operations (ops: Proto_alpha.operation list) = +let classify_operations ?threshold (ops: Proto_alpha.operation list) = let t = Array.make (List.length Proto_alpha.Main.validation_passes) [] in List.iter (fun (op: Proto_alpha.operation) -> @@ -196,7 +200,7 @@ let classify_operations (ops: Proto_alpha.operation list) = let manager_operations = t.(managers_index) in let { Alpha_environment.Updater.max_size } = List.nth Proto_alpha.Main.validation_passes managers_index in - sort_operations_by_fee manager_operations >>=? fun ordered_operations -> + sort_operations_by_fee ?threshold manager_operations >>=? fun ordered_operations -> let max_operations = retain_operations_up_to_quota ordered_operations max_size in @@ -310,6 +314,7 @@ let error_of_op (result: error Preapply_result.t) op = let forge_block cctxt ?(chain = `Main) block + ?threshold ?force ?operations ?(best_effort = operations = None) ?(sort = best_effort) ?timestamp @@ -324,7 +329,7 @@ let forge_block cctxt ?(chain = `Main) block (* get basic building blocks *) let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in - classify_operations operations_arg >>=? fun operations -> + classify_operations ?threshold operations_arg >>=? fun operations -> Alpha_block_services.Helpers.Preapply.block cctxt ~block ~timestamp ~sort ~protocol_data operations >>=? fun (shell_header, result) -> @@ -572,6 +577,7 @@ let filter_invalid_operations (cctxt : #full) state block_info (operations : pac let bake_slot cctxt state + ?threshold seed_nonce_hash (timestamp, (bi, priority, delegate)) (* baking slot *) = @@ -601,7 +607,7 @@ let bake_slot None in let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in - classify_operations operations >>=? fun operations -> + classify_operations ?threshold operations >>=? fun operations -> begin (* Don't load an alpha context if the chain is still in genesis *) if Protocol_hash.(bi.protocol = bi.next_protocol) then @@ -669,7 +675,7 @@ let pp_operation_list_list = (* [bake] create a single block when woken up to do so. All the necessary information (e.g., slot) is available in the [state]. *) -let bake (cctxt : #Proto_alpha.full) state = +let bake (cctxt : #Proto_alpha.full) ?threshold state = let slots = pop_baking_slots state in lwt_log_info "Found %d current slots and %d future slots." (List.length slots) @@ -678,7 +684,9 @@ let bake (cctxt : #Proto_alpha.full) state = let seed_nonce_hash = Nonce.hash seed_nonce in (* baking for each slot *) - filter_map_s (bake_slot cctxt state seed_nonce_hash) slots >>=? fun candidates -> + filter_map_s + (bake_slot cctxt ?threshold state seed_nonce_hash) + slots >>=? fun candidates -> (* FIXME: pick one block per-delegate *) (* selecting the candidate baked block *) @@ -740,6 +748,7 @@ let check_error p = the [delegates] *) let create (cctxt : #Proto_alpha.full) + ?threshold ?max_priority ~(context_path: string) (delegates: public_key_hash list) @@ -799,7 +808,7 @@ let create (* main event: it's baking time *) lwt_debug "Waking up for baking..." >>= fun () -> (* core functionality *) - check_error @@ bake cctxt state + check_error @@ bake cctxt ?threshold state end >>= fun () -> (* and restart *) worker_loop () in @@ -812,6 +821,7 @@ let create unavailable blocks (empty block chain). *) let create (cctxt : #Proto_alpha.full) + ?threshold ?max_priority ~(context_path: string) (delegates: public_key_hash list) @@ -819,4 +829,4 @@ let create Client_baking_scheduling.wait_for_first_block ~info:lwt_log_info block_stream - (create cctxt ?max_priority ~context_path delegates block_stream) + (create cctxt ?threshold ?max_priority ~context_path delegates block_stream) diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.mli b/src/proto_alpha/lib_delegate/client_baking_forge.mli index 4622ee7b9..3f3bf88d0 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.mli +++ b/src/proto_alpha/lib_delegate/client_baking_forge.mli @@ -39,6 +39,7 @@ val forge_block: #Proto_alpha.full -> ?chain:Chain_services.chain -> Block_services.block -> + ?threshold:Tez.t -> ?force:bool -> ?operations: Operation.packed list -> ?best_effort:bool -> @@ -49,7 +50,7 @@ val forge_block: src_sk:Client_keys.sk_uri -> unit -> Block_hash.t tzresult Lwt.t -(** [forge_block cctxt parent_blk ?force ?operations ?best_effort +(** [forge_block cctxt parent_blk ?threshold ?force ?operations ?best_effort ?sort ?timestamp ?max_priority ?priority ~seed_nonce ~src_sk pk_hash] injects a block in the node. In addition of inject_block, it will: @@ -65,6 +66,9 @@ val forge_block: * Timestamp: If [?timestamp] is set, and is compatible with the computed baking priority, it will be used. Otherwise, it will be set at the best baking priority. + + * Threshold: If [?threshold] is given, operations with fees lower than it + are not added to the block. *) module State : sig @@ -83,6 +87,7 @@ end val create: #Proto_alpha.full -> + ?threshold:Tez.t -> ?max_priority: int -> context_path: string -> public_key_hash list -> diff --git a/src/proto_alpha/lib_delegate/client_baking_lib.ml b/src/proto_alpha/lib_delegate/client_baking_lib.ml index f255e8365..3269ba233 100644 --- a/src/proto_alpha/lib_delegate/client_baking_lib.ml +++ b/src/proto_alpha/lib_delegate/client_baking_lib.ml @@ -12,6 +12,7 @@ open Alpha_context let bake_block (cctxt : #Proto_alpha.full) ?(chain = `Main) block + ?threshold ?force ?max_priority ?(minimal_timestamp=false) ?src_sk ?src_pk delegate = begin @@ -39,6 +40,7 @@ let bake_block (cctxt : #Proto_alpha.full) None, None in Client_baking_forge.forge_block cctxt ?timestamp:(if minimal_timestamp then None else Some (Time.now ())) + ?threshold ?force ?seed_nonce_hash ~src_sk block ~priority:(`Auto (delegate, max_priority)) () >>=? fun block_hash -> diff --git a/src/proto_alpha/lib_delegate/client_baking_lib.mli b/src/proto_alpha/lib_delegate/client_baking_lib.mli index 17e23f787..8de4bfc37 100644 --- a/src/proto_alpha/lib_delegate/client_baking_lib.mli +++ b/src/proto_alpha/lib_delegate/client_baking_lib.mli @@ -15,6 +15,7 @@ val bake_block: #Proto_alpha.full -> ?chain:Chain_services.chain -> Block_services.block -> + ?threshold:Tez.t -> ?force:bool -> ?max_priority: int -> ?minimal_timestamp: bool -> diff --git a/src/proto_alpha/lib_delegate/client_daemon.ml b/src/proto_alpha/lib_delegate/client_daemon.ml index 0af304ce5..8a0c4fd53 100644 --- a/src/proto_alpha/lib_delegate/client_daemon.ml +++ b/src/proto_alpha/lib_delegate/client_daemon.ml @@ -20,11 +20,11 @@ end module Baker = struct - let run (cctxt : #Proto_alpha.full) ?max_priority ?min_date ~context_path delegates = + let run (cctxt : #Proto_alpha.full) ?threshold ?max_priority ?min_date ~context_path delegates = Client_baking_blocks.monitor_heads cctxt `Main >>=? fun block_stream -> Client_baking_forge.create cctxt - ?max_priority ~context_path delegates block_stream >>=? fun () -> + ?threshold ?max_priority ~context_path delegates block_stream >>=? fun () -> ignore min_date; return () diff --git a/src/proto_alpha/lib_delegate/client_daemon.mli b/src/proto_alpha/lib_delegate/client_daemon.mli index 73e5a29f7..9c31ecfa1 100644 --- a/src/proto_alpha/lib_delegate/client_daemon.mli +++ b/src/proto_alpha/lib_delegate/client_daemon.mli @@ -21,6 +21,7 @@ end module Baker : sig val run: #Proto_alpha.full -> + ?threshold: Tez.tez -> ?max_priority: int -> ?min_date: Time.t -> context_path: string -> diff --git a/src/proto_alpha/lib_delegate/delegate_commands.ml b/src/proto_alpha/lib_delegate/delegate_commands.ml index 906a440af..44b4497e2 100644 --- a/src/proto_alpha/lib_delegate/delegate_commands.ml +++ b/src/proto_alpha/lib_delegate/delegate_commands.ml @@ -25,14 +25,14 @@ let delegate_commands () = let open Clic in [ command ~group ~desc: "Forge and inject block using the delegate rights." - (args3 max_priority_arg force_switch minimal_timestamp_switch) + (args4 max_priority_arg fee_threshold_arg force_switch minimal_timestamp_switch) (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, force, minimal_timestamp) delegate cctxt -> + (fun (max_priority, threshold, force, minimal_timestamp) delegate cctxt -> bake_block cctxt cctxt#block - ~force ?max_priority ~minimal_timestamp delegate) ; + ?threshold ~force ?max_priority ~minimal_timestamp delegate) ; command ~group ~desc: "Forge and inject a seed-nonce revelation operation." no_options (prefixes [ "reveal"; "nonce"; "for" ] @@ -62,15 +62,16 @@ let baker_commands () = in [ command ~group ~desc: "Launch the baker daemon." - (args1 max_priority_arg) + (args2 max_priority_arg fee_threshold_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 node_path delegates cctxt -> + (fun (max_priority, threshold) node_path delegates cctxt -> Client_daemon.Baker.run cctxt + ?threshold ?max_priority ~min_date:((Time.add (Time.now ()) (Int64.neg 1800L))) ~context_path:(Filename.concat node_path "context")