diff --git a/src/lib_client_base/client_context.ml b/src/lib_client_base/client_context.ml index d3950ce88..a9ab1172d 100644 --- a/src/lib_client_base/client_context.ml +++ b/src/lib_client_base/client_context.ml @@ -18,6 +18,11 @@ class type logger_sig = object method log : string -> ('a, unit) lwt_format -> 'a end +class type prompter_sig = object + method prompt : ('a, string) lwt_format -> 'a + method prompt_password : ('a, string) lwt_format -> 'a +end + class logger log = let message = (fun x -> @@ -48,17 +53,24 @@ class type block = object end class type logging_wallet = object - inherit logger + inherit logger_sig + inherit wallet +end + +class type io_wallet = object + inherit logger_sig + inherit prompter_sig inherit wallet end class type logging_rpcs = object - inherit logger + inherit logger_sig inherit RPC_context.json end class type full_context = object - inherit logger + inherit logger_sig + inherit prompter_sig inherit wallet inherit RPC_context.json inherit block @@ -84,4 +96,6 @@ class proxy_context (obj : full_context) = object 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 + method prompt : type a. (a, string) lwt_format -> a = obj#prompt + method prompt_password : type a. (a, string) lwt_format -> a = obj#prompt_password end diff --git a/src/lib_client_base/client_context.mli b/src/lib_client_base/client_context.mli index 3b1fee531..06b061cf3 100644 --- a/src/lib_client_base/client_context.mli +++ b/src/lib_client_base/client_context.mli @@ -18,6 +18,11 @@ class type logger_sig = object method log : string -> ('a, unit) lwt_format -> 'a end +class type prompter_sig = object + method prompt : ('a, string) lwt_format -> 'a + method prompt_password : ('a, string) lwt_format -> 'a +end + class logger : (string -> string -> unit Lwt.t) -> logger_sig class type wallet = object @@ -34,6 +39,12 @@ class type logging_wallet = object inherit wallet end +class type io_wallet = object + inherit logger_sig + inherit prompter_sig + inherit wallet +end + class type logging_rpcs = object inherit logger_sig inherit RPC_context.json @@ -41,6 +52,7 @@ end class type full_context = object inherit logger_sig + inherit prompter_sig inherit wallet inherit RPC_context.json inherit block diff --git a/src/lib_client_base_unix/client_context_unix.ml b/src/lib_client_base_unix/client_context_unix.ml index c31d49126..53f7dfb34 100644 --- a/src/lib_client_base_unix/client_context_unix.ml +++ b/src/lib_client_base_unix/client_context_unix.ml @@ -9,10 +9,10 @@ open Client_context -class file_wallet dir : wallet = object (self) +class unix_wallet ~base_dir : wallet = object (self) method private filename alias_name = Filename.concat - dir + base_dir (Str.(global_replace (regexp_string " ") "_" alias_name) ^ "s") method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t = @@ -35,7 +35,7 @@ class file_wallet dir : wallet = object (self) fun alias_name list encoding -> Lwt.catch (fun () -> - Lwt_utils_unix.create_dir dir >>= fun () -> + Lwt_utils_unix.create_dir base_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) @@ -43,50 +43,51 @@ class file_wallet dir : wallet = object (self) |> generic_trace "could not write the %s alias file." alias_name end -(* Default config *) +class unix_prompter = object + method prompt : type a. (a, string) lwt_format -> a = + Format.kasprintf begin fun msg -> + print_string msg ; + let line = read_line () in + Lwt.return line + end -let (//) = Filename.concat + method prompt_password : type a. (a, string) lwt_format -> a = + Format.kasprintf begin fun msg -> + print_string msg ; + let line = Lwt_utils_unix.getpass () in + Lwt.return line + end +end -let home = - try Sys.getenv "HOME" - with Not_found -> "/root" - -let default_base_dir = home // ".tezos-client" - -let default_block = `Prevalidation - -let default_log ~base_dir channel msg = +class unix_logger ~base_dir = 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 - ?(base_dir = default_base_dir) - ?(block = default_block) - ?(rpc_config = RPC_client.default_config) - log = + let log channel msg = 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) in object inherit Client_context.logger log - inherit file_wallet base_dir + end + +class unix_full_context ~base_dir ~block ~rpc_config : Client_context.full_context = + object + inherit unix_logger ~base_dir + inherit unix_prompter + inherit unix_wallet ~base_dir inherit RPC_client.http_ctxt rpc_config Media_type.all_media_types method block = block end - -let ignore_context = - make_context (fun _ _ -> Lwt.return ()) diff --git a/src/lib_client_base_unix/client_context_unix.mli b/src/lib_client_base_unix/client_context_unix.mli index 71e3dd1b0..5bb4b8980 100644 --- a/src/lib_client_base_unix/client_context_unix.mli +++ b/src/lib_client_base_unix/client_context_unix.mli @@ -7,20 +7,16 @@ (* *) (**************************************************************************) -val make_context : - ?base_dir:string -> - ?block:Block_services.block -> - ?rpc_config:RPC_client.config -> - (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_context.full_context -(** [ignore_context] is a context whose logging callbacks do nothing, - and whose [error] function calls [Lwt.fail_with]. *) - -val default_log : base_dir:string -> string -> string -> unit Lwt.t -val default_base_dir : string -val default_block : Block_services.block +class unix_wallet : + base_dir:string -> + Client_context.wallet +class unix_prompter : + Client_context.prompter_sig +class unix_logger : + base_dir:string -> + Client_context.logger_sig +class unix_full_context : + base_dir:string -> + block:Block_services.block -> + rpc_config:RPC_client.config -> + Client_context.full_context diff --git a/src/lib_client_base_unix/client_main_run.ml b/src/lib_client_base_unix/client_main_run.ml index 0c3bcff6f..5759de08a 100644 --- a/src/lib_client_base_unix/client_main_run.ml +++ b/src/lib_client_base_unix/client_main_run.ml @@ -9,71 +9,7 @@ (* 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 +open Client_context_unix let builtin_commands = let open Cli_entries in @@ -111,10 +47,10 @@ let main select_commands = (if Unix.isatty Unix.stderr then Ansi else Plain) Short) ; Lwt.catch begin fun () -> begin Client_config.parse_config_args - (make_context - Client_config.default_block - Client_config.default_base_dir - RPC_client.default_config) + (new unix_full_context + ~block:Client_config.default_block + ~base_dir:Client_config.default_base_dir + ~rpc_config:RPC_client.default_config) original_args >>=? fun (parsed_config_file, parsed_args, config_commands, remaining) -> let rpc_config : RPC_client.config = { @@ -141,10 +77,10 @@ let main select_commands = else rpc_config in let client_config = - make_context - parsed_args.block - parsed_config_file.base_dir - rpc_config in + new unix_full_context + ~block:parsed_args.block + ~base_dir:parsed_config_file.base_dir + ~rpc_config:rpc_config in begin match autocomplete with | Some (prev_arg, cur_arg, script) -> Cli_entries.autocompletion diff --git a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml index 5de62c8e2..7790470e6 100644 --- a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml @@ -28,7 +28,7 @@ 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_context.full_context = object +let no_write_context ?(block = `Prevalidation) config : #Client_context.full_context = object inherit RPC_client.http_ctxt config Media_type.all_media_types 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 = @@ -38,6 +38,10 @@ let no_write_context config block : #Client_context.full_context = object a Data_encoding.encoding -> unit Error_monad.tzresult Lwt.t = fun _ _ _ -> return () method block = block + method prompt : type a. (a, string) Client_context.lwt_format -> a = + Format.kasprintf (fun _ -> Lwt.return "") + method prompt_password : type a. (a, string) Client_context.lwt_format -> a = + Format.kasprintf (fun _ -> Lwt.return "") end let activate_alpha () = @@ -46,7 +50,7 @@ let activate_alpha () = ~scheme:"unencrypted" ~location:"edsk31vznjHSSpGExDMHYASz45VZqXN4DPxvsa4hAyY8dHM28cZzp6" in Tezos_client_genesis.Client_proto_main.bake - !rpc_ctxt (`Head 0) + (no_write_context ~block:(`Head 0) !rpc_config) (`Head 0) (Activate { protocol = Proto_alpha.hash ; fitness }) dictator_sk @@ -172,7 +176,8 @@ module Account = struct let src_sk = Client_keys.Secret_key_locator.create ~scheme:"unencrypted" ~location:(Ed25519.Secret_key.to_b58check account.sk) in - Client_proto_context.transfer !rpc_ctxt + Client_proto_context.transfer + (new wrap_full_context (no_write_context !rpc_config ~block)) block ~source:account.contract ~src_pk:account.pk @@ -205,7 +210,7 @@ module Account = struct ?delegate ~fee block - !rpc_ctxt + (new wrap_full_context (no_write_context !rpc_config)) () let set_delegate @@ -216,7 +221,7 @@ module Account = struct ~src_pk delegate_opt = Client_proto_context.set_delegate - !rpc_ctxt + (new wrap_full_context (no_write_context ~block !rpc_config)) block ~fee contract @@ -437,7 +442,7 @@ module Baking = struct ~scheme:"unencrypted" ~location:(Ed25519.Secret_key.to_b58check contract.sk) in Client_baking_forge.forge_block - !rpc_ctxt + (new wrap_full_context (no_write_context ~block !rpc_config)) block ~operations ~force:true