.
This commit is contained in:
parent
e239f802b1
commit
a05b8351f0
2 changed files with 77 additions and 79 deletions
|
|
@ -22,14 +22,21 @@ module EddsaPublicKey = struct
|
||||||
in
|
in
|
||||||
Bin.map (Bin.bytes 32) of_octets to_octets
|
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
|
||||||
let* pub = of_octets octets in
|
let* pub = of_octets octets in
|
||||||
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
|
||||||
|
|
@ -45,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
|
||||||
|
|
@ -61,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? *)
|
||||||
|
|
@ -74,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 =
|
||||||
|
|
@ -84,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
|
||||||
|
|
@ -108,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
|
||||||
|
|
@ -130,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
|
||||||
|
|
|
||||||
33
src/pg.ml
33
src/pg.ml
|
|
@ -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 -> 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 *)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue