~~~
This commit is contained in:
parent
099cd80670
commit
b507d540ad
43 changed files with 5647 additions and 1808 deletions
179
src/crypto.ml
179
src/crypto.ml
|
|
@ -10,18 +10,32 @@ module EddsaPublicKey = struct
|
|||
type t = pub
|
||||
|
||||
let to_octets t = pub_to_octets t
|
||||
let of_octets t = pub_of_octets t |> Result.get_ok
|
||||
let bin = Bin.map (Bin.bytes 32) of_octets to_octets
|
||||
|
||||
let of_octets t =
|
||||
pub_of_octets t |> function
|
||||
| Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
|
||||
| Ok v -> Ok v
|
||||
|
||||
let bin =
|
||||
let of_octets o =
|
||||
match of_octets o with Error e -> raise (Util.Bin_error e) | Ok v -> v
|
||||
in
|
||||
Bin.map (Bin.bytes 32) of_octets to_octets
|
||||
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* octets = B32.decode s in
|
||||
match pub_of_octets octets with
|
||||
| Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
|
||||
| Ok pub -> Ok pub
|
||||
let* pub = of_octets octets in
|
||||
Ok pub
|
||||
|
||||
let to_b32 t = B32.encode (to_octets t)
|
||||
let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
|
||||
|
||||
let caqti =
|
||||
Caqti_type.custom
|
||||
~encode:(fun v -> Ok (to_octets v))
|
||||
~decode:(fun v -> of_octets v)
|
||||
Caqti_type.octets
|
||||
end
|
||||
|
||||
module EddsaPrivateKey = struct
|
||||
|
|
@ -34,69 +48,88 @@ module EddsaPrivateKey = struct
|
|||
|
||||
let pub_of_priv = pub_of_priv
|
||||
let to_octets t = priv_to_octets t
|
||||
let of_octets t = priv_of_octets t |> Result.get_ok
|
||||
let bin = Bin.map (Bin.bytes 32) of_octets to_octets
|
||||
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* octets = B32.decode s in
|
||||
match priv_of_octets octets with
|
||||
| Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
|
||||
| Ok priv -> Ok priv
|
||||
let of_octets t =
|
||||
priv_of_octets t |> function
|
||||
| Error err ->
|
||||
let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in
|
||||
Error err
|
||||
| Ok v -> Ok v
|
||||
|
||||
let to_b32 t = B32.encode (to_octets t)
|
||||
let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
|
||||
let bin =
|
||||
let of_octets_exn t = of_octets t |> Result.get_ok in
|
||||
Bin.map (Bin.bytes 32) of_octets_exn to_octets
|
||||
|
||||
let jsont =
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* octets = B32.decode s in
|
||||
of_octets octets
|
||||
in
|
||||
let to_b32 t = B32.encode (to_octets t) in
|
||||
Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
|
||||
end
|
||||
|
||||
module EddsaSignature : sig
|
||||
type t
|
||||
|
||||
val sign : key:Mirage_crypto_ec.Ed25519.priv -> string -> t
|
||||
val sign_as_string : key:Mirage_crypto_ec.Ed25519.priv -> string -> string
|
||||
val of_b32 : string -> (t, string) result
|
||||
val to_b32 : t -> string
|
||||
val sign : key:EddsaPrivateKey.t -> string -> t
|
||||
|
||||
(* Ok () on verification success *)
|
||||
val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result
|
||||
val to_octets : t -> string
|
||||
val of_octets : string -> t
|
||||
val of_octets : string -> (t, string) result
|
||||
val jsont : t Jsont.t
|
||||
val bin : t Bin.t
|
||||
val caqti : t Caqti_type.t
|
||||
end = struct
|
||||
(* TODO key format
|
||||
endianess issue? *)
|
||||
(* EdDSA signatures are transmitted as 64-bytes base32
|
||||
binary-encoded objects with just the R and S values (base32_ binary-only).
|
||||
|
||||
They are signature over a c-struct like `TALER_xxxPS` + with a purpose *)
|
||||
(* transmitted as 64-bytes base32
|
||||
binary-encoded objects with just the R and S values *)
|
||||
type t = string
|
||||
|
||||
(* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)
|
||||
let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s
|
||||
|
||||
let verify ~key s ~msg =
|
||||
let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in
|
||||
match b with
|
||||
| false -> Error "signature verification failure: invalid signature"
|
||||
| true -> Ok ()
|
||||
|
||||
let to_octets t = t
|
||||
|
||||
let of_octets v =
|
||||
match String.length v = 64 with
|
||||
| false ->
|
||||
Fmt.failwith "EddsaSignature.of_octets failure: data is not 64 bytes."
|
||||
| true -> v
|
||||
Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
|
||||
| true -> Ok v
|
||||
|
||||
let bin = Bin.map (Bin.bytes 64) of_octets to_octets
|
||||
|
||||
let sign ~key s =
|
||||
(* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)
|
||||
Mirage_crypto_ec.Ed25519.sign ~key s
|
||||
|
||||
let sign_as_string ~key s = sign ~key s
|
||||
let bin =
|
||||
let of_octets_exn t = of_octets t |> Result.get_ok in
|
||||
Bin.map (Bin.bytes 64) of_octets_exn to_octets
|
||||
|
||||
let check_size t =
|
||||
match String.length t = 64 with
|
||||
| false -> Error "EddsaSignature: invalid string length"
|
||||
| true -> Ok ()
|
||||
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* t = B32.decode s in
|
||||
let+ () = check_size t in
|
||||
t
|
||||
let jsont =
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* t = B32.decode s in
|
||||
let+ () = check_size t in
|
||||
t
|
||||
in
|
||||
let to_b32 = B32.encode in
|
||||
Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
|
||||
|
||||
let to_b32 = B32.encode
|
||||
let jsont = Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
|
||||
let caqti =
|
||||
Caqti_type.custom
|
||||
~encode:(fun v -> Ok (to_octets v))
|
||||
~decode:(fun s -> of_octets s)
|
||||
Caqti_type.octets
|
||||
end
|
||||
|
||||
module RsaPublicKey = struct
|
||||
|
|
@ -104,18 +137,24 @@ module RsaPublicKey = struct
|
|||
|
||||
type t = Rsa.pub
|
||||
|
||||
let of_octets = Util.Bin_rsa.pub_of_octets
|
||||
let to_octets = Util.Bin_rsa.pub_to_octets
|
||||
let of_octets = Util.Bin_rsa.pub_of_octets
|
||||
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* s = B32.decode s in
|
||||
let v = Util.Bin_rsa.pub_of_octets s in
|
||||
let+ v = Rsa.pub ~n:v.n ~e:v.e |> unwrap_err_msg in
|
||||
v
|
||||
let jsont =
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* s = B32.decode s in
|
||||
let+ v = of_octets s in
|
||||
v
|
||||
in
|
||||
let to_b32 t = B32.encode (to_octets t) in
|
||||
Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
|
||||
|
||||
let to_b32 t = B32.encode (to_octets t)
|
||||
let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
|
||||
let caqti : t Caqti_type.t =
|
||||
Caqti_type.custom
|
||||
~encode:(fun v -> Ok (to_octets v))
|
||||
~decode:(fun v -> of_octets v)
|
||||
Caqti_type.octets
|
||||
end
|
||||
|
||||
module RsaPrivateKey = struct
|
||||
|
|
@ -123,37 +162,49 @@ module RsaPrivateKey = struct
|
|||
|
||||
type t = priv
|
||||
|
||||
let generate ~bits () =
|
||||
let priv = generate ~bits () in
|
||||
let pub = pub_of_priv priv in
|
||||
(priv, pub)
|
||||
|
||||
let pub_of_priv = pub_of_priv
|
||||
let of_octets = Util.Bin_rsa.priv_of_octets
|
||||
let to_octets = Util.Bin_rsa.priv_to_octets
|
||||
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* s = B32.decode s in
|
||||
Ok (of_octets s)
|
||||
|
||||
let to_b32 t = B32.encode (to_octets t)
|
||||
let jsont = Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
|
||||
let jsont =
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* s = B32.decode s in
|
||||
let+ v = of_octets s in
|
||||
v
|
||||
in
|
||||
let to_b32 t = B32.encode (to_octets t) in
|
||||
Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
|
||||
end
|
||||
|
||||
module RsaSignature : sig
|
||||
type t
|
||||
|
||||
val to_octets : t -> string
|
||||
val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t
|
||||
val of_b32 : string -> (t, string) result
|
||||
val to_b32 : t -> string
|
||||
val jsont : t Jsont.t
|
||||
end = struct
|
||||
type t = string
|
||||
|
||||
let to_octets t = t
|
||||
|
||||
(* TODO rsa sign *)
|
||||
let sign ~key s =
|
||||
Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s
|
||||
|
||||
let of_b32 s = B32.decode s
|
||||
let to_b32 t = B32.encode t
|
||||
let jsont = Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
|
||||
let jsont =
|
||||
let of_b32 s = B32.decode s in
|
||||
let to_b32 t = B32.encode t in
|
||||
Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
|
||||
end
|
||||
|
||||
(* some type aliases, just for prettier .mli *)
|
||||
type eddsa_priv = EddsaPrivateKey.t
|
||||
type eddsa_pub = EddsaPublicKey.t
|
||||
type eddsa_sig = EddsaSignature.t
|
||||
type rsa_priv = RsaPrivateKey.t
|
||||
type rsa_pub = RsaPublicKey.t
|
||||
type rsa_sig = RsaSignature.t
|
||||
type denomination_hash = Bin_type.DenominationHash.t
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue