This commit is contained in:
swrup 2025-12-07 07:51:32 +01:00
parent e239f802b1
commit a05b8351f0
2 changed files with 77 additions and 79 deletions

View file

@ -22,14 +22,21 @@ module EddsaPublicKey = struct
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 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 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
let to_b32 t = B32.encode (to_octets t)
let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
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 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 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 jsont =
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
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

View file

@ -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 *)