diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index ebe0ab1f1..0134ad034 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -83,7 +83,7 @@ let () = `Permanent ~id:"badEndorsementDelayArg" ~title:"Bad -endorsement-delay arg" - ~description:("invalid priority in -endorsement-delay") + ~description:("invalid duration in -endorsement-delay") ~pp:(fun ppf literal -> Format.fprintf ppf "Bad argument value for -endorsement-delay. Expected an integer, but given '%s'" literal) Data_encoding.(obj1 (req "parameter" string)) @@ -236,7 +236,7 @@ let max_priority_arg = let fee_threshold_arg = arg ~long:"fee-threshold" - ~placeholder:"threshold" + ~placeholder:"amount" ~doc:"exclude operations with fees lower than this threshold (in mutez)" (parameter (fun _ s -> match Tez.of_string s with @@ -267,7 +267,10 @@ let endorsement_delay_arg = production of endorsements for these blocks." ~default:"15" (parameter (fun _ s -> - try return (int_of_string s) + try + let i = int_of_string s in + fail_when (i < 0) (Bad_endorsement_delay s) >>=? fun () -> + return (int_of_string s) with _ -> fail (Bad_endorsement_delay s))) let preserved_levels_arg = diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index eadd7291a..6a891b8d7 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -33,6 +33,7 @@ open Logging (* The index of the different components of the protocol's validation passes *) (* TODO: ideally, we would like this to be more abstract and possibly part of the protocol, while retaining the generality of lists *) +(* Hypothesis : we suppose [List.length Proto_alpha.Main.validation_passes = 4] *) let endorsements_index = 0 let votes_index = 1 let anonymous_index = 2 @@ -253,13 +254,14 @@ let classify_operations (ops: Proto_alpha.operation list) = Alpha_block_services.live_blocks cctxt ~chain:`Main ~block () >>=? fun live_blocks -> - (* Remove operations that are too old for the mempool *) + (* Remove operations that are too old *) let ops = List.filter (fun { shell = { branch } } -> Block_hash.Set.mem branch live_blocks ) ops in - let t = Array.make (List.length Proto_alpha.Main.validation_passes) [] in + let validation_passes_len = List.length Proto_alpha.Main.validation_passes in + let t = Array.make (validation_passes_len + 1) [] in List.iter (fun (op: Proto_alpha.operation) -> List.iter @@ -278,7 +280,8 @@ let classify_operations trim_manager_operations ~max_size ~hard_gas_limit_per_block (List.map fst ordered_operations) >>=? fun (desired_manager_operations, overflowing_manager_operations) -> t.(managers_index) <- desired_manager_operations ; - return @@ (Array.fold_right (fun ops acc -> ops :: acc) t [ overflowing_manager_operations ]) + t.(validation_passes_len) <- overflowing_manager_operations ; + return (Array.to_list t) let parse (op : Operation.raw) : Operation.packed = let protocol_data = @@ -654,15 +657,14 @@ let fetch_operations (cctxt : #Proto_alpha.full) ~chain state - (timestamp, (head, priority, _delegate)) + (timestamp, (head, _, _delegate)) = Alpha_block_services.Mempool.monitor_operations cctxt ~chain ~applied:true ~branch_delayed:true ~refused:false ~branch_refused:false () >>=? fun (operation_stream, _stop) -> - (* Hypothesis : the first call to the stream returns instantly, even if the mempool is empty *) + (* Hypothesis : the first call to the stream returns instantly, even if the mempool is empty. *) Lwt_stream.get operation_stream >>= function - | None -> - (* New head received : should not happen. *) + | None -> (* New head received : not supposed to happen. *) return_none | Some current_mempool -> let operations = ref current_mempool in @@ -745,9 +747,6 @@ let build_block -% s Client_keys.Logging.tag name -% a timestamp_tag timestamp) >>= fun () -> - (* (\* Retrieve mempool's pending operations *\) - * Alpha_block_services.Mempool.pending_operations cctxt ~chain () >>=? fun mpool -> *) - fetch_operations cctxt ~chain state slot >>=? function | None -> lwt_log_info Tag.DSL.(fun f -> @@ -765,7 +764,7 @@ let build_block | Some hash -> hash in if Protocol_hash.(Proto_alpha.hash <> next_version) then - (* Delegate validation to shell *) + (* Let the shell validate this *) shell_prevalidation cctxt ~chain ~block seed_nonce_hash (List.sub operations 4) slot else @@ -1018,7 +1017,6 @@ let create in let timeout_k cctxt state () = - (* C'est safe ça ? *) bake cctxt state >>=? fun () -> (* Stopping the timeout and waiting for the next block *) state.best_slot <- None ;