~

src/crypto.ml

@@ -10,18 +10,33 @@ 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_b32 s =
+  let of_octets t =
-    let open Syntax in
+    pub_of_octets t |> function
-    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
+    | Ok v -> Ok v
 
-  let to_b32 t = B32.encode (to_octets t)
+  let bin =
-  let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
+    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 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 caqti =
+    Caqti_type.custom
+      ~encode:(fun v -> Ok (to_octets v))
+      ~decode:(fun v -> of_octets v)
+      Caqti_type.octets
 end
 
 module EddsaPrivateKey = struct
@@ -37,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 jsont =
-    let open Syntax in
+    let of_b32 s =
-    let* octets = B32.decode s in
+      let open Syntax in
-    match priv_of_octets octets with
+      let* octets = B32.decode s in
-    | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
+      match priv_of_octets octets with
-    | Ok priv -> Ok priv
+      | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
-
+      | Ok priv -> Ok priv
-  let to_b32 t = B32.encode (to_octets t)
+    in
-  let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
+    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
@@ -53,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? *)
@@ -66,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 =
@@ -76,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 jsont =
-    let open Syntax in
+    let of_b32 s =
-    let* t = B32.decode s in
+      let open Syntax in
-    let+ () = check_size t in
+      let* t = B32.decode s in
-    t
+      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 caqti =
-  let jsont = Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
+    Caqti_type.custom
+      ~encode:(fun v -> Ok (to_octets v))
+      ~decode:(fun s -> Ok (of_octets s))
+      Caqti_type.octets
 end
 
 module RsaPublicKey = struct
@@ -100,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 jsont =
-    let open Syntax in
+    let of_b32 s =
-    let* s = B32.decode s in
+      let open Syntax in
-    let+ v = of_octets s in
+      let* s = B32.decode s in
-    v
+      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 caqti : t Caqti_type.t =
-  let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
+    Caqti_type.custom
+      ~encode:(fun v -> Ok (to_octets v))
+      ~decode:(fun v -> of_octets v)
+      Caqti_type.octets
 end
 
 module RsaPrivateKey = struct
@@ -122,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 jsont =
-    let open Syntax in
+    let of_b32 s =
-    let* s = B32.decode s in
+      let open Syntax in
-    let+ v = of_octets s in
+      let* s = B32.decode s in
-    v
+      let+ v = of_octets s in
-
+      v
-  let to_b32 t = B32.encode (to_octets t)
+    in
-  let jsont = Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
+    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 jsont =
-  let to_b32 t = B32.encode t
+    let of_b32 s = B32.decode s in
-  let jsont = Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
+    let to_b32 t = B32.encode t in
+    Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
 end

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.caqti
-  let rsa_public : RsaPublicKey.t t =
+  let eddsa_public = EddsaPublicKey.caqti
-    let open RsaPublicKey in
+  let eddsa_signature = EddsaSignature.caqti
-    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 -> Ok (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
 
   include struct
     (* alias for hash *)

src/util.ml

@@ -1,3 +1,5 @@
+exception Bin_error of string
+
 (* TODO bin
    - no [Bin.of_string] ? *)
 let bin_of_string bin s =