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