diff --git a/src/lib_clic/clic.ml b/src/lib_clic/clic.ml index e9ee31d49..00822d4ff 100644 --- a/src/lib_clic/clic.ml +++ b/src/lib_clic/clic.ml @@ -32,6 +32,26 @@ type ('p, 'ctx) parameter = let parameter ?autocomplete converter = { converter ; autocomplete } +let compose_parameters { converter = c1; autocomplete = a1' } { converter = c2; autocomplete = a2' } = + { converter = (fun ctx s -> + c1 ctx s >>= function + | Ok r -> return r + | Error _ -> c2 ctx s); + autocomplete = match a1' with + | None -> a2' + | Some a1 -> match a2' with + | None -> a1' + | Some a2 -> Some (fun ctx -> + a1 ctx >>=? fun r1 -> + a2 ctx >>=? fun r2 -> + return (List.concat [r1; r2])) + } + +let map_parameter ~f { converter; autocomplete } = + { converter = (fun ctx s -> converter ctx s >>|? f); + autocomplete + } + type label = { long : string ; short : char option } diff --git a/src/lib_clic/clic.mli b/src/lib_clic/clic.mli index 9aca65a18..395b26910 100644 --- a/src/lib_clic/clic.mli +++ b/src/lib_clic/clic.mli @@ -58,6 +58,15 @@ val parameter : ('ctx -> string -> 'a tzresult Lwt.t) -> ('a, 'ctx) parameter +(** Build an argument parser by composing two other parsers. The + resulting parser will try the first parser and if it fails will + try the second. The auto-complete contents of the two will be + concatenated. *) +val compose_parameters : ('a, 'ctx) parameter -> ('a, 'ctx) parameter -> ('a, 'ctx) parameter + +(** Map a pure function over the result of a parameter parser. *) +val map_parameter : f:('a -> 'b) -> ('a, 'ctx) parameter -> ('b, 'ctx) parameter + (** {2 Flags and Options } *) (** The type for optional arguments (and switches). diff --git a/src/lib_client_base/client_aliases.ml b/src/lib_client_base/client_aliases.ml index 144f9190d..cce4abfa9 100644 --- a/src/lib_client_base/client_aliases.ml +++ b/src/lib_client_base/client_aliases.ml @@ -73,6 +73,7 @@ module type Alias = sig string -> t -> unit tzresult Lwt.t val of_source : string -> t tzresult Lwt.t val to_source : t -> string tzresult Lwt.t + val alias_parameter : unit -> (string * t, #Client_context.wallet) Clic.parameter val alias_param : ?name:string -> ?desc:string -> @@ -200,15 +201,15 @@ module Alias = functor (Entity : Entity) -> struct include Entity + let alias_parameter () = parameter + ~autocomplete + (fun cctxt s -> + find cctxt s >>=? fun v -> + return (s, v)) + let alias_param ?(name = "name") ?(desc = "existing " ^ Entity.name ^ " alias") next = - param ~name ~desc - (parameter - ~autocomplete - (fun (cctxt : #Client_context.wallet) s -> - find cctxt s >>=? fun v -> - return (s, v))) - next + param ~name ~desc (alias_parameter ()) next type fresh_param = Fresh of string diff --git a/src/lib_client_base/client_aliases.mli b/src/lib_client_base/client_aliases.mli index 6b3920682..dee6d3771 100644 --- a/src/lib_client_base/client_aliases.mli +++ b/src/lib_client_base/client_aliases.mli @@ -67,8 +67,9 @@ module type Alias = sig val update : #Client_context.wallet -> string -> t -> unit tzresult Lwt.t - val of_source : string -> t tzresult Lwt.t - val to_source : t -> string tzresult Lwt.t + val of_source : string -> t tzresult Lwt.t + val to_source : t -> string tzresult Lwt.t + val alias_parameter : unit -> (string * t, #Client_context.wallet) Clic.parameter val alias_param : ?name:string -> ?desc:string -> diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml index bb539da5e..136157df4 100644 --- a/src/lib_client_base/client_keys.ml +++ b/src/lib_client_base/client_keys.ml @@ -78,6 +78,10 @@ let make_pk_uri x = x type sk_uri = Uri.t let make_sk_uri x = 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 @@ -85,11 +89,11 @@ let pk_uri_param ?name ?desc params = 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 + 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 @@ -98,12 +102,7 @@ let sk_uri_param ?name ?desc params = 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 + Clic.param ~name ~desc (sk_uri_parameter ()) params module Secret_key = Client_aliases.Alias (struct diff --git a/src/lib_client_base/client_keys.mli b/src/lib_client_base/client_keys.mli index e7664f309..48698b927 100644 --- a/src/lib_client_base/client_keys.mli +++ b/src/lib_client_base/client_keys.mli @@ -28,9 +28,11 @@ type pk_uri = private Uri.t type sk_uri = private Uri.t +val pk_uri_parameter : unit -> (pk_uri, 'a) Clic.parameter val pk_uri_param : ?name:string -> ?desc:string -> ('a, 'b) Clic.params -> (pk_uri -> 'a, 'b) Clic.params +val sk_uri_parameter : unit -> (sk_uri, 'a) Clic.parameter val sk_uri_param : ?name:string -> ?desc:string -> ('a, 'b) Clic.params -> (sk_uri -> 'a, 'b) Clic.params diff --git a/src/lib_signer_backends/ledger.ml b/src/lib_signer_backends/ledger.ml index ea29236c7..b55ae127c 100644 --- a/src/lib_signer_backends/ledger.ml +++ b/src/lib_signer_backends/ledger.ml @@ -153,6 +153,17 @@ let pp_id ppf = function | Some a -> Format.fprintf fmt "/%a" Ledgerwallet_tezos.pp_curve a) curve +let pp_animals_uri ppf (names, curve, path) = + let (root, path_without_root) = List.split_n (List.length tezos_root) path in + if root <> tezos_root then + Format.kasprintf Pervasives.failwith "BIP32 path is missing Tezos BIP32 prefix of %a: %a" Bip32_path.pp_path tezos_root Bip32_path.pp_path path + else + Format.fprintf ppf "ledger://%a%a" pp_id (Animals (names, Some curve)) + (fun fmt -> function + | [] -> Format.fprintf fmt "" + | xs -> Format.fprintf fmt "/%a" Bip32_path.pp_path xs) + path_without_root + let parse_animals animals = match String.split '-' animals with | [c; t; h; d] -> Some { Ledger_names.c ; t ; h ; d } @@ -184,6 +195,20 @@ let id_of_uri uri = let id_of_pk_uri (uri : pk_uri) = id_of_uri (uri :> Uri.t) let id_of_sk_uri (uri : sk_uri) = id_of_uri (uri :> Uri.t) +let sk_or_alias_param next = + let name = "account-alias-or-ledger-uri" in + let desc = "An imported ledger alias or a ledger URI (e.g. 'ledger://animal/curve/path')." in + let open Clic in + (* Order of parsers is important: The secret key parser accepts far more inputs so must come last. *) + param ~name ~desc (compose_parameters + (map_parameter ~f:(fun (_, (x, _)) -> `Pk_uri x) (Public_key.alias_parameter ())) + (map_parameter ~f:(fun x -> `Sk_uri x) (Client_keys.sk_uri_parameter ()))) + next + +let id_of_sk_or_pk = function + | `Sk_uri sk -> id_of_sk_uri sk + | `Pk_uri pk -> id_of_pk_uri pk + let wrap_ledger_cmd f = let buf = Buffer.create 100 in let pp = Format.formatter_of_buffer buf in @@ -454,7 +479,7 @@ let public_key_hash ?interactive pk_uri = let curve_of_id = function | Pkh pkh -> return (curve_of_pkh pkh) - | Animals (a, curve_opt) -> unopt_curve a curve_opt + | Animals (a, curve_opt) -> unopt_curve a curve_opt (* The Ledger uses a special value 0x00000000 for the “any” chain-id: *) let pp_ledger_chain_id fmt s = @@ -527,7 +552,7 @@ let commands = find_ledgers () >>=? function | [] -> cctxt#message "No device found." >>= fun () -> - cctxt#message "Make sure a Ledger Nano S is connected and in the Tezos Wallet app." >>= fun () -> + cctxt#message "Make sure a Ledger Nano S is connected and in the Tezos Wallet or Tezos Baking app." >>= fun () -> return_unit | ledgers -> iter_s begin fun { Ledger.device_info = { Hidapi.path ; @@ -635,24 +660,45 @@ let commands = ~desc: "Query the path of the authorized key" no_options (prefixes [ "get" ; "ledger" ; "authorized" ; "path" ; "for" ] - @@ Public_key.alias_param + @@ sk_or_alias_param @@ stop) - (fun () (name, (pk_uri, _)) (cctxt : Client_context.full) -> - id_of_pk_uri pk_uri >>=? fun root_id -> - with_ledger root_id begin fun h _version _of_curve _to_curve -> - wrap_ledger_cmd begin fun pp -> - Ledgerwallet_tezos.get_authorized_key ~pp h - end >>=? function - | [] -> + (fun () uri (cctxt : Client_context.full) -> + id_of_sk_or_pk uri >>=? fun root_id -> + with_ledger root_id begin fun h version _of_curve _to_curve -> + (if version.major < 2 then + wrap_ledger_cmd (fun pp -> Ledgerwallet_tezos.get_authorized_key ~pp h) + >>|? fun path -> (path, None) + else + wrap_ledger_cmd (fun pp -> Ledgerwallet_tezos.get_authorized_path_and_curve ~pp h) + >>= function + | Error (LedgerError (AppError {status = Ledgerwallet.Transport.Status.Referenced_data_not_found; _}) :: _) -> return ([], None) + | Error _ as e -> Lwt.return e + | Ok (path, curve) -> return (path, Some curve)) + >>=? function + | ([], _) -> cctxt#message - "@[No baking key authorized for %s@]" name + "@[No baking key authorized for %a@]" pp_id root_id >>= fun () -> return_unit - | path -> + | (path, None) -> cctxt#message "@[Authorized baking path: %a@]" Bip32_path.pp_path path >>= fun () -> return_unit + | (path, Some curve) -> + cctxt#message + "@[Authorized baking path: %a@]" + Bip32_path.pp_path path >>= fun () -> + cctxt#message + "@[Authorized baking curve: %a@]" + Ledgerwallet_tezos.pp_curve curve >>= fun () -> + (match root_id with + | Pkh _ -> cctxt#message "@[Authorized baking PKH: %a@]" + pp_id root_id + | Animals (cthd, _) -> cctxt#message "@[Authorized baking URI: %a@]" + pp_animals_uri (cthd, curve, path)) + >>= fun () -> + return_unit end) ; Clic.command ~group @@ -800,16 +846,39 @@ let commands = return_unit end) ; + Clic.command ~group + ~desc: "Deauthorize Ledger from baking" + no_options + (prefixes [ "deauthorize" ; "ledger" ; "baking" ; "for" ] + @@ sk_or_alias_param + @@ stop) + (fun () uri (_ : Client_context.full) -> + id_of_sk_or_pk uri >>=? fun id -> + with_ledger id begin fun h version _ _ -> + match version.app_class with + | Tezos -> + failwith "Fatal: this operation is only valid with the \ + Tezos Baking application" + | TezBake when version.major < 2 -> + failwith "Fatal: this operation is only available with \ + Tezos Baking application version 2 or higher" + | TezBake -> + wrap_ledger_cmd begin fun pp -> + Ledgerwallet_tezos.deauthorize_baking ~pp h + end + end + ); + Clic.command ~group ~desc: "Get high water mark of a Ledger" (args1 (switch ~doc:"Prevent the fallback to the (deprecated) Ledger \ instructions (for 1.x.y versions of the Baking app)" ~long:"no-legacy-instructions" ())) (prefixes [ "get" ; "ledger" ; "high" ; "watermark" ; "for" ] - @@ Client_keys.sk_uri_param + @@ sk_or_alias_param @@ stop) - (fun no_legacy_apdu sk_uri (cctxt : Client_context.full) -> - id_of_sk_uri sk_uri >>=? fun id -> + (fun no_legacy_apdu uri (cctxt : Client_context.full) -> + id_of_sk_or_pk uri >>=? fun id -> with_ledger id begin fun h version _ _ -> match version.app_class with | Tezos -> @@ -847,7 +916,7 @@ let commands = ~desc: "Set high water mark of a Ledger" no_options (prefixes [ "set" ; "ledger" ; "high" ; "watermark" ; "for" ] - @@ Client_keys.sk_uri_param + @@ sk_or_alias_param @@ (prefix "to") @@ (param ~name: "high watermark" @@ -856,8 +925,8 @@ let commands = try return (Int32.of_string s) with _ -> failwith "%s is not an int32 value" s))) @@ stop) - (fun () sk_uri hwm (cctxt : Client_context.full) -> - id_of_sk_uri sk_uri >>=? fun id -> + (fun () uri hwm (cctxt : Client_context.full) -> + id_of_sk_or_pk uri >>=? fun id -> with_ledger id begin fun h version _ _ -> match version.app_class with | Tezos -> diff --git a/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml b/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml index 6868bef29..0b55b9aec 100644 --- a/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml +++ b/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml @@ -66,6 +66,8 @@ type ins = | Get_authorized_key | Setup | Query_all_high_watermarks + | Deauthorize_baking + | Get_authorized_path_and_curve let int_of_ins = function | Version -> 0x00 @@ -80,6 +82,8 @@ let int_of_ins = function | Get_authorized_key -> 0x07 | Setup -> 0x0A | Query_all_high_watermarks -> 0x0B + | Deauthorize_baking -> 0x0C + | Get_authorized_path_and_curve -> 0x0D type curve = | Ed25519 @@ -108,6 +112,21 @@ let int_of_curve = function | Secp256k1 -> 0x01 | Secp256r1 -> 0x02 +let curve_of_int = function + | 0x00 -> Some Ed25519 + | 0x01 -> Some Secp256k1 + | 0x02 -> Some Secp256r1 + | _ -> None + +type Transport.Status.t += + Tezos_invalid_curve_code of int + +let () = Transport.Status.register_string_f begin function + | Tezos_invalid_curve_code curve_code -> + Some ("Unrecognized curve code: " ^ string_of_int curve_code) + | _ -> None + end + let wrap_ins cmd = Apdu.create_cmd ~cmd ~cla_of_cmd:(fun _ -> 0x80) ~ins_of_cmd:int_of_ins @@ -121,15 +140,30 @@ let get_git_commit ?pp ?buf h = Transport.apdu ~msg:"get_git_commit" ?pp ?buf h apdu >>| Cstruct.to_string +let read_path_with_length buf = + let length = Cstruct.get_uint8 buf 0 in + let rec go acc path = + if Cstruct.len path = 0 || List.length acc = length then List.rev acc + else + go (Cstruct.BE.get_uint32 path 0 :: acc) + (Cstruct.shift path 4) in + go [] (Cstruct.shift buf 1) + let get_authorized_key ?pp ?buf h = let apdu = Apdu.create (wrap_ins Get_authorized_key) in Transport.apdu ~msg:"get_authorized_key" ?pp ?buf h apdu >>| fun path -> - let rec read_numbers acc path = - if Cstruct.len path = 0 then List.rev acc - else - read_numbers (Cstruct.BE.get_uint32 path 0 :: acc) - (Cstruct.shift path 4) in - read_numbers [] (Cstruct.shift path 1) + read_path_with_length path + +let get_authorized_path_and_curve ?pp ?buf h = + let apdu = Apdu.create (wrap_ins Get_authorized_path_and_curve) in + Transport.apdu ~msg:"get_authorized_path_and_curve" ?pp ?buf h apdu >>= fun payload -> + let curve_code = Cstruct.get_uint8 payload 0 in + match curve_of_int curve_code with + | None -> + Transport.app_error ~msg:"get_authorized_path_and_curve" (R.error (Tezos_invalid_curve_code curve_code)) + | Some curve -> + let path_components = read_path_with_length (Cstruct.shift payload 1) in + R.ok (path_components, curve) let write_path cs path = ListLabels.fold_left path ~init:cs ~f:begin fun cs i -> @@ -168,7 +202,7 @@ let setup_baking ?pp ?buf h ~main_chain_id ~main_hwm ~test_hwm curve path = (3 * 4) + 1 + (4 * nb_derivations) in let data_init = Cstruct.create lc in (* If the size of chain-ids changes, then all assumptions of this - binary format are broken (the ledger expects an int32). *) + binary format are broken (the ledger expects a uint32). *) assert (String.length main_chain_id = 4) ; for ith = 0 to 3 do Cstruct.set_uint8 data_init ith (int_of_char main_chain_id.[ith]) ; @@ -187,6 +221,11 @@ let setup_baking ?pp ?buf h ~main_chain_id ~main_hwm ~test_hwm curve path = let keylen = Cstruct.get_uint8 addr 0 in Cstruct.sub addr 1 keylen +let deauthorize_baking ?pp ?buf h = + let apdu = Apdu.create (wrap_ins Deauthorize_baking) in + Transport.apdu ~msg:"deauthorize_baking" ?pp ?buf h apdu >>| fun _ -> + () + let get_high_watermark ?pp ?buf h = let apdu = Apdu.create (wrap_ins Query_high_watermark) in Transport.apdu ~msg:"get_high_watermark" ?pp ?buf h apdu >>| fun hwm -> diff --git a/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli b/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli index 2e2eefff3..a4537eb90 100644 --- a/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli +++ b/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli @@ -48,6 +48,14 @@ val get_authorized_key : (** [get_authorized_key ?pp ?buf ledger] is the BIP32 path of the key authorized to bake on the Ledger app running at [ledger]. *) +val get_authorized_path_and_curve : + ?pp:Format.formatter -> ?buf:Cstruct.t -> + Hidapi.t -> (int32 list * curve, Transport.error) result +(** [get_authorized_path_and_curve ?pp ?buf ledger] is the BIP32 path + and the curve code of the key authorized to bake on the Ledger app + running at [ledger]. *) + + val get_public_key : ?prompt:bool -> ?pp:Format.formatter -> @@ -80,6 +88,11 @@ val setup_baking : indicates that the key at the given [curve/path] is authorized for baking. *) +val deauthorize_baking : + ?pp:Format.formatter -> ?buf:Cstruct.t -> Hidapi.t -> (unit, Transport.error) result +(** [deauthorize_baking ?pp ?buf ledger] + deauthorizes the Ledger's Baking application from baking for any address. *) + val get_high_watermark : ?pp:Format.formatter -> ?buf:Cstruct.t -> Hidapi.t -> (int32, Transport.error) result @@ -102,7 +115,7 @@ val set_high_watermark : Hidapi.t -> int32 -> (unit, Transport.error) result (** [set_high_watermark ?pp ?buf ledger hwm] reset the high water mark on [ledger] to [hwm] for the main-chain. - This works with the baking app only. Use {!setup_baking} to be able to also + This works with the baking app only. Use {!setup_baking} to be able to also reset all the test-chain water mark. *) val sign : diff --git a/vendors/ocaml-ledger-wallet/src/transport.ml b/vendors/ocaml-ledger-wallet/src/transport.ml index 009c50a59..1206c779f 100644 --- a/vendors/ocaml-ledger-wallet/src/transport.ml +++ b/vendors/ocaml-ledger-wallet/src/transport.ml @@ -32,6 +32,7 @@ module Status = struct | Incorrect_class | Ins_not_supported | Memory_error + | Referenced_data_not_found | Technical_problem of int | Ok | Unknown of int @@ -52,6 +53,7 @@ module Status = struct | 0x9000 -> Ok | 0x917e -> Incorrect_length_for_ins | 0x9200 -> Memory_error + | 0x6a88 -> Referenced_data_not_found | v when v >= 0x63c0 && v <= 0x63cf -> Invalid_pin (v land 0x0f) | v when v >= 0x6f00 && v <= 0x6fff -> Technical_problem (v land 0xff) | v -> Unknown v @@ -71,6 +73,7 @@ module Status = struct | Incorrect_params -> "Incorrect params" | Ins_not_supported -> "Instruction not supported" | Technical_problem i -> "Technical problem " ^ string_of_int i + | Referenced_data_not_found -> "Referenced data not found" | Ok -> "Ok" | Unknown i -> Printf.sprintf "Unknown status code 0x%x" i | t -> diff --git a/vendors/ocaml-ledger-wallet/src/transport.mli b/vendors/ocaml-ledger-wallet/src/transport.mli index f235a3b16..e505a3c4b 100644 --- a/vendors/ocaml-ledger-wallet/src/transport.mli +++ b/vendors/ocaml-ledger-wallet/src/transport.mli @@ -20,6 +20,7 @@ module Status : sig | Incorrect_class | Ins_not_supported | Memory_error + | Referenced_data_not_found | Technical_problem of int | Ok