From f89cf65259dba3231fd464861d9d0bd168fa4ebd Mon Sep 17 00:00:00 2001 From: swrup Date: Tue, 7 Oct 2025 23:45:07 +0200 Subject: [PATCH] refacto: Purpose.make_bin --- src/binary_formats.ml | 78 ++++++++++++++++--------------------------- test/test.ml | 3 +- 2 files changed, 30 insertions(+), 51 deletions(-) diff --git a/src/binary_formats.ml b/src/binary_formats.ml index a750e089..29ec5a56 100644 --- a/src/binary_formats.ml +++ b/src/binary_formats.ml @@ -14,8 +14,6 @@ module Time = struct type t = { timestamp_us: int64 } type t_nbo = { abs_value_us__: int64 } - let size = int64_size - (* not BE here? never used? *) let bin = let open Bin in @@ -34,8 +32,6 @@ module Time = struct type t = { timestamp_us: int64 } type t_nbo = { rel_value_us__: int64 } - let size = int64_size - let bin = let open Bin in record (fun timestamp_us -> { timestamp_us }) @@ -54,17 +50,15 @@ end (* MK_BASIC_XX functor for structs like: struct Foo { uint8t bar[XX]; } *) -module MKMK_BASIC (Size : sig +module MKMK_BASIC (S : sig val v : int end) = struct type t = { v: string } - let size = Size.v - let bin = let open Bin in - record (fun v -> { v }) |+ field (bytes size) (fun t -> t.v) |> sealr + record (fun v -> { v }) |+ field (bytes S.v) (fun t -> t.v) |> sealr end module SIZE_32 = struct @@ -80,16 +74,14 @@ module MK_BASIC_64 () = MKMK_BASIC (SIZE_64) (* MK_XX functor for structs like: struct FooWrap { struct Foo { uint8t bar[XX]; } } *) -module MKMK (Size : sig +module MKMK (S : sig val v : int end) = struct - module H = MKMK_BASIC (Size) + module H = MKMK_BASIC (S) type t = { v: H.t } - let size = H.size - let bin = let open Bin in record (fun v -> { v }) |+ field H.bin (fun t -> t.v) |> sealr @@ -226,8 +218,6 @@ module Purpose = struct purpose: int32; } - let size = 2 * int32_size - let bin = let open Bin in record (fun size purpose -> { size; purpose }) @@ -236,6 +226,20 @@ module Purpose = struct |> sealr let make ~size purpose = { size= Int32.of_int size; purpose } + let dummy = make ~size:0 0_l + + (* helper function to make ['signature Bin.t] *) + let make_bin = + let get_size f = + let open Bin in + match Size.of_value (Size.size_of (f dummy)) with + | Dynamic _ | Unknown -> + Fmt.failwith "size_of failure: size is not Static" + | Static n -> n + in + fun code f -> make ~size:(get_size f) code |> f + + let field purpose = Bin.field bin (fun _t -> purpose) end (* This is the running SHA512-hash over all @@ -260,8 +264,6 @@ module HashPlanchetsP = MK_64 () module AgeMask = struct type t = { mask: int32 } - let size = int32_size - let bin = let open Bin in record (fun mask -> { mask }) |+ field beint32 (fun t -> t.mask) |> sealr @@ -330,8 +332,6 @@ module Amount = struct currency: string; } - let size = int64_size + int32_size + currency_len - (* TODO BE here? *) let bin = let open Bin in @@ -349,8 +349,6 @@ module AmountNBO = struct currency: string; } - let size = int64_size + int32_size + currency_len - let bin = let open Bin in record (fun value fraction currency -> { value; fraction; currency }) @@ -407,22 +405,13 @@ module WithdrawRequestPS = struct mask: AgeMask.t; } - let size = - Purpose.size - + (2 * Amount.size) - + HashPlanchetsP.size - + BlindingMasterSeed.size - + int32_size - + AgeMask.size - - let purpose = Purpose.make ~size Taler_signatures.wallet_reserve_withdraw - let bin = let open Bin in + Purpose.make_bin Taler_signatures.wallet_reserve_withdraw @@ fun purpose -> record - (fun _urpose amount fee h_planchets blinding_seed max_age_group mask -> + (fun _purpose amount fee h_planchets blinding_seed max_age_group mask -> { amount; fee; h_planchets; blinding_seed; max_age_group; mask }) - |+ field Purpose.bin (Fun.const purpose) + |+ Purpose.field purpose |+ field Amount.bin (fun t -> t.amount) |+ field Amount.bin (fun t -> t.fee) |+ field HashPlanchetsP.bin (fun t -> t.h_planchets) @@ -451,23 +440,14 @@ module WithdrawConfirmationPS = struct noreveal_index: int32; } - (*let size = Purpose.size + HashPlanchetsP.size + int32_size*) - - open Bin - let bin = - record (fun purpose h_planchets noreveal_index -> - (purpose, { h_planchets; noreveal_index })) - |+ field Purpose.bin (fun (purpose, _t) -> purpose) - |+ field HashPlanchetsP.bin (fun (_p, t) -> t.h_planchets) - |+ field beint32 (fun (_p, t) -> t.noreveal_index) + let open Bin in + Purpose.make_bin Taler_signatures.exchange_confirm_withdraw + @@ fun purpose -> + record (fun _purpose h_planchets noreveal_index -> + { h_planchets; noreveal_index }) + |+ Purpose.field purpose + |+ field HashPlanchetsP.bin (fun t -> t.h_planchets) + |+ field beint32 (fun t -> t.noreveal_index) |> sealr - - let size = - match Size.of_value (Size.size_of bin) with - | Dynamic _ | Unknown -> Fmt.failwith "size_of failure: size is not Static" - | Static n -> n - - let purpose = Purpose.make ~size Taler_signatures.exchange_confirm_withdraw - let bin = map bin (fun (_p, t) -> t) (fun t -> (purpose, t)) end diff --git a/test/test.ml b/test/test.ml index 8f233513..cdacd3b9 100644 --- a/test/test.ml +++ b/test/test.ml @@ -76,8 +76,7 @@ let () = let open Binary_formats.WithdrawConfirmationPS in let str64 = String.init 64 (fun i -> Char.unsafe_chr (i + 1)) in let dummy_t = { h_planchets= { v= { v= str64 } }; noreveal_index= 0_l } in - let size' = Bin.size_of_value bin dummy_t |> Option.get in - assert (size = size'); + let size = Bin.size_of_value bin dummy_t |> Option.get in assert (size = 76); (* for cmp test with signatures.c output *)