balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Vendors: upgrade ocaml-ledger-wallet

Browse Source 
* Use result instead of exceptions
* Support newer versions of the companion Tezos/TezBake Ledger apps
This commit is contained in:
Vincent Bernardoff 2018-06-28 20:44:04 +02:00 committed by Benjamin Canou
parent 043194ea11
commit aceee178e1
6 changed files with 388 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
vendors/ocaml-ledger-wallet/ledgerwallet.opam vendored
View File

@ -16,7 +16,7 @@ build: [ "jbuilder" "build" "-j" jobs "-p" name "@install" ]
build-test: [ "jbuilder" "runtest" "-p" name "-j" jobs ]
depends: [
"jbuilder" {build & >= "1.0+beta16"}
"result" {>= "1.3"}
"rresult" {>= "0.5.0"}
"cstruct" {>= "3.2.1"}
"hidapi" {>= "1.0"}
]

2
vendors/ocaml-ledger-wallet/src/jbuild vendored
View File

@ -5,7 +5,7 @@
(public_name ledgerwallet)
(modules (Apdu Transport))
(synopsis "Ledger wallet library for OCaml: common parts")
(libraries (result cstruct hidapi))))
(libraries (rresult cstruct hidapi))))
(library
((name ledgerwallet_tezos)

99
vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml vendored
View File

@ -3,15 +3,75 @@
Distributed under the ISC license, see terms at the end of the file.
---------------------------------------------------------------------------*)
open Rresult
open Ledgerwallet
module Version = struct
type app_class = Tezos | TezBake
let pp_app_class ppf = function
| Tezos -> Format.pp_print_string ppf "Tezos"
| TezBake -> Format.pp_print_string ppf "TezBake"
let class_of_int = function
| 0 -> Tezos
| 1 -> TezBake
| _ -> invalid_arg "class_of_int"
type t = {
app_class : app_class ;
major : int ;
minor : int ;
patch : int ;
}
let pp ppf { app_class ; major ; minor ; patch } =
Format.fprintf ppf "%a.%d.%d.%d"
pp_app_class app_class major minor patch
let create ~app_class ~major ~minor ~patch = {
app_class ; major ; minor ; patch
}
type Transport.Status.t +=
Tezos_impossible_to_read_version
let () = Transport.Status.register_string_f begin function
| Tezos_impossible_to_read_version ->
Some "Impossible to read version"
| _ -> None
end
let read cs =
try
let app_class = class_of_int (Cstruct.get_uint8 cs 0) in
let major = Cstruct.get_uint8 cs 1 in
let minor = Cstruct.get_uint8 cs 2 in
let patch = Cstruct.get_uint8 cs 3 in
R.ok (create ~app_class ~major ~minor ~patch)
with _ ->
Transport.app_error
~msg:"Version.read" (R.error Tezos_impossible_to_read_version)
end
type ins =
| Version
| Authorize_baking
| Get_public_key
| Prompt_public_key
| Sign
| Sign_unsafe
| Reset_high_watermark
| Query_high_watermark
let int_of_ins = function
| Version -> 0x00
| Authorize_baking -> 0x01
| Get_public_key -> 0x02
| Prompt_public_key -> 0x03
| Sign -> 0x04
| Sign_unsafe -> 0x05
| Reset_high_watermark -> 0x06
| Query_high_watermark -> 0x08
type curve =
| Ed25519
@ -26,13 +86,18 @@ let int_of_curve = function
let wrap_ins cmd =
Apdu.create_cmd ~cmd ~cla_of_cmd:(fun _ -> 0x80) ~ins_of_cmd:int_of_ins
let get_version ?pp ?buf h =
let apdu = Apdu.create (wrap_ins Version) in
Transport.apdu ~msg:"get_version" ?pp ?buf h apdu >>=
Version.read
let write_path cs path =
ListLabels.fold_left path ~init:cs ~f:begin fun cs i ->
Cstruct.BE.set_uint32 cs 0 i ;
Cstruct.shift cs 4
end
let get_public_key ?pp ?buf h curve path =
let get_public_key_like cmd ?pp ?buf h curve path =
let nb_derivations = List.length path in
if nb_derivations > 10 then invalid_arg "get_public_key: max 10 derivations" ;
let lc = 1 + 4 * nb_derivations in
@ -40,14 +105,32 @@ let get_public_key ?pp ?buf h curve path =
Cstruct.set_uint8 data_init 0 nb_derivations ;
let data = Cstruct.shift data_init 1 in
let _data = write_path data path in
let msg = "Tezos.get_public_key" in
let apdu = Apdu.create ~p2:(int_of_curve curve)
~lc ~data:data_init (wrap_ins Get_public_key) in
let addr = Transport.apdu ~msg ?pp ?buf h apdu in
let msg = "get_public_key" in
let apdu = Apdu.create
~p2:(int_of_curve curve) ~lc ~data:data_init (wrap_ins cmd) in
Transport.apdu ~msg ?pp ?buf h apdu >>| fun addr ->
let keylen = Cstruct.get_uint8 addr 0 in
Cstruct.sub addr 1 keylen
let sign ?pp ?buf h curve path payload =
let get_public_key ?(prompt=true) =
let cmd = if prompt then Prompt_public_key else Get_public_key in
get_public_key_like cmd
let authorize_baking = get_public_key_like Authorize_baking
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 set_high_watermark ?pp ?buf h hwm =
let data = Cstruct.create 4 in
Cstruct.BE.set_uint32 data 0 hwm ;
let apdu = Apdu.create ~lc:4 ~data (wrap_ins Reset_high_watermark) in
Transport.apdu ~msg:"set_high_watermark" ?pp ?buf h apdu >>|
ignore
let sign ?pp ?buf ?(hash_on_ledger=true) h curve path payload =
let nb_derivations = List.length path in
if nb_derivations > 10 then invalid_arg "get_public_key: max 10 derivations" ;
let lc = 1 + 4 * nb_derivations in
@ -55,8 +138,8 @@ let sign ?pp ?buf h curve path payload =
Cstruct.set_uint8 data_init 0 nb_derivations ;
let data = Cstruct.shift data_init 1 in
let _data = write_path data path in
let cmd = wrap_ins Sign in
let msg = "Tezos.sign" in
let cmd = wrap_ins (if hash_on_ledger then Sign else Sign_unsafe) in
let msg = "sign" in
let apdu = Apdu.create ~p2:(int_of_curve curve) ~lc ~data:data_init cmd in
let _addr = Transport.apdu ~msg ?pp ?buf h apdu in
Transport.write_payload ~mark_last:true ?pp ?buf ~msg ~cmd h ~p1:0x01 payload

71
vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli vendored
View File

@ -3,22 +3,77 @@
Distributed under the ISC license, see terms at the end of the file.
---------------------------------------------------------------------------*)
open Ledgerwallet
module Version : sig
type app_class = Tezos | TezBake
val pp_app_class : Format.formatter -> app_class -> unit
type Transport.Status.t +=
Tezos_impossible_to_read_version
type t = {
app_class : app_class ;
major : int ;
minor : int ;
patch : int ;
}
val pp : Format.formatter -> t -> unit
end
type curve =
| Ed25519
| Secp256k1
| Secp256r1
val get_public_key :
val get_version :
?pp:Format.formatter -> ?buf:Cstruct.t ->
Hidapi.t -> curve -> int32 list -> Cstruct.t
(** [get_public_key ?pp ?buf ledger curve path] is [0x02 || pk] from
[ledger] at [path] for curve [curve]. *)
Hidapi.t -> (Version.t, Transport.error) result
(** [get_version ?pp ?buf ledger] is the version information of the
Ledger app running at [ledger]. *)
val get_public_key :
?prompt:bool ->
?pp:Format.formatter ->
?buf:Cstruct.t ->
Hidapi.t -> curve -> int32 list -> (Cstruct.t, Transport.error) result
(** [get_public_key ?pp ?buf ?prompt ledger curve path] is [0x02 ||
pk] from [ledger] at [path] for curve [curve]. If [prompt] is
[true] (the default), then a prompt on Ledger screen will ask user
confirmation. *)
val authorize_baking :
?pp:Format.formatter ->
?buf:Cstruct.t ->
Hidapi.t -> curve -> int32 list -> (Cstruct.t, Transport.error) result
(** [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. *)
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
only. *)
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
mark on [ledger] to [hwm]. This works with the baking app only. *)
val sign :
?pp:Format.formatter -> ?buf:Cstruct.t ->
Hidapi.t -> curve -> int32 list -> Cstruct.t -> Cstruct.t
(** [sign ?pp ?buf h curve path payload] is [signature], signed from
[ledger] with key from curve [curve] at [path]. *)
?pp:Format.formatter ->
?buf:Cstruct.t ->
?hash_on_ledger:bool ->
Hidapi.t -> curve -> int32 list ->
Cstruct.t -> (Cstruct.t, Transport.error) result
(** [sign ?pp ?buf ?hash_on_ledger h curve path payload] is the
signature of [payload] (or its hash if [hash_on_ledger] is [true],
the default), signed on [ledger] with key from curve [curve] at
[path]. *)
(*---------------------------------------------------------------------------
Copyright (c) 2017 Vincent Bernardoff

284
vendors/ocaml-ledger-wallet/src/transport.ml vendored
View File

@ -3,13 +3,21 @@
Distributed under the ISC license, see terms at the end of the file.
---------------------------------------------------------------------------*)
open Rresult
let packet_length = 64
let channel = 0x0101
let apdu = 0x05
let ping = 0x02
let check_buflen cs =
let cslen = Cstruct.len cs in
if cslen < packet_length then invalid_arg
("HID packets must be 64 bytes long, got " ^ string_of_int cslen)
module Status = struct
type t =
type t = ..
type t +=
| Invalid_pin of int
| Incorrect_length
| Incompatible_file_structure
@ -21,6 +29,7 @@ module Status = struct
| Ins_not_supported
| Technical_problem of int
| Ok
| Unknown of int
let of_int = function
| 0x6700 -> Incorrect_length
@ -34,10 +43,14 @@ module Status = struct
| 0x9000 -> Ok
| v when v >= 0x63c0 && v <= 0x63cf -> Invalid_pin (v land 0x0f)
| v when v >= 0x6f00 && v <= 0x6fff -> Technical_problem (v land 0xff)
| v -> invalid_arg (Printf.sprintf "Status.of_int: got 0x%x" v)
| v -> Unknown v
let string_fs = ref []
let register_string_f f =
string_fs := f :: !string_fs
let to_string = function
| Invalid_pin i -> Printf.sprintf "Invalid pin %d" i
| Invalid_pin i -> "Invalid pin " ^ string_of_int i
| Incorrect_length -> "Incorrect length"
| Incompatible_file_structure -> "Incompatible file structure"
| Security_status_unsatisfied -> "Security status unsatisfied"
@ -46,8 +59,15 @@ module Status = struct
| File_not_found -> "File not found"
| Incorrect_params -> "Incorrect params"
| Ins_not_supported -> "Instruction not supported"
| Technical_problem i -> Printf.sprintf "Technical problem %d" i
| Technical_problem i -> "Technical problem " ^ string_of_int i
| Ok -> "Ok"
| Unknown i -> Printf.sprintf "Unknown status code 0x%x" i
| t ->
try
List.fold_left begin fun a f ->
match f t with Some s -> failwith s | None -> a
end "Unregistered status message" !string_fs
with Failure s -> s
let show t = to_string t
@ -56,58 +76,142 @@ module Status = struct
end
module Header = struct
type t = {
cmd : [`Ping | `Apdu] ;
cmd : cmd ;
seq : int ;
}
and cmd = Ping | Apdu
let cmd_of_int = function
| 0x05 -> Some Apdu
| 0x02 -> Some Ping
| _ -> None
module Error = struct
type t =
| Header_too_short of int
| Invalid_channel of int
| Invalid_command_tag of int
| Unexpected_sequence_number of { expected : int ;
actual : int }
let pp ppf = function
| Header_too_short i ->
Format.fprintf ppf "Header too short (got %d bytes)" i
| Invalid_channel i ->
Format.fprintf ppf "Invalid channel (%d)" i
| Invalid_command_tag i ->
Format.fprintf ppf "Invalid command tag (%d)" i
| Unexpected_sequence_number { expected ; actual } ->
Format.fprintf ppf "Unexpected sequence number (expected %d, got %d)"
expected actual
end
let fail_header_too_short i = R.error (Error.Header_too_short i)
let fail_invalid_chan i = R.error (Error.Invalid_channel i)
let fail_invalid_cmd i = R.error (Error.Invalid_command_tag i)
let fail_unexpected_seqnum ~expected ~actual =
R.error (Error.Unexpected_sequence_number { expected ; actual })
let read cs =
let open Cstruct in
if BE.get_uint16 cs 0 <> channel then
invalid_arg "Transport.read_header: invalid channel id" ;
let cmd = match get_uint8 cs 2 with
| 0x05 -> `Apdu
| 0x02 -> `Ping
| _ -> invalid_arg "Transport.read_header: invalid command tag"
in
let seq = BE.get_uint16 cs 3 in
{ cmd ; seq }, Cstruct.shift cs 5
let cslen = Cstruct.len cs in
begin if cslen < 5 then
fail_header_too_short cslen
else R.ok ()
end >>= fun () ->
let channel_id = Cstruct.BE.get_uint16 cs 0 in
let cmd = Cstruct.get_uint8 cs 2 in
let seq = Cstruct.BE.get_uint16 cs 3 in
begin
if channel_id <> channel then
fail_invalid_chan channel_id
else R.ok ()
end >>= fun () ->
begin match cmd_of_int cmd with
| Some cmd -> R.ok cmd
| None -> fail_invalid_cmd cmd
end >>= fun cmd ->
R.ok ({ cmd ; seq }, Cstruct.shift cs 5)
let check_exn ?cmd ?seq t =
begin match cmd with
| None -> ()
| Some expected ->
if expected <> t.cmd then failwith "Header.check: unexpected command"
end ;
begin match seq with
| None -> ()
| Some expected ->
if expected <> t.seq then failwith "Header.check: unexpected seq num"
end
let check_seqnum t expected_seq =
if expected_seq <> t.seq then
fail_unexpected_seqnum ~actual:t.seq ~expected:expected_seq
else R.ok ()
end
type transport_error =
| Hidapi of string
| Incomplete_write of int
| Incomplete_read of int
let pp_transport_error ppf = function
| Hidapi s -> Format.pp_print_string ppf s
| Incomplete_write i ->
Format.fprintf ppf "wrote %d bytes, expected to write 64 \
bytes" i
| Incomplete_read i ->
Format.fprintf ppf "read %d bytes, expected to read 64 \
bytes" i
type error =
| AppError of { status : Status.t ; msg : string }
| ApduError of Header.Error.t
| TransportError of transport_error
let app_error ~msg r =
R.reword_error (fun status -> AppError { status ; msg }) r
let apdu_error r =
R.reword_error (fun e -> ApduError e) r
let pp_error ppf = function
| AppError { status ; msg } ->
Format.fprintf ppf "Application level error (%s): %a"
msg Status.pp status
| ApduError e ->
Format.fprintf ppf "APDU level error: %a" Header.Error.pp e
| TransportError e ->
Format.fprintf ppf "Transport level error: %a" pp_transport_error e
let check_nbwritten = function
| n when n = packet_length -> R.ok ()
| n -> R.error (TransportError (Incomplete_write n))
let check_nbread = function
| n when n = packet_length -> R.ok ()
| n -> R.error (TransportError (Incomplete_read n))
let write_hidapi h ?len buf =
R.reword_error (fun s -> TransportError (Hidapi s))
(Hidapi.write h ?len Cstruct.(to_bigarray (sub buf 0 packet_length))) >>=
check_nbwritten
let read_hidapi ?timeout h buf =
R.reword_error (fun s -> TransportError (Hidapi s))
(Hidapi.read ?timeout h buf packet_length) >>=
check_nbread
let write_ping ?(buf=Cstruct.create packet_length) h =
check_buflen buf ;
let open Cstruct in
BE.set_uint16 buf 0 channel ;
set_uint8 buf 2 ping ;
BE.set_uint16 buf 3 0 ;
memset (sub buf 5 59) 0 ;
match Hidapi.write h (to_bigarray (sub buf 0 packet_length)) with
| Error msg -> failwith msg
| Ok nb_written when nb_written <> packet_length -> failwith "Transport.write_ping"
| _ -> ()
write_hidapi h buf
let write_apdu
?pp
?(buf=Cstruct.create packet_length)
h p =
check_buflen buf ;
let apdu_len = Apdu.length p in
let apdu_buf = Cstruct.create apdu_len in
let _nb_written = Apdu.write apdu_buf p in
begin match pp with
| None -> ()
| Some pp ->
Format.fprintf pp "-> %a@." Cstruct.hexdump_pp apdu_buf
Format.fprintf pp "-> REQ %a@." Cstruct.hexdump_pp apdu_buf ;
Format.pp_print_flush pp ()
end ;
let apdu_p = ref 0 in (* pos in the apdu buf *)
let i = ref 0 in (* packet id *)
@ -120,48 +224,44 @@ let write_apdu
BE.set_uint16 buf 5 apdu_len ;
let nb_to_write = (min apdu_len (packet_length - 7)) in
blit apdu_buf 0 buf 7 nb_to_write ;
begin match Hidapi.write h (to_bigarray (sub buf 0 packet_length)) with
| Error msg -> failwith msg
| Ok nb_written when nb_written <> packet_length ->
failwith "Transport.write_apdu"
| _ -> ()
end ;
write_hidapi h buf >>= fun () ->
apdu_p := !apdu_p + nb_to_write ;
incr i ;
(* write following packets *)
while !apdu_p < apdu_len do
memset buf 0 ;
BE.set_uint16 buf 0 channel ;
set_uint8 buf 2 apdu ;
BE.set_uint16 buf 3 !i ;
let nb_to_write = (min (apdu_len - !apdu_p) (packet_length - 5)) in
blit apdu_buf !apdu_p buf 5 nb_to_write ;
begin match Hidapi.write h (to_bigarray (sub buf 0 packet_length)) with
| Error err -> failwith err
| Ok nb_written when nb_written <> packet_length ->
failwith "Transport.write_apdu"
| _ -> ()
end ;
apdu_p := !apdu_p + nb_to_write ;
incr i
done
let rec inner apdu_p =
if apdu_p >= apdu_len then R.ok ()
else begin
memset buf 0 ;
BE.set_uint16 buf 0 channel ;
set_uint8 buf 2 apdu ;
BE.set_uint16 buf 3 !i ;
let nb_to_write = (min (apdu_len - apdu_p) (packet_length - 5)) in
blit apdu_buf apdu_p buf 5 nb_to_write ;
write_hidapi h buf >>= fun () ->
incr i ;
inner (apdu_p + nb_to_write)
end
in
inner !apdu_p
let read ?(buf=Cstruct.create packet_length) h =
let read ?pp ?(buf=Cstruct.create packet_length) h =
check_buflen buf ;
let expected_seq = ref 0 in
let full_payload = ref (Cstruct.create 0) in
let payload = ref (Cstruct.create 0) in
(* let pos = ref 0 in *)
let rec inner () =
begin match Hidapi.read ~timeout:600000 h
(Cstruct.to_bigarray buf) packet_length with
| Error err -> failwith err
| Ok nb_read when nb_read <> packet_length ->
failwith (Printf.sprintf "Transport.read: read %d bytes" nb_read)
| _ -> ()
read_hidapi ~timeout:600_000 h (Cstruct.to_bigarray buf) >>= fun () ->
begin match pp with
| None -> ()
| Some pp ->
Format.fprintf pp "<- RAW PKT %a@."
Cstruct.hexdump_pp (Cstruct.sub buf 0 packet_length) ;
Format.pp_print_flush pp ()
end ;
let hdr, buf = Header.read buf in
Header.check_exn ~seq:!expected_seq hdr ;
apdu_error (Header.read buf) >>= fun (hdr, buf) ->
apdu_error (Header.check_seqnum hdr !expected_seq) >>= fun () ->
if hdr.seq = 0 then begin (* first frame *)
let len = Cstruct.BE.get_uint16 buf 0 in
let cs = Cstruct.shift buf 2 in
@ -180,40 +280,37 @@ let read ?(buf=Cstruct.create packet_length) h =
(* pos := !pos + nb_to_read ; *)
expected_seq := !expected_seq + 1
end ;
if Cstruct.len !payload = 0 then
if hdr.cmd = `Ping then Status.Ok, Cstruct.create 0
else
match Cstruct.len !payload, hdr.cmd with
| 0, Ping -> R.ok (Status.Ok, Cstruct.create 0)
| 0, Apdu ->
(* let sw_pos = Bytes.length !payload - 2 in *)
let payload_len = Cstruct.len !full_payload in
Status.of_int Cstruct.(BE.get_uint16 !full_payload (payload_len - 2)),
Cstruct.sub !full_payload 0 (payload_len - 2)
else inner ()
let sw = Cstruct.BE.get_uint16 !full_payload (payload_len - 2) in
R.ok
(Status.of_int sw,
Cstruct.sub !full_payload 0 (payload_len - 2))
| _ -> inner ()
in
inner ()
let ping ?buf h =
write_ping ?buf h ;
match read ?buf h with
| Status.Ok, _ -> ()
| s, _ -> failwith ((Status.to_string s))
let ping ?pp ?buf h =
write_ping ?buf h >>= fun () ->
read ?pp ?buf h >>|
ignore
let apdu ?pp ?(msg="") ?buf h apdu =
write_apdu ?pp ?buf h apdu ;
match read ?buf h with
| Status.Ok, payload ->
begin match pp with
| None -> ()
| Some pp ->
Format.fprintf pp "<- %a %a@." Status.pp Status.Ok Cstruct.hexdump_pp payload
end ;
payload
| s, payload ->
begin match pp with
| None -> ()
| Some pp ->
Format.fprintf pp "<- %a %a@." Status.pp s Cstruct.hexdump_pp payload
end ;
failwith ((Status.to_string s) ^ " " ^ msg)
write_apdu ?pp ?buf h apdu >>= fun () ->
read ?pp ?buf h >>= fun (status, payload) ->
begin match pp with
| None -> ()
| Some pp ->
Format.fprintf pp "<- RESP [%a] %a@."
Status.pp status Cstruct.hexdump_pp payload ;
Format.pp_print_flush pp ()
end ;
match status with
| Status.Ok -> R.ok payload
| status -> app_error ~msg (R.error status)
let write_payload
?pp ?(msg="write_payload") ?buf ?(mark_last=false) ~cmd ?p1 ?p2 h cs =
@ -225,11 +322,12 @@ let write_payload
| true, true, None -> Some 0x80
| true, true, Some p1 -> Some (0x80 lor p1)
| _ -> p1 in
let response = apdu ?pp ~msg ?buf h
Apdu.(create ?p1 ?p2 ~lc ~data:(Cstruct.sub cs 0 lc) cmd) in
if last then response
apdu ?pp ~msg ?buf h
Apdu.(create ?p1 ?p2 ~lc
~data:(Cstruct.sub cs 0 lc) cmd) >>= fun response ->
if last then R.ok response
else inner (Cstruct.shift cs lc) in
if Cstruct.len cs = 0 then cs else inner cs
if Cstruct.len cs = 0 then R.ok cs else inner cs
(*---------------------------------------------------------------------------
Copyright (c) 2017 Vincent Bernardoff

50
vendors/ocaml-ledger-wallet/src/transport.mli vendored
View File

@ -4,7 +4,8 @@
---------------------------------------------------------------------------*)
module Status : sig
type t =
type t = ..
type t +=
| Invalid_pin of int
| Incorrect_length
| Incompatible_file_structure
@ -17,34 +18,65 @@ module Status : sig
| Technical_problem of int
| Ok
val register_string_f : (t -> string option) -> unit
val to_string : t -> string
val show : t -> string
val pp : Format.formatter -> t -> unit
end
module Header : sig
module Error : sig
type t =
| Header_too_short of int
| Invalid_channel of int
| Invalid_command_tag of int
| Unexpected_sequence_number of { expected : int ;
actual : int }
end
end
type transport_error =
| Hidapi of string
| Incomplete_write of int
| Incomplete_read of int
type error =
| AppError of { status : Status.t ; msg : string }
| ApduError of Header.Error.t
| TransportError of transport_error
val app_error :
msg:string -> ('a, Status.t) result -> ('a, error) result
val pp_error : Format.formatter -> error -> unit
val write_apdu :
?pp:Format.formatter -> ?buf:Cstruct.t ->
Hidapi.t -> Apdu.t -> unit
Hidapi.t -> Apdu.t -> (unit, error) result
(** [write_apdu ?pp ?buf ledger apdu] writes [apdu] to [ledger]. *)
val read : ?buf:Cstruct.t -> Hidapi.t -> Status.t * Cstruct.t
(** [read ?buf ledger] reads from [ledger] a status response and a
val read :
?pp:Format.formatter -> ?buf:Cstruct.t ->
Hidapi.t -> (Status.t * Cstruct.t, error) result
(** [read ?pp ?buf ledger] reads from [ledger] a status response and a
payload. *)
val ping : ?buf:Cstruct.t -> Hidapi.t -> unit
(** [ping ?buf ledger] writes a ping packet to [ledger], optionally
containing [buf]. *)
val ping : ?pp:Format.formatter -> ?buf:Cstruct.t ->
Hidapi.t -> (unit, error) result
(** [ping ?pp ?buf ledger] writes a ping packet to [ledger],
optionally containing [buf]. *)
val apdu :
?pp:Format.formatter -> ?msg:string -> ?buf:Cstruct.t ->
Hidapi.t -> Apdu.t -> Cstruct.t
Hidapi.t -> Apdu.t -> (Cstruct.t, error) result
(** [apdu ?pp ?msg ?buf ledger apdu] writes [apdu] to [ledger] and
returns the response. *)
val write_payload :
?pp:Format.formatter -> ?msg:string -> ?buf:Cstruct.t ->
?mark_last:bool -> cmd:Apdu.cmd -> ?p1:int -> ?p2:int ->
Hidapi.t -> Cstruct.t -> Cstruct.t
Hidapi.t -> Cstruct.t -> (Cstruct.t, error) result
(** [write_payload ?pp ?msg ?buf ?mark_last ~cmd ?p1 ?p2 ledger
payload] writes the [payload] of [cmd] into [ledger] and returns
the response. *)