Vendors: import ocaml-ledger-wallet
This commit is contained in:
parent
8bc9695ad0
commit
3a2a11d888
13
vendors/ocaml-ledger-wallet/LICENSE.md
vendored
Normal file
13
vendors/ocaml-ledger-wallet/LICENSE.md
vendored
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
Copyright (c) 2017 Vincent Bernardoff
|
||||||
|
|
||||||
|
Permission to use, copy, modify, and/or distribute this software for any
|
||||||
|
purpose with or without fee is hereby granted, provided that the above
|
||||||
|
copyright notice and this permission notice appear in all copies.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||||
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||||
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||||
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||||
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||||
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
20
vendors/ocaml-ledger-wallet/ledgerwallet-tezos.opam
vendored
Normal file
20
vendors/ocaml-ledger-wallet/ledgerwallet-tezos.opam
vendored
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
opam-version: "1.2"
|
||||||
|
name: "ledgerwallet-tezos"
|
||||||
|
version: "dev"
|
||||||
|
authors: "Vincent Bernardoff <vb@luminar.eu.org>"
|
||||||
|
maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
|
||||||
|
license: "ISC"
|
||||||
|
homepage: "https://github.com/vbmithr/ocaml-ledger-wallet"
|
||||||
|
bug-reports: "https://github.com/vbmithr/ocaml-ledger-wallet/issues"
|
||||||
|
dev-repo: "git://github.com/vbmithr/ocaml-ledger-wallet"
|
||||||
|
|
||||||
|
available: [
|
||||||
|
ocaml-version >= "4.02.0"
|
||||||
|
]
|
||||||
|
|
||||||
|
build: [ "jbuilder" "build" "-j" jobs "-p" name "@install" ]
|
||||||
|
build-test: [ "jbuilder" "runtest" "-p" name "-j" jobs ]
|
||||||
|
depends: [
|
||||||
|
"jbuilder" {build & >= "1.0+beta16"}
|
||||||
|
"ledgerwallet" {= "dev"}
|
||||||
|
]
|
22
vendors/ocaml-ledger-wallet/ledgerwallet.opam
vendored
Normal file
22
vendors/ocaml-ledger-wallet/ledgerwallet.opam
vendored
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
opam-version: "1.2"
|
||||||
|
name: "ledgerwallet"
|
||||||
|
version: "dev"
|
||||||
|
authors: "Vincent Bernardoff <vb@luminar.eu.org>"
|
||||||
|
maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
|
||||||
|
license: "ISC"
|
||||||
|
homepage: "https://github.com/vbmithr/ocaml-ledger-wallet"
|
||||||
|
bug-reports: "https://github.com/vbmithr/ocaml-ledger-wallet/issues"
|
||||||
|
dev-repo: "git://github.com/vbmithr/ocaml-ledger-wallet"
|
||||||
|
|
||||||
|
available: [
|
||||||
|
ocaml-version >= "4.02.0"
|
||||||
|
]
|
||||||
|
|
||||||
|
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"}
|
||||||
|
"cstruct" {>= "3.2.1"}
|
||||||
|
"hidapi" {>= "1.0"}
|
||||||
|
]
|
61
vendors/ocaml-ledger-wallet/src/apdu.ml
vendored
Normal file
61
vendors/ocaml-ledger-wallet/src/apdu.ml
vendored
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
|
||||||
|
Distributed under the ISC license, see terms at the end of the file.
|
||||||
|
---------------------------------------------------------------------------*)
|
||||||
|
|
||||||
|
type cmd = Apdu_command : {
|
||||||
|
cmd : 'a ;
|
||||||
|
cla_of_cmd : 'a -> int ;
|
||||||
|
ins_of_cmd : 'a -> int ;
|
||||||
|
} -> cmd
|
||||||
|
|
||||||
|
let create_cmd ~cmd ~cla_of_cmd ~ins_of_cmd =
|
||||||
|
Apdu_command { cmd ; cla_of_cmd ; ins_of_cmd }
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
cmd : cmd ;
|
||||||
|
p1 : int ;
|
||||||
|
p2 : int ;
|
||||||
|
lc : int ;
|
||||||
|
le : int ;
|
||||||
|
data : Cstruct.t ;
|
||||||
|
}
|
||||||
|
|
||||||
|
let max_data_length = 230
|
||||||
|
|
||||||
|
let create ?(p1=0) ?(p2=0) ?(lc=0) ?(le=0) ?(data=Cstruct.create 0) cmd =
|
||||||
|
{ cmd ; p1 ; p2 ; lc ; le ; data }
|
||||||
|
|
||||||
|
let create_string ?(p1=0) ?(p2=0) ?(lc=0) ?(le=0) ?(data="") cmd =
|
||||||
|
let data = Cstruct.of_string data in
|
||||||
|
{ cmd ; p1 ; p2 ; lc ; le ; data }
|
||||||
|
|
||||||
|
let length { data ; _ } = 5 + Cstruct.len data
|
||||||
|
|
||||||
|
let write cs { cmd = Apdu_command { cmd ; cla_of_cmd ; ins_of_cmd } ;
|
||||||
|
p1 ; p2 ; lc ; le ; data } =
|
||||||
|
let len = match lc, le with | 0, _ -> le | _ -> lc in
|
||||||
|
let datalen = Cstruct.len data in
|
||||||
|
Cstruct.set_uint8 cs 0 (cla_of_cmd cmd) ;
|
||||||
|
Cstruct.set_uint8 cs 1 (ins_of_cmd cmd) ;
|
||||||
|
Cstruct.set_uint8 cs 2 p1 ;
|
||||||
|
Cstruct.set_uint8 cs 3 p2 ;
|
||||||
|
Cstruct.set_uint8 cs 4 len ;
|
||||||
|
Cstruct.blit data 0 cs 5 datalen ;
|
||||||
|
Cstruct.shift cs (5 + datalen)
|
||||||
|
|
||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff
|
||||||
|
|
||||||
|
Permission to use, copy, modify, and/or distribute this software for any
|
||||||
|
purpose with or without fee is hereby granted, provided that the above
|
||||||
|
copyright notice and this permission notice appear in all copies.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||||
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||||
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||||
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||||
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||||
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
|
---------------------------------------------------------------------------*)
|
55
vendors/ocaml-ledger-wallet/src/apdu.mli
vendored
Normal file
55
vendors/ocaml-ledger-wallet/src/apdu.mli
vendored
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
|
||||||
|
Distributed under the ISC license, see terms at the end of the file.
|
||||||
|
---------------------------------------------------------------------------*)
|
||||||
|
|
||||||
|
type cmd = Apdu_command : {
|
||||||
|
cmd : 'a ;
|
||||||
|
cla_of_cmd : 'a -> int ;
|
||||||
|
ins_of_cmd : 'a -> int ;
|
||||||
|
} -> cmd
|
||||||
|
(** Arbitrary type of a command, with its converters. *)
|
||||||
|
|
||||||
|
val create_cmd :
|
||||||
|
cmd:'a -> cla_of_cmd:('a -> int) -> ins_of_cmd:('a -> int) -> cmd
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
cmd : cmd ;
|
||||||
|
p1 : int ;
|
||||||
|
p2 : int ;
|
||||||
|
lc : int ;
|
||||||
|
le : int ;
|
||||||
|
data : Cstruct.t ;
|
||||||
|
}
|
||||||
|
(** Type of an ADPU. *)
|
||||||
|
|
||||||
|
val max_data_length : int
|
||||||
|
(** [max_data_length] is the maximum data length of an APDU. *)
|
||||||
|
|
||||||
|
val create :
|
||||||
|
?p1:int -> ?p2:int -> ?lc:int -> ?le:int -> ?data:Cstruct.t -> cmd -> t
|
||||||
|
val create_string :
|
||||||
|
?p1:int -> ?p2:int -> ?lc:int -> ?le:int -> ?data:string -> cmd -> t
|
||||||
|
|
||||||
|
val length : t -> int
|
||||||
|
(** [length t] is the size of [t] in bytes. *)
|
||||||
|
|
||||||
|
val write : Cstruct.t -> t -> Cstruct.t
|
||||||
|
(** [write cs t] writes t at [cs] and returns [cs] shifted by [length
|
||||||
|
t] bytes. *)
|
||||||
|
|
||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff
|
||||||
|
|
||||||
|
Permission to use, copy, modify, and/or distribute this software for any
|
||||||
|
purpose with or without fee is hereby granted, provided that the above
|
||||||
|
copyright notice and this permission notice appear in all copies.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||||
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||||
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||||
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||||
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||||
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
|
---------------------------------------------------------------------------*)
|
15
vendors/ocaml-ledger-wallet/src/jbuild
vendored
Normal file
15
vendors/ocaml-ledger-wallet/src/jbuild
vendored
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
(jbuild_version 1)
|
||||||
|
|
||||||
|
(library
|
||||||
|
((name ledgerwallet)
|
||||||
|
(public_name ledgerwallet)
|
||||||
|
(modules (Apdu Transport))
|
||||||
|
(synopsis "Ledger wallet library for OCaml: common parts")
|
||||||
|
(libraries (result cstruct hidapi))))
|
||||||
|
|
||||||
|
(library
|
||||||
|
((name ledgerwallet_tezos)
|
||||||
|
(public_name ledgerwallet-tezos)
|
||||||
|
(modules (Ledgerwallet_tezos))
|
||||||
|
(synopsis "Ledger wallet library for OCaml: Tezos app")
|
||||||
|
(libraries (ledgerwallet))))
|
78
vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml
vendored
Normal file
78
vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml
vendored
Normal file
@ -0,0 +1,78 @@
|
|||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
|
||||||
|
Distributed under the ISC license, see terms at the end of the file.
|
||||||
|
---------------------------------------------------------------------------*)
|
||||||
|
|
||||||
|
open Ledgerwallet
|
||||||
|
|
||||||
|
type ins =
|
||||||
|
| Get_public_key
|
||||||
|
| Sign
|
||||||
|
|
||||||
|
let int_of_ins = function
|
||||||
|
| Get_public_key -> 0x02
|
||||||
|
| Sign -> 0x04
|
||||||
|
|
||||||
|
type curve =
|
||||||
|
| Ed25519
|
||||||
|
| Secp256k1
|
||||||
|
| Secp256r1
|
||||||
|
|
||||||
|
let int_of_curve = function
|
||||||
|
| Ed25519 -> 0x00
|
||||||
|
| Secp256k1 -> 0x01
|
||||||
|
| Secp256r1 -> 0x02
|
||||||
|
|
||||||
|
let wrap_ins cmd =
|
||||||
|
Apdu.create_cmd ~cmd ~cla_of_cmd:(fun _ -> 0x80) ~ins_of_cmd:int_of_ins
|
||||||
|
|
||||||
|
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 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
|
||||||
|
let data_init = Cstruct.create lc in
|
||||||
|
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 keylen = Cstruct.get_uint8 addr 0 in
|
||||||
|
Cstruct.sub addr 1 keylen
|
||||||
|
|
||||||
|
let sign ?pp ?buf 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
|
||||||
|
let data_init = Cstruct.create lc in
|
||||||
|
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 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
|
||||||
|
|
||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff
|
||||||
|
|
||||||
|
Permission to use, copy, modify, and/or distribute this software for any
|
||||||
|
purpose with or without fee is hereby granted, provided that the above
|
||||||
|
copyright notice and this permission notice appear in all copies.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||||
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||||
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||||
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||||
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||||
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
|
---------------------------------------------------------------------------*)
|
37
vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli
vendored
Normal file
37
vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli
vendored
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
|
||||||
|
Distributed under the ISC license, see terms at the end of the file.
|
||||||
|
---------------------------------------------------------------------------*)
|
||||||
|
|
||||||
|
type curve =
|
||||||
|
| Ed25519
|
||||||
|
| Secp256k1
|
||||||
|
| Secp256r1
|
||||||
|
|
||||||
|
val get_public_key :
|
||||||
|
?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]. *)
|
||||||
|
|
||||||
|
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]. *)
|
||||||
|
|
||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff
|
||||||
|
|
||||||
|
Permission to use, copy, modify, and/or distribute this software for any
|
||||||
|
purpose with or without fee is hereby granted, provided that the above
|
||||||
|
copyright notice and this permission notice appear in all copies.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||||
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||||
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||||
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||||
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||||
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
|
---------------------------------------------------------------------------*)
|
248
vendors/ocaml-ledger-wallet/src/transport.ml
vendored
Normal file
248
vendors/ocaml-ledger-wallet/src/transport.ml
vendored
Normal file
@ -0,0 +1,248 @@
|
|||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
|
||||||
|
Distributed under the ISC license, see terms at the end of the file.
|
||||||
|
---------------------------------------------------------------------------*)
|
||||||
|
|
||||||
|
let packet_length = 64
|
||||||
|
let channel = 0x0101
|
||||||
|
let apdu = 0x05
|
||||||
|
let ping = 0x02
|
||||||
|
|
||||||
|
module Status = struct
|
||||||
|
type t =
|
||||||
|
| Invalid_pin of int
|
||||||
|
| Incorrect_length
|
||||||
|
| Incompatible_file_structure
|
||||||
|
| Security_status_unsatisfied
|
||||||
|
| Conditions_of_use_not_satisfied
|
||||||
|
| Incorrect_data
|
||||||
|
| File_not_found
|
||||||
|
| Incorrect_params
|
||||||
|
| Ins_not_supported
|
||||||
|
| Technical_problem of int
|
||||||
|
| Ok
|
||||||
|
|
||||||
|
let of_int = function
|
||||||
|
| 0x6700 -> Incorrect_length
|
||||||
|
| 0x6981 -> Incompatible_file_structure
|
||||||
|
| 0x6982 -> Security_status_unsatisfied
|
||||||
|
| 0x6985 -> Conditions_of_use_not_satisfied
|
||||||
|
| 0x6a80 -> Incorrect_data
|
||||||
|
| 0x9404 -> File_not_found
|
||||||
|
| 0x6b00 -> Incorrect_params
|
||||||
|
| 0x6d00 -> Ins_not_supported
|
||||||
|
| 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)
|
||||||
|
|
||||||
|
let to_string = function
|
||||||
|
| Invalid_pin i -> Printf.sprintf "Invalid pin %d" i
|
||||||
|
| Incorrect_length -> "Incorrect length"
|
||||||
|
| Incompatible_file_structure -> "Incompatible file structure"
|
||||||
|
| Security_status_unsatisfied -> "Security status unsatisfied"
|
||||||
|
| Conditions_of_use_not_satisfied -> "Conditions of use not satisfied"
|
||||||
|
| Incorrect_data -> "Incorrect data"
|
||||||
|
| 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
|
||||||
|
| Ok -> "Ok"
|
||||||
|
|
||||||
|
let show t = to_string t
|
||||||
|
|
||||||
|
let pp ppf t =
|
||||||
|
Format.pp_print_string ppf (to_string t)
|
||||||
|
end
|
||||||
|
|
||||||
|
module Header = struct
|
||||||
|
type t = {
|
||||||
|
cmd : [`Ping | `Apdu] ;
|
||||||
|
seq : int ;
|
||||||
|
}
|
||||||
|
|
||||||
|
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 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
|
||||||
|
end
|
||||||
|
|
||||||
|
let write_ping ?(buf=Cstruct.create packet_length) h =
|
||||||
|
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"
|
||||||
|
| _ -> ()
|
||||||
|
|
||||||
|
let write_apdu
|
||||||
|
?pp
|
||||||
|
?(buf=Cstruct.create packet_length)
|
||||||
|
h p =
|
||||||
|
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
|
||||||
|
end ;
|
||||||
|
let apdu_p = ref 0 in (* pos in the apdu buf *)
|
||||||
|
let i = ref 0 in (* packet id *)
|
||||||
|
let open Cstruct in
|
||||||
|
|
||||||
|
(* write first packet *)
|
||||||
|
BE.set_uint16 buf 0 channel ;
|
||||||
|
set_uint8 buf 2 apdu ;
|
||||||
|
BE.set_uint16 buf 3 !i ;
|
||||||
|
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 ;
|
||||||
|
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 read ?(buf=Cstruct.create packet_length) h =
|
||||||
|
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)
|
||||||
|
| _ -> ()
|
||||||
|
end ;
|
||||||
|
let hdr, buf = Header.read buf in
|
||||||
|
Header.check_exn ~seq:!expected_seq hdr ;
|
||||||
|
if hdr.seq = 0 then begin (* first frame *)
|
||||||
|
let len = Cstruct.BE.get_uint16 buf 0 in
|
||||||
|
let cs = Cstruct.shift buf 2 in
|
||||||
|
payload := Cstruct.create len ;
|
||||||
|
full_payload := !payload ;
|
||||||
|
let nb_to_read = min len (packet_length - 7) in
|
||||||
|
Cstruct.blit cs 0 !payload 0 nb_to_read ;
|
||||||
|
payload := Cstruct.shift !payload nb_to_read ;
|
||||||
|
(* pos := !pos + nb_to_read ; *)
|
||||||
|
expected_seq := !expected_seq + 1 ;
|
||||||
|
end else begin (* next frames *)
|
||||||
|
(* let rem = Bytes.length !payload - !pos in *)
|
||||||
|
let nb_to_read = min (Cstruct.len !payload) (packet_length - 5) in
|
||||||
|
Cstruct.blit buf 0 !payload 0 nb_to_read ;
|
||||||
|
payload := Cstruct.shift !payload nb_to_read ;
|
||||||
|
(* 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
|
||||||
|
(* 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 ()
|
||||||
|
in
|
||||||
|
inner ()
|
||||||
|
|
||||||
|
let ping ?buf h =
|
||||||
|
write_ping ?buf h ;
|
||||||
|
match read ?buf h with
|
||||||
|
| Status.Ok, _ -> ()
|
||||||
|
| s, _ -> failwith ((Status.to_string s))
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
let write_payload
|
||||||
|
?pp ?(msg="write_payload") ?buf ?(mark_last=false) ~cmd ?p1 ?p2 h cs =
|
||||||
|
let rec inner cs =
|
||||||
|
let cs_len = Cstruct.len cs in
|
||||||
|
let lc = min Apdu.max_data_length cs_len in
|
||||||
|
let last = lc = cs_len in
|
||||||
|
let p1 = match last, mark_last, p1 with
|
||||||
|
| 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
|
||||||
|
else inner (Cstruct.shift cs lc) in
|
||||||
|
if Cstruct.len cs = 0 then cs else inner cs
|
||||||
|
|
||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff
|
||||||
|
|
||||||
|
Permission to use, copy, modify, and/or distribute this software for any
|
||||||
|
purpose with or without fee is hereby granted, provided that the above
|
||||||
|
copyright notice and this permission notice appear in all copies.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||||
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||||
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||||
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||||
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||||
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
|
---------------------------------------------------------------------------*)
|
66
vendors/ocaml-ledger-wallet/src/transport.mli
vendored
Normal file
66
vendors/ocaml-ledger-wallet/src/transport.mli
vendored
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
|
||||||
|
Distributed under the ISC license, see terms at the end of the file.
|
||||||
|
---------------------------------------------------------------------------*)
|
||||||
|
|
||||||
|
module Status : sig
|
||||||
|
type t =
|
||||||
|
| Invalid_pin of int
|
||||||
|
| Incorrect_length
|
||||||
|
| Incompatible_file_structure
|
||||||
|
| Security_status_unsatisfied
|
||||||
|
| Conditions_of_use_not_satisfied
|
||||||
|
| Incorrect_data
|
||||||
|
| File_not_found
|
||||||
|
| Incorrect_params
|
||||||
|
| Ins_not_supported
|
||||||
|
| Technical_problem of int
|
||||||
|
| Ok
|
||||||
|
|
||||||
|
val to_string : t -> string
|
||||||
|
val show : t -> string
|
||||||
|
val pp : Format.formatter -> t -> unit
|
||||||
|
end
|
||||||
|
|
||||||
|
val write_apdu :
|
||||||
|
?pp:Format.formatter -> ?buf:Cstruct.t ->
|
||||||
|
Hidapi.t -> Apdu.t -> unit
|
||||||
|
(** [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
|
||||||
|
payload. *)
|
||||||
|
|
||||||
|
val ping : ?buf:Cstruct.t -> Hidapi.t -> unit
|
||||||
|
(** [ping ?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
|
||||||
|
(** [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
|
||||||
|
(** [write_payload ?pp ?msg ?buf ?mark_last ~cmd ?p1 ?p2 ledger
|
||||||
|
payload] writes the [payload] of [cmd] into [ledger] and returns
|
||||||
|
the response. *)
|
||||||
|
|
||||||
|
(*---------------------------------------------------------------------------
|
||||||
|
Copyright (c) 2017 Vincent Bernardoff
|
||||||
|
|
||||||
|
Permission to use, copy, modify, and/or distribute this software for any
|
||||||
|
purpose with or without fee is hereby granted, provided that the above
|
||||||
|
copyright notice and this permission notice appear in all copies.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||||
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||||
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||||
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||||
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||||
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
|
---------------------------------------------------------------------------*)
|
9
vendors/ocaml-ledger-wallet/test/jbuild
vendored
Normal file
9
vendors/ocaml-ledger-wallet/test/jbuild
vendored
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
(executable
|
||||||
|
((name test_tezos)
|
||||||
|
(modules (Test_tezos))
|
||||||
|
(libraries (hex alcotest ledgerwallet-tezos tweetnacl uecc))))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
((name runtest-ledgerwallet-tezos)
|
||||||
|
(deps (test_tezos.exe))
|
||||||
|
(action (run ${<}))))
|
79
vendors/ocaml-ledger-wallet/test/test_tezos.ml
vendored
Normal file
79
vendors/ocaml-ledger-wallet/test/test_tezos.ml
vendored
Normal file
@ -0,0 +1,79 @@
|
|||||||
|
open Ledgerwallet_tezos
|
||||||
|
|
||||||
|
let vendor_id = 0x2C97
|
||||||
|
let product_id = 0x0001
|
||||||
|
|
||||||
|
let test_open_close () =
|
||||||
|
let h = Hidapi.open_id_exn ~vendor_id ~product_id in
|
||||||
|
Hidapi.close h
|
||||||
|
|
||||||
|
let test_ping () =
|
||||||
|
let h = Hidapi.open_id_exn ~vendor_id ~product_id in
|
||||||
|
Ledgerwallet.Transport.ping h ;
|
||||||
|
Hidapi.close h
|
||||||
|
|
||||||
|
let hard x =
|
||||||
|
Int32.logor x 0x8000_0000l
|
||||||
|
|
||||||
|
let path = [
|
||||||
|
hard 44l ; hard 1729l
|
||||||
|
]
|
||||||
|
|
||||||
|
let curves = [Ed25519; Secp256k1; Secp256r1]
|
||||||
|
|
||||||
|
let msg = Cstruct.of_string "Voulez-vous coucher avec moi, ce soir ?"
|
||||||
|
let msg_ba = Cstruct.to_bigarray msg
|
||||||
|
|
||||||
|
let test_getpk h curve =
|
||||||
|
let pk = get_public_key h curve path in
|
||||||
|
Alcotest.(check int "pklen"
|
||||||
|
(if curve = Ed25519 then 33 else 65) (Cstruct.len pk))
|
||||||
|
|
||||||
|
let test_getpk () =
|
||||||
|
let h = Hidapi.open_id_exn ~vendor_id ~product_id in
|
||||||
|
List.iter (test_getpk h) curves ;
|
||||||
|
Hidapi.close h
|
||||||
|
|
||||||
|
let test_sign h curve =
|
||||||
|
let open Alcotest in
|
||||||
|
let pk = get_public_key h curve path in
|
||||||
|
let signature = sign h curve path msg in
|
||||||
|
match curve with
|
||||||
|
| Ed25519 ->
|
||||||
|
let pk = Tweetnacl.Sign.(pk_of_cstruct_exn (Cstruct.sub pk 1 pkbytes)) in
|
||||||
|
check bool "sign Ed25519" true
|
||||||
|
(Tweetnacl.Sign.verify_detached ~key:pk ~signature msg)
|
||||||
|
| Secp256k1 -> begin
|
||||||
|
let pk = Cstruct.to_bigarray pk in
|
||||||
|
let signature = Cstruct.to_bigarray signature in
|
||||||
|
match Uecc.(pk_of_bytes secp256k1 pk) with
|
||||||
|
| None -> assert false
|
||||||
|
| Some pk ->
|
||||||
|
check bool "sign Secp256k1" true (Uecc.verify pk ~msg:msg_ba ~signature)
|
||||||
|
end
|
||||||
|
| Secp256r1 -> begin
|
||||||
|
let pk = Cstruct.to_bigarray pk in
|
||||||
|
let signature = Cstruct.to_bigarray signature in
|
||||||
|
match Uecc.(pk_of_bytes secp256r1 pk) with
|
||||||
|
| None -> assert false
|
||||||
|
| Some pk ->
|
||||||
|
check bool "sign Secp256r1" true (Uecc.verify pk ~msg:msg_ba ~signature)
|
||||||
|
end
|
||||||
|
|
||||||
|
let test_sign () =
|
||||||
|
let h = Hidapi.open_id_exn ~vendor_id ~product_id in
|
||||||
|
(* List.iter (test_sign h) curves ; *)
|
||||||
|
(* List.iter (test_sign h) [Secp256k1] ; *)
|
||||||
|
Hidapi.close h
|
||||||
|
|
||||||
|
let basic = [
|
||||||
|
"open_close", `Quick, test_open_close ;
|
||||||
|
"ping", `Quick, test_ping ;
|
||||||
|
"get_public_key", `Quick, test_getpk ;
|
||||||
|
"sign", `Quick, test_sign ;
|
||||||
|
]
|
||||||
|
|
||||||
|
let () =
|
||||||
|
Alcotest.run "ledgerwallet.tezos" [
|
||||||
|
"basic", basic ;
|
||||||
|
]
|
Loading…
Reference in New Issue
Block a user