From 94b8c503750b8114c54058450dd5434d778a7b14 Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 18 Oct 2025 17:35:15 +0200 Subject: [PATCH] --- src/api_types.ml | 90 +++++++++++++++++++++ src/binary_formats.ml | 47 +---------- src/json.ml | 1 + src/management.ml | 3 +- src/mte.ml | 2 +- src/types.ml | 183 ++++++++++++++---------------------------- 6 files changed, 154 insertions(+), 172 deletions(-) create mode 100644 src/api_types.ml diff --git a/src/api_types.ml b/src/api_types.ml new file mode 100644 index 00000000..4ed5697a --- /dev/null +++ b/src/api_types.ml @@ -0,0 +1,90 @@ +(* TODO + number + - number is "float", but we probably want int everywhere instead + - numeric values capped at 2^53 -1 inclusive because json + time + - better types + - issues with "never" = uint64_max *) +open Types + +module ErrorDetail = struct + (* TODO GANA error codes + https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *) + type t = { + code: int; + hint: string option; + } +end + +module Timestamp = struct + type t = + | Seconds of float + | Never + + let of_ptime p = Seconds (Ptime.to_float_s p) +end + +module RelativeTime = struct + type t = + | Microseconds of float + | Forever +end + +module RsaDenominationKey = struct + type t = { + age_mask: int; + rsa_pub: RsaPublicKey.t; + } +end + +(* not implemented *) +module CSDenominationKey = struct + (* Clause Schnorr *) + type t = { + age_mask: int; + cs_pub: string; + } +end + +module DenominationKey = struct + type t = + | Rsa of RsaDenominationKey.t + | CS of CSDenominationKey.t +end + +module FutureSignKey = struct + type t = { + key: EddsaPublicKey.t; + stamp_start: Timestamp.t; + stamp_expire: Timestamp.t; + stamp_end: Timestamp.t; + signkey_secmod_sig: EddsaSignature.t; + } +end + +module FutureDenom = struct + type t = { + section_name: string; + value: Amount.t; + stamp_start: Timestamp.t; + stamp_expire_withdraw: Timestamp.t; + stamp_expire_deposit: Timestamp.t; + stamp_expire_legal: Timestamp.t; + denom_pub: DenominationKey.t; + fee_withdraw: Amount.t; + fee_deposit: Amount.t; + fee_refresh: Amount.t; + fee_refund: Amount.t; + denom_secmod_sig: EddsaSignature.t; + } +end + +module FutureKeysResponse = struct + type t = { + future_denoms: FutureDenom.t list; + future_signkeys: FutureSignKey.t list; + master_pub: EddsaPublicKey.t; + denom_secmod_public_key: EddsaPublicKey.t; + signkey_secmod_public_key: EddsaPublicKey.t; + } +end diff --git a/src/binary_formats.ml b/src/binary_formats.ml index 4edb28a7..ad3f594e 100644 --- a/src/binary_formats.ml +++ b/src/binary_formats.ml @@ -43,51 +43,6 @@ module Taler_signatures = Include.Taler_signatures let int32_size = 4 let int64_size = 8 -module RsaPublicKey = struct - (* https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html - format: { uint16_be: n size; uint16_be: e size; n; e} - - integer in big-endian format (MSB first) - leading zeroes are stripped unless they are required to keep a value positive - no 0-termination *) - - let rev_string len s = String.init len (fun i -> s.[len - 1 - i]) - - (* todo: need to strip leading zeros or something? *) - (* reverse bytes because Z.of_bits reads bytes in little endian *) - let z_of_bits_be src pos len = - String.sub src pos len |> rev_string len |> Z.of_bits - - let to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) = - let n_len = Z.size n in - let e_len = Z.size e in - let len = 4 + n_len + e_len in - let b = Bytes.make len '\x00' in - Bytes.set_uint16_be b 0 n_len; - Bytes.set_uint16_be b 2 e_len; - let n = Z.to_bits n |> rev_string n_len in - let e = Z.to_bits e |> rev_string e_len in - Bytes.blit_string n 0 b 4 n_len; - Bytes.blit_string e 0 b (4 + n_len) e_len; - Bytes.unsafe_to_string b - - let of_octets = - let check = function - | false -> Error "RsaPublicKey.of_octets: invalid data" - | true -> Ok () - in - fun s -> - let open Syntax in - let len = String.length s in - let* () = check (len >= 4) in - let n_len = String.get_uint16_be s 0 in - let e_len = String.get_uint16_be s 2 in - let* () = check (len = n_len + e_len + 4) in - let n = z_of_bits_be s 4 n_len in - let e = z_of_bits_be s (4 + n_len) e_len in - Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg -end - (* -- Time -- *) (* microseconds since the UNIX Epoch @@ -292,7 +247,7 @@ module DenominationHash = MK_SRC_HASH_32 (struct type src = Mirage_crypto_pk.Rsa.pub (* function to convert src type to a string for hashing *) - let to_octets = RsaPublicKey.to_octets + let to_octets = Types.RsaPublicKey.to_octets end) module ExchangePublicKeyP = struct diff --git a/src/json.ml b/src/json.ml index 73a1c7c4..5236c36b 100644 --- a/src/json.ml +++ b/src/json.ml @@ -1,4 +1,5 @@ open Types +open Api_types let encode_exn jsont v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok let encode jsont v = Jsont_bytesrw.encode_string jsont v diff --git a/src/management.ml b/src/management.ml index e6374a13..9ecb1b34 100644 --- a/src/management.ml +++ b/src/management.ml @@ -1,4 +1,5 @@ -open Types +(*open Types*) +open Api_types (* TODO - take secmod devices as param diff --git a/src/mte.ml b/src/mte.ml index a570a185..596d759a 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -14,7 +14,7 @@ along with this program. If not, see . *) let error_detail ?hint _status = - let open Types.ErrorDetail in + let open Api_types.ErrorDetail in let open Json in let code = -1 in let s = encode_exn ErrorDetail.jsont { code; hint } in diff --git a/src/types.ml b/src/types.ml index 0df429f6..7cf6b6ff 100644 --- a/src/types.ml +++ b/src/types.ml @@ -30,43 +30,6 @@ module Config_types = struct end end -module HashCode = struct - type t = string -end - -(* https://docs.taler.net/core/api-common.html#tsref-type-ErrorDetail *) -module ErrorDetail = struct - (* TODO GANA error codes - https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *) - type t = { - code: int; - hint: string option; - } -end - -(* TODO number - - number is "float", but we probably want int everywhere instead - - numeric values capped at 2^53 -1 inclusive because json - *) - -(* TODO time - - int64 instead of float/int (binary format time in int64 us) - ? make api types take in Ptime.t instead of Timestamp.t - ? issues with "never" = uint64_max *) -module Timestamp = struct - type t = - | Seconds of float - | Never - - let of_ptime p = Seconds (Ptime.to_float_s p) -end - -module RelativeTime = struct - type t = - | Microseconds of float - | Forever -end - module Amount = struct include Amount @@ -80,17 +43,18 @@ module EddsaPublicKey = struct (* EdDSA and ECDHE public keys always point on Curve25519 and represented using the standard 256 bits Ed25519 compact format, converted to Crockford Base32. *) - type t = Mirage_crypto_ec.Ed25519.pub + open Mirage_crypto_ec.Ed25519 - let to_octets t = Mirage_crypto_ec.Ed25519.pub_to_octets t - let of_octets t = Mirage_crypto_ec.Ed25519.pub_of_octets t + type t = pub + + let to_octets t = pub_to_octets t + let of_octets t = pub_of_octets t let of_b32 s = let open Syntax in - let open Mirage_crypto_ec in let* octets = B32.decode s in - match Ed25519.pub_of_octets octets with - | Error e -> Fmt.error "%a" pp_error e + match pub_of_octets octets with + | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e | Ok pub -> Ok pub let to_b32 t = B32.encode (to_octets t) @@ -106,6 +70,8 @@ module EddsaSignature : sig val to_b32 : t -> string val jsont : t Jsont.t end = struct + (* TODO key format + endianess issue? *) (* EdDSA signatures are transmitted as 64-bytes base32 binary-encoded objects with just the R and S values (base32_ binary-only). @@ -114,9 +80,6 @@ end = struct let to_octets t = t - (* TODO key format - is it exactly like in GNU_CRYPTO? - endianess issue? *) let sign ~key s = (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *) Mirage_crypto_ec.Ed25519.sign ~key s @@ -132,16 +95,61 @@ end = struct end module RsaPublicKey = struct - open Binary_formats.RsaPublicKey + module Binary = struct + (* https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html + format: { uint16_be: n size; uint16_be: e size; n; e} - type t = Mirage_crypto_pk.Rsa.pub + integer in big-endian format (MSB first) + leading zeroes are stripped unless they are required to keep a value positive + no 0-termination *) + + let rev_string len s = String.init len (fun i -> s.[len - 1 - i]) + + (* todo: need to strip leading zeros or something? *) + (* reverse bytes because Z.of_bits reads bytes in little endian *) + let z_of_bits_be src pos len = + String.sub src pos len |> rev_string len |> Z.of_bits + + let to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) = + let n_len = Z.size n in + let e_len = Z.size e in + let len = 4 + n_len + e_len in + let b = Bytes.make len '\x00' in + Bytes.set_uint16_be b 0 n_len; + Bytes.set_uint16_be b 2 e_len; + let n = Z.to_bits n |> rev_string n_len in + let e = Z.to_bits e |> rev_string e_len in + Bytes.blit_string n 0 b 4 n_len; + Bytes.blit_string e 0 b (4 + n_len) e_len; + Bytes.unsafe_to_string b + + let of_octets = + let check = function + | false -> Error "RsaPublicKey.of_octets: invalid data" + | true -> Ok () + in + fun s -> + let open Syntax in + let len = String.length s in + let* () = check (len >= 4) in + let n_len = String.get_uint16_be s 0 in + let e_len = String.get_uint16_be s 2 in + let* () = check (len = n_len + e_len + 4) in + let n = z_of_bits_be s 4 n_len in + let e = z_of_bits_be s (4 + n_len) e_len in + Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg + end + + include Binary + open Mirage_crypto_pk + + type t = Rsa.pub let of_b32 s = let open Syntax in - let open Binary_formats.RsaPublicKey in let* s = B32.decode s in let* v = of_octets s in - let+ v = Mirage_crypto_pk.Rsa.pub ~n:v.n ~e:v.e |> unwrap_err_msg in + let+ v = Rsa.pub ~n:v.n ~e:v.e |> unwrap_err_msg in v let to_b32 t = B32.encode (to_octets t) @@ -161,8 +169,7 @@ end = struct let to_octets t = t - (* no Rsa.sign(?): - decrypt is equivalent to sign *) + (* TODO rsa sign *) let sign ~key s = Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s @@ -170,75 +177,3 @@ end = struct let to_b32 t = B32.encode t let jsont = Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32 end - -module RsaDenominationKey = struct - type t = { - age_mask: int; - rsa_pub: RsaPublicKey.t; - } -end - -(* not implemented *) -module CSDenominationKey = struct - (* Clause Schnorr *) - type t = { - age_mask: int; - cs_pub: string; - } -end - -module DenominationKey = struct - type t = - | Rsa of RsaDenominationKey.t - | CS of CSDenominationKey.t -end - -module FutureSignKey = struct - type t = { - (* The actual exchange's EdDSA signing public key *) - key: EddsaPublicKey.t; - (* Initial validity date for the signing key. *) - stamp_start: Timestamp.t; - (* Date when the exchange will stop using the signing key, allowed to overlap - slightly with the next signing key's validity to allow for clock skew. *) - stamp_expire: Timestamp.t; - (* Date when all signatures made by the signing key expire and should - henceforth no longer be considered valid in legal disputes. *) - stamp_end: Timestamp.t; - (* Signature over TALER_SigningKeyAnnouncementPS - for this signing key by the signkey security - module using purpose TALER_SIGNATURE_SM_SIGNING_KEY. *) - signkey_secmod_sig: EddsaSignature.t; - } -end - -module FutureDenom = struct - type t = { - section_name: string; - value: Amount.t; - stamp_start: Timestamp.t; - stamp_expire_withdraw: Timestamp.t; - stamp_expire_deposit: Timestamp.t; - stamp_expire_legal: Timestamp.t; - denom_pub: DenominationKey.t; - fee_withdraw: Amount.t; - fee_deposit: Amount.t; - fee_refresh: Amount.t; - fee_refund: Amount.t; - (* Signature by the denomination security module - over TALER_DenominationKeyAnnouncementPS - for this denomination with purpose - TALER_SIGNATURE_SM_DENOMINATION_KEY. *) - denom_secmod_sig: EddsaSignature.t; - } -end - -module FutureKeysResponse = struct - type t = { - future_denoms: FutureDenom.t list; - future_signkeys: FutureSignKey.t list; - master_pub: EddsaPublicKey.t; - denom_secmod_public_key: EddsaPublicKey.t; - signkey_secmod_public_key: EddsaPublicKey.t; - } -end