refacto: Purpose.make_bin

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