diff --git a/src/bin_client/client_config.ml b/src/bin_client/client_config.ml index 6f1ed71d3..c518292bc 100644 --- a/src/bin_client/client_config.ml +++ b/src/bin_client/client_config.ml @@ -48,6 +48,12 @@ let () = (fun s -> Invalid_port_arg s) +let default_base_dir = + let home = try Sys.getenv "HOME" with Not_found -> "/root" in + Filename.concat home ".tezos-client" + +let default_block = `Prevalidation + let (//) = Filename.concat module Cfg_file = struct @@ -61,7 +67,7 @@ module Cfg_file = struct } let default = { - base_dir = Client_context.default_base_dir ; + base_dir = default_base_dir ; node_addr = "localhost" ; node_port = 8732 ; tls = false ; @@ -109,7 +115,7 @@ type cli_args = { } let default_cli_args = { - block = Client_context.default_block ; + block = default_block ; protocol = None ; print_timings = false ; log_requests = false ; @@ -118,7 +124,7 @@ let default_cli_args = { open Cli_entries -let string_parameter () : (string, #Client_commands.full_context) parameter = +let string_parameter () : (string, #Client_context.full_context) parameter = parameter (fun _ x -> return x) let block_parameter () = @@ -148,7 +154,7 @@ let base_dir_arg () = ~placeholder:"path" ~doc:("client data directory\n\ The directory where the Tezos client will store all its data.\n\ - By default " ^ Client_context.default_base_dir) + By default: '" ^ default_base_dir ^"'.") (string_parameter ()) let config_file_arg () = arg @@ -228,7 +234,7 @@ let commands config_file cfg = [ command ~group ~desc:"Show the config file." no_options (fixed [ "config" ; "show" ]) - (fun () (cctxt : #Client_commands.full_context) -> + (fun () (cctxt : #Client_context.full_context) -> let pp_cfg ppf cfg = Format.fprintf ppf "%a" Data_encoding.Json.pp (Data_encoding.Json.construct Cfg_file.encoding cfg) in if not @@ Sys.file_exists config_file then cctxt#warning @@ -294,7 +300,7 @@ let global_options () = (port_arg ()) (tls_switch ()) -let parse_config_args (ctx : #Client_commands.full_context) argv = +let parse_config_args (ctx : #Client_context.full_context) argv = parse_global_options (global_options ()) ctx @@ -310,7 +316,7 @@ let parse_config_args (ctx : #Client_commands.full_context) argv = tls), remaining) -> begin match base_dir with | None -> - let base_dir = Client_context.default_base_dir in + let base_dir = default_base_dir in unless (Sys.file_exists base_dir) begin fun () -> Lwt_utils_unix.create_dir base_dir >>= return end >>=? fun () -> diff --git a/src/bin_client/client_context.ml b/src/bin_client/client_context_unix.ml similarity index 98% rename from src/bin_client/client_context.ml rename to src/bin_client/client_context_unix.ml index 6fc0b143b..5a639693f 100644 --- a/src/bin_client/client_context.ml +++ b/src/bin_client/client_context_unix.ml @@ -82,7 +82,7 @@ let make_context ?(rpc_config = RPC_client.default_config) log = object - inherit Client_commands.logger log + inherit Client_context.logger log inherit file_wallet base_dir inherit RPC_client.http_ctxt rpc_config Media_type.all_media_types method block = block diff --git a/src/bin_client/client_context.mli b/src/bin_client/client_context_unix.mli similarity index 91% rename from src/bin_client/client_context.mli rename to src/bin_client/client_context_unix.mli index 2fc77936c..71e3dd1b0 100644 --- a/src/bin_client/client_context.mli +++ b/src/bin_client/client_context_unix.mli @@ -11,13 +11,13 @@ val make_context : ?base_dir:string -> ?block:Block_services.block -> ?rpc_config:RPC_client.config -> - (string -> string -> unit Lwt.t) -> Client_commands.full_context + (string -> string -> unit Lwt.t) -> Client_context.full_context (** [make_context ?config log_fun] builds a context whose logging callbacks call [log_fun section msg], and whose [error] function fails with [Failure] and the given message. If not passed, [config] is {!default_cfg}. *) -val ignore_context : Client_commands.full_context +val ignore_context : Client_context.full_context (** [ignore_context] is a context whose logging callbacks do nothing, and whose [error] function calls [Lwt.fail_with]. *) diff --git a/src/bin_client/client_main_run.ml b/src/bin_client/client_main_run.ml index 73658ea7e..48c57a06d 100644 --- a/src/bin_client/client_main_run.ml +++ b/src/bin_client/client_main_run.ml @@ -9,12 +9,74 @@ (* Tezos Command line interface - Main Program *) +open Client_context + +class file_wallet dir : wallet = object (self) + method private filename alias_name = + Filename.concat + dir + (Str.(global_replace (regexp_string " ") "_" alias_name) ^ "s") + + method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t = + fun alias_name ~default encoding -> + let filename = self#filename alias_name in + if not (Sys.file_exists filename) then + return default + else + Lwt_utils_unix.Json.read_file filename + |> generic_trace + "couldn't to read the %s file" alias_name >>=? fun json -> + match Data_encoding.Json.destruct encoding json with + | exception _ -> (* TODO print_error *) + failwith "didn't understand the %s file" alias_name + | data -> + return data + + method write : + type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = + fun alias_name list encoding -> + Lwt.catch + (fun () -> + Lwt_utils_unix.create_dir dir >>= fun () -> + let filename = self#filename alias_name in + let json = Data_encoding.Json.construct encoding list in + Lwt_utils_unix.Json.write_file filename json) + (fun exn -> Lwt.return (error_exn exn)) + |> generic_trace "could not write the %s alias file." alias_name +end + +let default_log ~base_dir channel msg = + let startup = + CalendarLib.Printer.Precise_Calendar.sprint + "%Y-%m-%dT%H:%M:%SZ" + (CalendarLib.Calendar.Precise.now ()) in + match channel with + | "stdout" -> + print_endline msg ; + Lwt.return () + | "stderr" -> + prerr_endline msg ; + Lwt.return () + | log -> + let (//) = Filename.concat in + Lwt_utils_unix.create_dir (base_dir // "logs" // log) >>= fun () -> + Lwt_io.with_file + ~flags: Unix.[ O_APPEND ; O_CREAT ; O_WRONLY ] + ~mode: Lwt_io.Output + (base_dir // "logs" // log // startup) + (fun chan -> Lwt_io.write chan msg) + + +let make_context block base_dir rpc_config = + object + inherit Client_context.logger (default_log ~base_dir) + inherit file_wallet base_dir + inherit RPC_client.http_ctxt rpc_config Media_type.all_media_types + method block = block + end + (* Main (lwt) entry *) let main select_commands = - let cctxt ~base_dir ~block rpc_config = - Client_context.make_context - ~base_dir ~block ~rpc_config - (Client_context.default_log ~base_dir) in let executable_name = Filename.basename Sys.executable_name in let global_options = Client_config.global_options () in let original_args, autocomplete = @@ -35,8 +97,9 @@ let main select_commands = (if Unix.isatty Unix.stderr then Ansi else Plain) Short) ; Lwt.catch begin fun () -> begin Client_config.parse_config_args - (cctxt ~base_dir:Client_context.default_base_dir - ~block:Client_context.default_block + (make_context + Client_config.default_block + Client_config.default_base_dir RPC_client.default_config) original_args >>=? fun (parsed_config_file, parsed_args, config_commands, remaining) -> @@ -64,7 +127,10 @@ let main select_commands = else rpc_config in let client_config = - cctxt ~block:parsed_args.block ~base_dir:parsed_config_file.base_dir rpc_config in + make_context + parsed_args.block + parsed_config_file.base_dir + rpc_config in begin match autocomplete with | Some (prev_arg, cur_arg, script) -> Cli_entries.autocompletion diff --git a/src/bin_client/client_main_run.mli b/src/bin_client/client_main_run.mli index d6f3c60b5..d77db523a 100644 --- a/src/bin_client/client_main_run.mli +++ b/src/bin_client/client_main_run.mli @@ -10,5 +10,5 @@ val run : (RPC_client.http_ctxt -> Client_config.cli_args -> - Client_commands.full_context Cli_entries.command list tzresult Lwt.t) -> + Client_context.full_context Cli_entries.command list tzresult Lwt.t) -> unit diff --git a/src/bin_client/client_protocols.ml b/src/bin_client/client_protocols_commands.ml similarity index 93% rename from src/bin_client/client_protocols.ml rename to src/bin_client/client_protocols_commands.ml index aa049508f..681318bbb 100644 --- a/src/bin_client/client_protocols.ml +++ b/src/bin_client/client_protocols_commands.ml @@ -24,7 +24,7 @@ let commands () = command ~group ~desc: "List protocols known by the node." no_options (prefixes [ "list" ; "protocols" ] stop) - (fun () (cctxt : #Client_commands.full_context) -> + (fun () (cctxt : #Client_context.full_context) -> Protocol_services.list ~contents:false cctxt >>=? fun protos -> Lwt_list.iter_s (fun (ph, _p) -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () -> return () @@ -35,7 +35,7 @@ let commands () = (prefixes [ "inject" ; "protocol" ] @@ param ~name:"dir" ~desc:"directory containing a protocol" check_dir_parameter @@ stop) - (fun () dirname (cctxt : #Client_commands.full_context) -> + (fun () dirname (cctxt : #Client_context.full_context) -> Lwt.catch (fun () -> Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) -> @@ -58,7 +58,7 @@ let commands () = (prefixes [ "dump" ; "protocol" ] @@ Protocol_hash.param ~name:"protocol hash" ~desc:"" @@ stop) - (fun () ph (cctxt : #Client_commands.full_context) -> + (fun () ph (cctxt : #Client_context.full_context) -> Protocol_services.contents cctxt ph >>=? fun proto -> Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () -> cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () -> diff --git a/src/bin_client/client_protocols.mli b/src/bin_client/client_protocols_commands.mli similarity index 100% rename from src/bin_client/client_protocols.mli rename to src/bin_client/client_protocols_commands.mli diff --git a/src/lib_client_base/client_generic_rpcs.ml b/src/bin_client/client_rpc_commands.ml similarity index 97% rename from src/lib_client_base/client_generic_rpcs.ml rename to src/bin_client/client_rpc_commands.ml index 9282bebb5..126fd5c30 100644 --- a/src/lib_client_base/client_generic_rpcs.ml +++ b/src/bin_client/client_rpc_commands.ml @@ -191,7 +191,7 @@ let rec count = (*-- Commands ---------------------------------------------------------------*) -let list url (cctxt : #Client_commands.full_context) = +let list url (cctxt : #Client_context.full_context) = let args = String.split '/' url in RPC_description.describe cctxt ~recurse:true args >>=? fun tree -> @@ -290,7 +290,7 @@ let list url (cctxt : #Client_commands.full_context) = end else return () -let schema url (cctxt : #Client_commands.full_context) = +let schema url (cctxt : #Client_context.full_context) = let args = String.split '/' url in let open RPC_description in RPC_description.describe cctxt ~recurse:false args >>=? function @@ -315,7 +315,7 @@ let schema url (cctxt : #Client_commands.full_context) = "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> return () -let format url (cctxt : #Client_commands.logging_rpcs) = +let format url (cctxt : #Client_context.logging_rpcs) = let args = String.split '/' url in let open RPC_description in RPC_description.describe cctxt ~recurse:false args >>=? function @@ -354,7 +354,7 @@ let fill_in ?(show_optionals=true) schema = | Any | Object { properties = [] } -> Lwt.return (Ok (`O [])) | _ -> editor_fill_in ~show_optionals schema -let display_answer (cctxt : #Client_commands.full_context) = function +let display_answer (cctxt : #Client_context.full_context) = function | `Ok json -> cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () -> @@ -366,7 +366,7 @@ let display_answer (cctxt : #Client_commands.full_context) = function cctxt#message "Unexpected server answer\n%!" >>= fun () -> return () -let call raw_url (cctxt : #Client_commands.full_context) = +let call raw_url (cctxt : #Client_context.full_context) = let uri = Uri.of_string raw_url in let args = String.split_path (Uri.path uri) in RPC_description.describe cctxt ~recurse:false args >>=? function @@ -392,7 +392,7 @@ let call raw_url (cctxt : #Client_commands.full_context) = cctxt#message "No service found at this URL\n%!" >>= fun () -> return () -let call_with_json raw_url json (cctxt: #Client_commands.full_context) = +let call_with_json raw_url json (cctxt: #Client_context.full_context) = let uri = Uri.of_string raw_url in match Data_encoding.Json.from_string json with | Error err -> @@ -403,7 +403,7 @@ let call_with_json raw_url json (cctxt: #Client_commands.full_context) = cctxt#generic_json_call `POST ~body uri >>=? display_answer cctxt -let call_with_file_or_json url maybe_file (cctxt: #Client_commands.full_context) = +let call_with_file_or_json url maybe_file (cctxt: #Client_context.full_context) = begin match TzString.split ':' ~limit:1 maybe_file with | [ "file" ; filename] -> @@ -429,7 +429,7 @@ let commands = [ ~desc: "List the protocol versions that this client understands." no_options (fixed [ "list" ; "versions" ]) - (fun () (cctxt : #Client_commands.full_context) -> + (fun () (cctxt : #Client_context.full_context) -> Lwt_list.iter_s (fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver) (Client_commands.get_versions ()) >>= fun () -> diff --git a/src/lib_client_base/client_generic_rpcs.mli b/src/bin_client/client_rpc_commands.mli similarity index 100% rename from src/lib_client_base/client_generic_rpcs.mli rename to src/bin_client/client_rpc_commands.mli diff --git a/src/bin_client/main_admin.ml b/src/bin_client/main_admin.ml index 99737d514..5178aed25 100644 --- a/src/bin_client/main_admin.ml +++ b/src/bin_client/main_admin.ml @@ -13,6 +13,7 @@ let select_commands _ _ = [ Client_report_commands.commands () ; Client_admin_commands.commands () ; Client_network_commands.commands () ; - Client_generic_rpcs.commands ]) + Client_protocols_commands.commands () ; + Client_rpc_commands.commands ]) let () = Client_main_run.run select_commands diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml index 461239392..45aacbd98 100644 --- a/src/bin_client/main_client.ml +++ b/src/bin_client/main_client.ml @@ -41,7 +41,7 @@ let get_commands_for_version ctxt block protocol = let select_commands ctxt { block ; protocol } = get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version) -> - Client_generic_rpcs.commands @ + Client_rpc_commands.commands @ Client_network_commands.commands () @ Client_keys_commands.commands () @ Client_protocols.commands () @ diff --git a/src/lib_client_base/client_admin_commands.ml b/src/lib_client_base/client_admin_commands.ml index 14761b036..c86c48134 100644 --- a/src/lib_client_base/client_admin_commands.ml +++ b/src/lib_client_base/client_admin_commands.ml @@ -17,7 +17,7 @@ let commands () = no_options (prefixes [ "unmark" ; "invalid" ] @@ seq_of_param (Block_hash.param ~name:"block" ~desc:"block to remove from invalid list")) - (fun () blocks (cctxt : #Client_commands.full_context) -> + (fun () blocks (cctxt : #Client_context.full_context) -> iter_s (fun block -> Block_services.unmark_invalid cctxt block >>=? fun () -> diff --git a/src/lib_client_base/client_admin_commands.mli b/src/lib_client_base/client_admin_commands.mli index f75ebea1c..da4f110ac 100644 --- a/src/lib_client_base/client_admin_commands.mli +++ b/src/lib_client_base/client_admin_commands.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -val commands : unit -> #Client_commands.full_context Cli_entries.command list +val commands : unit -> #Client_context.full_context Cli_entries.command list diff --git a/src/lib_client_base/client_aliases.ml b/src/lib_client_base/client_aliases.ml index eb4776a06..fb59ce844 100644 --- a/src/lib_client_base/client_aliases.ml +++ b/src/lib_client_base/client_aliases.ml @@ -24,43 +24,43 @@ module type Alias = sig type t type fresh_param val load : - #Client_commands.wallet -> + #Client_context.wallet -> (string * t) list tzresult Lwt.t val set : - #Client_commands.wallet -> + #Client_context.wallet -> (string * t) list -> unit tzresult Lwt.t val find : - #Client_commands.wallet -> + #Client_context.wallet -> string -> t tzresult Lwt.t val find_opt : - #Client_commands.wallet -> + #Client_context.wallet -> string -> t option tzresult Lwt.t val rev_find : - #Client_commands.wallet -> + #Client_context.wallet -> t -> string option tzresult Lwt.t val name : - #Client_commands.wallet -> + #Client_context.wallet -> t -> string tzresult Lwt.t val mem : - #Client_commands.wallet -> + #Client_context.wallet -> string -> bool tzresult Lwt.t val add : force:bool -> - #Client_commands.wallet -> + #Client_context.wallet -> string -> t -> unit tzresult Lwt.t val del : - #Client_commands.wallet -> + #Client_context.wallet -> string -> unit tzresult Lwt.t val update : - #Client_commands.wallet -> + #Client_context.wallet -> string -> t -> unit tzresult Lwt.t val of_source : string -> t tzresult Lwt.t val to_source : t -> string tzresult Lwt.t val alias_param : ?name:string -> ?desc:string -> - ('a, (#Client_commands.wallet as 'b)) Cli_entries.params -> + ('a, (#Client_context.wallet as 'b)) Cli_entries.params -> (string * t -> 'a, 'b) Cli_entries.params val fresh_alias_param : ?name:string -> @@ -68,24 +68,24 @@ module type Alias = sig ('a, (< .. > as 'obj)) Cli_entries.params -> (fresh_param -> 'a, 'obj) Cli_entries.params val force_switch : - unit -> (bool, #Client_commands.full_context) arg + unit -> (bool, #Client_context.full_context) arg val of_fresh : - #Client_commands.wallet -> + #Client_context.wallet -> bool -> fresh_param -> string tzresult Lwt.t val source_param : ?name:string -> ?desc:string -> - ('a, (#Client_commands.wallet as 'obj)) Cli_entries.params -> + ('a, (#Client_context.wallet as 'obj)) Cli_entries.params -> (t -> 'a, 'obj) Cli_entries.params val autocomplete: - #Client_commands.wallet -> string list tzresult Lwt.t + #Client_context.wallet -> string list tzresult Lwt.t end module Alias = functor (Entity : Entity) -> struct - open Client_commands + open Client_context let wallet_encoding : (string * Entity.t) list Data_encoding.encoding = let open Data_encoding in @@ -184,7 +184,7 @@ module Alias = functor (Entity : Entity) -> struct param ~name ~desc (parameter ~autocomplete - (fun (cctxt : #Client_commands.wallet) s -> + (fun (cctxt : #Client_context.wallet) s -> find cctxt s >>=? fun v -> return (s, v))) next diff --git a/src/lib_client_base/client_aliases.mli b/src/lib_client_base/client_aliases.mli index 9b5421e4a..f48799e04 100644 --- a/src/lib_client_base/client_aliases.mli +++ b/src/lib_client_base/client_aliases.mli @@ -20,43 +20,43 @@ module type Alias = sig type t type fresh_param val load : - #Client_commands.wallet -> + #Client_context.wallet -> (string * t) list tzresult Lwt.t val set : - #Client_commands.wallet -> + #Client_context.wallet -> (string * t) list -> unit tzresult Lwt.t val find : - #Client_commands.wallet -> + #Client_context.wallet -> string -> t tzresult Lwt.t val find_opt : - #Client_commands.wallet -> + #Client_context.wallet -> string -> t option tzresult Lwt.t val rev_find : - #Client_commands.wallet -> + #Client_context.wallet -> t -> string option tzresult Lwt.t val name : - #Client_commands.wallet -> + #Client_context.wallet -> t -> string tzresult Lwt.t val mem : - #Client_commands.wallet -> + #Client_context.wallet -> string -> bool tzresult Lwt.t val add : force:bool -> - #Client_commands.wallet -> + #Client_context.wallet -> string -> t -> unit tzresult Lwt.t val del : - #Client_commands.wallet -> + #Client_context.wallet -> string -> unit tzresult Lwt.t val update : - #Client_commands.wallet -> + #Client_context.wallet -> string -> t -> unit tzresult Lwt.t val of_source : string -> t tzresult Lwt.t val to_source : t -> string tzresult Lwt.t val alias_param : ?name:string -> ?desc:string -> - ('a, (#Client_commands.wallet as 'b)) Cli_entries.params -> + ('a, (#Client_context.wallet as 'b)) Cli_entries.params -> (string * t -> 'a, 'b) Cli_entries.params val fresh_alias_param : ?name:string -> @@ -64,18 +64,18 @@ module type Alias = sig ('a, (< .. > as 'obj)) Cli_entries.params -> (fresh_param -> 'a, 'obj) Cli_entries.params val force_switch : - unit -> (bool, #Client_commands.full_context) Cli_entries.arg + unit -> (bool, #Client_context.full_context) Cli_entries.arg val of_fresh : - #Client_commands.wallet -> + #Client_context.wallet -> bool -> fresh_param -> string tzresult Lwt.t val source_param : ?name:string -> ?desc:string -> - ('a, (#Client_commands.wallet as 'obj)) Cli_entries.params -> + ('a, (#Client_context.wallet as 'obj)) Cli_entries.params -> (t -> 'a, 'obj) Cli_entries.params val autocomplete: - #Client_commands.wallet -> string list tzresult Lwt.t + #Client_context.wallet -> string list tzresult Lwt.t end module Alias (Entity : Entity) : Alias with type t = Entity.t diff --git a/src/lib_client_base/client_commands.ml b/src/lib_client_base/client_commands.ml index 6e9c2d782..fad0e07a1 100644 --- a/src/lib_client_base/client_commands.ml +++ b/src/lib_client_base/client_commands.ml @@ -7,84 +7,7 @@ (* *) (**************************************************************************) -type ('a, 'b) lwt_format = - ('a, Format.formatter, unit, 'b Lwt.t) format4 - -class type logger_sig = object - method error : ('a, 'b) lwt_format -> 'a - method warning : ('a, unit) lwt_format -> 'a - method message : ('a, unit) lwt_format -> 'a - method answer : ('a, unit) lwt_format -> 'a - method log : string -> ('a, unit) lwt_format -> 'a -end - -class logger log = - let message = - (fun x -> - Format.kasprintf (fun msg -> log "stdout" msg) x) in - object - method error : type a b. (a, b) lwt_format -> a = - Format.kasprintf - (fun msg -> - Lwt.fail (Failure msg)) - method warning : type a. (a, unit) lwt_format -> a = - Format.kasprintf - (fun msg -> log "stderr" msg) - method message : type a. (a, unit) lwt_format -> a = message - method answer : type a. (a, unit) lwt_format -> a = message - method log : type a. string -> (a, unit) lwt_format -> a = - fun name -> - Format.kasprintf - (fun msg -> log name msg) - end - -class type wallet = object - method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t - method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t -end - -class type block = object - method block : Block_services.block -end - -class type logging_wallet = object - inherit logger - inherit wallet -end - -class type logging_rpcs = object - inherit logger - inherit RPC_context.json -end - -class type full_context = object - inherit logger - inherit wallet - inherit RPC_context.json - inherit block -end - -class proxy_context (obj : full_context) = object - method block = obj#block - method answer : type a. (a, unit) lwt_format -> a = obj#answer - method call_service : - 'm 'p 'q 'i 'o. - ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t -> - 'p -> 'q -> 'i -> 'o tzresult Lwt.t = obj#call_service - method call_streamed_service : - 'm 'p 'q 'i 'o. - ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t -> - on_chunk: ('o -> unit) -> - on_close: (unit -> unit) -> - 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = obj#call_streamed_service - method error : type a b. (a, b) lwt_format -> a = obj#error - method generic_json_call = obj#generic_json_call - method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t = obj#load - method log : type a. string -> (a, unit) lwt_format -> a = obj#log - method message : type a. (a, unit) lwt_format -> a = obj#message - method warning : type a. (a, unit) lwt_format -> a = obj#warning - method write : type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = obj#write -end +open Client_context type command = full_context Cli_entries.command diff --git a/src/lib_client_base/client_commands.mli b/src/lib_client_base/client_commands.mli index 4e28418b4..094b208a9 100644 --- a/src/lib_client_base/client_commands.mli +++ b/src/lib_client_base/client_commands.mli @@ -7,52 +7,7 @@ (* *) (**************************************************************************) -type ('a, 'b) lwt_format = - ('a, Format.formatter, unit, 'b Lwt.t) format4 - -class type logger_sig = object - method error : ('a, 'b) lwt_format -> 'a - method warning : ('a, unit) lwt_format -> 'a - method message : ('a, unit) lwt_format -> 'a - method answer : ('a, unit) lwt_format -> 'a - method log : string -> ('a, unit) lwt_format -> 'a -end - -class logger : (string -> string -> unit Lwt.t) -> logger_sig - -class type wallet = object - method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t - method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t -end - -class type block = object - method block : Block_services.block -end - -class type logging_wallet = object - inherit logger_sig - inherit wallet -end - -class type logging_rpcs = object - inherit logger_sig - inherit RPC_context.json -end - -class type full_context = object - inherit logger_sig - inherit wallet - inherit RPC_context.json - inherit block -end -(** The [full_context] allows the client {!command} handlers to work in - various modes (command line, batch mode, web client, etc.) by - abstracting some basic operations such as logging and reading - configuration options. It is passed as parameter to the command - handler when running a command, and must be transmitted to all - basic operations, also making client commands reantrant. *) - -class proxy_context : full_context -> full_context +open Client_context type command = full_context Cli_entries.command diff --git a/src/lib_client_base/client_context.ml b/src/lib_client_base/client_context.ml new file mode 100644 index 000000000..d3950ce88 --- /dev/null +++ b/src/lib_client_base/client_context.ml @@ -0,0 +1,87 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type ('a, 'b) lwt_format = + ('a, Format.formatter, unit, 'b Lwt.t) format4 + +class type logger_sig = object + method error : ('a, 'b) lwt_format -> 'a + method warning : ('a, unit) lwt_format -> 'a + method message : ('a, unit) lwt_format -> 'a + method answer : ('a, unit) lwt_format -> 'a + method log : string -> ('a, unit) lwt_format -> 'a +end + +class logger log = + let message = + (fun x -> + Format.kasprintf (fun msg -> log "stdout" msg) x) in + object + method error : type a b. (a, b) lwt_format -> a = + Format.kasprintf + (fun msg -> + Lwt.fail (Failure msg)) + method warning : type a. (a, unit) lwt_format -> a = + Format.kasprintf + (fun msg -> log "stderr" msg) + method message : type a. (a, unit) lwt_format -> a = message + method answer : type a. (a, unit) lwt_format -> a = message + method log : type a. string -> (a, unit) lwt_format -> a = + fun name -> + Format.kasprintf + (fun msg -> log name msg) + end + +class type wallet = object + method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t + method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t +end + +class type block = object + method block : Block_services.block +end + +class type logging_wallet = object + inherit logger + inherit wallet +end + +class type logging_rpcs = object + inherit logger + inherit RPC_context.json +end + +class type full_context = object + inherit logger + inherit wallet + inherit RPC_context.json + inherit block +end + +class proxy_context (obj : full_context) = object + method block = obj#block + method answer : type a. (a, unit) lwt_format -> a = obj#answer + method call_service : + 'm 'p 'q 'i 'o. + ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t -> + 'p -> 'q -> 'i -> 'o tzresult Lwt.t = obj#call_service + method call_streamed_service : + 'm 'p 'q 'i 'o. + ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t -> + on_chunk: ('o -> unit) -> + on_close: (unit -> unit) -> + 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = obj#call_streamed_service + method error : type a b. (a, b) lwt_format -> a = obj#error + method generic_json_call = obj#generic_json_call + method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t = obj#load + method log : type a. string -> (a, unit) lwt_format -> a = obj#log + method message : type a. (a, unit) lwt_format -> a = obj#message + method warning : type a. (a, unit) lwt_format -> a = obj#warning + method write : type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = obj#write +end diff --git a/src/lib_client_base/client_context.mli b/src/lib_client_base/client_context.mli new file mode 100644 index 000000000..3b1fee531 --- /dev/null +++ b/src/lib_client_base/client_context.mli @@ -0,0 +1,55 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type ('a, 'b) lwt_format = + ('a, Format.formatter, unit, 'b Lwt.t) format4 + +class type logger_sig = object + method error : ('a, 'b) lwt_format -> 'a + method warning : ('a, unit) lwt_format -> 'a + method message : ('a, unit) lwt_format -> 'a + method answer : ('a, unit) lwt_format -> 'a + method log : string -> ('a, unit) lwt_format -> 'a +end + +class logger : (string -> string -> unit Lwt.t) -> logger_sig + +class type wallet = object + method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t + method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t +end + +class type block = object + method block : Block_services.block +end + +class type logging_wallet = object + inherit logger_sig + inherit wallet +end + +class type logging_rpcs = object + inherit logger_sig + inherit RPC_context.json +end + +class type full_context = object + inherit logger_sig + inherit wallet + inherit RPC_context.json + inherit block +end +(** The [full_context] allows the client {!command} handlers to work in + various modes (command line, batch mode, web client, etc.) by + abstracting some basic operations such as logging and reading + configuration options. It is passed as parameter to the command + handler when running a command, and must be transmitted to all + basic operations, also making client commands reantrant. *) + +class proxy_context : full_context -> full_context diff --git a/src/lib_client_base/client_helpers_commands.ml b/src/lib_client_base/client_helpers_commands.ml index d0f4141b7..961e3796b 100644 --- a/src/lib_client_base/client_helpers_commands.ml +++ b/src/lib_client_base/client_helpers_commands.ml @@ -25,7 +25,7 @@ let commands () = Cli_entries.[ ~name: "prefix" ~desc: "the prefix of the hash to complete" @@ stop) - (fun unique prefix (cctxt : #Client_commands.full_context) -> + (fun unique prefix (cctxt : #Client_context.full_context) -> Shell_services.complete cctxt ~block:cctxt#block prefix >>=? fun completions -> match completions with @@ -39,7 +39,7 @@ let commands () = Cli_entries.[ no_options (prefixes [ "bootstrapped" ] @@ stop) - (fun () (cctxt : #Client_commands.full_context) -> + (fun () (cctxt : #Client_context.full_context) -> Shell_services.bootstrapped cctxt >>=? fun (stream, _) -> Lwt_stream.iter_s (fun (hash, time) -> diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml index 95ef426b4..6e7d8a842 100644 --- a/src/lib_client_base/client_keys.ml +++ b/src/lib_client_base/client_keys.ml @@ -118,10 +118,10 @@ module type SIGNER = sig val title : string val description : string val sk_locator_of_human_input : - Client_commands.logging_wallet -> + Client_context.logging_wallet -> string list -> sk_locator tzresult Lwt.t val pk_locator_of_human_input : - Client_commands.logging_wallet -> + Client_context.logging_wallet -> string list -> pk_locator tzresult Lwt.t val sk_of_locator : sk_locator -> secret_key tzresult Lwt.t val pk_of_locator : pk_locator -> public_key tzresult Lwt.t @@ -156,7 +156,7 @@ let append loc buf = sign loc buf >>|? fun signature -> MBytes.concat buf (Ed25519.Signature.to_bytes signature) -let gen_keys ?(force=false) ?seed (cctxt : #Client_commands.wallet) name = +let gen_keys ?(force=false) ?seed (cctxt : #Client_context.wallet) name = let seed = match seed with | None -> Ed25519.Seed.generate () @@ -170,7 +170,7 @@ let gen_keys ?(force=false) ?seed (cctxt : #Client_commands.wallet) name = cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () -> return () -let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_commands.full_context) = +let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_context.full_context) = let unrepresentable = List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in match unrepresentable with @@ -225,7 +225,7 @@ let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt return () end -let get_key (cctxt : #Client_commands.wallet) pkh = +let get_key (cctxt : #Client_context.wallet) pkh = Public_key_hash.rev_find cctxt pkh >>=? function | None -> failwith "no keys for the source contract manager" | Some n -> @@ -238,7 +238,7 @@ let get_key (cctxt : #Client_commands.wallet) pkh = Signer.public_key pk >>= fun pk -> return (n, pk, sk) -let get_keys (wallet : #Client_commands.wallet) = +let get_keys (wallet : #Client_context.wallet) = Secret_key.load wallet >>=? fun sks -> Lwt_list.filter_map_s begin fun (name, sk) -> begin diff --git a/src/lib_client_base/client_keys.mli b/src/lib_client_base/client_keys.mli index f41656d42..e5cf6ed66 100644 --- a/src/lib_client_base/client_keys.mli +++ b/src/lib_client_base/client_keys.mli @@ -53,14 +53,14 @@ module type SIGNER = sig signer, that should include the format of key specifications. *) val sk_locator_of_human_input : - Client_commands.logging_wallet -> + Client_context.logging_wallet -> string list -> sk_locator tzresult Lwt.t (** [sk_locator_of_human_input wallet spec] is the [sk_locator] corresponding to the human readable specification [spec] (plugin dependent). *) val pk_locator_of_human_input : - Client_commands.logging_wallet -> + Client_context.logging_wallet -> string list -> pk_locator tzresult Lwt.t (** [pk_locator_of_human_input wallet spec] is the [pk_locator] corresponding to the human readable specification [spec] (plugin @@ -106,30 +106,30 @@ val append : sk_locator -> MBytes.t -> MBytes.t tzresult Lwt.t val gen_keys : ?force:bool -> ?seed:Ed25519.Seed.t -> - #Client_commands.wallet -> string -> unit tzresult Lwt.t + #Client_context.wallet -> string -> unit tzresult Lwt.t val gen_keys_containing : ?prefix:bool -> ?force:bool -> containing:string list -> name:string -> - #Client_commands.full_context -> unit tzresult Lwt.t + #Client_context.full_context -> unit tzresult Lwt.t val list_keys : - #Client_commands.wallet -> + #Client_context.wallet -> (string * Public_key_hash.t * pk_locator option * sk_locator option) list tzresult Lwt.t val alias_keys : - #Client_commands.wallet -> string -> + #Client_context.wallet -> string -> (Public_key_hash.t * pk_locator option * sk_locator option) option tzresult Lwt.t val get_key: - #Client_commands.wallet -> + #Client_context.wallet -> Public_key_hash.t -> (string * Ed25519.Public_key.t * sk_locator) tzresult Lwt.t val get_keys: - #Client_commands.wallet -> + #Client_context.wallet -> (string * Public_key_hash.t * Ed25519.Public_key.t * sk_locator) list tzresult Lwt.t -val force_switch : unit -> (bool, #Client_commands.full_context) Cli_entries.arg +val force_switch : unit -> (bool, #Client_context.full_context) Cli_entries.arg diff --git a/src/lib_client_base/client_keys_commands.ml b/src/lib_client_base/client_keys_commands.ml index a210707ba..77ae93247 100644 --- a/src/lib_client_base/client_keys_commands.ml +++ b/src/lib_client_base/client_keys_commands.ml @@ -34,7 +34,7 @@ let commands () = version of the tezos client supports." no_options (fixed [ "list" ; "signing" ; "schemes" ]) - (fun () (cctxt : #Client_commands.full_context) -> + (fun () (cctxt : #Client_context.full_context) -> let signers = List.sort (fun (ka, _) (kb, _) -> String.compare ka kb) @@ -50,7 +50,7 @@ let commands () = (prefixes [ "gen" ; "keys" ] @@ Secret_key.fresh_alias_param @@ stop) - (fun force name (cctxt : #Client_commands.full_context) -> + (fun force name (cctxt : #Client_context.full_context) -> Secret_key.of_fresh cctxt force name >>=? fun name -> gen_keys ~force cctxt name) ; @@ -92,7 +92,7 @@ let commands () = Lwt.return (find_signer_for_key ~scheme) >>=? fun signer -> let module Signer = (val signer : SIGNER) in Signer.sk_locator_of_human_input - (cctxt :> Client_commands.logging_wallet) spec >>=? fun skloc -> + (cctxt :> Client_context.logging_wallet) spec >>=? fun skloc -> Signer.sk_of_locator skloc >>=? fun sk -> Signer.neuterize sk >>= fun pk -> Signer.pk_to_locator pk >>= fun pkloc -> @@ -131,7 +131,7 @@ let commands () = Lwt.return (find_signer_for_key ~scheme) >>=? fun signer -> let module Signer = (val signer : SIGNER) in Signer.pk_locator_of_human_input - (cctxt :> Client_commands.logging_wallet) location >>=? fun pkloc -> + (cctxt :> Client_context.logging_wallet) location >>=? fun pkloc -> Signer.pk_of_locator pkloc >>=? fun pk -> Signer.public_key_hash pk >>= fun pkh -> Public_key_hash.add ~force cctxt name pkh >>=? fun () -> @@ -150,7 +150,7 @@ let commands () = command ~group ~desc: "List all identities and associated keys." no_options (fixed [ "list" ; "known" ; "identities" ]) - (fun () (cctxt : #Client_commands.full_context) -> + (fun () (cctxt : #Client_context.full_context) -> list_keys cctxt >>=? fun l -> iter_s begin fun (name, pkh, pk, sk) -> Public_key_hash.to_source pkh >>=? fun v -> @@ -169,7 +169,7 @@ let commands () = (prefixes [ "show" ; "identity"] @@ Public_key_hash.alias_param @@ stop) - (fun show_private (name, _) (cctxt : #Client_commands.full_context) -> + (fun show_private (name, _) (cctxt : #Client_context.full_context) -> let ok_lwt x = x >>= (fun x -> return x) in alias_keys cctxt name >>=? fun key_info -> match key_info with diff --git a/src/lib_client_base/client_network_commands.ml b/src/lib_client_base/client_network_commands.ml index 9d80747a4..fc2f31bf7 100644 --- a/src/lib_client_base/client_network_commands.ml +++ b/src/lib_client_base/client_network_commands.ml @@ -15,7 +15,7 @@ let commands () = [ let open Cli_entries in command ~group ~desc: "show global network status" no_options - (prefixes ["network" ; "stat"] stop) begin fun () (cctxt : #Client_commands.full_context) -> + (prefixes ["network" ; "stat"] stop) begin fun () (cctxt : #Client_context.full_context) -> P2p_services.stat cctxt >>=? fun stat -> P2p_services.Connections.list cctxt >>=? fun conns -> P2p_services.Peers.list cctxt >>=? fun peers -> diff --git a/src/lib_client_base/client_report_commands.mli b/src/lib_client_base/client_report_commands.mli index 28884861b..b6881a606 100644 --- a/src/lib_client_base/client_report_commands.mli +++ b/src/lib_client_base/client_report_commands.mli @@ -8,4 +8,4 @@ (**************************************************************************) -val commands : unit -> #Client_commands.full_context Cli_entries.command list +val commands : unit -> #Client_context.full_context Cli_entries.command list diff --git a/src/lib_client_base/client_tags.mli b/src/lib_client_base/client_tags.mli index f32196c35..ce42d3c2d 100644 --- a/src/lib_client_base/client_tags.mli +++ b/src/lib_client_base/client_tags.mli @@ -32,17 +32,17 @@ module Tags (Entity : Entity) : sig (Tag.t -> 'a, 'ctx) Cli_entries.params val rev_find_by_tag: - #Client_commands.full_context -> + #Client_context.full_context -> string -> string option tzresult Lwt.t val filter: - #Client_commands.full_context -> + #Client_context.full_context -> (string * t -> bool) -> (string * t) list tzresult Lwt.t val filter_by_tag: - #Client_commands.full_context -> + #Client_context.full_context -> string -> (string * t) list tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/client_baking_endorsement.ml b/src/proto_alpha/lib_client/client_baking_endorsement.ml index 616dbb3f1..bd651c4ad 100644 --- a/src/proto_alpha/lib_client/client_baking_endorsement.ml +++ b/src/proto_alpha/lib_client/client_baking_endorsement.ml @@ -15,13 +15,13 @@ open Logging.Client.Endorsement module State : sig val get_endorsement: - #Client_commands.wallet -> + #Client_context.wallet -> Raw_level.t -> int -> (Block_hash.t * Operation_hash.t) option tzresult Lwt.t val record_endorsement: - #Client_commands.wallet -> + #Client_context.wallet -> Raw_level.t -> Block_hash.t -> int -> Operation_hash.t -> unit tzresult Lwt.t @@ -50,15 +50,15 @@ end = struct let name = "endorsements" - let load (wallet : #Client_commands.wallet) = + let load (wallet : #Client_context.wallet) = wallet#load name encoding ~default:LevelMap.empty - let save (wallet : #Client_commands.wallet) map = + let save (wallet : #Client_context.wallet) map = wallet#write name encoding map let lock = Lwt_mutex.create () - let get_endorsement (wallet : #Client_commands.wallet) level slot = + let get_endorsement (wallet : #Client_context.wallet) level slot = Lwt_mutex.with_lock lock (fun () -> load wallet >>=? fun map -> @@ -69,7 +69,7 @@ end = struct return (Some (block, op)) with Not_found -> return None) - let record_endorsement (wallet : #Client_commands.wallet) level hash slot oph = + let record_endorsement (wallet : #Client_context.wallet) level hash slot oph = Lwt_mutex.with_lock lock (fun () -> load wallet >>=? fun map -> diff --git a/src/proto_alpha/lib_client/client_baking_forge.ml b/src/proto_alpha/lib_client/client_baking_forge.ml index a5bfba343..5c312442c 100644 --- a/src/proto_alpha/lib_client/client_baking_forge.ml +++ b/src/proto_alpha/lib_client/client_baking_forge.ml @@ -241,11 +241,11 @@ let forge_block cctxt block module State : sig val get_block: - #Client_commands.wallet -> + #Client_context.wallet -> Raw_level.t -> Block_hash.t list tzresult Lwt.t val record_block: - #Client_commands.wallet -> + #Client_context.wallet -> Raw_level.t -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t end = struct @@ -268,15 +268,15 @@ end = struct let name = "blocks" - let load (wallet : #Client_commands.wallet) = + let load (wallet : #Client_context.wallet) = wallet#load name ~default:LevelMap.empty encoding - let save (wallet : #Client_commands.wallet) map = + let save (wallet : #Client_context.wallet) map = wallet#write name map encoding let lock = Lwt_mutex.create () - let get_block (cctxt : #Client_commands.wallet) level = + let get_block (cctxt : #Client_context.wallet) level = Lwt_mutex.with_lock lock (fun () -> load cctxt >>=? fun map -> diff --git a/src/proto_alpha/lib_client/client_baking_lib.ml b/src/proto_alpha/lib_client/client_baking_lib.ml index 797e41e62..e7dcb3203 100644 --- a/src/proto_alpha/lib_client/client_baking_lib.ml +++ b/src/proto_alpha/lib_client/client_baking_lib.ml @@ -41,7 +41,7 @@ let endorse_block cctxt ?max_priority delegate = cctxt#answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> return () -let get_predecessor_cycle (cctxt : #Client_commands.logger) cycle = +let get_predecessor_cycle (cctxt : #Client_context.logger) cycle = match Cycle.pred cycle with | None -> if Cycle.(cycle = root) then diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 603d33955..dc3ffbbda 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -92,7 +92,7 @@ let originate rpc_config ?net_id ~block ?signature bytes = "The origination introduced %d contracts instead of one." (List.length contracts) -let operation_submitted_message (cctxt : #Client_commands.logger) ?(contracts = []) oph = +let operation_submitted_message (cctxt : #Client_context.logger) ?(contracts = []) oph = cctxt#message "Operation successfully injected in the node." >>= fun () -> cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> Lwt_list.iter_s diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index 8f808fcf6..77cc9c51a 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -45,7 +45,7 @@ val set_delegate : Operation_list_hash.elt tzresult Lwt.t val operation_submitted_message : - #Client_commands.logger -> + #Client_context.logger -> Operation_hash.t -> unit tzresult Lwt.t @@ -77,7 +77,7 @@ val save_contract : unit tzresult Lwt.t val operation_submitted_message : - #Client_commands.logger -> + #Client_context.logger -> ?contracts:Contract.t list -> Operation_hash.t -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/client_proto_context_commands.ml b/src/proto_alpha/lib_client/client_proto_context_commands.ml index ac8bbbe99..cb6a11a49 100644 --- a/src/proto_alpha/lib_client/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client/client_proto_context_commands.ml @@ -20,7 +20,7 @@ let get_pkh cctxt = function | None -> return None | Some x -> Public_key_hash.find_opt cctxt x -let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_commands.logger) = function +let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_context.logger) = function | Error errs -> cctxt#warning "%a" (Michelson_v1_error_reporter.report_errors diff --git a/src/proto_alpha/lib_client/client_proto_contracts.mli b/src/proto_alpha/lib_client/client_proto_contracts.mli index 699d9580e..9b3bf9964 100644 --- a/src/proto_alpha/lib_client/client_proto_contracts.mli +++ b/src/proto_alpha/lib_client/client_proto_contracts.mli @@ -16,29 +16,29 @@ module RawContractAlias : module ContractAlias : sig val get_contract: - #Client_commands.wallet -> + #Client_context.wallet -> string -> (string * Contract.t) tzresult Lwt.t val alias_param: ?name:string -> ?desc:string -> - ('a, (#Client_commands.wallet as 'wallet)) params -> + ('a, (#Client_context.wallet as 'wallet)) params -> (Lwt_io.file_name * Contract.t -> 'a, 'wallet) params val destination_param: ?name:string -> ?desc:string -> - ('a, (#Client_commands.wallet as 'wallet)) params -> + ('a, (#Client_context.wallet as 'wallet)) params -> (Lwt_io.file_name * Contract.t -> 'a, 'wallet) params val rev_find: - #Client_commands.wallet -> + #Client_context.wallet -> Contract.t -> string option tzresult Lwt.t val name: - #Client_commands.wallet -> + #Client_context.wallet -> Contract.t -> string tzresult Lwt.t - val autocomplete: #Client_commands.wallet -> string list tzresult Lwt.t + val autocomplete: #Client_context.wallet -> string list tzresult Lwt.t end val list_contracts: - #Client_commands.wallet -> + #Client_context.wallet -> (string * string * RawContractAlias.t) list tzresult Lwt.t val get_manager: diff --git a/src/proto_alpha/lib_client/client_proto_nonces.ml b/src/proto_alpha/lib_client/client_proto_nonces.ml index 32d112276..0adf873f8 100644 --- a/src/proto_alpha/lib_client/client_proto_nonces.ml +++ b/src/proto_alpha/lib_client/client_proto_nonces.ml @@ -23,13 +23,13 @@ let encoding : t Data_encoding.t = let name = "nonces" -let load (wallet : #Client_commands.wallet) = +let load (wallet : #Client_context.wallet) = wallet#load ~default:[] name encoding -let save (wallet : #Client_commands.wallet) list = +let save (wallet : #Client_context.wallet) list = wallet#write name list encoding -let mem (wallet : #Client_commands.wallet) block_hash = +let mem (wallet : #Client_context.wallet) block_hash = load wallet >>|? fun data -> List.mem_assoc block_hash data diff --git a/src/proto_alpha/lib_client/client_proto_nonces.mli b/src/proto_alpha/lib_client/client_proto_nonces.mli index 49f519379..1c71d6ddc 100644 --- a/src/proto_alpha/lib_client/client_proto_nonces.mli +++ b/src/proto_alpha/lib_client/client_proto_nonces.mli @@ -11,17 +11,17 @@ open Proto_alpha open Alpha_context val mem: - #Client_commands.wallet -> + #Client_context.wallet -> Block_hash.t -> bool tzresult Lwt.t val find: - #Client_commands.wallet -> + #Client_context.wallet -> Block_hash.t -> Nonce.t option tzresult Lwt.t val add: - #Client_commands.wallet -> + #Client_context.wallet -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t val del: - #Client_commands.wallet -> + #Client_context.wallet -> Block_hash.t -> unit tzresult Lwt.t val dels: - #Client_commands.wallet -> + #Client_context.wallet -> Block_hash.t list -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 83d556f34..6d4b49da9 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -26,7 +26,7 @@ module Program = Client_aliases.Alias (struct let name = "program" end) -let print_errors (cctxt : #Client_commands.logger) errs ~show_source ~parsed = +let print_errors (cctxt : #Client_context.logger) errs ~show_source ~parsed = cctxt#warning "%a" (Michelson_v1_error_reporter.report_errors ~details:false @@ -54,7 +54,7 @@ let print_big_map_diff ppf = function value)) diff -let print_run_result (cctxt : #Client_commands.logger) ~show_source ~parsed = function +let print_run_result (cctxt : #Client_context.logger) ~show_source ~parsed = function | Ok (storage, output, maybe_diff) -> cctxt#message "@[@[storage@,%a@]@,@[output@,%a@]@,@[%a@]@]@." print_expr storage @@ -64,7 +64,7 @@ let print_run_result (cctxt : #Client_commands.logger) ~show_source ~parsed = fu | Error errs -> print_errors cctxt errs ~show_source ~parsed -let print_trace_result (cctxt : #Client_commands.logger) ~show_source ~parsed = +let print_trace_result (cctxt : #Client_context.logger) ~show_source ~parsed = function | Ok (storage, output, trace, maybe_big_map_diff) -> cctxt#message @@ -126,7 +126,7 @@ let typecheck_program (program : Michelson_v1_parser.parsed) block cctxt = let print_typecheck_result ~emacs ~show_types ~print_source_on_error - program res (cctxt : #Client_commands.logger) = + program res (cctxt : #Client_context.logger) = if emacs then let type_map, errs = match res with | Ok type_map -> type_map, [] diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index 4ad18b5a4..c91f76605 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -33,14 +33,14 @@ val trace : (Script.expr * Script.expr * (int * Gas.t * Script.expr list) list * (Script.expr * Script.expr option) list option) tzresult Lwt.t val print_run_result : - #Client_commands.logger -> + #Client_context.logger -> show_source:bool -> parsed:Michelson_v1_parser.parsed -> (Script_repr.expr * Script_repr.expr * (Script_repr.expr * Script_repr.expr option) list option) tzresult -> unit tzresult Lwt.t val print_trace_result : - #Client_commands.logger -> + #Client_context.logger -> show_source:bool -> parsed:Michelson_v1_parser.parsed -> (Script_repr.expr * Script_repr.expr * @@ -75,5 +75,5 @@ val print_typecheck_result : print_source_on_error:bool -> Michelson_v1_parser.parsed -> (Script_tc_errors.type_map, error list) result -> - #Client_commands.logger -> + #Client_context.logger -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/proto_alpha.ml b/src/proto_alpha/lib_client/proto_alpha.ml index e703e4cec..363c9e2b3 100644 --- a/src/proto_alpha/lib_client/proto_alpha.ml +++ b/src/proto_alpha/lib_client/proto_alpha.ml @@ -31,12 +31,12 @@ class wrap_proto_context (t : RPC_context.json) : rpc_context = object end class type full_context = object - inherit Client_commands.full_context + inherit Client_context.full_context inherit [Block_services.block] Alpha_environment.RPC_context.simple end -class wrap_full_context (t : Client_commands.full_context) : full_context = object - inherit Client_commands.proxy_context t +class wrap_full_context (t : Client_context.full_context) : full_context = object + inherit Client_context.proxy_context t inherit [Block_services.block] Alpha_environment.proto_rpc_context (t :> RPC_context.t) (Block_services.S.proto_path ()) end diff --git a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml index bc8e64057..6cc3ee0e6 100644 --- a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml @@ -28,9 +28,9 @@ let build_rpc_context config = let rpc_ctxt = ref (build_rpc_context !rpc_config) (* Context that does not write to alias files *) -let no_write_context config block : #Client_commands.full_context = object +let no_write_context config block : #Client_context.full_context = object inherit RPC_client.http_ctxt config Media_type.all_media_types - inherit Client_commands.logger (fun _ _ -> Lwt.return_unit) + inherit Client_context.logger (fun _ _ -> Lwt.return_unit) method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t = fun _ ~default _ -> return default method write : type a. string -> diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index 8f17db00f..c749eabf4 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -60,7 +60,7 @@ let commands () = @@ Client_keys.Secret_key.source_param ~name:"password" ~desc:"Dictator's key" @@ stop) - begin fun timestamp hash fitness sk (cctxt : Client_commands.full_context) -> + begin fun timestamp hash fitness sk (cctxt : Client_context.full_context) -> let fitness = Proto_alpha.Fitness_repr.from_int64 fitness in bake cctxt ?timestamp cctxt#block (Activate { protocol = hash ; fitness })