459 lines
16 KiB
OCaml
459 lines
16 KiB
OCaml
module Context = struct
|
|
type t
|
|
|
|
external create : int -> t = "caml_secp256k1_context_create"
|
|
external clone : t -> t = "caml_secp256k1_context_clone"
|
|
external randomize : t -> Bigstring.t -> bool = "caml_secp256k1_context_randomize" [@@noalloc]
|
|
|
|
let create ?(sign=true) ?(verify=true) () =
|
|
let flags = 1 lor
|
|
(if sign then 0x100 else 0) lor
|
|
(if verify then 0x200 else 0) in
|
|
create flags
|
|
|
|
let randomize ctx buf =
|
|
if Bigstring.length buf < 32 then
|
|
invalid_arg "Context.randomize: input must be at least 32 bytes long" ;
|
|
randomize ctx buf
|
|
end
|
|
|
|
module Key = struct
|
|
type secret
|
|
type public
|
|
type _ t =
|
|
| Sk : Bigstring.t -> secret t
|
|
| Pk : Bigstring.t -> public t
|
|
|
|
let buffer : type a. a t -> Bigstring.t = function
|
|
| Sk sk -> sk
|
|
| Pk pk -> pk
|
|
|
|
let secret_bytes = 32
|
|
let public_bytes = 64
|
|
let compressed_pk_bytes = 33
|
|
let uncompressed_pk_bytes = 65
|
|
|
|
let bytes : type a. a t -> int = function
|
|
| Sk _ -> secret_bytes
|
|
| Pk _ -> public_bytes
|
|
|
|
let serialized_bytes :
|
|
type a. ?compressed:bool -> a t -> int =
|
|
fun ?(compressed=true) -> function
|
|
| Sk _ -> secret_bytes
|
|
| Pk _ -> if compressed then public_bytes + 1 else secret_bytes + 1
|
|
|
|
let equal : type a. a t -> a t -> bool = fun a b ->
|
|
match a, b with
|
|
| Sk a, Sk b -> Bigstring.equal a b
|
|
| Pk a, Pk b -> Bigstring.equal a b
|
|
|
|
let copy : type a. a t -> a t = function
|
|
| Sk sk -> Sk (Bigstring.copy sk)
|
|
| Pk pk -> Pk (Bigstring.copy pk)
|
|
|
|
external sk_negate_inplace : Context.t -> Bigstring.t -> unit =
|
|
"caml_secp256k1_ec_privkey_negate" [@@noalloc]
|
|
external sk_add_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ec_privkey_tweak_add" [@@noalloc]
|
|
external sk_mul_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ec_privkey_tweak_mul" [@@noalloc]
|
|
external pk_negate_inplace : Context.t -> Bigstring.t -> unit =
|
|
"caml_secp256k1_ec_pubkey_negate" [@@noalloc]
|
|
external pk_add_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ec_pubkey_tweak_add" [@@noalloc]
|
|
external pk_mul_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ec_pubkey_tweak_mul" [@@noalloc]
|
|
external pk_combine : Context.t -> Bigstring.t -> Bigstring.t list -> bool =
|
|
"caml_secp256k1_ec_pubkey_combine" [@@noalloc]
|
|
|
|
let negate_inplace :
|
|
type a. Context.t -> a t -> unit = fun ctx -> function
|
|
| Sk k -> sk_negate_inplace ctx k
|
|
| Pk k -> pk_negate_inplace ctx k
|
|
|
|
let negate ctx k =
|
|
let k' = copy k in
|
|
negate_inplace ctx k' ;
|
|
k'
|
|
|
|
let op_tweak :
|
|
type a. string -> (Context.t -> Bigstring.t -> Bigstring.t -> bool) ->
|
|
Context.t -> a t -> Bigstring.t -> Bigstring.t =
|
|
fun name f ctx k buf ->
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < 32 then
|
|
invalid_arg (Printf.sprintf "Key.%s: " name) ;
|
|
let k' = buffer (copy k) in
|
|
if not (f ctx k' buf) then
|
|
failwith (Printf.sprintf "Key.%s: operation failed" name) ;
|
|
k'
|
|
|
|
let add_tweak :
|
|
type a. Context.t -> a t -> Bigstring.t -> a t =
|
|
fun ctx k buf ->
|
|
match k with
|
|
| Sk _ -> Sk (op_tweak "add_tweak" sk_add_tweak_inplace ctx k buf)
|
|
| Pk _ -> Pk (op_tweak "add_tweak" pk_add_tweak_inplace ctx k buf)
|
|
|
|
let mul_tweak :
|
|
type a. Context.t -> a t -> Bigstring.t -> a t =
|
|
fun ctx k buf ->
|
|
match k with
|
|
| Sk _ -> Sk (op_tweak "mul_tweak" sk_mul_tweak_inplace ctx k buf)
|
|
| Pk _ -> Pk (op_tweak "mul_tweak" pk_mul_tweak_inplace ctx k buf)
|
|
|
|
external pk_parse : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ec_pubkey_parse" [@@noalloc]
|
|
external pk_serialize : Context.t -> Bigstring.t -> Bigstring.t -> int =
|
|
"caml_secp256k1_ec_pubkey_serialize" [@@noalloc]
|
|
external pk_create : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ec_pubkey_create" [@@noalloc]
|
|
|
|
let neuterize :
|
|
type a. Context.t -> a t -> public t option = fun ctx -> function
|
|
| Pk pk -> Some (Pk pk)
|
|
| Sk sk ->
|
|
let pk = Bigstring.create public_bytes in
|
|
if pk_create ctx pk sk then Some (Pk pk) else None
|
|
|
|
let neuterize_exn ctx k =
|
|
match neuterize ctx k with
|
|
| None -> invalid_arg "Key.neuterize_exn: invalid secret key"
|
|
| Some pk -> pk
|
|
|
|
let list_map_filter_opt ~f l =
|
|
ListLabels.fold_left ~init:[] ~f:begin fun a e ->
|
|
match f e with
|
|
| None -> a
|
|
| Some r -> r :: a
|
|
end l
|
|
|
|
let combine ctx pks =
|
|
let nb_pks = List.length pks in
|
|
if nb_pks = 0 || nb_pks > 1024 then None
|
|
else
|
|
let pk = Bigstring.create public_bytes in
|
|
let pks = list_map_filter_opt ~f:begin fun k ->
|
|
match neuterize ctx k with
|
|
| None -> None
|
|
| Some (Pk k) -> Some k
|
|
end pks in
|
|
if pk_combine ctx pk pks then Some (Pk pk)
|
|
else None
|
|
|
|
let combine_exn ctx pks =
|
|
match combine ctx pks with
|
|
| None -> invalid_arg "Key.combine_exn: sum of pks is invalid"
|
|
| Some pk -> pk
|
|
|
|
external verify_sk : Context.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ec_seckey_verify" [@@noalloc]
|
|
|
|
let read_sk_exn ctx buf =
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < secret_bytes then
|
|
invalid_arg (Printf.sprintf "Key.read_sk: invalid buffer size %d" buflen) ;
|
|
match verify_sk ctx buf with
|
|
| true -> Sk Bigstring.(copy (sub buf 0 secret_bytes))
|
|
| false -> invalid_arg "Key.read_sk: secret key is invalid"
|
|
|
|
let read_sk ctx buf =
|
|
try Ok (read_sk_exn ctx buf) with
|
|
| Invalid_argument msg -> Error msg
|
|
|
|
let read_pk_exn ctx buf =
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < compressed_pk_bytes then
|
|
invalid_arg (Printf.sprintf "Key.read_pk: invalid buffer size %d" buflen) ;
|
|
let outbuf = Bigstring.create public_bytes in
|
|
if pk_parse ctx outbuf buf then
|
|
Pk outbuf
|
|
else
|
|
invalid_arg "Key.read_pk_exn: public key is invalid"
|
|
|
|
let read_pk ctx buf =
|
|
try Ok (read_pk_exn ctx buf) with
|
|
| Invalid_argument msg -> Error msg
|
|
|
|
let write :
|
|
type a. ?compress:bool -> Context.t -> ?pos:int -> Bigstring.t -> a t -> int =
|
|
fun ?(compress=true) ctx ?(pos=0) buf -> function
|
|
| Sk sk ->
|
|
let buflen = Bigstring.length buf in
|
|
if pos < 0 || pos > buflen - secret_bytes then
|
|
invalid_arg "Key.write (secret): pos < 0 or pos + 32 > buflen" ;
|
|
Bigstring.blit sk 0 buf pos secret_bytes ;
|
|
secret_bytes
|
|
| Pk pk ->
|
|
let buflen = Bigstring.length buf in
|
|
if pos < 0
|
|
|| (compress && pos > buflen - compressed_pk_bytes)
|
|
|| (not compress && pos > buflen - uncompressed_pk_bytes) then
|
|
invalid_arg (Printf.sprintf "Key.write (public): pos=%d, buflen=%d" pos buflen) ;
|
|
let len = if compress then 33 else 65 in
|
|
let buf = Bigstring.sub buf pos len in
|
|
pk_serialize ctx buf pk
|
|
|
|
let to_bytes :
|
|
type a. ?compress:bool -> Context.t -> a t -> Bigstring.t =
|
|
fun ?(compress=true) ctx -> function
|
|
| Sk _ as sk ->
|
|
let buf = Bigstring.create secret_bytes in
|
|
let _ = write ~compress ctx buf sk in
|
|
buf
|
|
| Pk _ as pk ->
|
|
let buf =
|
|
Bigstring.create (1 + (if compress then secret_bytes else public_bytes)) in
|
|
let _ = write ~compress ctx buf pk in
|
|
buf
|
|
end
|
|
|
|
module Sign = struct
|
|
type plain
|
|
type recoverable
|
|
type _ t =
|
|
| P : Bigstring.t -> plain t
|
|
| R : Bigstring.t -> recoverable t
|
|
|
|
let buffer : type a. a t -> Bigstring.t = function
|
|
| P plain -> plain
|
|
| R recoverable -> recoverable
|
|
|
|
let plain_bytes = 64
|
|
let recoverable_bytes = 65
|
|
let msg_bytes = 32
|
|
|
|
let equal : type a. a t -> a t -> bool = fun a b ->
|
|
match a, b with
|
|
| P a, P b -> Bigstring.equal a b
|
|
| R a, R b -> Bigstring.equal a b
|
|
|
|
external parse_compact : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ecdsa_signature_parse_compact" [@@noalloc]
|
|
external parse_der : Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ecdsa_signature_parse_der" [@@noalloc]
|
|
external serialize_compact : Context.t -> Bigstring.t -> Bigstring.t -> unit =
|
|
"caml_secp256k1_ecdsa_signature_serialize_compact" [@@noalloc]
|
|
external serialize_der : Context.t -> Bigstring.t -> Bigstring.t -> int =
|
|
"caml_secp256k1_ecdsa_signature_serialize_der" [@@noalloc]
|
|
external parse_recoverable : Context.t -> Bigstring.t -> Bigstring.t -> int -> bool =
|
|
"caml_secp256k1_ecdsa_recoverable_signature_parse_compact" [@@noalloc]
|
|
external serialize_recoverable : Context.t -> Bigstring.t -> Bigstring.t -> int =
|
|
"caml_secp256k1_ecdsa_recoverable_signature_serialize_compact" [@@noalloc]
|
|
|
|
let read_exn ctx buf =
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < plain_bytes then
|
|
invalid_arg (Printf.sprintf "Sign.read: invalid buffer size %d" buflen) ;
|
|
let signature = Bigstring.create plain_bytes in
|
|
if parse_compact ctx signature buf then
|
|
P signature
|
|
else
|
|
invalid_arg "Sign.read: signature could not be parsed"
|
|
|
|
let read ctx buf =
|
|
try Ok (read_exn ctx buf) with
|
|
Invalid_argument msg -> Error msg
|
|
|
|
let read_der_exn ctx buf =
|
|
let signature = Bigstring.create plain_bytes in
|
|
if parse_der ctx signature buf then
|
|
P signature
|
|
else
|
|
invalid_arg "Sign.read_der: signature could not be parsed"
|
|
|
|
let read_der ctx buf =
|
|
try Ok (read_der_exn ctx buf) with
|
|
Invalid_argument msg -> Error msg
|
|
|
|
let read_recoverable_exn ctx buf =
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < recoverable_bytes then
|
|
invalid_arg (Printf.sprintf "Sign.read_recoverable: invalid buffer size %d" buflen) ;
|
|
let signature = Bigstring.create recoverable_bytes in
|
|
let recid = int_of_char (Bigstring.get buf 64) in
|
|
if parse_recoverable ctx signature buf recid then
|
|
R signature
|
|
else
|
|
invalid_arg "Sign.read_recoverable: signature could not be parsed"
|
|
|
|
let read_recoverable ctx buf =
|
|
try Ok (read_recoverable_exn ctx buf) with
|
|
| Invalid_argument msg -> Error msg
|
|
|
|
let write_exn :
|
|
type a. ?der:bool -> Context.t -> Bigstring.t -> a t -> int =
|
|
fun ?(der=false) ctx buf -> function
|
|
| P signature ->
|
|
let buflen = Bigstring.length buf in
|
|
if not der then begin
|
|
if buflen < plain_bytes then
|
|
invalid_arg (Printf.sprintf "Sign.write: buffer length too small (%d)" buflen) ;
|
|
serialize_compact ctx buf signature ;
|
|
plain_bytes
|
|
end
|
|
else begin
|
|
match serialize_der ctx buf signature with
|
|
| 0 -> invalid_arg "Sign.write_exn: buffer too small to \
|
|
contain a DER signature"
|
|
| len -> len
|
|
end
|
|
| R signature ->
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < recoverable_bytes then
|
|
invalid_arg (Printf.sprintf "Sign.write: buffer length too small (%d)" buflen) ;
|
|
let recid = serialize_recoverable ctx buf signature in
|
|
Bigstring.set buf 64 (char_of_int recid) ;
|
|
recoverable_bytes
|
|
|
|
let write ?der ctx buf signature =
|
|
try Ok (write_exn ?der ctx buf signature) with
|
|
Invalid_argument msg -> Error msg
|
|
|
|
let to_bytes :
|
|
type a. ?der:bool -> Context.t -> a t -> Bigstring.t =
|
|
fun ?(der=false) ctx -> function
|
|
| P _ as signature ->
|
|
if der then begin
|
|
let buf = Bigstring.create 72 in
|
|
let nb_written = write_exn ~der ctx buf signature in
|
|
Bigstring.sub buf 0 nb_written
|
|
end
|
|
else
|
|
let buf = Bigstring.create plain_bytes in
|
|
let _nb_written = write_exn ~der ctx buf signature in
|
|
buf
|
|
| R _ as signature ->
|
|
let buf = Bigstring.create recoverable_bytes in
|
|
let _nb_written = write_exn ctx buf signature in
|
|
buf
|
|
|
|
external normalize :
|
|
Context.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ecdsa_signature_normalize" [@@noalloc]
|
|
|
|
let normalize ctx (P signature) =
|
|
let normalized_sig = Bigstring.create plain_bytes in
|
|
if normalize ctx normalized_sig signature then
|
|
Some (P normalized_sig) else None
|
|
|
|
(* [sign ctx signature msg sk] *)
|
|
external sign :
|
|
Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ecdsa_sign" [@@noalloc]
|
|
|
|
(* [verify ctx pk msg signature] *)
|
|
external verify :
|
|
Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ecdsa_verify" [@@noalloc]
|
|
|
|
let check_msglen msg =
|
|
let msglen = Bigstring.length msg in
|
|
if msglen < msg_bytes
|
|
then invalid_arg
|
|
(Printf.sprintf "message is too small (%d < %d)" msglen msg_bytes)
|
|
|
|
let sign_exn ctx buf ~sk ~msg =
|
|
check_msglen msg ;
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < plain_bytes then
|
|
invalid_arg (Printf.sprintf "Sign.write_sign: buffer length too \
|
|
small (%d)" buflen) ;
|
|
match sign ctx buf (Key.buffer sk) msg with
|
|
| true -> ()
|
|
| false -> invalid_arg "Sign.write_sign: the nonce generation \
|
|
function failed, or the private key was \
|
|
invalid"
|
|
|
|
let write_sign_exn ctx buf ~sk ~msg =
|
|
let signature = Bigstring.create plain_bytes in
|
|
sign_exn ctx signature ~sk ~msg ;
|
|
write_exn ctx buf (P signature)
|
|
|
|
let write_sign ctx buf ~sk ~msg =
|
|
try Ok (write_sign_exn ctx ~sk ~msg buf)
|
|
with Invalid_argument msg -> Error msg
|
|
|
|
let sign_exn ctx ~sk msg =
|
|
let signature = Bigstring.create plain_bytes in
|
|
sign_exn ctx signature ~sk ~msg ;
|
|
P signature
|
|
|
|
let sign ctx ~sk msg =
|
|
try Ok (sign_exn ctx ~sk msg)
|
|
with Invalid_argument msg -> Error msg
|
|
|
|
external sign_recoverable :
|
|
Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ecdsa_sign_recoverable" [@@noalloc]
|
|
|
|
let write_sign_recoverable_exn ctx ~sk ~msg buf =
|
|
check_msglen msg ;
|
|
let buflen = Bigstring.length buf in
|
|
if buflen < recoverable_bytes then
|
|
invalid_arg (Printf.sprintf "Sign.write_sign_recoverable: buffer \
|
|
length too small (%d)" buflen) ;
|
|
if sign_recoverable ctx buf (Key.buffer sk) msg then
|
|
recoverable_bytes
|
|
else invalid_arg "Sign.write_sign_recoverable_exn: the nonce \
|
|
generation function failed, or the private key \
|
|
was invalid"
|
|
|
|
let write_sign_recoverable ctx ~sk ~msg buf =
|
|
try Ok (write_sign_recoverable_exn ctx ~sk ~msg buf)
|
|
with Invalid_argument msg -> Error msg
|
|
|
|
let sign_recoverable ctx ~sk msg =
|
|
let signature = Bigstring.create recoverable_bytes in
|
|
match write_sign_recoverable ctx ~sk ~msg signature with
|
|
| Error error -> Error error
|
|
| Ok _nb_written -> Ok (R signature)
|
|
|
|
let sign_recoverable_exn ctx ~sk msg =
|
|
match sign_recoverable ctx ~sk msg with
|
|
| Error msg -> invalid_arg msg
|
|
| Ok signature -> signature
|
|
|
|
external to_plain : Context.t -> Bigstring.t -> Bigstring.t -> unit =
|
|
"caml_secp256k1_ecdsa_recoverable_signature_convert" [@@noalloc]
|
|
|
|
let to_plain : type a. Context.t -> a t -> plain t = fun ctx -> function
|
|
| P _ as signature -> signature
|
|
| R recoverable ->
|
|
let plain = Bigstring.create plain_bytes in
|
|
to_plain ctx plain recoverable ;
|
|
P plain
|
|
|
|
let verify_plain_exn ctx ~pk msg signature =
|
|
check_msglen msg ;
|
|
let siglen = Bigstring.length signature in
|
|
if siglen < plain_bytes then
|
|
invalid_arg (Printf.sprintf "verify: signature too short (%d < %d)"
|
|
siglen plain_bytes) ;
|
|
verify ctx (Key.buffer pk) msg signature
|
|
|
|
let verify_exn ctx ~pk ~msg ~signature =
|
|
let P signature = to_plain ctx signature in
|
|
verify_plain_exn ctx ~pk msg signature
|
|
|
|
let verify ctx ~pk ~msg ~signature =
|
|
try Ok (verify_exn ctx ~pk ~msg ~signature) with
|
|
| Invalid_argument msg -> Error msg
|
|
|
|
external recover :
|
|
Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
|
|
"caml_secp256k1_ecdsa_recover" [@@noalloc]
|
|
|
|
let recover_exn ctx ~signature:(R signature) msg =
|
|
check_msglen msg ;
|
|
let pk = Bigstring.create Key.public_bytes in
|
|
if recover ctx pk signature msg then Key.Pk pk
|
|
else
|
|
invalid_arg "Sign.recover: pk could not be recovered"
|
|
|
|
let recover ctx ~signature msg =
|
|
try Ok (recover_exn ctx ~signature msg) with
|
|
Invalid_argument msg -> Error msg
|
|
end
|