From 8bc9695ad0670d14cf2cf4229c3c32bdf6860c71 Mon Sep 17 00:00:00 2001
From: Vincent Bernardoff <vb@luminar.eu.org>
Date: Thu, 14 Jun 2018 18:49:50 +0200
Subject: [PATCH] Client: add `{sk,pk}_uri_param`

---
 src/lib_client_base/client_keys.ml            | 27 +++++++++++++++++++
 src/lib_client_base/client_keys.mli           |  7 +++++
 .../client_keys_commands.ml                   | 20 ++------------
 3 files changed, 36 insertions(+), 18 deletions(-)

diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml
index 364c72fe8..a8e2553d8 100644
--- a/src/lib_client_base/client_keys.ml
+++ b/src/lib_client_base/client_keys.ml
@@ -65,6 +65,33 @@ let make_pk_uri x = x
 type sk_uri = Uri.t
 let make_sk_uri x = x
 
+let pk_uri_param ?name ?desc params =
+  let name = Option.unopt ~default:"uri" name in
+  let desc = Option.unopt
+      ~default:"public key\n\
+                Varies from one scheme to the other.\n\
+                Use command `list signing schemes` for more \
+                information." desc in
+  let open Clic in
+  param ~name ~desc (parameter (fun _ s ->
+      try return (make_pk_uri @@ Uri.of_string s)
+      with Failure s -> failwith "Error while parsing uri: %s" s))
+    params
+
+let sk_uri_param ?name ?desc params =
+  let name = Option.unopt ~default:"uri" name in
+  let desc = Option.unopt
+      ~default:"secret key\n\
+                Varies from one scheme to the other.\n\
+                Use command `list signing schemes` for more \
+                information." desc in
+  let open Clic in
+  param ~name ~desc
+    (parameter (fun _ s ->
+         try return (make_sk_uri @@ Uri.of_string s)
+         with Failure s -> failwith "Error while parsing uri: %s" s))
+    params
+
 module Secret_key =
   Client_aliases.Alias (Entity(struct let name = "secret_key" end))
 module Public_key =
diff --git a/src/lib_client_base/client_keys.mli b/src/lib_client_base/client_keys.mli
index 48a12c63c..57470fe99 100644
--- a/src/lib_client_base/client_keys.mli
+++ b/src/lib_client_base/client_keys.mli
@@ -12,6 +12,13 @@
 type pk_uri = private Uri.t
 type sk_uri = private Uri.t
 
+val pk_uri_param :
+  ?name:string -> ?desc:string ->
+  ('a, 'b) Clic.params -> (pk_uri -> 'a, 'b) Clic.params
+val sk_uri_param :
+  ?name:string -> ?desc:string ->
+  ('a, 'b) Clic.params -> (sk_uri -> 'a, 'b) Clic.params
+
 type error += Unregistered_key_scheme of string
 type error += Invalid_uri of Uri.t
 
diff --git a/src/lib_client_commands/client_keys_commands.ml b/src/lib_client_commands/client_keys_commands.ml
index fcf1d56fe..ac9a8b015 100644
--- a/src/lib_client_commands/client_keys_commands.ml
+++ b/src/lib_client_commands/client_keys_commands.ml
@@ -166,15 +166,7 @@ let commands () : Client_context.io_wallet Clic.command list =
       (prefix "import"
        @@ prefixes [ "secret" ; "key" ]
        @@ Secret_key.fresh_alias_param
-       @@ param
-         ~name:"uri"
-         ~desc:"secret key\n\
-                Varies from one scheme to the other.\n\
-                Use command `list signing schemes` for more \
-                information."
-         (parameter (fun _ s ->
-              try return (Client_keys.make_sk_uri @@ Uri.of_string s)
-              with Failure s -> failwith "Error while parsing uri: %s" s))
+       @@ Client_keys.sk_uri_param
        @@ stop)
       (fun force name sk_uri (cctxt : Client_context.io_wallet) ->
          Secret_key.of_fresh cctxt force name >>=? fun name ->
@@ -196,15 +188,7 @@ let commands () : Client_context.io_wallet Clic.command list =
       (prefix "import"
        @@ prefixes [ "public" ; "key" ]
        @@ Public_key.fresh_alias_param
-       @@ param
-         ~name:"uri"
-         ~desc:"public key\n\
-                Varies from one scheme to the other.\n\
-                Use command `list signing schemes` for more \
-                information."
-         (parameter (fun _ s ->
-              try return (Client_keys.make_pk_uri @@ Uri.of_string s)
-              with Failure s -> failwith "Error while parsing uri: %s" s))
+       @@ Client_keys.pk_uri_param
        @@ stop)
       (fun force name pk_uri (cctxt : Client_context.io_wallet) ->
          Public_key.of_fresh cctxt force name >>=? fun name ->