This commit is contained in:
swrup 2025-12-07 06:39:33 +01:00
parent f8ef92b67e
commit eb3152a2f6
3 changed files with 89 additions and 81 deletions

View file

@ -10,18 +10,33 @@ module EddsaPublicKey = struct
type t = pub type t = pub
let to_octets t = pub_to_octets t 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 jsont =
let of_b32 s = let of_b32 s =
let open Syntax in let open Syntax in
let* octets = B32.decode s in let* octets = B32.decode s in
match pub_of_octets octets with let* pub = of_octets octets in
| Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e Ok pub
| Ok pub -> 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 caqti =
let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" 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 end
module EddsaPrivateKey = struct module EddsaPrivateKey = struct
@ -37,15 +52,16 @@ module EddsaPrivateKey = struct
let of_octets t = priv_of_octets t |> Result.get_ok let of_octets t = priv_of_octets t |> Result.get_ok
let bin = Bin.map (Bin.bytes 32) of_octets to_octets let bin = Bin.map (Bin.bytes 32) of_octets to_octets
let jsont =
let of_b32 s = let of_b32 s =
let open Syntax in let open Syntax in
let* octets = B32.decode s in let* octets = B32.decode s in
match priv_of_octets octets with match priv_of_octets octets with
| Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
| Ok priv -> Ok priv | Ok priv -> Ok priv
in
let to_b32 t = B32.encode (to_octets t) let to_b32 t = B32.encode (to_octets t) in
let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32 Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
end end
module EddsaSignature : sig module EddsaSignature : sig
@ -53,12 +69,11 @@ module EddsaSignature : sig
val sign : key:EddsaPrivateKey.t -> string -> t val sign : key:EddsaPrivateKey.t -> string -> t
val verify : key:EddsaPublicKey.t -> t -> msg:string -> bool 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 to_octets : t -> string
val of_octets : string -> t val of_octets : string -> t
val jsont : t Jsont.t val jsont : t Jsont.t
val bin : t Bin.t val bin : t Bin.t
val caqti : t Caqti_type.t
end = struct end = struct
(* TODO key format (* TODO key format
endianess issue? *) endianess issue? *)
@ -66,6 +81,9 @@ end = struct
binary-encoded objects with just the R and S values *) binary-encoded objects with just the R and S values *)
type t = string 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 to_octets t = t
let of_octets v = let of_octets v =
@ -76,23 +94,26 @@ end = struct
let bin = Bin.map (Bin.bytes 64) of_octets to_octets 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 = let check_size t =
match String.length t = 64 with match String.length t = 64 with
| false -> Error "EddsaSignature: invalid string length" | false -> Error "EddsaSignature: invalid string length"
| true -> Ok () | true -> Ok ()
let jsont =
let of_b32 s = let of_b32 s =
let open Syntax in let open Syntax in
let* t = B32.decode s in let* t = B32.decode s in
let+ () = check_size t in let+ () = check_size t in
t 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 end
module RsaPublicKey = struct module RsaPublicKey = struct
@ -100,17 +121,24 @@ module RsaPublicKey = struct
type t = Rsa.pub type t = Rsa.pub
let of_octets = Util.Bin_rsa.pub_of_octets
let to_octets = Util.Bin_rsa.pub_to_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 of_b32 s =
let open Syntax in let open Syntax in
let* s = B32.decode s in let* s = B32.decode s in
let+ v = of_octets s in let+ v = of_octets s in
v 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 end
module RsaPrivateKey = struct module RsaPrivateKey = struct
@ -122,34 +150,31 @@ module RsaPrivateKey = struct
let of_octets = Util.Bin_rsa.priv_of_octets let of_octets = Util.Bin_rsa.priv_of_octets
let to_octets = Util.Bin_rsa.priv_to_octets let to_octets = Util.Bin_rsa.priv_to_octets
let jsont =
let of_b32 s = let of_b32 s =
let open Syntax in let open Syntax in
let* s = B32.decode s in let* s = B32.decode s in
let+ v = of_octets s in let+ v = of_octets s in
v v
in
let to_b32 t = B32.encode (to_octets t) let to_b32 t = B32.encode (to_octets t) in
let jsont = Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32 Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
end end
module RsaSignature : sig module RsaSignature : sig
type t type t
val to_octets : t -> string
val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t 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 val jsont : t Jsont.t
end = struct end = struct
type t = string type t = string
let to_octets t = t
(* TODO rsa sign *) (* TODO rsa sign *)
let sign ~key s = let sign ~key s =
Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~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 end

View file

@ -12,11 +12,6 @@ open Crypto
module Caqti_type = struct module Caqti_type = struct
include Caqti_type 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 amount : Amount.t t =
let open Amount in let open Amount in
custom custom
@ -25,28 +20,14 @@ module Caqti_type = struct
Amount.make ~sign:None ~currency:Config.currency ~value ~fraction) Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
(t2 int64 int32) (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 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 include struct
(* alias for hash *) (* alias for hash *)

View file

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