balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client: add method prompt to context and cleanup Unix context

Browse Source
This commit is contained in:
Benjamin Canou 2018-02-16 11:08:04 +01:00
parent dfeb96842a
commit 67019246e9
6 changed files with 102 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/lib_client_base/client_context.ml
View File

@ -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

12
src/lib_client_base/client_context.mli
View File

@ -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

79
src/lib_client_base_unix/client_context_unix.ml
View File

@ -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 ())

30
src/lib_client_base_unix/client_context_unix.mli
View File

@ -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

82
src/lib_client_base_unix/client_main_run.ml
View File

@ -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

17
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
View File

@ -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