.
This commit is contained in:
parent
e239f802b1
commit
a05b8351f0
2 changed files with 77 additions and 79 deletions
123
src/crypto.ml
123
src/crypto.ml
|
|
@ -22,14 +22,21 @@ module EddsaPublicKey = struct
|
|||
in
|
||||
Bin.map (Bin.bytes 32) of_octets to_octets
|
||||
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* octets = B32.decode s in
|
||||
let* pub = of_octets octets in
|
||||
Ok pub
|
||||
let jsont =
|
||||
let of_b32 s =
|
||||
let open Syntax in
|
||||
let* octets = B32.decode s in
|
||||
let* pub = of_octets octets in
|
||||
Ok pub
|
||||
in
|
||||
let to_b32 t = B32.encode (to_octets t) in
|
||||
Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
|
||||
|
||||
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
|
||||
|
|
@ -45,15 +52,16 @@ module EddsaPrivateKey = struct
|
|||
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 to_b32 t = B32.encode (to_octets t)
|
||||
let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
|
||||
let jsont =
|
||||
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
|
||||
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
|
||||
|
|
@ -61,12 +69,11 @@ module EddsaSignature : sig
|
|||
|
||||
val sign : key:EddsaPrivateKey.t -> string -> t
|
||||
val verify : key:EddsaPublicKey.t -> t -> msg:string -> bool
|
||||
val of_b32 : string -> (t, string) result
|
||||
val to_b32 : t -> string
|
||||
val to_octets : t -> string
|
||||
val of_octets : string -> t
|
||||
val jsont : t Jsont.t
|
||||
val bin : t Bin.t
|
||||
val caqti : t Caqti_type.t
|
||||
end = struct
|
||||
(* TODO key format
|
||||
endianess issue? *)
|
||||
|
|
@ -74,6 +81,9 @@ end = struct
|
|||
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 = Mirage_crypto_ec.Ed25519.verify ~key s ~msg
|
||||
let to_octets t = t
|
||||
|
||||
let of_octets v =
|
||||
|
|
@ -84,23 +94,26 @@ end = struct
|
|||
|
||||
let bin = Bin.map (Bin.bytes 64) of_octets to_octets
|
||||
|
||||
(* 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 = Mirage_crypto_ec.Ed25519.verify ~key s ~msg
|
||||
|
||||
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 -> Ok (of_octets s))
|
||||
Caqti_type.octets
|
||||
end
|
||||
|
||||
module RsaPublicKey = struct
|
||||
|
|
@ -108,17 +121,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 = of_octets s 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
|
||||
|
|
@ -130,34 +150,31 @@ module RsaPrivateKey = struct
|
|||
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
|
||||
let+ v = of_octets s in
|
||||
v
|
||||
|
||||
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
|
||||
|
|
|
|||
33
src/pg.ml
33
src/pg.ml
|
|
@ -12,11 +12,6 @@ open Crypto
|
|||
module Caqti_type = struct
|
||||
include Caqti_type
|
||||
|
||||
(* we want to use int64 timestamps,
|
||||
not postgresql built-in timestamp type *)
|
||||
let ptime : Ptime.t option t = Timestamp.caqti
|
||||
let time = Timestamp.caqti
|
||||
|
||||
let amount : Amount.t t =
|
||||
let open Amount in
|
||||
custom
|
||||
|
|
@ -25,28 +20,14 @@ module Caqti_type = struct
|
|||
Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
|
||||
(t2 int64 int32)
|
||||
|
||||
(* we want to use int64 timestamps,
|
||||
not postgresql built-in timestamp type *)
|
||||
let ptime : Ptime.t option t = Timestamp.caqti
|
||||
let time = Timestamp.caqti
|
||||
let age_mask : int t = Caqti_type.int
|
||||
|
||||
let rsa_public : RsaPublicKey.t t =
|
||||
let open RsaPublicKey in
|
||||
custom
|
||||
~encode:(fun v -> Ok (to_octets v))
|
||||
~decode:(fun v -> of_octets v)
|
||||
octets
|
||||
|
||||
let eddsa_public : EddsaPublicKey.t t =
|
||||
let open EddsaPublicKey in
|
||||
custom
|
||||
~encode:(fun v -> Ok (to_octets v))
|
||||
~decode:(fun v -> of_octets v)
|
||||
octets
|
||||
|
||||
let eddsa_signature : EddsaSignature.t t =
|
||||
let open EddsaSignature in
|
||||
custom
|
||||
~encode:(fun v -> Ok (to_octets v))
|
||||
~decode:(fun s -> Ok (of_octets s))
|
||||
octets
|
||||
let rsa_public = RsaPublicKey.caqti
|
||||
let eddsa_public = EddsaPublicKey.caqti
|
||||
let eddsa_signature = EddsaSignature.caqti
|
||||
|
||||
include struct
|
||||
(* alias for hash *)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue