Client: split client-base modules into functions / commands

Makefile

@@ -5,12 +5,12 @@ PACKAGES:=$(patsubst %.opam,%,$(notdir $(shell find -name *.opam)))
 all:
 	@jbuilder build ${DEV} \
 		src/bin_node/main.exe \
-		src/bin_client/main.exe \
+		src/bin_client/main_client.exe \
-		src/bin_client/admin_main.exe \
+		src/bin_client/main_admin.exe \
 		src/lib_protocol_compiler/main_native.exe
 	@cp _build/default/src/bin_node/main.exe tezos-node
-	@cp _build/default/src/bin_client/main.exe tezos-client
+	@cp _build/default/src/bin_client/main_client.exe tezos-client
-	@cp _build/default/src/bin_client/admin_main.exe tezos-admin-client
+	@cp _build/default/src/bin_client/main_admin.exe tezos-admin-client
 	@cp _build/default/src/lib_protocol_compiler/main_native.exe tezos-protocol-compiler
 
 all.pkg:

src/bin_client/client_config.ml

@@ -61,7 +61,7 @@ module Cfg_file = struct
   }
 
   let default = {
-    base_dir = Client_context_unix.default_base_dir ;
+    base_dir = Client_context.default_base_dir ;
     node_addr = "localhost" ;
     node_port = 8732 ;
     tls = false ;
@@ -109,7 +109,7 @@ type cli_args = {
 }
 
 let default_cli_args = {
-  block = Client_context_unix.default_block ;
+  block = Client_context.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_context_unix.default_base_dir)
+           By default " ^ Client_context.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_context_unix.default_base_dir in
+        let base_dir = Client_context.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_main_run.ml

@@ -9,41 +9,12 @@
 
 (* Tezos Command line interface - Main Program *)
 
-let cctxt ~base_dir ~block rpc_config =
-  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
-  | Ok version -> begin
-      match protocol with
-      | None ->
-          return (Some version, Client_commands.commands_for_version version)
-      | Some given_version -> begin
-          if not (Protocol_hash.equal version given_version) then
-            Format.eprintf
-              "@[<v 2>Warning:@,\
-               The protocol provided via `-protocol` (%a)@,\
-               is not the one retrieved from the node (%a).@]@\n@."
-              Protocol_hash.pp_short given_version
-              Protocol_hash.pp_short version ;
-          return (Some version, Client_commands.commands_for_version given_version)
-        end
-    end
-  | Error errs -> begin
-      match protocol with
-      | None -> begin
-          Format.eprintf
-            "@[<v 2>@{<warning>@{<title>Warning@}@}@,\
-             Failed to acquire the protocol version from the node@,%a@]@\n@."
-            (Format.pp_print_list pp) errs ;
-          return (None, [])
-        end
-      | Some version ->
-          return (Some version, Client_commands.commands_for_version version)
-    end
-
 (* Main (lwt) entry *)
-let main ?only_commands () =
+let main select_commands =
+  let cctxt ~base_dir ~block rpc_config =
+    Client_context.make_context
+      ~base_dir ~block ~rpc_config
+      (Client_context.default_log ~base_dir) in
   let executable_name = Filename.basename Sys.executable_name in
   let global_options = Client_config.global_options () in
   let original_args, autocomplete =
@@ -64,8 +35,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_context_unix.default_base_dir
+        (cctxt ~base_dir:Client_context.default_base_dir
-           ~block:Client_context_unix.default_block
+           ~block:Client_context.default_block
            RPC_client.default_config)
         original_args
       >>=? fun (parsed_config_file, parsed_args, config_commands, remaining) ->
@@ -76,28 +47,14 @@ let main ?only_commands () =
         tls = parsed_config_file.tls ;
       } in
       let ctxt = new RPC_client.http_ctxt rpc_config Media_type.all_media_types in
