Add support for test-chain-related APDUs

src/bin_client/main_client.ml

@@ -127,11 +127,11 @@ let select_commands ctxt { block ; protocol } =
   check_network ctxt >>= fun network ->
   get_commands_for_version ctxt network block protocol >>|? fun (_, commands_for_version)  ->
   Client_rpc_commands.commands @
+  Tezos_signer_backends.Ledger.commands () @
   List.map
     (Clic.map_command
        (fun (o : Client_context.full) -> (o :> Client_context.io_wallet)))
-    (Tezos_signer_backends.Ledger.commands () @
+    (Client_keys_commands.commands network) @
-     Client_keys_commands.commands network) @
   Client_helpers_commands.commands () @
   commands_for_version
 

src/bin_signer/main_signer.ml

@@ -118,7 +118,7 @@ let may_setup_pidfile = function
 
 let commands base_dir require_auth =
   Client_keys_commands.commands None @
-  Tezos_signer_backends.Ledger.commands () @
+  (* Tezos_signer_backends.Ledger.commands () @ *)
   [ command ~group
       ~desc: "Launch a signer daemon over a TCP socket."
       (args5

src/lib_signer_backends/dune

@@ -6,6 +6,7 @@
             tezos-client-base
             tezos-rpc-http
             tezos-signer-services
+            tezos-shell-services
             pbkdf
             bip39
             ledgerwallet-tezos)
@@ -13,6 +14,7 @@
                    -open Tezos_stdlib_unix
                    -open Tezos_client_base
                    -open Tezos_signer_services
+                   -open Tezos_shell_services
                    -open Tezos_rpc_http)))
 
 (alias

src/lib_signer_backends/ledger.ml

@@ -195,19 +195,23 @@ let wrap_ledger_cmd f =
   | Ok v ->
       return v
 
-let get_public_key
+let public_key_returning_instruction which
-    ?(authorize_baking=false)
     ?(prompt=false)
     ledger curve path =
   let path = tezos_root @ path in
-  begin match authorize_baking with
+  begin match which with
-    | false -> wrap_ledger_cmd begin fun pp ->
+    | `Get_public_key -> wrap_ledger_cmd begin fun pp ->
         Ledgerwallet_tezos.get_public_key ~prompt ~pp ledger curve path
       end
-    | true ->
+    | `Authorize_baking ->
         wrap_ledger_cmd begin fun pp ->
           Ledgerwallet_tezos.authorize_baking ~pp ledger curve path
         end
+    | `Setup (main_chain_id, main_hwm, test_hwm) ->
+        wrap_ledger_cmd begin fun pp ->
+          Ledgerwallet_tezos.setup_baking ~pp ledger curve path
+            ~main_chain_id ~main_hwm ~test_hwm
+        end
   end >>|? fun pk ->
   let pk = Cstruct.to_bigarray pk in
   match curve with
@@ -233,6 +237,8 @@ let get_public_key
           let _nb_written = write_key ~compress:true (MBytes.sub buf 1 pklen) pk in
           Data_encoding.Binary.of_bytes_exn Signature.Public_key.encoding buf
 
+let get_public_key = public_key_returning_instruction `Get_public_key
+
 module Ledger = struct
   type t = {
     device_info : Hidapi.device_info ;
@@ -511,7 +517,7 @@ let commands =
         ~desc: "List supported Ledger Nano S devices connected."
         no_options
         (fixed [ "list" ; "connected" ; "ledgers" ])
-        (fun () (cctxt : Client_context.io_wallet) ->
+        (fun () (cctxt : Client_context.full) ->
            find_ledgers () >>=? function
            | [] ->
                cctxt#message "No device found." >>= fun () ->
@@ -557,7 +563,7 @@ let commands =
         (prefixes [ "show" ; "ledger" ]
          @@ Client_keys.sk_uri_param
          @@ stop)
-        (fun test_sign sk_uri (cctxt : Client_context.io_wallet) ->
+        (fun test_sign sk_uri (cctxt : Client_context.full) ->
            neuterize sk_uri >>=? fun pk_uri ->
            id_of_pk_uri pk_uri >>=? fun id ->
            find_ledgers ~id () >>=? function
@@ -625,7 +631,7 @@ let commands =
         (prefixes [ "get" ; "ledger" ; "authorized" ; "path" ; "for" ]
          @@ Public_key.alias_param
          @@ stop)
-        (fun () (name, (pk_uri, _)) (cctxt : Client_context.io_wallet) ->
+        (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 ->
@@ -644,17 +650,103 @@ let commands =
            end) ;
 
       Clic.command ~group
-        ~desc: "Authorize a Ledger to bake for a key"
+        ~desc: "Authorize a Ledger to bake for a key (deprecated, \
+                use `setup ledger ...` with recent versions of the Baking app)"
         no_options
         (prefixes [ "authorize" ; "ledger" ; "to" ; "bake" ; "for" ]
          @@ Public_key.alias_param
          @@ stop)
-        (fun () (_, (pk_uri, _)) (cctxt : Client_context.io_wallet) ->
+        (fun () (_, (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 _of_pkh ->
              let path = path_of_pk_uri pk_uri in
              curve_of_id root_id >>=? fun curve ->
-             get_public_key ~authorize_baking:true h curve path >>=? fun pk ->
+             public_key_returning_instruction `Authorize_baking h curve path
+             >>=? fun pk ->
+             let pkh = Signature.Public_key.hash pk in
+             cctxt#message
+               "@[<v 0>Authorized baking for address: %a@,\
+                Corresponding full public key: %a@]"
+               Signature.Public_key_hash.pp pkh
+               Signature.Public_key.pp pk >>= fun () ->
+             return_unit
+           end) ;
+
+      Clic.command ~group
+        ~desc: "Setup a Ledger to bake for a key"
+        (let hwm_arg kind =
+           let doc =
+             Printf.sprintf
+               "Use <HWM> as %s chain high watermark instead of asking the ledger."
+               kind in
+           let long = kind ^ "-hwm" in
+           default_arg ~doc ~long ~placeholder:"HWM"
+             ~default:"ASK-LEDGER"
+             (parameter
+                (fun _ -> function
+                   | "ASK-LEDGER" -> return None
+                   | s ->
+                       try return (Some (Int32.of_string s)) with _ ->
+                         failwith "Parameter %S should be a 32-bits integer" s))
+         in
+         args3
+           (default_arg
+              ~doc:"Use <ID> as main chain-id instead of asking the node."
+              ~long:"main-chain-id" ~placeholder:"ID"
+              ~default:"ASK-NODE"
+              (parameter
+                 (fun _ -> function
+                    | "ASK-NODE" -> return `Ask_node
+                    | s ->
+                        try return (`Int32 (Int32.of_string s))
+                        with _ ->
+                          (try return (`Chain_id (Chain_id.of_b58check_exn s))
+                           with _ ->
+                             failwith "Parameter %S should be a 32-bits integer \
+                                       or a Base58 chain-id" s))))
+           (hwm_arg "main") (hwm_arg "test"))
+        (prefixes [ "setup" ; "ledger" ; "to" ; "bake" ; "for" ]
+         @@ Public_key.alias_param
+         @@ stop)
+        (fun (chain_id_opt, main_hwm_opt, test_hwm_opt)
+          (_, (pk_uri, _)) (cctxt : Client_context.full) ->
+          let chain_id_of_int32 i32 =
+            let open Int32 in
+            let byte n =
+              logand 0xFFl (shift_right i32 (n * 8))
+              |> Int32.to_int |> char_of_int in
+            Chain_id.of_string_exn
+              (Stringext.of_array (Array.init 4 (fun i -> byte (3 - i)))) in
+          begin match chain_id_opt with
+            | `Ask_node ->
+                Chain_services.chain_id cctxt ()
+            | `Int32 s -> return (chain_id_of_int32 s)
+            | `Chain_id chid -> return chid
+          end
+          >>=? fun main_chain_id ->
+          id_of_pk_uri pk_uri >>=? fun root_id ->
+          with_ledger root_id begin fun h _version _of_curve _of_pkh ->
+            let path = path_of_pk_uri pk_uri in
+            curve_of_id root_id >>=? fun curve ->
+            wrap_ledger_cmd begin fun pp ->
+              Ledgerwallet_tezos.get_all_high_watermarks ~pp h
+            end
+            >>=? fun (`Main_hwm current_mh, `Test_hwm current_th, `Chain_id current_ci) ->
+            let main_hwm = Option.unopt main_hwm_opt ~default:current_mh in
+            let test_hwm = Option.unopt test_hwm_opt ~default:current_th in
+            cctxt#message "Setting up the ledger:@.\
+                           * Main chain ID: %a -> %a@.\
+                           * Main chain High Watermark: %ld -> %ld@.\
+                           * Test chain High Watermark: %ld -> %ld"
+              Chain_id.pp (Chain_id.of_string_exn current_ci)
+              Chain_id.pp main_chain_id
+              current_mh main_hwm
+              current_th test_hwm
+            >>= fun () ->
+            public_key_returning_instruction
+              (`Setup (Chain_id.to_string main_chain_id, main_hwm, test_hwm))
+              h curve path
+            >>=? fun pk ->
             let pkh = Signature.Public_key.hash pk in
             cctxt#message
               "@[<v 0>Authorized baking for address: %a@,\
@@ -666,24 +758,39 @@ let commands =
 
       Clic.command ~group
         ~desc: "Get high water mark of a Ledger"
-        no_options
+        (args1 (switch ~doc:"Use the (deprecated) Ledger instructions \
+                             (for older versions of the Baking app)"
+                  ~long:"use-legacy-instructions" ()))
         (prefixes [ "get" ; "ledger" ; "high" ; "watermark" ; "for" ]
          @@ Client_keys.sk_uri_param
          @@ stop)
-        (fun () sk_uri (cctxt : Client_context.io_wallet) ->
+        (fun legacy_apdu sk_uri (cctxt : Client_context.full) ->
            id_of_sk_uri sk_uri >>=? fun id ->
            with_ledger id begin fun h version _ _ ->
              match version.app_class with
              | Tezos ->
-                 failwith "Fatal: this operation is only valid with TezBake"
+                 failwith "Fatal: this operation is only valid with the \
-             | TezBake ->
+                           Tezos Baking application"
+             | TezBake when legacy_apdu ->
                  wrap_ledger_cmd begin fun pp ->
                    Ledgerwallet_tezos.get_high_watermark ~pp h
-                 end >>=? fun hwm ->
+                 end
-                 cctxt#message
+                 >>=? fun hwm ->
-                   "@[<v 0>%a has high water mark: %ld@]"
+                 cctxt#message "The high water mark for@ %a@ is %ld."
                    pp_id id hwm >>= fun () ->
                  return_unit
+             | TezBake ->
+                 wrap_ledger_cmd begin fun pp ->
+                   Ledgerwallet_tezos.get_all_high_watermarks ~pp h
+                 end
+                 >>=? fun (`Main_hwm mh, `Test_hwm th, `Chain_id ci) ->
+                 cctxt#message
+                   "The high water mark values for@ %a@ are\
+                    @ %ld for the main-chain@ (%a)@ \
+                    and@ %ld for the test-chain."
+                   pp_id id mh Chain_id.pp Chain_id.(of_string_exn ci) th
+                 >>= fun () ->
+                 return_unit
            end
         ) ;
 
@@ -700,7 +807,7 @@ 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.io_wallet) ->
+        (fun () sk_uri hwm (cctxt : Client_context.full) ->
            id_of_sk_uri sk_uri >>=? fun id ->
            with_ledger id begin fun h version _ _ ->
              match version.app_class with

src/lib_signer_backends/ledger.mli

@@ -37,4 +37,6 @@ end
 
 include Client_keys.SIGNER
 
-val commands : unit -> Client_context.io_wallet Clic.command list
+
+
+val commands : unit -> Client_context.full Clic.command list

src/lib_signer_backends/tezos-signer-backends.opam

@@ -13,6 +13,7 @@ depends: [
   "tezos-client-base"
   "tezos-rpc-http"
   "tezos-signer-services"
+  "tezos-shell-services"
   "pbkdf"
   "bip39"
   "ledgerwallet-tezos"

vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml

@@ -64,6 +64,8 @@ type ins =
   | Reset_high_watermark
   | Query_high_watermark
   | Get_authorized_key
+  | Setup
+  | Query_all_high_watermarks
 
 let int_of_ins = function
   | Version -> 0x00
@@ -76,6 +78,8 @@ let int_of_ins = function
   | Query_high_watermark -> 0x08
   | Git_commit -> 0x09
   | Get_authorized_key -> 0x07
+  | Setup -> 0x0A
+  | Query_all_high_watermarks -> 0x0B
 
 type curve =
   | Ed25519
@@ -154,11 +158,48 @@ let get_public_key ?(prompt=true) =
 
 let authorize_baking = get_public_key_like Authorize_baking
 
+let setup_baking ?pp ?buf h ~main_chain_id ~main_hwm ~test_hwm curve path =
+  let nb_derivations = List.length path in
+  if nb_derivations > 10 then
+    invalid_arg "Ledgerwallet_tezos.setup: max 10 derivations" ;
+  let lc =
+    (* [ chain-id | main-hwm | test-hwm | derivations-path ] *)
+    (* derivations-path = [ length | paths ] *)
+    (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). *)
+  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]) ;
+  done ;
+  Cstruct.BE.set_uint32 data_init 4 main_hwm ;
+  Cstruct.BE.set_uint32 data_init 8 test_hwm ;
+  Cstruct.set_uint8 data_init 12 nb_derivations ;
+  let (_ : Cstruct.t) =
+    let data = Cstruct.shift data_init (12 + 1) in
+    write_path data path in
+  let msg = "setup" in
+  let apdu =
+    Apdu.create
+      ~p2:(int_of_curve curve) ~lc ~data:data_init (wrap_ins Setup) in
+  Transport.apdu ~msg ?pp ?buf h apdu >>| fun addr ->
+  let keylen = Cstruct.get_uint8 addr 0 in
+  Cstruct.sub addr 1 keylen
+
 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 ->
   Cstruct.BE.get_uint32 hwm 0
 
+let get_all_high_watermarks ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Query_all_high_watermarks) in
+  Transport.apdu ~msg:"get_high_watermark" ?pp ?buf h apdu >>| fun tuple ->
+  let main_hwm = Cstruct.BE.get_uint32 tuple 0 in
+  let test_hwm = Cstruct.BE.get_uint32 tuple 4 in
+  let chain_id = Cstruct.copy tuple 8 4 in
+  (`Main_hwm main_hwm, `Test_hwm test_hwm, `Chain_id chain_id)
+
 let set_high_watermark ?pp ?buf h hwm =
   let data = Cstruct.create 4 in
   Cstruct.BE.set_uint32 data 0 hwm ;

vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli

@@ -65,20 +65,45 @@ val authorize_baking :
 (** [authorize_baking ?pp ?buf ?prompt ledger curve path] is like
     [get_public_key] with [prompt = true], but only works with the
     baking Ledger application and serves to indicate that the key from
-    [curve] at [path] is allowed to bake. *)
+    [curve] at [path] is allowed to bake.
+
+    This is deprecated as it ignores test-chains, see {!setup_baking}. *)
+
+val setup_baking :
+  ?pp:Format.formatter -> ?buf:Cstruct.t -> Hidapi.t ->
+  main_chain_id: string -> main_hwm:int32 -> test_hwm:int32 ->
+  curve -> int32 list -> (Cstruct.t, Transport.error) result
+(** [setup_baking ?pp ?buf ?prompt ledger ~main_chain_id ~main_hwm ~test_hwm curve path]
+    sets up the Ledger's Baking application: it informs
+    the device of the ID of the main chain (should be of length [4]),
+    sets the high watermarks for the main and test chains, {i and}
+    indicates that the key at the given [curve/path] is authorized for
+    baking. *)
 
 val get_high_watermark :
   ?pp:Format.formatter -> ?buf:Cstruct.t ->
   Hidapi.t -> (int32, Transport.error) result
 (** [get_high_watermark ?pp ?buf ledger] is the current value of the
-    high water mark on [ledger]. This works with the baking app
+    high water mark for the main-chain on [ledger]. This works with
-    only. *)
+    the baking app only. See {!get_all_high_watermarks} for a more
+    complete query. *)
+
+val get_all_high_watermarks :
+  ?pp:Format.formatter ->
+  ?buf:Cstruct.t ->
+  Hidapi.t ->
+  ([ `Main_hwm of int32 ] * [ `Test_hwm of int32 ] * [ `Chain_id of string ],
+   Transport.error) result
+(** Query the high water marks for the main and test chains, as well as the ID
+    of the main-chain (string of length 4) recorded by the Ledger Baking app. *)
 
 val set_high_watermark :
   ?pp:Format.formatter -> ?buf:Cstruct.t ->
   Hidapi.t -> int32 -> (unit, Transport.error) result
-(** [get_high_watermark ?pp ?buf ledger hwm] reset the high water
+(** [set_high_watermark ?pp ?buf ledger hwm] reset the high water
-    mark on [ledger] to [hwm]. This works with the baking app only. *)
+    mark on [ledger] to [hwm] for the main-chain.
+    This works with the baking app only. Use {!setup_baking} to be able to also 
+    reset all the test-chain water mark. *)
 
 val sign :
   ?pp:Format.formatter ->