From 20abe05bd53f3ee51f80da6d9154fe4af2a5ec68 Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 18 Oct 2025 14:07:12 +0200 Subject: [PATCH] --- src/binary_formats.ml | 135 ++++++++++++++++++++++++++---------------- src/management.ml | 2 +- src/types.ml | 1 + 3 files changed, 85 insertions(+), 53 deletions(-) diff --git a/src/binary_formats.ml b/src/binary_formats.ml index f6ec142a..c0bbb70e 100644 --- a/src/binary_formats.ml +++ b/src/binary_formats.ml @@ -42,9 +42,9 @@ let int32_size = 4 let int64_size = 8 (* TODO clean up - ? rm all of UTIL_FUNC + ? rm all of UTIL ? Bin.map int64 to Ptime.t here *) -module UTIL_FUNC = struct +module UTIL = struct (* microseconds since the UNIX Epoch UINT64_MAX represents "never" *) module MK_TIME () = struct @@ -64,74 +64,48 @@ module UTIL_FUNC = struct record (fun v -> { v }) |+ field beint64 (fun t -> t.v) |> sealr end + module type Bytes_sig = sig + type t = { v: string } + + val of_octets : string -> t + val bin : t Bin.t + end + (* MK_XX functor for structs like: struct Foo { uint8t thing[XX]; } MK_HASH_XX for hashed value taler doc: - Taler uses 512-bit hash codes (64 bytes). - usually SHA-512 *) - module MK_32 () = struct + module MK_32 () : Bytes_sig = struct type t = { v: string } + let of_octets v = + match String.length v = 32 with + | false -> Fmt.failwith "of_octets failure: data is not 32 bytes" + | true -> { v } + let bin = let open Bin in record (fun v -> { v }) |+ field (bytes 32) (fun t -> t.v) |> sealr end - module MK_64 () = struct + module MK_64 () : Bytes_sig = struct type t = { v: string } + let of_octets v = + match String.length v = 64 with + | false -> Fmt.failwith "of_octets failure: data is not 64 bytes" + | true -> { v } + let bin = let open Bin in record (fun v -> { v }) |+ field (bytes 64) (fun t -> t.v) |> sealr end - module MK_HASH_32 () : sig - type t = private { hash: string } + module Bytes_32 = MK_32 () + module Bytes_64 = MK_64 () - val of_octets : string -> t - val bin : t Bin.t - end = struct - type t = { hash: string } - - let of_octets s = - match String.length s = 32 with - | false -> Fmt.failwith "SHA256 failure: data is not 32 bytes" - | true -> - let hash = Digestif.SHA256.(to_raw_string (digest_string s)) in - { hash } - - let bin = - let open Bin in - record (fun hash -> { hash }) - |+ field (bytes 32) (fun t -> t.hash) - |> sealr - end - - module MK_HASH_64 () : sig - type t = private { hash: string } - - val of_string : string -> t - val bin : t Bin.t - end = struct - type t = { hash: string } - - let of_string s = - match String.length s = 64 with - | false -> Fmt.failwith "SHA512 failure: data is not 64bytes" - | true -> - let hash = Digestif.SHA512.(to_raw_string (digest_string s)) in - { hash } - - let bin = - let open Bin in - record (fun hash -> { hash }) - |+ field (bytes 64) (fun t -> t.hash) - |> sealr - end -end - -module UTIL_HASH = struct module type H_sig = sig type t @@ -176,10 +150,55 @@ module UTIL_HASH = struct let s = s ^ "\x00" in hash s end + + module MK_HASH_64 () : H_sig = struct + include HHH_64 + end + + module HHH_32 : H_sig = struct + type t = { hash: Digestif.SHA256.t } + + let hash s = + let hash = Digestif.SHA256.(digest_string s) in + { hash } + + let hash_bin = + let open Bin in + map (bytes 32) Digestif.SHA256.of_raw_string Digestif.SHA256.to_raw_string + + let bin = + let open Bin in + record (fun hash -> { hash }) |+ field hash_bin (fun t -> t.hash) |> sealr + end + + (* sha256 with string size check *) + module Hash_32 : H_sig = struct + include HHH_32 + + let hash s = + match String.length s = 32 with + | false -> Fmt.failwith "SHA256 failure: data is not 32 bytes" + | true -> hash s + end + + (* sha256 but add a null termination to the given string + this is "HashCode" in GNU TALER + + todo: maybe need to have a cstring.ml *) + module Cstring_hash_32 : H_sig = struct + include HHH_32 + + let hash s = + let s = s ^ "\x00" in + hash s + end + + module MK_HASH_32 () : H_sig = struct + include HHH_32 + end end -open UTIL_FUNC -include UTIL_HASH +include UTIL module Taler_signatures = Include.Taler_signatures (* -- Time -- *) @@ -265,6 +284,17 @@ module DenominationHash = struct |> hash end +module ExchangePublicKeyP = struct + type t = Mirage_crypto_ec.Ed25519.pub + + let bin = + let open Mirage_crypto_ec.Ed25519 in + let open Bin in + let open Bytes_32 in + map bin + (fun { v } -> pub_of_octets v |> Result.get_ok) + (fun pub -> { v= pub_to_octets pub }) +end (* --- Hashes --- *) (* Hash over a full payto://-URI, including receiver-name @@ -312,7 +342,8 @@ module TransferPublicKeyP = MK_32 () module TransferPrivateKeyP = MK_32 () module AmlOfficerPublicKeyP = MK_32 () module AmlOfficerPrivateKeyP = MK_32 () -module ExchangePublicKeyP = MK_32 () + +(*module ExchangePublicKeyP = MK_32 ()*) module ExchangePrivateKeyP = MK_32 () module MasterPublicKeyP = MK_32 () module MasterPrivateKeyP = MK_32 () diff --git a/src/management.ml b/src/management.ml index 19704629..e6374a13 100644 --- a/src/management.ml +++ b/src/management.ml @@ -67,7 +67,7 @@ let mk_future_sign_key signkey_secmod_sign_f ({ pub; sign= _; stamp_start; stamp_expire; stamp_end } : Secmod_keys.t) = let signkey_secmod_sig = let open Binary_formats in - let exchange_pub = ExchangePublicKeyP.{ v= EddsaPublicKey.to_octets pub } in + let exchange_pub = pub in let anchor_time = TimeAbsoluteNBO.{ v= Util.ptime_to_int64_us stamp_start } in diff --git a/src/types.ml b/src/types.ml index 8b97da6c..45e9b7a2 100644 --- a/src/types.ml +++ b/src/types.ml @@ -83,6 +83,7 @@ module EddsaPublicKey = struct type t = Mirage_crypto_ec.Ed25519.pub let to_octets t = Mirage_crypto_ec.Ed25519.pub_to_octets t + let of_octets t = Mirage_crypto_ec.Ed25519.pub_of_octets t let of_b32 s = let open Syntax in