-      begin match only_commands with
+      select_commands ctxt parsed_args >>=? fun commands ->
-        | None ->
-            get_commands_for_version ctxt
-              parsed_args.block
-              parsed_args.protocol >>|? fun (_version, commands_for_version)  ->
-            Client_generic_rpcs.commands @
-            Client_network.commands () @
-            Client_keys.commands () @
-            Client_protocols.commands () @
-            Client_helpers.commands () @
-            config_commands @
-            commands_for_version
-        | Some commands ->
-            return (config_commands @ commands)
-      end >>=? fun commands ->
       let commands =
         Cli_entries.add_manual
           ~executable_name
           ~global_options
           (if Unix.isatty Unix.stdout then Cli_entries.Ansi else Cli_entries.Plain)
           Format.std_formatter
-          commands in
+          (config_commands @ commands) in
       let rpc_config =
         if parsed_args.print_timings then
           { rpc_config with
@@ -150,3 +107,7 @@ let main ?only_commands () =
   Format.fprintf Format.std_formatter "@." ;
   Format.fprintf Format.err_formatter "@." ;
   Lwt.return retcode
+
+(* Where all the user friendliness starts *)
+let run select_commands =
+  Pervasives.exit (Lwt_main.run (main select_commands))

src/bin_client/client_main_run.mli

@@ -7,9 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* Where all the user friendliness starts *)
+val run :
-let () = Pervasives.exit (Lwt_main.run (
+  (RPC_client.http_ctxt ->
-    Main_lib.main ~only_commands:(Client_debug.commands ()
+   Client_config.cli_args ->
-                                  @ Client_admin.commands ()
+   Client_commands.full_context Cli_entries.command list tzresult Lwt.t) ->
-                                  @ Client_network.commands ()
+  unit
-                                  @ Client_generic_rpcs.commands) ()))

src/bin_client/jbuild

