Client: less restrictive type for Client_keys_commands.commands

This commit is contained in:
Grégoire Henry 2018-05-26 10:52:34 +02:00
parent b32e6e7374
commit 664f36a46a
8 changed files with 23 additions and 16 deletions

View File

@ -42,7 +42,10 @@ let get_commands_for_version ctxt block protocol =
let select_commands ctxt { block ; protocol } = let select_commands ctxt { block ; protocol } =
get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version) -> get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version) ->
Client_rpc_commands.commands @ Client_rpc_commands.commands @
Client_keys_commands.commands () @ List.map
(Clic.map_command
(fun (o : Client_context.full) -> (o :> Client_context.io_wallet)))
(Client_keys_commands.commands ()) @
Client_helpers_commands.commands () @ Client_helpers_commands.commands () @
commands_for_version commands_for_version

View File

@ -11,7 +11,7 @@ open Client_signer_remote_messages
let log = Logging.Client.Sign.lwt_log_notice let log = Logging.Client.Sign.lwt_log_notice
let run_socket_daemon (cctxt : #Client_context_unix.unix_full) path = let run_socket_daemon (cctxt : #Client_context.io_wallet) path =
let open Client_signer_remote_socket in let open Client_signer_remote_socket in
Connection.bind path >>=? fun (fd, display_path) -> Connection.bind path >>=? fun (fd, display_path) ->
let rec loop () = let rec loop () =
@ -80,7 +80,7 @@ let run_socket_daemon (cctxt : #Client_context_unix.unix_full) path =
end >>= fun () -> end >>= fun () ->
loop () loop ()
let run_https_daemon (cctxt : #Client_context_unix.unix_full) host port cert key = let run_https_daemon (cctxt : #Client_context.io_wallet) host port cert key =
let open Client_signer_remote_services in let open Client_signer_remote_services in
base (host, port) >>=? fun (host, port) -> base (host, port) >>=? fun (host, port) ->
log "Accepting HTTPS requests on port %d" port >>= fun () -> log "Accepting HTTPS requests on port %d" port >>= fun () ->
@ -148,7 +148,10 @@ let group =
let select_commands _ _ = let select_commands _ _ =
return return
(List.flatten (List.map
(Clic.map_command
(fun (o : Client_context.full) -> (o :> Client_context.io_wallet))) @@
List.flatten
[ Client_keys_commands.commands () ; [ Client_keys_commands.commands () ;
[ command ~group [ command ~group
~desc: "Launch a signer daemon over a TCP socket." ~desc: "Launch a signer daemon over a TCP socket."
@ -213,4 +216,5 @@ let select_commands _ _ =
run_https_daemon cctxt host port cert key) ; run_https_daemon cctxt host port cert key) ;
]]) ]])
let () = Client_main_run.run select_commands let () =
Client_main_run.run select_commands

View File

@ -68,7 +68,7 @@ module type Alias = sig
('a, (< .. > as 'obj)) Clic.params -> ('a, (< .. > as 'obj)) Clic.params ->
(fresh_param -> 'a, 'obj) Clic.params (fresh_param -> 'a, 'obj) Clic.params
val force_switch : val force_switch :
unit -> (bool, #Client_context.full) arg unit -> (bool, _) arg
val of_fresh : val of_fresh :
#Client_context.wallet -> #Client_context.wallet ->
bool -> bool ->

View File

@ -64,7 +64,7 @@ module type Alias = sig
('a, (< .. > as 'obj)) Clic.params -> ('a, (< .. > as 'obj)) Clic.params ->
(fresh_param -> 'a, 'obj) Clic.params (fresh_param -> 'a, 'obj) Clic.params
val force_switch : val force_switch :
unit -> (bool, #Client_context.full) Clic.arg unit -> (bool, _) Clic.arg
val of_fresh : val of_fresh :
#Client_context.wallet -> #Client_context.wallet ->
bool -> bool ->

View File

@ -205,7 +205,7 @@ let gen_keys ?(force=false) ?algo ?seed (cctxt : #Client_context.io_wallet) name
let key = Signature.generate_key ?algo ?seed () in let key = Signature.generate_key ?algo ?seed () in
register_key cctxt ~force key name register_key cctxt ~force key name
let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_context.full) = let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_context.io_wallet) =
let unrepresentable = let unrepresentable =
List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in
match unrepresentable with match unrepresentable with

