add result.ml; polymorphic variant errors + refacto

This commit is contained in:
swrup 2026-03-26 06:23:42 +01:00 committed by Swrup
parent 9fd3b5a3cc
commit 42b0ec1445
36 changed files with 949 additions and 954 deletions

View file

@ -1,7 +1,7 @@
open Syntax
module Mirage_eddsa = Mirage_crypto_ec.Ed25519
let pp_error = Mirage_crypto_ec.pp_error
let pp_mirage_error = Mirage_crypto_ec.pp_error
type priv = Mirage_eddsa.priv
type pub = Mirage_eddsa.pub
@ -9,50 +9,6 @@ type sig_ = S of string [@@unboxed]
let generate = Mirage_eddsa.generate
let pub_of_priv = Mirage_eddsa.pub_of_priv
let priv_to_octets t = Mirage_eddsa.priv_to_octets t
let priv_of_octets t =
Mirage_eddsa.priv_of_octets t |> function
| Error err -> Fmt.error "%a" pp_error err
| Ok v -> Ok v
let priv_bin =
let priv_of_octets_exn t = priv_of_octets t |> Result.get_ok in
Bin.map (Bin.bytes 32) priv_of_octets_exn priv_to_octets
let priv_jsont =
let of_b32 s =
let* octets = B32.decode s in
priv_of_octets octets
in
let to_b32 t = B32.encode (priv_to_octets t) in
Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
let pub_to_octets t = Mirage_eddsa.pub_to_octets t
let pub_of_octets t =
Mirage_eddsa.pub_of_octets t |> function
| Error e -> Fmt.error "%a" pp_error e
| Ok v -> Ok v
let pub_bin =
let pub_of_octets_exn t = pub_of_octets t |> Result.get_ok in
Bin.map (Bin.bytes 32) pub_of_octets_exn pub_to_octets
let pub_of_b32 s =
let* octets = B32.decode s in
pub_of_octets octets
let pub_to_b32 t = B32.encode (pub_to_octets t)
let pub_jsont =
Jsont.of_of_string ~kind:"EddsaPublicKey" pub_of_b32 ~enc:pub_to_b32
let pub_caqti =
Caqti_type.custom
~encode:(fun v -> Ok (pub_to_octets v))
~decode:(fun v -> pub_of_octets v)
Caqti_type.octets
let sign ~key s =
let sig_ = Mirage_eddsa.sign ~key s in
@ -60,29 +16,90 @@ let sign ~key s =
let verify ~key (S s) ~msg =
let b = Mirage_eddsa.verify ~key s ~msg in
match b with false -> Error "Eddsa verify: not valid" | true -> Ok ()
if b then Ok () else Error `Invalid_signature_eddsa
let sig_to_octets (S s) = s
module Priv = struct
let priv_to_octets t = Mirage_eddsa.priv_to_octets t
let sig_of_octets s =
match String.length s = 64 with
| false -> Error "Eddsa decode signature (binary): invalid data"
| true -> Ok (S s)
let priv_of_octets o =
Mirage_eddsa.priv_of_octets o
|> Result.map_error (Fmt.str "%a" pp_mirage_error)
let sig_bin =
let sig_of_octets_exn t = sig_of_octets t |> Result.get_ok in
Bin.map (Bin.bytes 64) sig_of_octets_exn sig_to_octets
let priv_to_b32 t = priv_to_octets t |> B32.encode
let priv_of_b32 s =
let* octets = B32.decode s in
priv_of_octets octets
let priv_jsont =
Jsont.of_of_string ~kind:"EddsaPrivateKey" priv_of_b32 ~enc:priv_to_b32
let priv_bin =
let priv_of_octets_exn t =
match priv_of_octets t with Error e -> invalid_arg e | Ok v -> v
in
Bin.map (Bin.bytes 32) priv_of_octets_exn priv_to_octets
end
module Pub = struct
let pub_to_octets t = Mirage_eddsa.pub_to_octets t
let pub_of_octets t =
Mirage_eddsa.pub_of_octets t
|> Result.map_error (Fmt.str "%a" pp_mirage_error)
let pub_to_b32 t = pub_to_octets t |> B32.encode
let pub_of_b32 s =
let* octets = B32.decode s in
pub_of_octets octets
let pub_jsont =
Jsont.of_of_string ~kind:"EddsaPublicKey" pub_of_b32 ~enc:pub_to_b32
let pub_bin =
let pub_of_octets_exn t =
match pub_of_octets t with Error e -> invalid_arg e | Ok v -> v
in
Bin.map (Bin.bytes 32) pub_of_octets_exn pub_to_octets
let pub_caqti =
Caqti_type.custom
~encode:(fun v -> Ok (pub_to_octets v))
~decode:pub_of_octets Caqti_type.octets
end
module Sig_ = struct
let sig_to_octets (S s) = s
let sig_of_octets s =
match String.length s = 64 with
| false -> Error "invalid eddsa signature length"
| true -> Ok (S s)
let sig_jsont =
let sig_of_b32 s =
let* s = B32.decode s in
sig_of_octets s
in
let sig_to_b32 (S s) = B32.encode s in
Jsont.of_of_string ~kind:"EddsaSignature" sig_of_b32 ~enc:sig_to_b32
let sig_caqti =
Caqti_type.custom
~encode:(fun v -> Ok (sig_to_octets v))
~decode:(fun s -> sig_of_octets s)
Caqti_type.octets
let sig_to_b32 (S s) = B32.encode s
let sig_jsont =
Jsont.of_of_string ~kind:"EddsaSignature" sig_of_b32 ~enc:sig_to_b32
let sig_bin =
let sig_of_octets_exn t =
match sig_of_octets t with Error e -> invalid_arg e | Ok v -> v
in
Bin.map (Bin.bytes 64) sig_of_octets_exn sig_to_octets
let sig_caqti =
Caqti_type.custom
~encode:(fun v -> Ok (sig_to_octets v))
~decode:sig_of_octets Caqti_type.octets
end
include Priv
include Pub
include Sig_
let pp_pub ppf pub = Fmt.pf ppf "%s" (pub_to_b32 pub)