Prompt for key validation from Ledger (importing)

src/lib_client_base/client_keys.ml

@@ -144,8 +144,12 @@ module type SIGNER = sig
   val title : string
   val description : string
   val neuterize : sk_uri -> pk_uri tzresult Lwt.t
-  val public_key : pk_uri -> Signature.Public_key.t tzresult Lwt.t
+  val public_key :
-  val public_key_hash : pk_uri -> (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
+    ?interactive: Client_context.io_wallet ->
+    pk_uri -> Signature.Public_key.t tzresult Lwt.t
+  val public_key_hash :
+    ?interactive: Client_context.io_wallet ->
+    pk_uri -> (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
   val sign :
     ?watermark: Signature.watermark ->
     sk_uri -> MBytes.t -> Signature.t tzresult Lwt.t
@@ -188,14 +192,14 @@ let neuterize sk_uri =
   let module Signer = (val signer : SIGNER) in
   Signer.neuterize sk_uri
 
-let public_key pk_uri =
+let public_key ?interactive pk_uri =
   let scheme = Option.unopt ~default:"" (Uri.scheme pk_uri) in
   find_signer_for_key ~scheme >>=? fun signer ->
   let module Signer = (val signer : SIGNER) in
-  Signer.public_key pk_uri
+  Signer.public_key ?interactive pk_uri
 
-let public_key_hash pk_uri =
+let public_key_hash ?interactive pk_uri =
-  public_key pk_uri >>=? fun pk ->
+  public_key ?interactive pk_uri >>=? fun pk ->
   return (Signature.Public_key.hash pk, Some pk)
 
 let sign cctxt ?watermark sk_uri buf =

src/lib_client_base/client_keys.mli

@@ -67,13 +67,25 @@ module type SIGNER = sig
   val neuterize : sk_uri -> pk_uri tzresult Lwt.t
   (** [neuterize sk] is the corresponding [pk]. *)
 
-  val public_key : pk_uri -> Signature.Public_key.t tzresult Lwt.t
+  val public_key :
-  (** [public_key pk] is the Ed25519 version of [pk]. *)
+    ?interactive: Client_context.io_wallet ->
+    pk_uri -> Signature.Public_key.t tzresult Lwt.t
+  (** [public_key pk] is the Ed25519 version of [pk]. 
 
-  val public_key_hash : pk_uri -> (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
+      Some signer implementations improve long-term security by
+      requiring human/manual validation while importing keys, the
+      [?interactive] argument can be used to prompt the user in such
+      case. *)
+
+  val public_key_hash :
+    ?interactive: Client_context.io_wallet ->
+    pk_uri ->
+    (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
   (** [public_key_hash pk] is the hash of [pk].
       As some signers will query the full public key to obtain the hash,
-      it can be optionally returned to reduce the amount of queries. *)
+      it can be optionally returned to reduce the amount of queries.
+
+      See {!public_key} for the [?interactive] argument. *)
 
   val sign :
     ?watermark: Signature.watermark ->
@@ -89,9 +101,13 @@ val register_signer : (module SIGNER) -> unit
 
 val registered_signers : unit -> (string * (module SIGNER)) list
 
-val public_key : pk_uri -> Signature.Public_key.t tzresult Lwt.t
+val public_key :
+  ?interactive: Client_context.io_wallet ->
+  pk_uri -> Signature.Public_key.t tzresult Lwt.t
 
-val public_key_hash : pk_uri -> (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
+val public_key_hash :
+  ?interactive: Client_context.io_wallet ->
+  pk_uri -> (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
 
 val neuterize : sk_uri -> pk_uri tzresult Lwt.t
 

src/lib_client_commands/client_keys_commands.ml

@@ -290,7 +290,8 @@ let commands version : Client_context.io_wallet Clic.command list =
                     "public and secret keys '%s' don't correspond, \
                      please don't use --force" name)
          end >>=? fun () ->
-         Client_keys.public_key_hash pk_uri >>=? fun (pkh, public_key) ->
+         Client_keys.public_key_hash ~interactive:cctxt pk_uri
+         >>=? fun (pkh, public_key) ->
          cctxt#message
            "Tezos address added: %a"
            Signature.Public_key_hash.pp pkh >>= fun () ->

src/lib_signer_backends/http_gen.ml

@@ -85,7 +85,7 @@ module Make(N : sig val scheme : string end) = struct
       Lwt.return (Signature.Public_key_hash.of_b58check pkh) >>=? fun pkh ->
       return (base, pkh)
 
-    let public_key uri =
+    let public_key ?interactive:_ uri =
       parse (uri : pk_uri :> Uri.t) >>=? fun (base, pkh) ->
       RPC_client.call_service
         ~logger: P.logger
@@ -96,8 +96,8 @@ module Make(N : sig val scheme : string end) = struct
     let neuterize uri =
       return (Client_keys.make_pk_uri (uri : sk_uri :> Uri.t))
 
-    let public_key_hash uri =
+    let public_key_hash ?interactive uri =
-      public_key uri >>=? fun pk ->
+      public_key ?interactive uri >>=? fun pk ->
       return (Signature.Public_key.hash pk, Some pk)
 
     let sign ?watermark uri msg =

src/lib_signer_backends/ledger.ml

@@ -362,7 +362,8 @@ let path_of_pk_uri (uri : pk_uri) =
       List.map int32_of_path_element_exn path
   | path -> List.map int32_of_path_element_exn path
 
-let public_key (pk_uri : pk_uri) =
+let public_key
+    ?(interactive : Client_context.io_wallet option) (pk_uri : pk_uri) =
   let find_ledger of_pkh = function
     | Pkh pkh -> snd (List.assoc pkh of_pkh)
     | Animals (_, curve) -> curve
@@ -374,7 +375,19 @@ let public_key (pk_uri : pk_uri) =
       with_ledger id begin fun ledger _version _of_curve of_pkh  ->
         let curve = find_ledger of_pkh id in
         let path = path_of_pk_uri pk_uri in
-        get_public_key ledger curve path >>=? fun pk ->
+        begin
+          match interactive with
+          | Some cctxt ->
+              get_public_key ~prompt:false ledger curve path >>=? fun pk ->
+              let pkh = Signature.Public_key.hash pk in
+              cctxt#message
+                "Please validate@ (and write down)@ the public key hash\
+                 @ displayed@ on the Ledger,@ it should be equal@ to `%a`:"
+                Signature.Public_key_hash.pp pkh >>= fun () ->
+              get_public_key ~prompt:true ledger curve path
+          | None ->
+              get_public_key ~prompt:false ledger curve path
+        end >>=? fun pk ->
         let pkh = Signature.Public_key.hash pk in
         Hashtbl.replace pks pk_uri pk ;
         Hashtbl.replace pkhs pk_uri pkh ;
@@ -383,11 +396,11 @@ let public_key (pk_uri : pk_uri) =
       | Error err -> failwith "%a" pp_print_error err
       | Ok v -> return v
 
-let public_key_hash pk_uri =
+let public_key_hash ?interactive pk_uri =
   match Hashtbl.find_opt pkhs pk_uri with
   | Some pkh -> return (pkh, None)
   | None ->
-      public_key pk_uri >>=? fun pk ->
+      public_key ?interactive pk_uri >>=? fun pk ->
       return (Hashtbl.find pkhs pk_uri, Some pk)
 
 let curve_of_id = function

src/lib_signer_backends/remote.ml

@@ -80,12 +80,12 @@ module Make(S : sig
            | path -> Uri.with_path S.default (path ^ "/" ^ key))
     | _ -> assert false
 
-  let public_key pk_uri =
+  let public_key ?interactive pk_uri =
-    Remote.public_key
+    Remote.public_key ?interactive
       (Client_keys.make_pk_uri (key (pk_uri : pk_uri :> Uri.t)))
 
-  let public_key_hash pk_uri =
+  let public_key_hash ?interactive pk_uri =
-    Remote.public_key_hash
+    Remote.public_key_hash ?interactive
       (Client_keys.make_pk_uri (key (pk_uri : pk_uri :> Uri.t)))
 
   let neuterize sk_uri =

src/lib_signer_backends/socket.ml

@@ -93,14 +93,14 @@ module Make(P : sig
           Lwt.return (Signature.Public_key_hash.of_b58check key) >>=? fun key ->
           return (Lwt_utils_unix.Socket.Unix (Uri.path uri), key)
 
-    let public_key uri =
+    let public_key ?interactive:(_) uri =
       parse (uri : pk_uri :> Uri.t) >>=? fun (path, pkh) ->
       public_key path pkh
 
     let neuterize uri =
       return (Client_keys.make_pk_uri (uri : sk_uri :> Uri.t))
 
-    let public_key_hash uri =
+    let public_key_hash ?interactive:(_) uri =
       public_key uri >>=? fun pk ->
       return (Signature.Public_key.hash pk, Some pk)
 
@@ -139,15 +139,15 @@ module Make(P : sig
           return (Lwt_utils_unix.Socket.Tcp (path, string_of_int port,
                                              [Lwt_unix.AI_SOCKTYPE SOCK_STREAM]), pkh)
 
-    let public_key uri =
+    let public_key ?interactive:(_) uri =
       parse (uri : pk_uri :> Uri.t) >>=? fun (path, pkh) ->
       public_key path pkh
 
     let neuterize uri =
       return (Client_keys.make_pk_uri (uri : sk_uri :> Uri.t))
 
-    let public_key_hash uri =
+    let public_key_hash ?interactive uri =
-      public_key uri >>=? fun pk ->
+      public_key ?interactive uri >>=? fun pk ->
       return (Signature.Public_key.hash pk, Some pk)
 
     let sign ?watermark uri msg =

src/lib_signer_backends/unencrypted.ml

@@ -47,7 +47,7 @@ let make_sk sk =
   Client_keys.make_sk_uri
     (Uri.make ~scheme ~path:(Signature.Secret_key.to_b58check sk) ())
 
-let public_key pk_uri =
+let public_key ?interactive:(_) pk_uri =
   Lwt.return
     (Signature.Public_key.of_b58check (Uri.path (pk_uri : pk_uri :> Uri.t)))
 
@@ -59,8 +59,8 @@ let neuterize sk_uri =
   secret_key sk_uri >>=? fun sk ->
   return (make_pk (Signature.Secret_key.to_public_key sk))
 
-let public_key_hash pk_uri =
+let public_key_hash ?interactive pk_uri =
-  public_key pk_uri >>=? fun pk ->
+  public_key ?interactive pk_uri >>=? fun pk ->
   return (Signature.Public_key.hash pk, Some pk)
 
 let sign ?watermark sk_uri buf =