From 664f36a46ad5d64d131bb6b85d018b1ff5cb5ee4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sat, 26 May 2018 10:52:34 +0200 Subject: [PATCH] Client: less restrictive type for `Client_keys_commands.commands` --- src/bin_client/main_client.ml | 5 ++++- src/bin_client/main_signer.ml | 12 ++++++++---- src/lib_client_base/client_aliases.ml | 2 +- src/lib_client_base/client_aliases.mli | 2 +- src/lib_client_base/client_keys.ml | 2 +- src/lib_client_base/client_keys.mli | 4 ++-- src/lib_client_commands/client_keys_commands.ml | 10 +++++----- src/lib_client_commands/client_keys_commands.mli | 2 +- 8 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml index c596ca115..b4c3a11f3 100644 --- a/src/bin_client/main_client.ml +++ b/src/bin_client/main_client.ml @@ -42,7 +42,10 @@ let get_commands_for_version ctxt block protocol = let select_commands ctxt { block ; protocol } = get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version) -> 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 () @ commands_for_version diff --git a/src/bin_client/main_signer.ml b/src/bin_client/main_signer.ml index 1a024024b..e666275b4 100644 --- a/src/bin_client/main_signer.ml +++ b/src/bin_client/main_signer.ml @@ -11,7 +11,7 @@ open Client_signer_remote_messages 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 Connection.bind path >>=? fun (fd, display_path) -> let rec loop () = @@ -80,7 +80,7 @@ let run_socket_daemon (cctxt : #Client_context_unix.unix_full) path = end >>= fun () -> 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 base (host, port) >>=? fun (host, port) -> log "Accepting HTTPS requests on port %d" port >>= fun () -> @@ -148,7 +148,10 @@ let group = let select_commands _ _ = return - (List.flatten + (List.map + (Clic.map_command + (fun (o : Client_context.full) -> (o :> Client_context.io_wallet))) @@ + List.flatten [ Client_keys_commands.commands () ; [ command ~group ~desc: "Launch a signer daemon over a TCP socket." @@ -213,4 +216,5 @@ let select_commands _ _ = run_https_daemon cctxt host port cert key) ; ]]) -let () = Client_main_run.run select_commands +let () = + Client_main_run.run select_commands diff --git a/src/lib_client_base/client_aliases.ml b/src/lib_client_base/client_aliases.ml index e019c760c..166340209 100644 --- a/src/lib_client_base/client_aliases.ml +++ b/src/lib_client_base/client_aliases.ml @@ -68,7 +68,7 @@ module type Alias = sig ('a, (< .. > as 'obj)) Clic.params -> (fresh_param -> 'a, 'obj) Clic.params val force_switch : - unit -> (bool, #Client_context.full) arg + unit -> (bool, _) arg val of_fresh : #Client_context.wallet -> bool -> diff --git a/src/lib_client_base/client_aliases.mli b/src/lib_client_base/client_aliases.mli index 319efb758..514d98328 100644 --- a/src/lib_client_base/client_aliases.mli +++ b/src/lib_client_base/client_aliases.mli @@ -64,7 +64,7 @@ module type Alias = sig ('a, (< .. > as 'obj)) Clic.params -> (fresh_param -> 'a, 'obj) Clic.params val force_switch : - unit -> (bool, #Client_context.full) Clic.arg + unit -> (bool, _) Clic.arg val of_fresh : #Client_context.wallet -> bool -> diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml index 1db24608c..fb86253d3 100644 --- a/src/lib_client_base/client_keys.ml +++ b/src/lib_client_base/client_keys.ml @@ -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 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 = List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in match unrepresentable with diff --git a/src/lib_client_base/client_keys.mli b/src/lib_client_base/client_keys.mli index 197fbfa73..de13ceb32 100644 --- a/src/lib_client_base/client_keys.mli +++ b/src/lib_client_base/client_keys.mli @@ -135,7 +135,7 @@ val gen_keys_containing : ?force:bool -> containing:string list -> name:string -> - #Client_context.full -> unit tzresult Lwt.t + #Client_context.io_wallet -> unit tzresult Lwt.t val list_keys : #Client_context.wallet -> @@ -154,4 +154,4 @@ val get_keys: #Client_context.io_wallet -> (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 diff --git a/src/lib_client_commands/client_keys_commands.ml b/src/lib_client_commands/client_keys_commands.ml index 353c29ad6..863511369 100644 --- a/src/lib_client_commands/client_keys_commands.ml +++ b/src/lib_client_commands/client_keys_commands.ml @@ -43,7 +43,7 @@ let commands () = version of the tezos client supports." no_options (fixed [ "list" ; "signing" ; "schemes" ]) - (fun () (cctxt : #Client_context.full) -> + (fun () (cctxt : Client_context.io_wallet) -> let signers = List.sort (fun (ka, _) (kb, _) -> String.compare ka kb) @@ -59,7 +59,7 @@ let commands () = (prefixes [ "gen" ; "keys" ] @@ Secret_key.fresh_alias_param @@ 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 -> gen_keys ~force ~algo cctxt name) ; @@ -75,7 +75,7 @@ let commands () = @@ 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 -> + (fun (prefix, force) name containing (cctxt : #Client_context.io_wallet) -> Public_key_hash.of_fresh cctxt force name >>=? fun name -> gen_keys_containing ~force ~prefix ~containing ~name cctxt) ; @@ -159,7 +159,7 @@ let commands () = command ~group ~desc: "List all identities and associated keys." no_options (fixed [ "list" ; "known" ; "identities" ]) - (fun () (cctxt : #Client_context.full) -> + (fun () (cctxt : #Client_context.io_wallet) -> list_keys cctxt >>=? fun l -> iter_s begin fun (name, pkh, pk, sk) -> Public_key_hash.to_source pkh >>=? fun v -> @@ -178,7 +178,7 @@ let commands () = (prefixes [ "show" ; "identity"] @@ Public_key_hash.alias_param @@ 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 alias_keys cctxt name >>=? fun key_info -> match key_info with diff --git a/src/lib_client_commands/client_keys_commands.mli b/src/lib_client_commands/client_keys_commands.mli index cd41b6053..e4d448d02 100644 --- a/src/lib_client_commands/client_keys_commands.mli +++ b/src/lib_client_commands/client_keys_commands.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -val commands: unit -> Client_commands.command list +val commands: unit -> Client_context.io_wallet Clic.command list