Client: remove Unix dependencies from client-base and client-alpha

.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##
 

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

src/bin_client/client_context_unix.ml

@@ -0,0 +1,92 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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 ())

src/bin_client/client_context_unix.mli

@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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

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)

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
+        (cctxt ~base_dir:Client_context_unix.default_base_dir
-           ~block:Client_commands.default_block
+           ~block:Client_context_unix.default_block
            RPC_client.default_config)
         original_args
       >>=? fun (parsed_config_file, parsed_args, config_commands, remaining) ->

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: [

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

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

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-rpc
-              tezos-shell-services
+              tezos-shell-services))
-              tezos-rpc-http))
   (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
-                    -open Tezos_rpc_http
                     -open Tezos_shell_services))))
 
 (alias

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 ;

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 +=

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
+class http_ctxt config media_types : RPC_context.json =
-  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 =
   let base =
     Uri.make
       ~scheme:(if config.tls then "https" else "http")

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 =
+class http_ctxt : config -> Media_type.t list -> RPC_context.json
-  [ `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
 
 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
 

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} ${^}))))

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 ]
+]

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)

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

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)