@@ -1,7 +1,7 @@
 (jbuild_version 1)
 
 (executables
- ((names (main admin_main))
+ ((names (main_client main_admin))
   (public_names (tezos-client tezos-admin))
   (libraries (tezos-base
               tezos-rpc-http

src/bin_client/main_admin.ml

@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let select_commands _ _ =
+  return
+    (List.flatten
+       [ Client_debug.commands () ;
+         Client_admin.commands () ;
+         Client_network_commands.commands () ;
+         Client_generic_rpcs.commands ])
+
+let () = Client_main_run.run select_commands

src/bin_client/main_client.ml

@@ -0,0 +1,51 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Client_config
+
+let get_commands_for_version ctxt block protocol =
+  Block_services.protocol ctxt block >>= function
+  | Ok version -> begin
+      match protocol with
+      | None ->
+          return (Some version, Client_commands.commands_for_version version)
+      | Some given_version -> begin
+          if not (Protocol_hash.equal version given_version) then
+            Format.eprintf
+              "@[<v 2>Warning:@,\
+               The protocol provided via `-protocol` (%a)@,\
+               is not the one retrieved from the node (%a).@]@\n@."
+              Protocol_hash.pp_short given_version
+              Protocol_hash.pp_short version ;
+          return (Some version, Client_commands.commands_for_version given_version)
+        end
+    end
+  | Error errs -> begin
+      match protocol with
+      | None -> begin
+          Format.eprintf
+            "@[<v 2>@{<warning>@{<title>Warning@}@}@,\
+             Failed to acquire the protocol version from the node@,%a@]@\n@."
+            (Format.pp_print_list pp) errs ;
+          return (None, [])
+        end
+      | Some version ->
+          return (Some version, Client_commands.commands_for_version version)
+    end
+
+let select_commands ctxt { block ; protocol } =
+  get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version)  ->
+  Client_generic_rpcs.commands @
+  Client_network_commands.commands () @
+  Client_keys_commands.commands () @
+  Client_protocols.commands () @
+  Client_helpers_commands.commands () @
+  commands_for_version
+
+let () = Client_main_run.run select_commands

src/bin_client/tezos-init-sandboxed-client.sh

@@ -214,7 +214,7 @@ main () {
 
     local bin_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
     if [ $(basename "$bin_dir") = "bin_client" ]; then
-        local_client="${local_client:-$bin_dir/../../_build/default/src/bin_client/main.exe}"
+        local_client="${local_client:-$bin_dir/../../_build/default/src/bin_client/main_client.exe}"
     else
         local_client="${local_client:-tezos-client}"
     fi
@@ -233,7 +233,7 @@ main () {
     echo "exec $client \"\$@\"" >> $client_dir/bin/tezos-client
     chmod +x $client_dir/bin/tezos-client
     echo '#!/bin/sh' > $client_dir/bin/tezos-admin-client
-    echo "exec $client \"\$@\"" | sed s/tezos-client/tezos-adming-client/g  >> $client_dir/bin/tezos-admin-client
+    echo "exec $client \"\$@\"" | sed s/main_client/main_admin/g  >> $client_dir/bin/tezos-admin-client
     chmod +x $client_dir/bin/tezos-admin-client
 
     cat <<EOF

src/lib_client_base/client_keys.ml

@@ -143,6 +143,9 @@ let find_signer_for_key ~scheme =
   | exception Not_found -> error (Unregistered_key_scheme scheme)
   | signer -> ok signer
 
+let registered_signers () : (string * (module SIGNER)) list =
+  Hashtbl.fold (fun k v acc -> (k, v) :: acc) signers_table []
+
 let sign ((Sk_locator { scheme }) as skloc) buf =
   Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
   let module Signer = (val signer : SIGNER) in
@@ -278,199 +281,3 @@ let alias_keys cctxt name =
 
 let force_switch () =
   Client_commands.force_switch ~doc:"overwrite existing keys" ()
-
-let group =
-  { Cli_entries.name = "keys" ;
-    title = "Commands for managing the wallet of cryptographic keys" }
-
-let commands () =
-  let open Cli_entries in
-  let show_private_switch =
-    switch
-      ~long:"show-secret"
-      ~short:'S'
-      ~doc:"show the private key" () in
-  [
-    command ~group
-      ~desc: "List supported signing schemes.\n\
-              Signing schemes are identifiers for signer modules: the \
-              built-in signing routines, a hardware wallet, an \
-              external agent, etc.\n\
-              Each signer has its own format for describing secret \
-              keys, such a raw secret key for the default \
-              `unencrypted` scheme, the path on a hardware security \
-              module, an alias for an external agent, etc.\n\
-              This command gives the list of signer modules that this \
-              version of the tezos client supports."
-      no_options
-      (fixed [ "list" ; "signing" ; "schemes" ])
-      (fun () (cctxt : #Client_commands.full_context) ->
-         let schemes = Hashtbl.fold (fun k _ a -> k :: a) signers_table [] in
-         let schemes = List.sort String.compare schemes in
-         Lwt_list.iter_s
-           (fun n ->
-              let (module S : SIGNER) = Hashtbl.find signers_table n in
-              cctxt#message "@[<v 2>Scheme `%s`: %s@,@[<hov 0>%a@]@]"
-                n S.title Format.pp_print_text S.description)
-           schemes >>= return) ;
-
-    command ~group ~desc: "Generate a pair of (unencrypted) keys."
-      (args1 (Secret_key.force_switch ()))
-      (prefixes [ "gen" ; "keys" ]
-       @@ Secret_key.fresh_alias_param
-       @@ stop)
-      (fun force name (cctxt : #Client_commands.full_context) ->
-         Secret_key.of_fresh cctxt force name >>=? fun name ->
-         gen_keys ~force cctxt name) ;
-
-    command ~group ~desc: "Generate (unencrypted) keys including the given string."
-      (args2
-         (switch
-            ~long:"prefix"
-            ~short:'P'
-            ~doc:"the key must begin with tz1[word]"
-            ())
-         (force_switch ()))
-      (prefixes [ "gen" ; "vanity" ; "keys" ]
-       @@ Public_key_hash.fresh_alias_param
-       @@ prefix "matching"
-       @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words"))
-      (fun (prefix, force) name containing cctxt ->
-         Public_key_hash.of_fresh cctxt force name >>=? fun name ->
-         gen_keys_containing ~force ~prefix ~containing ~name cctxt) ;
-
-    command ~group ~desc: "Add a secret key to the wallet."
-      (args1 (Secret_key.force_switch ()))
-      (prefix "import"
-       @@ string
-         ~name:"scheme"
-         ~desc:"signer to use for this secret key\n\
-                Use command `list signing schemes` for a list of \
-                supported signers."
-       @@ prefixes [ "secret" ; "key" ]
-       @@ Secret_key.fresh_alias_param
-       @@ seq_of_param
-         (string
-            ~name:"spec"
-            ~desc:"secret key specification\n\
-                   Varies from one scheme to the other.\n\
-                   Use command `list signing schemes` for more \
-                   information."))
-      (fun force scheme name spec cctxt ->
-         Secret_key.of_fresh cctxt force name >>=? fun name ->
-         Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
-         let module Signer = (val signer : SIGNER) in
-         Signer.sk_locator_of_human_input
-           (cctxt :> Client_commands.logging_wallet) spec >>=? fun skloc ->
-         Signer.sk_of_locator skloc >>=? fun sk ->
-         Signer.neuterize sk >>= fun pk ->
-         Signer.pk_to_locator pk >>= fun pkloc ->
-         Public_key.find_opt cctxt name >>=? function
-         | None ->
-             Signer.public_key_hash pk >>= fun pkh ->
-             Secret_key.add ~force cctxt name skloc >>=? fun () ->
-             Public_key_hash.add ~force cctxt name pkh >>=? fun () ->
-             Public_key.add ~force cctxt name pkloc
-         | Some pk ->
-             fail_unless (pkloc = pk || force)
-               (failure
-                  "public and secret keys '%s' don't correspond, \
-                   please don't use -force" name) >>=? fun () ->
-             Secret_key.add ~force cctxt name skloc) ;
-
-    command ~group ~desc: "Add a public key to the wallet."
-      (args1 (Public_key.force_switch ()))
-      (prefix "import"
-       @@ string
-         ~name:"scheme"
-         ~desc:"signer to use for this public key\n\
-                Use command `list signing schemes` for a list of \
-                supported signers."
-       @@ prefixes [ "public" ; "key" ]
-       @@ Public_key.fresh_alias_param
-       @@ seq_of_param
-         (string
-            ~name:"spec"
-            ~desc:"public key specification\n\
-                   Varies from one scheme to the other.\n\
-                   Use command `list signing schemes` for more \
-                   information."))
-      (fun force scheme name location cctxt ->
-         Public_key.of_fresh cctxt force name >>=? fun name ->
-         Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
-         let module Signer = (val signer : SIGNER) in
-         Signer.pk_locator_of_human_input
-           (cctxt :> Client_commands.logging_wallet) location >>=? fun pkloc ->
-         Signer.pk_of_locator pkloc >>=? fun pk ->
-         Signer.public_key_hash pk >>= fun pkh ->
-         Public_key_hash.add ~force cctxt name pkh >>=? fun () ->
-         Public_key.add ~force cctxt name pkloc) ;
-
-    command ~group ~desc: "Add an identity to the wallet."
-      (args1 (Public_key.force_switch ()))
-      (prefixes [ "add" ; "identity" ]
-       @@ Public_key_hash.fresh_alias_param
-       @@ Public_key_hash.source_param
-       @@ stop)
-      (fun force name hash cctxt ->
-         Public_key_hash.of_fresh cctxt force name >>=? fun name ->
-         Public_key_hash.add ~force cctxt name hash) ;
-
-    command ~group ~desc: "List all identities and associated keys."
-      no_options
-      (fixed [ "list" ; "known" ; "identities" ])
-      (fun () (cctxt : #Client_commands.full_context) ->
-         list_keys cctxt >>=? fun l ->
-         iter_s begin fun (name, pkh, pk, sk) ->
-           Public_key_hash.to_source pkh >>=? fun v ->
-           begin match pk, sk with
-             | None, None ->
-                 cctxt#message "%s: %s" name v
-             | _, Some Sk_locator { scheme } ->
-                 cctxt#message "%s: %s (%s sk known)" name v scheme
-             | Some Pk_locator { scheme }, _ ->
-                 cctxt#message "%s: %s (%s pk known)" name v scheme
-           end >>= fun () -> return ()
-         end l) ;
-
-    command ~group ~desc: "Show the keys associated with an identity."
-      (args1 show_private_switch)
-      (prefixes [ "show" ; "identity"]
-       @@ Public_key_hash.alias_param
-       @@ stop)
-      (fun show_private (name, _) (cctxt : #Client_commands.full_context) ->
-         let ok_lwt x = x >>= (fun x -> return x) in
-         alias_keys cctxt name >>=? fun key_info ->
-         match key_info with
-         | None -> ok_lwt @@ cctxt#message "No keys found for identity"
-         | Some (pkh, pk, skloc) ->
-             ok_lwt @@ cctxt#message "Hash: %a"
-               Ed25519.Public_key_hash.pp pkh >>=? fun () ->
-             match pk with
-             | None -> return ()
-             | Some (Pk_locator { scheme } as pkloc) ->
-                 Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
-                 let module Signer = (val signer : SIGNER) in
-                 Signer.pk_of_locator pkloc >>=? fun pk ->
-                 Signer.public_key pk >>= fun pk ->
-                 ok_lwt @@ cctxt#message "Public Key: %a"
-                   Ed25519.Public_key.pp pk >>=? fun () ->
-                 if show_private then
-                   match skloc with
-                   | None -> return ()
-                   | Some skloc ->
-                       Secret_key.to_source skloc >>=? fun skloc ->
-                       ok_lwt @@ cctxt#message "Secret Key: %s" skloc
-                 else return ()) ;
-
-    command ~group ~desc: "Forget the entire wallet of keys."
-      (args1 (Client_commands.force_switch ~doc:"you got to use the force for that" ()))
-      (fixed [ "forget" ; "all" ; "keys" ])
-      (fun force cctxt ->
-         fail_unless force
-           (failure "this can only used with option -force") >>=? fun () ->
-         Public_key.set cctxt [] >>=? fun () ->
-         Secret_key.set cctxt [] >>=? fun () ->
-         Public_key_hash.set cctxt []) ;
-
-  ]

src/lib_client_base/client_keys.mli

@@ -97,11 +97,34 @@ val register_signer : (module SIGNER) -> unit
     signer for keys with scheme [(val signer : SIGNER).scheme]. *)
 
 val find_signer_for_key : scheme:string -> (module SIGNER) tzresult
+
+val registered_signers : unit -> (string * (module SIGNER)) list
+
 val sign : sk_locator -> MBytes.t -> Ed25519.Signature.t tzresult Lwt.t
 val append : sk_locator -> MBytes.t -> MBytes.t tzresult Lwt.t
 
+val gen_keys :
+  ?force:bool ->
+  ?seed:Ed25519.Seed.t ->
+  #Client_commands.wallet -> string -> unit tzresult Lwt.t
+
+val gen_keys_containing :
+  ?prefix:bool ->
+  ?force:bool ->
+  containing:string list ->
+  name:string ->
+  #Client_commands.full_context -> unit tzresult Lwt.t
+
+val list_keys :
+  #Client_commands.wallet ->
+  (string * Public_key_hash.t * pk_locator option * sk_locator option) list tzresult Lwt.t
+
+val alias_keys :
+  #Client_commands.wallet -> string ->
+  (Public_key_hash.t * pk_locator option * sk_locator option) option tzresult Lwt.t
+
 val get_key:
-  #Client_commands.full_context ->
+  #Client_commands.wallet ->
   Public_key_hash.t ->
   (string * Ed25519.Public_key.t * sk_locator) tzresult Lwt.t
 
@@ -110,5 +133,3 @@ val get_keys:
   (string * Public_key_hash.t * Ed25519.Public_key.t * sk_locator) list tzresult Lwt.t
 
 val force_switch : unit -> (bool, #Client_commands.full_context) Cli_entries.arg
-
-val commands: unit -> Client_commands.command list

src/lib_client_base/client_keys_commands.ml

@@ -0,0 +1,207 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Client_keys
+
+let group =
+  { Cli_entries.name = "keys" ;
+    title = "Commands for managing the wallet of cryptographic keys" }
+
+let commands () =
+  let open Cli_entries in
+  let show_private_switch =
+    switch
+      ~long:"show-secret"
+      ~short:'S'
+      ~doc:"show the private key" () in
+  [
+    command ~group
+      ~desc: "List supported signing schemes.\n\
+              Signing schemes are identifiers for signer modules: the \
+              built-in signing routines, a hardware wallet, an \
+              external agent, etc.\n\
+              Each signer has its own format for describing secret \
+              keys, such a raw secret key for the default \
+              `unencrypted` scheme, the path on a hardware security \
+              module, an alias for an external agent, etc.\n\
+              This command gives the list of signer modules that this \
+              version of the tezos client supports."
+      no_options
+      (fixed [ "list" ; "signing" ; "schemes" ])
+      (fun () (cctxt : #Client_commands.full_context) ->
+         let signers =
+           List.sort
+             (fun (ka, _) (kb, _) -> String.compare ka kb)
+             (registered_signers ()) in
+         Lwt_list.iter_s
+           (fun (n, (module S : SIGNER))  ->
+              cctxt#message "@[<v 2>Scheme `%s`: %s@,@[<hov 0>%a@]@]"
+                n S.title Format.pp_print_text S.description)
+           signers >>= return) ;
+
+    command ~group ~desc: "Generate a pair of (unencrypted) keys."
+      (args1 (Secret_key.force_switch ()))
+      (prefixes [ "gen" ; "keys" ]
+       @@ Secret_key.fresh_alias_param
+       @@ stop)
+      (fun force name (cctxt : #Client_commands.full_context) ->
+         Secret_key.of_fresh cctxt force name >>=? fun name ->
+         gen_keys ~force cctxt name) ;
+
+    command ~group ~desc: "Generate (unencrypted) keys including the given string."
+      (args2
+         (switch
+            ~long:"prefix"
+            ~short:'P'
+            ~doc:"the key must begin with tz1[word]"
+            ())
+         (force_switch ()))
+      (prefixes [ "gen" ; "vanity" ; "keys" ]
+       @@ Public_key_hash.fresh_alias_param
+       @@ prefix "matching"
+       @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words"))
+      (fun (prefix, force) name containing cctxt ->
+         Public_key_hash.of_fresh cctxt force name >>=? fun name ->
+         gen_keys_containing ~force ~prefix ~containing ~name cctxt) ;
+
+    command ~group ~desc: "Add a secret key to the wallet."
+      (args1 (Secret_key.force_switch ()))
+      (prefix "import"
+       @@ string
+         ~name:"scheme"
+         ~desc:"signer to use for this secret key\n\
+                Use command `list signing schemes` for a list of \
+                supported signers."
+       @@ prefixes [ "secret" ; "key" ]
+       @@ Secret_key.fresh_alias_param
+       @@ seq_of_param
+         (string
+            ~name:"spec"
+            ~desc:"secret key specification\n\
+                   Varies from one scheme to the other.\n\
+                   Use command `list signing schemes` for more \
+                   information."))
+      (fun force scheme name spec cctxt ->
+         Secret_key.of_fresh cctxt force name >>=? fun name ->
+         Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
+         let module Signer = (val signer : SIGNER) in
+         Signer.sk_locator_of_human_input
+           (cctxt :> Client_commands.logging_wallet) spec >>=? fun skloc ->
+         Signer.sk_of_locator skloc >>=? fun sk ->
+         Signer.neuterize sk >>= fun pk ->
+         Signer.pk_to_locator pk >>= fun pkloc ->
+         Public_key.find_opt cctxt name >>=? function
+         | None ->
+             Signer.public_key_hash pk >>= fun pkh ->
+             Secret_key.add ~force cctxt name skloc >>=? fun () ->
+             Public_key_hash.add ~force cctxt name pkh >>=? fun () ->
+             Public_key.add ~force cctxt name pkloc
+         | Some pk ->
+             fail_unless (pkloc = pk || force)
+               (failure
+                  "public and secret keys '%s' don't correspond, \
+                   please don't use -force" name) >>=? fun () ->
+             Secret_key.add ~force cctxt name skloc) ;
+
+    command ~group ~desc: "Add a public key to the wallet."
+      (args1 (Public_key.force_switch ()))
+      (prefix "import"
+       @@ string
+         ~name:"scheme"
+         ~desc:"signer to use for this public key\n\
+                Use command `list signing schemes` for a list of \
+                supported signers."
+       @@ prefixes [ "public" ; "key" ]
+       @@ Public_key.fresh_alias_param
+       @@ seq_of_param
+         (string
+            ~name:"spec"
+            ~desc:"public key specification\n\
+                   Varies from one scheme to the other.\n\
+                   Use command `list signing schemes` for more \
+                   information."))
+      (fun force scheme name location cctxt ->
+         Public_key.of_fresh cctxt force name >>=? fun name ->
+         Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
+         let module Signer = (val signer : SIGNER) in
+         Signer.pk_locator_of_human_input
+           (cctxt :> Client_commands.logging_wallet) location >>=? fun pkloc ->
+         Signer.pk_of_locator pkloc >>=? fun pk ->
+         Signer.public_key_hash pk >>= fun pkh ->
+         Public_key_hash.add ~force cctxt name pkh >>=? fun () ->
+         Public_key.add ~force cctxt name pkloc) ;
+
+    command ~group ~desc: "Add an identity to the wallet."
+      (args1 (Public_key.force_switch ()))
+      (prefixes [ "add" ; "identity" ]
+       @@ Public_key_hash.fresh_alias_param
+       @@ Public_key_hash.source_param
+       @@ stop)
+      (fun force name hash cctxt ->
+         Public_key_hash.of_fresh cctxt force name >>=? fun name ->
+         Public_key_hash.add ~force cctxt name hash) ;
+
+    command ~group ~desc: "List all identities and associated keys."
+      no_options
+      (fixed [ "list" ; "known" ; "identities" ])
+      (fun () (cctxt : #Client_commands.full_context) ->
+         list_keys cctxt >>=? fun l ->
+         iter_s begin fun (name, pkh, pk, sk) ->
+           Public_key_hash.to_source pkh >>=? fun v ->
+           begin match pk, sk with
+             | None, None ->
+                 cctxt#message "%s: %s" name v
+             | _, Some Sk_locator { scheme } ->
+                 cctxt#message "%s: %s (%s sk known)" name v scheme
+             | Some Pk_locator { scheme }, _ ->
+                 cctxt#message "%s: %s (%s pk known)" name v scheme
+           end >>= fun () -> return ()
+         end l) ;
+
+    command ~group ~desc: "Show the keys associated with an identity."
+      (args1 show_private_switch)
+      (prefixes [ "show" ; "identity"]
+       @@ Public_key_hash.alias_param
+       @@ stop)
+      (fun show_private (name, _) (cctxt : #Client_commands.full_context) ->
+         let ok_lwt x = x >>= (fun x -> return x) in
+         alias_keys cctxt name >>=? fun key_info ->
+         match key_info with
+         | None -> ok_lwt @@ cctxt#message "No keys found for identity"
+         | Some (pkh, pk, skloc) ->
+             ok_lwt @@ cctxt#message "Hash: %a"
+               Ed25519.Public_key_hash.pp pkh >>=? fun () ->
+             match pk with
+             | None -> return ()
+             | Some (Pk_locator { scheme } as pkloc) ->
+                 Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
+                 let module Signer = (val signer : SIGNER) in
+                 Signer.pk_of_locator pkloc >>=? fun pk ->
+                 Signer.public_key pk >>= fun pk ->
+                 ok_lwt @@ cctxt#message "Public Key: %a"
+                   Ed25519.Public_key.pp pk >>=? fun () ->
+                 if show_private then
+                   match skloc with
+                   | None -> return ()
+                   | Some skloc ->
+                       Secret_key.to_source skloc >>=? fun skloc ->
+                       ok_lwt @@ cctxt#message "Secret Key: %s" skloc
+                 else return ()) ;
+
+    command ~group ~desc: "Forget the entire wallet of keys."
+      (args1 (Client_commands.force_switch ~doc:"you got to use the force for that" ()))
+      (fixed [ "forget" ; "all" ; "keys" ])
+      (fun force cctxt ->
+         fail_unless force
+           (failure "this can only used with option -force") >>=? fun () ->
+         Public_key.set cctxt [] >>=? fun () ->
+         Secret_key.set cctxt [] >>=? fun () ->
+         Public_key_hash.set cctxt []) ;
+
+  ]

src/lib_client_base/client_network_commands.mli

@@ -7,5 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* Where all the user friendliness starts *)
+val commands: unit -> Client_commands.command list
-let () = Pervasives.exit (Lwt_main.run (Main_lib.main ()))