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

Client: split client-base modules into functions / commands

Browse Source
This commit is contained in:
Benjamin Canou 2018-02-14 11:01:23 +01:00
parent b3066d6a24
commit a14616517e
18 changed files with 333 additions and 270 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile
View File

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

8
src/bin_client/client_config.ml
View File

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

0
src/bin_client/client_context_unix.ml → src/bin_client/client_context.ml
View File

0
src/bin_client/client_context_unix.mli → src/bin_client/client_context.mli
View File

65
src/bin_client/main_lib.ml → src/bin_client/client_main_run.ml
View File

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

11
src/bin_client/admin_main.ml → src/bin_client/client_main_run.mli
View File

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

2
src/bin_client/jbuild
View File

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

18
src/bin_client/main_admin.ml Normal file
View File

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

51
src/bin_client/main_client.ml Normal file
View File

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

4
src/bin_client/tezos-init-sandboxed-client.sh
View File

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

0
src/lib_client_base/client_helpers.ml → src/lib_client_base/client_helpers_commands.ml
View File

0
src/lib_client_base/client_helpers.mli → src/lib_client_base/client_helpers_commands.mli
View File

199
src/lib_client_base/client_keys.ml
View File

@ -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 []) ;
]

27
src/lib_client_base/client_keys.mli
View File

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

207
src/lib_client_base/client_keys_commands.ml Normal file
View File

@ -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 []) ;
]

0
src/lib_client_base/client_network.mli → src/lib_client_base/client_keys_commands.mli
View File

0
src/lib_client_base/client_network.ml → src/lib_client_base/client_network_commands.ml
View File

3
src/bin_client/main.ml → src/lib_client_base/client_network_commands.mli
View File

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