diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1d4f6bc79..346dd69eb 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -396,6 +396,11 @@ opam:36:tezos-protocol-demo: variables: package: tezos-protocol-demo +opam:37:tezos-unix-signers: + <<: *opam_definition + variables: + package: tezos-unix-signers + ##END_OPAM## diff --git a/src/lib_client_base/client_config.ml b/src/bin_client/client_config.ml similarity index 98% rename from src/lib_client_base/client_config.ml rename to src/bin_client/client_config.ml index 018403fef..30591d695 100644 --- a/src/lib_client_base/client_config.ml +++ b/src/bin_client/client_config.ml @@ -61,7 +61,7 @@ module Cfg_file = struct } let default = { - base_dir = Client_commands.default_base_dir ; + base_dir = Client_context_unix.default_base_dir ; node_addr = "localhost" ; node_port = 8732 ; tls = false ; @@ -109,7 +109,7 @@ type cli_args = { } let default_cli_args = { - block = Client_commands.default_block ; + block = Client_context_unix.default_block ; protocol = None ; print_timings = false ; log_requests = false ; @@ -148,7 +148,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_commands.default_base_dir) + By default " ^ Client_context_unix.default_base_dir) (string_parameter ()) let config_file_arg () = arg @@ -310,7 +310,7 @@ let parse_config_args (ctx : #Client_commands.full_context) argv = tls), remaining) -> begin match base_dir with | None -> - let base_dir = Client_commands.default_base_dir in + let base_dir = Client_context_unix.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_unix.ml b/src/bin_client/client_context_unix.ml new file mode 100644 index 000000000..6fc0b143b --- /dev/null +++ b/src/bin_client/client_context_unix.ml @@ -0,0 +1,92 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Client_commands + +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 + +(* Default config *) + +let (//) = Filename.concat + +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 = + 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 = + object + inherit Client_commands.logger log + inherit file_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/bin_client/client_context_unix.mli b/src/bin_client/client_context_unix.mli new file mode 100644 index 000000000..2fc77936c --- /dev/null +++ b/src/bin_client/client_context_unix.mli @@ -0,0 +1,26 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val make_context : + ?base_dir:string -> + ?block:Block_services.block -> + ?rpc_config:RPC_client.config -> + (string -> string -> unit Lwt.t) -> Client_commands.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 +(** [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 diff --git a/src/lib_client_base/client_protocols.ml b/src/bin_client/client_protocols.ml similarity index 100% rename from src/lib_client_base/client_protocols.ml rename to src/bin_client/client_protocols.ml diff --git a/src/lib_client_base/client_protocols.mli b/src/bin_client/client_protocols.mli similarity index 100% rename from src/lib_client_base/client_protocols.mli rename to src/bin_client/client_protocols.mli diff --git a/src/bin_client/jbuild b/src/bin_client/jbuild index af2d9e39f..b4e345fcf 100644 --- a/src/bin_client/jbuild +++ b/src/bin_client/jbuild @@ -8,14 +8,17 @@ tezos-shell-services tezos-client-base tezos-client-genesis + tezos-stdlib-unix + tezos-unix-signers tezos-client-alpha)) (flags (:standard -w -9+27-30-32-40@8 -safe-string -open Tezos_base__TzPervasives -open Tezos_rpc_http + -open Tezos_stdlib_unix -open Tezos_shell_services -open Tezos_client_base - -linkall)))) + -open Tezos_unix_signers)))) (install ((section bin) diff --git a/src/bin_client/main_lib.ml b/src/bin_client/main_lib.ml index 22b058f54..87a208582 100644 --- a/src/bin_client/main_lib.ml +++ b/src/bin_client/main_lib.ml @@ -10,7 +10,7 @@ (* Tezos Command line interface - Main Program *) let cctxt ~base_dir ~block rpc_config = - Client_commands.make_context ~base_dir ~block ~rpc_config (Client_commands.default_log ~base_dir) + Client_context_unix.make_context ~base_dir ~block ~rpc_config (Client_context_unix.default_log ~base_dir) let get_commands_for_version ctxt block protocol = Block_services.protocol ctxt block >>= function @@ -64,8 +64,8 @@ let main ?only_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_commands.default_base_dir - ~block:Client_commands.default_block + (cctxt ~base_dir:Client_context_unix.default_base_dir + ~block:Client_context_unix.default_block RPC_client.default_config) original_args >>=? fun (parsed_config_file, parsed_args, config_commands, remaining) -> diff --git a/src/bin_client/tezos-client.opam b/src/bin_client/tezos-client.opam index ab4055f99..b7dac1962 100644 --- a/src/bin_client/tezos-client.opam +++ b/src/bin_client/tezos-client.opam @@ -13,6 +13,7 @@ depends: [ "tezos-client-base" "tezos-client-genesis" "tezos-client-alpha" + "tezos-unix-signers" "tezos-node" { test } ] build: [ diff --git a/src/lib_client_base/client_commands.ml b/src/lib_client_base/client_commands.ml index c344115fd..6e9c2d782 100644 --- a/src/lib_client_base/client_commands.ml +++ b/src/lib_client_base/client_commands.ml @@ -54,13 +54,13 @@ end class type logging_rpcs = object inherit logger - inherit RPC_client.ctxt + inherit RPC_context.json end class type full_context = object inherit logger inherit wallet - inherit RPC_client.ctxt + inherit RPC_context.json inherit block end @@ -86,91 +86,8 @@ class proxy_context (obj : full_context) = object method write : type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = obj#write end - -class file_wallet dir : wallet = object (self) - method private filename alias_name = - Filename.concat - dir - (Re_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 - type command = full_context Cli_entries.command -(* Default config *) - -let (//) = Filename.concat - -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 = - 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 = - object - inherit logger log - inherit file_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 ()) - exception Version_not_found let versions = Protocol_hash.Table.create 7 diff --git a/src/lib_client_base/client_commands.mli b/src/lib_client_base/client_commands.mli index 9ff41e96e..4e28418b4 100644 --- a/src/lib_client_base/client_commands.mli +++ b/src/lib_client_base/client_commands.mli @@ -18,8 +18,6 @@ class type logger_sig = object method log : string -> ('a, unit) lwt_format -> 'a end -val default_log : base_dir:string -> string -> string -> unit Lwt.t - class logger : (string -> string -> unit Lwt.t) -> logger_sig class type wallet = object @@ -38,13 +36,13 @@ end class type logging_rpcs = object inherit logger_sig - inherit RPC_client.ctxt + inherit RPC_context.json end class type full_context = object inherit logger_sig inherit wallet - inherit RPC_client.ctxt + inherit RPC_context.json inherit block end (** The [full_context] allows the client {!command} handlers to work in @@ -56,20 +54,6 @@ end class proxy_context : full_context -> full_context -val make_context : - ?base_dir:string -> - ?block:Block_services.block -> - ?rpc_config:RPC_client.config -> - (string -> string -> unit Lwt.t) -> 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 : full_context -(** [ignore_context] is a context whose logging callbacks do nothing, - and whose [error] function calls [Lwt.fail_with]. *) - type command = full_context Cli_entries.command exception Version_not_found @@ -81,6 +65,3 @@ val get_versions: unit -> (Protocol_hash.t * (command list)) list (** Have a command execute ignoring warnings. Default doc is ["Silence any warnings and some checks."]. *) val force_switch : ?doc:string -> unit -> (bool, #full_context) Cli_entries.arg - -val default_base_dir : string -val default_block : Block_services.block diff --git a/src/lib_client_base/jbuild b/src/lib_client_base/jbuild index 77a9105c9..1b884bb5b 100644 --- a/src/lib_client_base/jbuild +++ b/src/lib_client_base/jbuild @@ -4,15 +4,13 @@ ((name tezos_client_base) (public_name tezos-client-base) (libraries (tezos-base - tezos-stdlib-unix - tezos-shell-services - tezos-rpc-http)) + tezos-rpc + tezos-shell-services)) (library_flags (:standard -linkall)) (flags (:standard -w -9+27-30-32-40@8 -safe-string -open Tezos_base__TzPervasives - -open Tezos_stdlib_unix - -open Tezos_rpc_http + -open Tezos_rpc -open Tezos_shell_services)))) (alias diff --git a/src/lib_rpc/RPC_context.ml b/src/lib_rpc/RPC_context.ml index 2bb99b066..066356439 100644 --- a/src/lib_rpc/RPC_context.ml +++ b/src/lib_rpc/RPC_context.ml @@ -43,6 +43,24 @@ class type t = object inherit streamed end +type ('o, 'e) rest_result = + [ `Ok of 'o + | `Conflict of 'e + | `Error of 'e + | `Forbidden of 'e + | `Not_found of 'e + | `Unauthorized of 'e ] tzresult + +class type json = object + inherit t + method generic_json_call : + RPC_service.meth -> + ?body:Data_encoding.json -> + Uri.t -> + (Data_encoding.json, Data_encoding.json option) + rest_result Lwt.t +end + type error += | Not_found of { meth: RPC_service.meth ; diff --git a/src/lib_rpc/RPC_context.mli b/src/lib_rpc/RPC_context.mli index ce7e4be68..561955993 100644 --- a/src/lib_rpc/RPC_context.mli +++ b/src/lib_rpc/RPC_context.mli @@ -43,6 +43,24 @@ class type t = object inherit streamed end +type ('o, 'e) rest_result = + [ `Ok of 'o + | `Conflict of 'e + | `Error of 'e + | `Forbidden of 'e + | `Not_found of 'e + | `Unauthorized of 'e ] tzresult + +class type json = object + inherit t + method generic_json_call : + RPC_service.meth -> + ?body:Data_encoding.json -> + Uri.t -> + (Data_encoding.json, Data_encoding.json option) + rest_result Lwt.t +end + class ['pr] of_directory : 'pr RPC_directory.t -> ['pr] gen type error += diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml index 0bcc7e543..f77f9f0ca 100644 --- a/src/lib_rpc_http/RPC_client.ml +++ b/src/lib_rpc_http/RPC_client.ml @@ -15,14 +15,6 @@ let null_logger = Client.null_logger let timings_logger = Client.timings_logger let full_logger = Client.full_logger -type ('o, 'e) rest_result = - [ `Ok of 'o - | `Conflict of 'e - | `Error of 'e - | `Forbidden of 'e - | `Not_found of 'e - | `Unauthorized of 'e ] tzresult - type rpc_error = | Empty_answer | Connection_failed of string @@ -221,7 +213,7 @@ let request_failed meth uri error = type content_type = (string * string) type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option -let generic_call ?logger ?accept ?body ?media meth uri : (content, content) rest_result Lwt.t = +let generic_call ?logger ?accept ?body ?media meth uri : (content, content) RPC_context.rest_result Lwt.t = Client.generic_call meth ?logger ?accept ?body ?media uri >>= function | `Ok (Some v) -> return (`Ok v) | `Ok None -> request_failed meth uri Empty_answer @@ -275,7 +267,7 @@ let handle_error meth uri (body, media, _) f = acceptable = [Media_type.(name json)] ; body }) -let generic_json_call ?logger ?body meth uri : (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t = +let generic_json_call ?logger ?body meth uri : (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result Lwt.t = let body = Option.map body ~f:begin fun b -> (Cohttp_lwt.Body.of_string (Data_encoding.Json.to_string b)) @@ -415,21 +407,7 @@ let default_config = { logger = null_logger ; } -class type json_ctxt = object - method generic_json_call : - RPC_service.meth -> - ?body:Data_encoding.json -> - Uri.t -> - (Data_encoding.json, Data_encoding.json option) - rest_result Lwt.t -end - -class type ctxt = object - inherit RPC_context.t - inherit json_ctxt -end - -class http_ctxt config media_types : ctxt = +class http_ctxt config media_types : RPC_context.json = let base = Uri.make ~scheme:(if config.tls then "https" else "http") diff --git a/src/lib_rpc_http/RPC_client.mli b/src/lib_rpc_http/RPC_client.mli index 2bbe41367..e2089fc74 100644 --- a/src/lib_rpc_http/RPC_client.mli +++ b/src/lib_rpc_http/RPC_client.mli @@ -33,29 +33,7 @@ type config = { val config_encoding: config Data_encoding.t val default_config: config -type ('o, 'e) rest_result = - [ `Ok of 'o - | `Conflict of 'e - | `Error of 'e - | `Forbidden of 'e - | `Not_found of 'e - | `Unauthorized of 'e ] tzresult - -class type json_ctxt = object - method generic_json_call : - RPC_service.meth -> - ?body:Data_encoding.json -> - Uri.t -> - (Data_encoding.json, Data_encoding.json option) - rest_result Lwt.t -end - -class type ctxt = object - inherit RPC_context.t - inherit json_ctxt -end - -class http_ctxt : config -> Media_type.t list -> ctxt +class http_ctxt : config -> Media_type.t list -> RPC_context.json type rpc_error = | Empty_answer @@ -102,7 +80,7 @@ val generic_json_call : ?logger:logger -> ?body:Data_encoding.json -> [< RPC_service.meth ] -> Uri.t -> - (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t + (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result Lwt.t type content_type = (string * string) type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option @@ -113,5 +91,5 @@ val generic_call : ?body:Cohttp_lwt.Body.t -> ?media:Media_type.t -> [< RPC_service.meth ] -> - Uri.t -> (content, content) rest_result Lwt.t + Uri.t -> (content, content) RPC_context.rest_result Lwt.t diff --git a/src/lib_client_base/client_signer_unencrypted.ml b/src/lib_unix_signers/client_signer_unencrypted.ml similarity index 100% rename from src/lib_client_base/client_signer_unencrypted.ml rename to src/lib_unix_signers/client_signer_unencrypted.ml diff --git a/src/lib_unix_signers/jbuild b/src/lib_unix_signers/jbuild new file mode 100644 index 000000000..4a9e11b8c --- /dev/null +++ b/src/lib_unix_signers/jbuild @@ -0,0 +1,19 @@ +(jbuild_version 1) + +(library + ((name tezos_unix_signers) + (public_name tezos-unix-signers) + (libraries (tezos-base + tezos-client-base + tezos-stdlib-unix)) + (flags (:standard -w -9+27-30-32-40@8 + -safe-string + -open Tezos_base__TzPervasives + -open Tezos_stdlib_unix + -open Tezos_client_base + -linkall)))) + +(alias + ((name runtest_indent) + (deps ((glob_files *.ml*))) + (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^})))) diff --git a/src/lib_unix_signers/tezos-unix-signers.opam b/src/lib_unix_signers/tezos-unix-signers.opam new file mode 100644 index 000000000..3004eab39 --- /dev/null +++ b/src/lib_unix_signers/tezos-unix-signers.opam @@ -0,0 +1,20 @@ +opam-version: "1.2" +version: "dev" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "https://gitlab.com/tezos/tezos.git" +license: "unreleased" +depends: [ + "ocamlfind" { build } + "jbuilder" { build & >= "1.0+beta17" } + "tezos-base" + "tezos-client-base" +] +build: [ + [ "jbuilder" "build" "-p" name "-j" jobs ] +] +build-test: [ + [ "jbuilder" "runtest" "-p" name "-j" jobs ] +] diff --git a/src/proto_alpha/lib_client/jbuild b/src/proto_alpha/lib_client/jbuild index e856317c4..cc6a4157e 100644 --- a/src/proto_alpha/lib_client/jbuild +++ b/src/proto_alpha/lib_client/jbuild @@ -8,14 +8,14 @@ tezos-protocol-environment-client tezos-shell-services tezos-client-base - tezos-rpc-http)) + tezos-rpc)) (library_flags (:standard -linkall)) (flags (:standard -w -9+27-30-32-40@8 -safe-string -open Tezos_base__TzPervasives -open Tezos_shell_services -open Tezos_client_base - -open Tezos_rpc_http)))) + -open Tezos_rpc)))) (alias ((name runtest_indent) diff --git a/src/proto_alpha/lib_client/proto_alpha.ml b/src/proto_alpha/lib_client/proto_alpha.ml index 3a10cf4a9..e703e4cec 100644 --- a/src/proto_alpha/lib_client/proto_alpha.ml +++ b/src/proto_alpha/lib_client/proto_alpha.ml @@ -12,11 +12,11 @@ module Alpha_environment = Tezos_protocol_environment_client.Fake.Make(Name)() include Tezos_protocol_alpha.Functor.Make(Alpha_environment) class type rpc_context = object - inherit RPC_client.ctxt + inherit RPC_context.json inherit [Block_services.block] Alpha_environment.RPC_context.simple end -class wrap_proto_context (t : RPC_client.ctxt) : rpc_context = object +class wrap_proto_context (t : RPC_context.json) : rpc_context = object method generic_json_call = t#generic_json_call method call_service : 'm 'p 'q 'i 'o. ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_alpha/lib_client/test/jbuild b/src/proto_alpha/lib_client/test/jbuild index 94f23a047..bec991147 100644 --- a/src/proto_alpha/lib_client/test/jbuild +++ b/src/proto_alpha/lib_client/test/jbuild @@ -12,6 +12,7 @@ tezos-client-base tezos-client-genesis tezos-client-alpha + tezos-unix-signers alcotest-lwt)) (flags (:standard -w -9-32 -safe-string -open Tezos_base__TzPervasives @@ -19,7 +20,8 @@ -open Tezos_shell_services -open Tezos_client_base -open Tezos_client_genesis - -open Tezos_client_alpha)))) + -open Tezos_client_alpha + -open Tezos_unix_signers)))) (alias ((name buildtest)