View File

@ -135,7 +135,7 @@ val gen_keys_containing :
?force:bool -> ?force:bool ->
containing:string list -> containing:string list ->
name:string -> name:string ->
#Client_context.full -> unit tzresult Lwt.t #Client_context.io_wallet -> unit tzresult Lwt.t
val list_keys : val list_keys :
#Client_context.wallet -> #Client_context.wallet ->
@ -154,4 +154,4 @@ val get_keys:
#Client_context.io_wallet -> #Client_context.io_wallet ->
(string * Public_key_hash.t * Signature.Public_key.t * sk_locator) list tzresult Lwt.t (string * Public_key_hash.t * Signature.Public_key.t * sk_locator) list tzresult Lwt.t
val force_switch : unit -> (bool, #Client_context.full) Clic.arg val force_switch : unit -> (bool, 'ctx) Clic.arg

View File

@ -43,7 +43,7 @@ let commands () =
version of the tezos client supports." version of the tezos client supports."
no_options no_options
(fixed [ "list" ; "signing" ; "schemes" ]) (fixed [ "list" ; "signing" ; "schemes" ])
(fun () (cctxt : #Client_context.full) -> (fun () (cctxt : Client_context.io_wallet) ->
let signers = let signers =
List.sort List.sort
(fun (ka, _) (kb, _) -> String.compare ka kb) (fun (ka, _) (kb, _) -> String.compare ka kb)
@ -59,7 +59,7 @@ let commands () =
(prefixes [ "gen" ; "keys" ] (prefixes [ "gen" ; "keys" ]
@@ Secret_key.fresh_alias_param @@ Secret_key.fresh_alias_param
@@ stop) @@ stop)
(fun (force, algo) name (cctxt : #Client_context.full) -> (fun (force, algo) name (cctxt : #Client_context.io_wallet) ->
Secret_key.of_fresh cctxt force name >>=? fun name -> Secret_key.of_fresh cctxt force name >>=? fun name ->
gen_keys ~force ~algo cctxt name) ; gen_keys ~force ~algo cctxt name) ;
@ -75,7 +75,7 @@ let commands () =
@@ Public_key_hash.fresh_alias_param @@ Public_key_hash.fresh_alias_param
@@ prefix "matching" @@ prefix "matching"
@@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words")) @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words"))
(fun (prefix, force) name containing cctxt -> (fun (prefix, force) name containing (cctxt : #Client_context.io_wallet) ->
Public_key_hash.of_fresh cctxt force name >>=? fun name -> Public_key_hash.of_fresh cctxt force name >>=? fun name ->
gen_keys_containing ~force ~prefix ~containing ~name cctxt) ; gen_keys_containing ~force ~prefix ~containing ~name cctxt) ;
@ -159,7 +159,7 @@ let commands () =
command ~group ~desc: "List all identities and associated keys." command ~group ~desc: "List all identities and associated keys."
no_options no_options
(fixed [ "list" ; "known" ; "identities" ]) (fixed [ "list" ; "known" ; "identities" ])
(fun () (cctxt : #Client_context.full) -> (fun () (cctxt : #Client_context.io_wallet) ->
list_keys cctxt >>=? fun l -> list_keys cctxt >>=? fun l ->
iter_s begin fun (name, pkh, pk, sk) -> iter_s begin fun (name, pkh, pk, sk) ->
Public_key_hash.to_source pkh >>=? fun v -> Public_key_hash.to_source pkh >>=? fun v ->
@ -178,7 +178,7 @@ let commands () =
(prefixes [ "show" ; "identity"] (prefixes [ "show" ; "identity"]
@@ Public_key_hash.alias_param @@ Public_key_hash.alias_param
@@ stop) @@ stop)
(fun show_private (name, _) (cctxt : #Client_context.full) -> (fun show_private (name, _) (cctxt : #Client_context.io_wallet) ->
let ok_lwt x = x >>= (fun x -> return x) in let ok_lwt x = x >>= (fun x -> return x) in
alias_keys cctxt name >>=? fun key_info -> alias_keys cctxt name >>=? fun key_info ->
match key_info with match key_info with

View File

@ -7,4 +7,4 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
val commands: unit -> Client_commands.command list val commands: unit -> Client_context.io_wallet Clic.command list