diff --git a/src/crypto.ml b/src/crypto.ml index fbdf996c..388cb839 100644 --- a/src/crypto.ml +++ b/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 diff --git a/src/pg.ml b/src/pg.ml index 6be18f8e..d958c6a6 100644 --- a/src/pg.ml +++ b/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 *)