From a14616517eea0b747bcabebc7a2ff53f7592ffcc Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Wed, 14 Feb 2018 11:01:23 +0100 Subject: [PATCH] Client: split client-base modules into functions / commands --- Makefile | 8 +- src/bin_client/client_config.ml | 8 +- ...ient_context_unix.ml => client_context.ml} | 0 ...nt_context_unix.mli => client_context.mli} | 0 .../{main_lib.ml => client_main_run.ml} | 65 ++---- .../{admin_main.ml => client_main_run.mli} | 11 +- src/bin_client/jbuild | 2 +- src/bin_client/main_admin.ml | 18 ++ src/bin_client/main_client.ml | 51 +++++ src/bin_client/tezos-init-sandboxed-client.sh | 4 +- ..._helpers.ml => client_helpers_commands.ml} | 0 ...elpers.mli => client_helpers_commands.mli} | 0 src/lib_client_base/client_keys.ml | 199 +---------------- src/lib_client_base/client_keys.mli | 27 ++- src/lib_client_base/client_keys_commands.ml | 207 ++++++++++++++++++ ...t_network.mli => client_keys_commands.mli} | 0 ..._network.ml => client_network_commands.ml} | 0 .../client_network_commands.mli} | 3 +- 18 files changed, 333 insertions(+), 270 deletions(-) rename src/bin_client/{client_context_unix.ml => client_context.ml} (100%) rename src/bin_client/{client_context_unix.mli => client_context.mli} (100%) rename src/bin_client/{main_lib.ml => client_main_run.ml} (67%) rename src/bin_client/{admin_main.ml => client_main_run.mli} (64%) create mode 100644 src/bin_client/main_admin.ml create mode 100644 src/bin_client/main_client.ml rename src/lib_client_base/{client_helpers.ml => client_helpers_commands.ml} (100%) rename src/lib_client_base/{client_helpers.mli => client_helpers_commands.mli} (100%) create mode 100644 src/lib_client_base/client_keys_commands.ml rename src/lib_client_base/{client_network.mli => client_keys_commands.mli} (100%) rename src/lib_client_base/{client_network.ml => client_network_commands.ml} (100%) rename src/{bin_client/main.ml => lib_client_base/client_network_commands.mli} (85%) diff --git a/Makefile b/Makefile index 4007d48ac..5fdacf306 100644 --- a/Makefile +++ b/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/admin_main.exe \ + src/bin_client/main_client.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/admin_main.exe tezos-admin-client + @cp _build/default/src/bin_client/main_client.exe tezos-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: diff --git a/src/bin_client/client_config.ml b/src/bin_client/client_config.ml index 30591d695..6f1ed71d3 100644 --- a/src/bin_client/client_config.ml +++ b/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 () -> diff --git a/src/bin_client/client_context_unix.ml b/src/bin_client/client_context.ml similarity index 100% rename from src/bin_client/client_context_unix.ml rename to src/bin_client/client_context.ml diff --git a/src/bin_client/client_context_unix.mli b/src/bin_client/client_context.mli similarity index 100% rename from src/bin_client/client_context_unix.mli rename to src/bin_client/client_context.mli diff --git a/src/bin_client/main_lib.ml b/src/bin_client/client_main_run.ml similarity index 67% rename from src/bin_client/main_lib.ml rename to src/bin_client/client_main_run.ml index 87a208582..73658ea7e 100644 --- a/src/bin_client/main_lib.ml +++ b/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 - "@[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 - "@[@{@{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 - ~block:Client_context_unix.default_block + (cctxt ~base_dir:Client_context.default_base_dir + ~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 - | 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 -> + select_commands ctxt parsed_args >>=? 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)) diff --git a/src/bin_client/admin_main.ml b/src/bin_client/client_main_run.mli similarity index 64% rename from src/bin_client/admin_main.ml rename to src/bin_client/client_main_run.mli index 248e254e1..d6f3c60b5 100644 --- a/src/bin_client/admin_main.ml +++ b/src/bin_client/client_main_run.mli @@ -7,9 +7,8 @@ (* *) (**************************************************************************) -(* Where all the user friendliness starts *) -let () = Pervasives.exit (Lwt_main.run ( - Main_lib.main ~only_commands:(Client_debug.commands () - @ Client_admin.commands () - @ Client_network.commands () - @ Client_generic_rpcs.commands) ())) +val run : + (RPC_client.http_ctxt -> + Client_config.cli_args -> + Client_commands.full_context Cli_entries.command list tzresult Lwt.t) -> + unit diff --git a/src/bin_client/jbuild b/src/bin_client/jbuild index b4e345fcf..cb787221f 100644 --- a/src/bin_client/jbuild +++ b/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 diff --git a/src/bin_client/main_admin.ml b/src/bin_client/main_admin.ml new file mode 100644 index 000000000..b64fe11a4 --- /dev/null +++ b/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 diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml new file mode 100644 index 000000000..461239392 --- /dev/null +++ b/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 diff --git a/src/bin_client/tezos-init-sandboxed-client.sh b/src/bin_client/tezos-init-sandboxed-client.sh index 01391cf55..68535d49b 100755 --- a/src/bin_client/tezos-init-sandboxed-client.sh +++ b/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 diff --git a/src/lib_client_base/client_helpers.ml b/src/lib_client_base/client_helpers_commands.ml similarity index 100% rename from src/lib_client_base/client_helpers.ml rename to src/lib_client_base/client_helpers_commands.ml diff --git a/src/lib_client_base/client_helpers.mli b/src/lib_client_base/client_helpers_commands.mli similarity index 100% rename from src/lib_client_base/client_helpers.mli rename to src/lib_client_base/client_helpers_commands.mli diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml index 44ada29e7..95ef426b4 100644 --- a/src/lib_client_base/client_keys.ml +++ b/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 []) ; - - ] diff --git a/src/lib_client_base/client_keys.mli b/src/lib_client_base/client_keys.mli index af68c2fb8..f41656d42 100644 --- a/src/lib_client_base/client_keys.mli +++ b/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 diff --git a/src/lib_client_base/client_keys_commands.ml b/src/lib_client_base/client_keys_commands.ml new file mode 100644 index 000000000..a210707ba --- /dev/null +++ b/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 []) ; + + ] diff --git a/src/lib_client_base/client_network.mli b/src/lib_client_base/client_keys_commands.mli similarity index 100% rename from src/lib_client_base/client_network.mli rename to src/lib_client_base/client_keys_commands.mli diff --git a/src/lib_client_base/client_network.ml b/src/lib_client_base/client_network_commands.ml similarity index 100% rename from src/lib_client_base/client_network.ml rename to src/lib_client_base/client_network_commands.ml diff --git a/src/bin_client/main.ml b/src/lib_client_base/client_network_commands.mli similarity index 85% rename from src/bin_client/main.ml rename to src/lib_client_base/client_network_commands.mli index 2bbd0a78c..cd41b6053 100644 --- a/src/bin_client/main.ml +++ b/src/lib_client_base/client_network_commands.mli @@ -7,5 +7,4 @@ (* *) (**************************************************************************) -(* Where all the user friendliness starts *) -let () = Pervasives.exit (Lwt_main.run (Main_lib.main ())) +val commands: unit -> Client_commands.command list