Revision 2314ff8aef4492aee55f65330d4dc15ed1d5c1f6 authored by Pietro on 23 April 2020, 10:46:43 UTC, committed by Romain on 11 May 2020, 14:42:04 UTC
1 parent 32818f5
client_keys.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type error += Unregistered_key_scheme of string
type error += Invalid_uri of Uri.t
let () =
register_error_kind
`Permanent
~id:"cli.unregistered_key_scheme"
~title:"Unregistered key scheme"
~description:
"A key has been provided with an unregistered scheme (no corresponding \
plugin)"
~pp:(fun ppf s ->
Format.fprintf ppf "No matching plugin for key scheme %s" s)
Data_encoding.(obj1 (req "value" string))
(function Unregistered_key_scheme s -> Some s | _ -> None)
(fun s -> Unregistered_key_scheme s) ;
register_error_kind
`Permanent
~id:"cli.key.invalid_uri"
~title:"Invalid key uri"
~description:"A key has been provided with an invalid uri."
~pp:(fun ppf s -> Format.fprintf ppf "Cannot parse the key uri: %s" s)
Data_encoding.(obj1 (req "value" string))
(function Invalid_uri s -> Some (Uri.to_string s) | _ -> None)
(fun s -> Invalid_uri (Uri.of_string s))
module Public_key_hash = struct
include Client_aliases.Alias (struct
type t = Signature.Public_key_hash.t
let encoding = Signature.Public_key_hash.encoding
let of_source s = Lwt.return (Signature.Public_key_hash.of_b58check s)
let to_source p = return (Signature.Public_key_hash.to_b58check p)
let name = "public key hash"
end)
end
module Logging = struct
let tag = Tag.def ~doc:"Identity" "pk_alias" Format.pp_print_text
end
let uri_encoding = Data_encoding.(conv Uri.to_string Uri.of_string string)
type pk_uri = Uri.t
let make_pk_uri (x : Uri.t) : pk_uri =
match Uri.scheme x with
| None ->
Stdlib.failwith "PK_URI needs a scheme"
| Some _ ->
x
type sk_uri = Uri.t
let make_sk_uri (x : Uri.t) : sk_uri =
match Uri.scheme x with
| None ->
Stdlib.failwith "SK_URI needs a scheme"
| Some _ ->
x
let pk_uri_parameter () =
Clic.parameter (fun _ s ->
try return (make_pk_uri @@ Uri.of_string s)
with Failure s -> failwith "Error while parsing URI: %s" s)
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
Clic.param ~name ~desc (pk_uri_parameter ()) params
let sk_uri_parameter () =
Clic.parameter (fun _ s ->
try return (make_sk_uri @@ Uri.of_string s)
with Failure s -> failwith "Error while parsing URI: %s" s)
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
Clic.param ~name ~desc (sk_uri_parameter ()) params
module Secret_key = Client_aliases.Alias (struct
let name = "secret_key"
type t = Uri.t
let of_source s = return (Uri.of_string s)
let to_source t = return (Uri.to_string t)
let encoding = uri_encoding
end)
module Public_key = Client_aliases.Alias (struct
let name = "public_key"
type t = Uri.t * Signature.Public_key.t option
let of_source s = return (Uri.of_string s, None)
let to_source (t, _) = return (Uri.to_string t)
let encoding =
let open Data_encoding in
union
[ case
Json_only
~title:"Locator_only"
uri_encoding
(function (uri, None) -> Some uri | (_, Some _) -> None)
(fun uri -> (uri, None));
case
Json_only
~title:"Locator_and_full_key"
(obj2
(req "locator" uri_encoding)
(req "key" Signature.Public_key.encoding))
(function (uri, Some key) -> Some (uri, key) | (_, None) -> None)
(fun (uri, key) -> (uri, Some key)) ]
end)
module type SIGNER = sig
val scheme : string
val title : string
val description : string
val neuterize : sk_uri -> pk_uri tzresult Lwt.t
val import_secret_key :
io:Client_context.io_wallet ->
pk_uri ->
(Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult
Lwt.t
val public_key : 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 sign :
?watermark:Signature.watermark ->
sk_uri ->
Bytes.t ->
Signature.t tzresult Lwt.t
val deterministic_nonce : sk_uri -> Bytes.t -> Bigstring.t tzresult Lwt.t
val deterministic_nonce_hash : sk_uri -> Bytes.t -> Bytes.t tzresult Lwt.t
val supports_deterministic_nonces : sk_uri -> bool tzresult Lwt.t
end
let signers_table : (string, (module SIGNER)) Hashtbl.t = Hashtbl.create 13
let register_signer signer =
let module Signer = (val signer : SIGNER) in
Hashtbl.replace signers_table Signer.scheme signer
let find_signer_for_key ~scheme =
match Hashtbl.find_opt signers_table scheme with
| None ->
fail (Unregistered_key_scheme scheme)
| Some signer ->
return signer
let registered_signers () : (string * (module SIGNER)) list =
Hashtbl.fold (fun k v acc -> (k, v) :: acc) signers_table []
type error += Signature_mismatch of sk_uri
let () =
register_error_kind
`Permanent
~id:"cli.signature_mismatch"
~title:"Signature mismatch"
~description:"The signer produced an invalid signature"
~pp:(fun ppf sk ->
Format.fprintf
ppf
"The signer for %a produced an invalid signature"
Uri.pp_hum
sk)
Data_encoding.(obj1 (req "locator" uri_encoding))
(function Signature_mismatch sk -> Some sk | _ -> None)
(fun sk -> Signature_mismatch sk)
let with_scheme_signer (uri : Uri.t) (f : (module SIGNER) -> 'a) : 'a =
match Uri.scheme uri with
| None ->
assert false
| Some scheme ->
find_signer_for_key ~scheme >>=? fun signer -> f signer
let neuterize sk_uri =
with_scheme_signer sk_uri (fun (module Signer : SIGNER) ->
Signer.neuterize sk_uri)
let public_key pk_uri =
with_scheme_signer pk_uri (fun (module Signer : SIGNER) ->
Signer.public_key pk_uri)
let public_key_hash pk_uri =
with_scheme_signer pk_uri (fun (module Signer : SIGNER) ->
Signer.public_key_hash pk_uri)
let import_secret_key ~io pk_uri =
with_scheme_signer pk_uri (fun (module Signer : SIGNER) ->
Signer.import_secret_key ~io pk_uri)
let sign cctxt ?watermark sk_uri buf =
with_scheme_signer sk_uri (fun (module Signer : SIGNER) ->
Signer.sign ?watermark sk_uri buf
>>=? fun signature ->
Signer.neuterize sk_uri
>>=? fun pk_uri ->
Secret_key.rev_find cctxt sk_uri
>>=? (function
| None ->
public_key pk_uri
| Some name -> (
Public_key.find cctxt name
>>=? function
| (_, None) ->
public_key pk_uri
>>=? fun pk ->
Public_key.update cctxt name (pk_uri, Some pk)
>>=? fun () -> return pk
| (_, Some pubkey) ->
return pubkey ))
>>=? fun pubkey ->
fail_unless
(Signature.check ?watermark pubkey signature buf)
(Signature_mismatch sk_uri)
>>=? fun () -> return signature)
let append cctxt ?watermark loc buf =
sign cctxt ?watermark loc buf
>>|? fun signature -> Signature.concat buf signature
let check ?watermark pk_uri signature buf =
public_key pk_uri
>>=? fun pk -> return (Signature.check ?watermark pk signature buf)
let deterministic_nonce sk_uri data =
with_scheme_signer sk_uri (fun (module Signer : SIGNER) ->
Signer.deterministic_nonce sk_uri data)
let deterministic_nonce_hash sk_uri data =
with_scheme_signer sk_uri (fun (module Signer : SIGNER) ->
Signer.deterministic_nonce_hash sk_uri data)
let supports_deterministic_nonces sk_uri =
with_scheme_signer sk_uri (fun (module Signer : SIGNER) ->
Signer.supports_deterministic_nonces sk_uri)
let register_key cctxt ?(force = false) (public_key_hash, pk_uri, sk_uri)
?public_key name =
Public_key.add ~force cctxt name (pk_uri, public_key)
>>=? fun () ->
Secret_key.add ~force cctxt name sk_uri
>>=? fun () ->
Public_key_hash.add ~force cctxt name public_key_hash
>>=? fun () -> return_unit
let raw_get_key (cctxt : #Client_context.wallet) pkh =
Public_key_hash.rev_find cctxt pkh
>>=? (function
| None ->
failwith "no keys for the source contract manager"
| Some n ->
Secret_key.find_opt cctxt n
>>=? fun sk_uri ->
Public_key.find_opt cctxt n
>>=? (function
| None ->
return_none
| Some (_, Some pk) ->
return_some pk
| Some (pk_uri, None) ->
public_key pk_uri
>>=? fun pk ->
Public_key.update cctxt n (pk_uri, Some pk)
>>=? fun () -> return_some pk)
>>=? fun pk -> return (n, pk, sk_uri))
>>= function
| (Ok (_, None, None) | Error _) as initial_result -> (
(* try to lookup for a remote key *)
find_signer_for_key ~scheme:"remote"
>>=? (fun signer ->
let module Signer = (val signer : SIGNER) in
let path = Signature.Public_key_hash.to_b58check pkh in
let uri = Uri.make ~scheme:Signer.scheme ~path () in
Signer.public_key uri
>>=? fun pk -> return (path, Some pk, Some uri))
>>= function
| Error _ ->
Lwt.return initial_result
| Ok _ as success ->
Lwt.return success )
| Ok _ as success ->
Lwt.return success
let get_key cctxt pkh =
raw_get_key cctxt pkh
>>=? function
| (pkh, Some pk, Some sk) ->
return (pkh, pk, sk)
| (_pkh, _pk, None) ->
failwith "Unknown secret key for %a" Signature.Public_key_hash.pp pkh
| (_pkh, None, _sk) ->
failwith "Unknown public key for %a" Signature.Public_key_hash.pp pkh
let get_public_key cctxt pkh =
raw_get_key cctxt pkh
>>=? function
| (pkh, Some pk, _sk) ->
return (pkh, pk)
| (_pkh, None, _sk) ->
failwith "Unknown public key for %a" Signature.Public_key_hash.pp pkh
let get_keys (cctxt : #Client_context.wallet) =
Secret_key.load cctxt
>>=? fun sks ->
Lwt_list.filter_map_s
(fun (name, sk_uri) ->
Public_key_hash.find cctxt name
>>=? (fun pkh ->
Public_key.find cctxt name
>>=? (function
| (_, Some pk) ->
return pk
| (pk_uri, None) ->
public_key pk_uri
>>=? fun pk ->
Public_key.update cctxt name (pk_uri, Some pk)
>>=? fun () -> return pk)
>>=? fun pk -> return (name, pkh, pk, sk_uri))
>>= function Ok r -> Lwt.return_some r | Error _ -> Lwt.return_none)
sks
>>= fun keys -> return keys
let list_keys cctxt =
Public_key_hash.load cctxt
>>=? fun l ->
map_s
(fun (name, pkh) ->
raw_get_key cctxt pkh
>>= function
| Ok (_name, pk, sk_uri) ->
return (name, pkh, pk, sk_uri)
| Error _ ->
return (name, pkh, None, None))
l
let alias_keys cctxt name =
Public_key_hash.find cctxt name
>>=? fun pkh ->
raw_get_key cctxt pkh
>>= function
| Ok (_name, pk, sk_uri) ->
return_some (pkh, pk, sk_uri)
| Error _ ->
return_none
let force_switch () =
Clic.switch ~long:"force" ~short:'f' ~doc:"overwrite existing keys" ()
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...