From 9613e5c79741d99cb9e173304945bd359b272a87 Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Wed, 11 Jan 2023 16:22:12 +0100 Subject: [PATCH 1/3] clic: add map_es combinator --- src/lib_clic/tezos_clic.ml | 10 ++++++++++ src/lib_clic/tezos_clic.mli | 7 +++++++ 2 files changed, 17 insertions(+) diff --git a/src/lib_clic/tezos_clic.ml b/src/lib_clic/tezos_clic.ml index e29a4e467476..e258bd1dff45 100644 --- a/src/lib_clic/tezos_clic.ml +++ b/src/lib_clic/tezos_clic.ml @@ -66,6 +66,16 @@ let map_parameter ~f {converter; autocomplete} = autocomplete; } +let map_es_parameter ~f {converter; autocomplete} = + let open Lwt_result_syntax in + { + converter = + (fun ctx s -> + let* v = converter ctx s in + f ctx v); + autocomplete; + } + type label = {long : string; short : char option} type ('a, 'ctx) arg = diff --git a/src/lib_clic/tezos_clic.mli b/src/lib_clic/tezos_clic.mli index f16ea1f67bd3..1085208c83c7 100644 --- a/src/lib_clic/tezos_clic.mli +++ b/src/lib_clic/tezos_clic.mli @@ -68,6 +68,13 @@ val compose_parameters : (** Map a pure function over the result of a parameter parser. *) val map_parameter : f:('a -> 'b) -> ('a, 'ctx) parameter -> ('b, 'ctx) parameter +(** Same as {!map_parameter} but with a function taking the ctxt and returning + in the lwt result monad. *) +val map_es_parameter : + f:('ctx -> 'a -> 'b tzresult Lwt.t) -> + ('a, 'ctx) parameter -> + ('b, 'ctx) parameter + (** {2 Flags and Options } *) (** The type for optional arguments (and switches). -- GitLab From 90352c89a356e303cd83ed96d1266724615e17e1 Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 12 Jan 2023 08:42:43 +0100 Subject: [PATCH 2/3] client: refactor with file_or_text_parameter --- .../lib_client/client_proto_args.ml | 29 ++++++++++++--- .../lib_client/client_proto_args.mli | 14 +++++++- .../client_proto_programs_commands.ml | 36 ++++++++++++------- 3 files changed, 60 insertions(+), 19 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index 913e82e17d9e..7bdf6700b2f9 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -156,30 +156,49 @@ let bytes_of_prefixed_string (cctxt : #Client_context.full) s = let bytes_parameter = Tezos_clic.parameter bytes_of_prefixed_string +type 'a file_or_text = File of {path : string; content : 'a} | Text of 'a + +let content_of_file_or_text = function + | File {content; _} | Text content -> content + let parse_file ~from_text ~read_file ~path = let open Lwt_result_syntax in let* content = read_file path in from_text content let file_or_text ~from_text ~read_file = + let open Lwt_result_syntax in Client_aliases.parse_alternatives [ - ("file", fun path -> parse_file ~from_text ~read_file ~path); - ("text", from_text); + ( "file", + fun path -> + let* content = parse_file ~from_text ~read_file ~path in + return (File {path; content}) ); + ( "text", + fun text -> + let* content = from_text text in + return (Text content) ); ] -let file_or_text_parameter ~from_text () = +let file_or_text_with_origin_parameter ~from_text () = Tezos_clic.parameter (fun (cctxt : #Client_context.full) -> file_or_text ~from_text:(from_text cctxt) ~read_file:cctxt#read_file) -let json_parameter = +let file_or_text_parameter ~from_text () = + file_or_text_with_origin_parameter ~from_text () + |> Tezos_clic.map_parameter ~f:content_of_file_or_text + +let json_with_origin_parameter = let from_text (cctxt : #Client_context.full) s = match Data_encoding.Json.from_string s with | Ok json -> return json | Error err -> cctxt#error "'%s' is not a valid JSON-encoded value: %s" s err in - file_or_text_parameter ~from_text () + file_or_text_with_origin_parameter ~from_text () + +let json_parameter = + Tezos_clic.map_parameter ~f:content_of_file_or_text json_with_origin_parameter let data_parameter = let open Lwt_syntax in diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index a0d8d440cc72..016d4efa3bd8 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -138,17 +138,29 @@ val bytes_of_prefixed_string : full -> string -> Bytes.t tzresult Lwt.t val bytes_parameter : (Bytes.t, full) Tezos_clic.parameter +type 'a file_or_text = File of {path : string; content : 'a} | Text of 'a + +val content_of_file_or_text : 'a file_or_text -> 'a + val file_or_text : from_text:(string -> 'a tzresult Lwt.t) -> read_file:(string -> string tzresult Lwt.t) -> string -> - 'a tzresult Lwt.t + 'a file_or_text tzresult Lwt.t + +val file_or_text_with_origin_parameter : + from_text:(full -> string -> 'a tzresult Lwt.t) -> + unit -> + ('a file_or_text, full) Tezos_clic.parameter val file_or_text_parameter : from_text:(full -> string -> 'a tzresult Lwt.t) -> unit -> ('a, full) Tezos_clic.parameter +val json_with_origin_parameter : + (Data_encoding.Json.t file_or_text, full) Tezos_clic.parameter + val json_parameter : (Data_encoding.Json.t, full) Tezos_clic.parameter val data_parameter : (Michelson_v1_parser.parsed, full) Tezos_clic.parameter diff --git a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index 06a735f9d9c0..d32a31e4c326 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml @@ -176,16 +176,21 @@ let commands () = "invalid output format, expecting one of \"michelson\", \ \"json\", \"binary\" or \"ocaml\".")) in + let file_or_literal_with_origin_param () = + param + ~name:"source" + ~desc:"literal or a path to a file" + (Client_proto_args.file_or_text_with_origin_parameter + ~from_text:(fun _cctxt s -> Lwt_result_syntax.return s) + ()) + in let file_or_literal_param () = param ~name:"source" ~desc:"literal or a path to a file" - (parameter (fun cctxt s -> - let open Lwt_result_syntax in - let*! r = cctxt#read_file s in - match r with - | Ok v -> return (Some s, v) - | Error _ -> return (None, s))) + (Client_proto_args.file_or_text_parameter + ~from_text:(fun _cctx s -> Lwt_result_syntax.return s) + ()) in let handle_parsing_error label (cctxt : Protocol_client_context.full) (emacs_mode, no_print_source) program body = @@ -528,7 +533,9 @@ let commands () = enforce_indentation_flag display_names_flag (Tezos_clic_unix.Scriptable.clic_arg ())) - (prefixes ["hash"; "script"] @@ seq_of_param @@ file_or_literal_param ()) + (prefixes ["hash"; "script"] + @@ seq_of_param + @@ file_or_literal_with_origin_param ()) (fun (check, display_names, scriptable) expr_strings (cctxt : Protocol_client_context.full) -> @@ -541,7 +548,10 @@ let commands () = else let* hash_name_rows = List.mapi_ep - (fun i (src, expr_string) -> + (fun i content_with_origin -> + let expr_string = + Client_proto_args.content_of_file_or_text content_with_origin + in let program = Michelson_v1_parser.parse_toplevel ~check expr_string in @@ -559,9 +569,9 @@ let commands () = (Script_expr_hash.hash_bytes [bytes]) in let name = - Option.value - src - ~default:("Literal script " ^ string_of_int (i + 1)) + match content_with_origin with + | Client_proto_args.File {path; _} -> path + | Text _ -> "Literal script " ^ string_of_int (i + 1) in return (hash, name)) expr_strings @@ -859,7 +869,7 @@ let commands () = @@ file_or_literal_param () @@ prefix "from" @@ convert_input_format_param @@ prefix "to" @@ convert_output_format_param @@ stop) (fun (zero_loc, legacy, check) - (_, expr_string) + expr_string from_format to_format (cctxt : Protocol_client_context.full) -> @@ -942,7 +952,7 @@ let commands () = @@ file_or_literal_param () @@ prefix "from" @@ convert_input_format_param @@ prefix "to" @@ convert_output_format_param @@ stop) (fun (zero_loc, data_ty) - (_, data_string) + data_string from_format to_format (cctxt : Protocol_client_context.full) -> -- GitLab From f8912022e1ff83f9a34af74b6d9b329aadd7f41c Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 12 Jan 2023 09:46:33 +0100 Subject: [PATCH 3/3] client: add json_encoded_parameter --- .../lib_client/client_proto_args.ml | 39 +++++++ .../lib_client/client_proto_args.mli | 28 +++++ .../client_proto_context_commands.ml | 108 +++++++----------- .../client_proto_fa12_commands.ml | 64 +++++------ .../client_proto_programs_commands.ml | 21 +--- .../client_proto_stresstest_commands.ml | 60 +++------- 6 files changed, 158 insertions(+), 162 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index 7bdf6700b2f9..fbdb7fc71f6b 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -208,6 +208,45 @@ let data_parameter = in file_or_text_parameter ~from_text () +let safe_decode_json (cctxt : #Client_context.full) ~name + ?(pp_error = fun _json fmt exn -> Data_encoding.Json.print_error fmt exn) + encoding json = + let open Lwt_result_syntax in + match Data_encoding.Json.destruct encoding json with + | exception (Data_encoding.Json.Cannot_destruct _ as exn) -> + cctxt#error + "@[could not decode %s JSON:@,%a@]" + name + (pp_error json) + exn + | exception ((Stack_overflow | Out_of_memory) as exc) -> raise exc + | exception exc -> + cctxt#error "could not decode json (%s)" (Printexc.to_string exc) + | expr -> return expr + +let json_encoded_with_origin_parameter ~name ?pp_error encoding = + let open Lwt_result_syntax in + Tezos_clic.map_es_parameter + ~f:(fun (cctxt : #Client_context.full) json_with_origin -> + match json_with_origin with + | File {path; content} -> + let+ content = + safe_decode_json ~name ?pp_error cctxt encoding content + in + File {path; content} + | Text content -> + let+ content = safe_decode_json ~name cctxt encoding content in + Text content) + json_with_origin_parameter + +let json_encoded_parameter ~name ?pp_error encoding = + Tezos_clic.map_parameter + ~f:content_of_file_or_text + (json_encoded_with_origin_parameter ~name ?pp_error encoding) + +let json_encoded_param ~name ~desc ?pp_error encoding = + Tezos_clic.param ~name ~desc (json_encoded_parameter ~name ?pp_error encoding) + let binary_encoded_parameter ~name encoding = let open Lwt_result_syntax in let from_text (cctxt : #Client_context.full) s = diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index 016d4efa3bd8..c6fe4627c515 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -161,6 +161,34 @@ val file_or_text_parameter : val json_with_origin_parameter : (Data_encoding.Json.t file_or_text, full) Tezos_clic.parameter +val safe_decode_json : + full -> + name:string -> + ?pp_error:(Data_encoding.json -> Format.formatter -> exn -> unit) -> + 'a Data_encoding.t -> + Data_encoding.json -> + 'a tzresult Lwt.t + +val json_encoded_with_origin_parameter : + name:string -> + ?pp_error:(Data_encoding.json -> Format.formatter -> exn -> unit) -> + 'a Data_encoding.t -> + ('a file_or_text, full) Tezos_clic.parameter + +val json_encoded_parameter : + name:string -> + ?pp_error:(Data_encoding.json -> Format.formatter -> exn -> unit) -> + 'a Data_encoding.t -> + ('a, full) Tezos_clic.parameter + +val json_encoded_param : + name:string -> + desc:string -> + ?pp_error:(Data_encoding.json -> Format.formatter -> exn -> unit) -> + 'b Data_encoding.t -> + ('a, full) Tezos_clic.params -> + ('b -> 'a, full) Tezos_clic.params + val json_parameter : (Data_encoding.Json.t, full) Tezos_clic.parameter val data_parameter : (Michelson_v1_parser.parsed, full) Tezos_clic.parameter diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 30849e07c3d8..774636b393a9 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -1008,42 +1008,28 @@ let commands_network network () = (args2 (Secret_key.force_switch ()) encrypted_switch) (prefixes ["activate"; "account"] @@ Secret_key.fresh_alias_param @@ prefixes ["with"] - @@ param + @@ Client_proto_args.json_encoded_param ~name:"activation_key" ~desc: "Activate an Alphanet/Zeronet faucet account from the JSON \ (file or directly inlined)." - json_parameter + Client_proto_context.activation_key_encoding @@ stop) - (fun (force, encrypted) name activation_json cctxt -> + (fun (force, encrypted) name activation_key cctxt -> let open Lwt_result_syntax in let* name = Secret_key.of_fresh cctxt force name in - match - Data_encoding.Json.destruct - Client_proto_context.activation_key_encoding - activation_json - with - | exception (Data_encoding.Json.Cannot_destruct _ as exn) -> - Format.kasprintf - (fun s -> failwith "%s" s) - "Invalid activation file: %a %a" - (fun ppf -> Data_encoding.Json.print_error ppf) - exn - Data_encoding.Json.pp - activation_json - | key -> - let* _res = - activate_account - cctxt - ~chain:cctxt#chain - ~block:cctxt#block - ?confirmations:cctxt#confirmations - ~encrypted - ~force - key - name - in - return_unit); + let* _res = + activate_account + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~encrypted + ~force + activation_key + name + in + return_unit); ] | Some `Mainnet -> [ @@ -1326,7 +1312,7 @@ let commands_rw () = ~name:"src" ~desc:"name of the source contract" @@ prefix "using" - @@ param + @@ json_encoded_param ~name:"transfers.json" ~desc: "List of operations originating from the source contract in JSON \ @@ -1335,7 +1321,30 @@ let commands_rw () = \"amount\": qty (, : ...) } (, ...) ]', where an \ optional can either be \"fee\", \"gas-limit\", \ \"storage-limit\", \"arg\", or \"entrypoint\"." - json_parameter + ~pp_error:(fun json fmt exn -> + match (json, exn) with + | `A lj, Data_encoding.Json.Cannot_destruct ([`Index n], exn) -> + Format.fprintf + fmt + "Invalid transfer at index %i: %a %a" + n + (fun ppf -> Data_encoding.Json.print_error ppf) + exn + (Format.pp_print_option Data_encoding.Json.pp) + (List.nth_opt lj n) + | _, (Data_encoding.Json.Cannot_destruct _ as exn) -> + Format.fprintf + fmt + "Invalid transfer file: %a %a" + (fun ppf -> Data_encoding.Json.print_error ppf) + exn + Data_encoding.Json.pp + json + | _, exn -> raise exn + (* this case can't happen because only `Cannot_destruct` error are + given to this pp *)) + (Data_encoding.list + Client_proto_context.batch_transfer_operation_encoding) @@ stop) (fun ( fee, dry_run, @@ -1351,7 +1360,7 @@ let commands_rw () = entrypoint, replace_by_fees ) source - operations_json + operations cctxt -> (* When --force is used we want to inject the transfer even if it fails. In that case we cannot rely on simulation to compute limits and fees @@ -1382,12 +1391,7 @@ let commands_rw () = source i in - match - Data_encoding.Json.destruct - (Data_encoding.list - Client_proto_context.batch_transfer_operation_encoding) - operations_json - with + match operations with | [] -> cctxt#error "Empty operation list" | operations -> let* source = @@ -1434,33 +1438,7 @@ let commands_rw () = cctxt errors in - return_unit - | exception (Data_encoding.Json.Cannot_destruct (path, exn2) as exn) - -> ( - match (path, operations_json) with - | [`Index n], `A lj -> ( - match List.nth_opt lj n with - | Some j -> - failwith - "Invalid transfer at index %i: %a %a" - n - (fun ppf -> Data_encoding.Json.print_error ppf) - exn2 - Data_encoding.Json.pp - j - | _ -> - failwith - "Invalid transfer at index %i: %a" - n - (fun ppf -> Data_encoding.Json.print_error ppf) - exn2) - | _ -> - failwith - "Invalid transfer file: %a %a" - (fun ppf -> Data_encoding.Json.print_error ppf) - exn - Data_encoding.Json.pp - operations_json)); + return_unit); command ~group ~desc:"Execute an Epoxy origination operation.\n" diff --git a/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml index 8cb89767cd61..20a9b367fa06 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml @@ -601,8 +601,8 @@ let commands_rw () : #Protocol_client_context.full Tezos_clic.command list = ~name:"src" ~desc:"name or address of the source of the transfers" @@ prefix "using" - @@ param - ~name:"transfers.json" + @@ json_encoded_param + ~name:"transfers" ~desc: (Format.sprintf "List of token transfers to inject from the source contract \ @@ -615,7 +615,29 @@ let commands_rw () : #Protocol_client_context.full Tezos_clic.command list = \"storage-limit\". The complete schema can be inspected via \ `tezos-codec describe %s.fa1.2.token_transfer json schema`." Protocol.name) - json_parameter + ~pp_error:(fun json fmt exn -> + match (json, exn) with + | `A lj, Data_encoding.Json.Cannot_destruct ([`Index n], exn) -> + Format.fprintf + fmt + "Invalid transfer at index %i: %a %a" + n + (fun ppf -> Data_encoding.Json.print_error ppf) + exn + (Format.pp_print_option Data_encoding.Json.pp) + (List.nth_opt lj n) + | _, (Data_encoding.Json.Cannot_destruct _ as exn) -> + Format.fprintf + fmt + "Invalid transfer file: %a %a" + (fun ppf -> Data_encoding.Json.print_error ppf) + exn + Data_encoding.Json.pp + json + | _, exn -> raise exn + (* this case can't happen because only `Cannot_destruct` error are + given to this pp *)) + (Data_encoding.list Client_proto_fa12.token_transfer_encoding) @@ stop) (fun ( fee, as_address, @@ -627,15 +649,11 @@ let commands_rw () : #Protocol_client_context.full Tezos_clic.command list = no_print_source, fee_parameter ) src - operations_json + operations cctxt -> let open Lwt_result_syntax in let caller = Option.value ~default:src as_address in - match - Data_encoding.Json.destruct - (Data_encoding.list Client_proto_fa12.token_transfer_encoding) - operations_json - with + match operations with | [] -> cctxt#error "Empty operation list" | operations -> let* source, src_pk, src_sk = @@ -668,33 +686,7 @@ let commands_rw () : #Protocol_client_context.full Tezos_clic.command list = cctxt errors in - return_unit - | exception (Data_encoding.Json.Cannot_destruct (path, exn2) as exn) - -> ( - match (path, operations_json) with - | [`Index n], `A lj -> ( - match List.nth_opt lj n with - | Some j -> - failwith - "Invalid transfer at index %i: %a %a" - n - (fun ppf -> Data_encoding.Json.print_error ppf) - exn2 - Data_encoding.Json.pp - j - | _ -> - failwith - "Invalid transfer at index %i: %a" - n - (fun ppf -> Data_encoding.Json.print_error ppf) - exn2) - | _ -> - failwith - "Invalid transfer file: %a %a" - (fun ppf -> Data_encoding.Json.print_error ppf) - exn - Data_encoding.Json.pp - operations_json)); + return_unit); ] let commands () = commands_ro () @ commands_rw () diff --git a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index d32a31e4c326..2a578de23455 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml @@ -37,19 +37,6 @@ open Client_proto_programs open Client_proto_args open Client_proto_contracts -let safe_decode_json (cctxt : Protocol_client_context.full) encoding json = - match Data_encoding.Json.destruct encoding json with - | exception Data_encoding.Json.Cannot_destruct (_, exc) -> - cctxt#error - "could not decode json (%a)" - (Data_encoding.Json.print_error ~print_unknown:(fun fmt exc -> - Format.fprintf fmt "%s" (Printexc.to_string exc))) - exc - | exception ((Stack_overflow | Out_of_memory) as exc) -> raise exc - | exception exc -> - cctxt#error "could not decode json (%s)" (Printexc.to_string exc) - | expr -> Lwt_result_syntax.return expr - let commands () = let open Tezos_clic in let show_types_switch = @@ -907,8 +894,11 @@ let commands () = match Data_encoding.Json.from_string expr_string with | Error err -> cctxt#error "%s" err | Ok json -> - safe_decode_json cctxt Alpha_context.Script.expr_encoding json - ) + safe_decode_json + ~name:"script" + cctxt + Alpha_context.Script.expr_encoding + json) | `Binary -> ( let* bytes = bytes_of_prefixed_string cctxt expr_string in match @@ -1002,6 +992,7 @@ let commands () = | Ok json -> ( let* expr = safe_decode_json + ~name:"script" cctxt Alpha_context.Script.expr_encoding json diff --git a/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml index 4f9cb95f70fc..d1920589f114 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml @@ -181,8 +181,6 @@ let input_source_encoding = (fun pkh -> Wallet_pkh pkh); ] -let input_source_list_encoding = Data_encoding.list input_source_encoding - let injected_operations_encoding = let open Data_encoding in list @@ -886,29 +884,12 @@ let group = Tezos_clic. {name = "stresstest"; title = "Commands for stress-testing the network"} -type pool_source = - | From_string of {json : Ezjsonm.value} - | From_file of {path : string; json : Ezjsonm.value} - -let json_of_pool_source = function - | From_string {json} | From_file {json; _} -> json +let input_source_list_encoding = Data_encoding.list input_source_encoding -let json_file_or_text_parameter = - Tezos_clic.parameter (fun _ p -> - let open Lwt_result_syntax in - match String.split ~limit:1 ':' p with - | ["text"; text] -> return (From_string {json = Ezjsonm.from_string text}) - | ["file"; path] -> - let+ json = Lwt_utils_unix.Json.read_file path in - From_file {path; json} - | _ -> ( - if Sys.file_exists p then - let+ json = Lwt_utils_unix.Json.read_file p in - From_file {path = p; json} - else - try return (From_string {json = Ezjsonm.from_string p}) - with Ezjsonm.Parse_error _ -> - failwith "Neither an existing file nor valid JSON: '%s'" p)) +let pool_source_param = + Client_proto_args.json_encoded_with_origin_parameter + ~name:"input source list" + input_source_list_encoding let seed_arg = let open Tezos_clic in @@ -972,17 +953,9 @@ let smart_contract_parameters_arg = "A JSON object that maps smart contract aliases to objects with three \ fields: probability in [0;1], invocation_fee, and \ invocation_gas_limit.") - (parameter (fun (cctxt : Protocol_client_context.full) s -> - match Data_encoding.Json.from_string s with - | Ok json -> - Lwt_result_syntax.return - (Data_encoding.Json.destruct - Smart_contracts.contract_parameters_collection_encoding - json) - | Error _ -> - cctxt#error - "While parsing --smart-contract-parameters: invalid JSON %s" - s)) + (Client_proto_args.json_encoded_parameter + ~name:"smart contract" + Smart_contracts.contract_parameters_collection_encoding) let strategy_arg = let open Tezos_clic in @@ -1100,14 +1073,14 @@ let save_pool_callback (cctxt : Protocol_client_context.full) pool_source state in let open Lwt_syntax in match pool_source with - | From_string _ -> + | Client_proto_args.Text _ -> (* If the initial pool was given directly as json, save pool to a temp file. *) let path = Filename.temp_file "client-stresstest-pool-" ".json" in let* () = cctxt#message "writing back address pool in file %s" path in let* r = Lwt_utils_unix.Json.write_file path json in catch_write_error r - | From_file {path; _} -> + | File {path; _} -> (* If the pool specification was a json file, save pool to the same file. *) let* () = cctxt#message "writing back address pool in file %s" path in @@ -1137,7 +1110,7 @@ let generate_random_transactions = ~name:"sources.json" ~desc: {|List of accounts from which to perform transfers in JSON format. The input JSON must be an array of objects of the form {"pkh":"","pk":"","sk":""} or {"alias":""} or {"pkh":""} with the pkh, pk and sk encoded in B58 form."|} - json_file_or_text_parameter + pool_source_param @@ stop) (fun ( seed, tps, @@ -1151,7 +1124,7 @@ let generate_random_transactions = level_limit, verbose_flag, debug_flag ) - sources_json + pool_source (cctxt : Protocol_client_context.full) -> let open Lwt_result_syntax in (verbosity := @@ -1183,12 +1156,7 @@ let generate_random_transactions = |> set_option level_limit (fun parameter level_limit -> {parameter with level_limit = Some level_limit}) in - match - Data_encoding.Json.destruct - input_source_list_encoding - (json_of_pool_source sources_json) - with - | exception _ -> cctxt#error "Could not decode list of sources" + match Client_proto_args.content_of_file_or_text pool_source with | [] -> cctxt#error "It is required to provide sources" | sources -> let*! () = @@ -1251,7 +1219,7 @@ let generate_random_transactions = | Error e -> cctxt#message "Error: %a" Error_monad.pp_print_trace e) in - let save_pool () = save_pool_callback cctxt sources_json state in + let save_pool () = save_pool_callback cctxt pool_source state in (* Register a callback for saving the pool when the tool is interrupted through ctrl-c *) let exit_callback_id = -- GitLab