functo refacto ~!

src/binary_formats.ml

@@ -4,13 +4,8 @@
 
 open Include
 
-(* TODO
+let int32_size = 4
-   less boilerplate?
+let int64_size = 8
-     - type t abstract
-     - type t = { v = string }
-   padding issues?
-   how to encode union? not really needed?
-   test *)
 
 (* -- Time -- *)
 
@@ -19,6 +14,8 @@ 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
@@ -37,6 +34,8 @@ 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 })
@@ -53,59 +52,67 @@ end
 
 (* -- Cryptographic primitives -- *)
 
-module Hash_code = struct
+(* MK_BASIC_XX functor for structs like:
-  (* usually SHA-512 *)
+   struct Foo { uint8_t bar[XX]; } *)
-  type t = { hash: string (* = uint8_t hash[64] *) }
+module MKMK_BASIC (Size : sig
-
+  val v : int
-  let size = 64
-
-  let bin =
-    let open Bin in
-    record (fun hash -> { hash })
-    |+ field (bytes size) (fun t -> t.hash)
-    |> sealr
-end
-
-module Short_hash_code = struct
-  type t = { hash: string }
-
-  let size = 32
-
-  let bin =
-    let open Bin in
-    record (fun hash -> { hash })
-    |+ field (bytes size) (fun t -> t.hash)
-    |> sealr
-end
-
-module MAKE_H (H : sig
-  type t = { hash: string }
-
-  val size : int
-  val bin : t Bin.t
 end) =
 struct
-  type t = { hash: H.t }
+  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
+end
+
+module SIZE_32 = struct
+  let v = 32
+end
+
+module SIZE_64 = struct
+  let v = 64
+end
+
+module MK_BASIC_32 () = MKMK_BASIC (SIZE_32)
+module MK_BASIC_64 () = MKMK_BASIC (SIZE_64)
+
+(* MK_XX functor for structs like:
+   struct FooWrap { struct Foo { uint8_t bar[XX]; } } *)
+module MKMK (Size : sig
+  val v : int
+end) =
+struct
+  module H = MKMK_BASIC (Size)
+
+  type t = { v: H.t }
 
   let size = H.size
 
   let bin =
     let open Bin in
-    record (fun hash -> { hash }) |+ field H.bin (fun t -> t.hash) |> sealr
+    record (fun v -> { v }) |+ field H.bin (fun t -> t.v) |> sealr
 end
 
-module Denomination_hash = MAKE_H (Hash_code)
+module MK_32 () = MKMK (SIZE_32)
-module Private_contract_hash = MAKE_H (Hash_code)
+module MK_64 () = MKMK (SIZE_64)
-module Extensions_policy_hash = MAKE_H (Hash_code)
+(* - *)
-module Merchant_wire_hash = MAKE_H (Hash_code)
+
+module ShortHashCode = MK_BASIC_32 ()
+module HashCode = MK_BASIC_64 ()
+module Denomination_hash = MK_64 ()
+module Private_contract_hash = MK_64 ()
+module Extensions_policy_hash = MK_64 ()
+module Merchant_wire_hash = MK_64 ()
 
 (* Hash over a full payto://-URI, including receiver-name
    (and possibly BIC and other optional fields). *)
-module Full_payto_hash = MAKE_H (Short_hash_code)
+module Full_payto_hash = MK_32 ()
 
 (* Hash over a normalized payto://-URI, including all optional
    fields and also with account-part canonicalized (so no BIC). *)
-module Normalized_payto_hash = MAKE_H (Short_hash_code)
+module Normalized_payto_hash = MK_32 ()
 
 (* Hash over:
      a) the hash of the denomination's public key,
@@ -113,80 +120,18 @@ module Normalized_payto_hash = MAKE_H (Short_hash_code)
      c) cipher-dependant blinded information.
    See implementation of `TALER_coin_ev_hash`
    in libtalerexchange for details. *)
-module Blinded_coin_hash = MAKE_H (Hash_code)
+module Blinded_coin_hash = MK_64 ()
-module Coin_pub_hash = MAKE_H (Hash_code)
+module Coin_pub_hash = MK_64 ()
-module Output_commitment_hash = MAKE_H (Hash_code)
+module Output_commitment_hash = MK_64 ()
+module Reserve_public_key_p = MK_32 ()
+module Reserve_private_key_p = MK_32 ()
+module Reserve_signature_p = MK_64 ()
+module Merchant_public_key_p = MK_32 ()
+module Merchant_private_key_p = MK_32 ()
+(*module Merchant_signature_p = MK_64 () *)
 
-module MAKE_EDDSA_PUB () = struct
+module Transfert_public_key_p = MK_32 ()
-  type t = { eddsa_pub: string }
+module Transfert_private_key_p = MK_32 ()
-
-  let bin =
-    let open Bin in
-    record (fun eddsa_pub -> { eddsa_pub })
-    |+ field (bytes 32) (fun t -> t.eddsa_pub)
-    |> sealr
-end
-
-module MAKE_EDDSA_PRIV () = struct
-  type t = { eddsa_priv: string }
-
-  let bin =
-    let open Bin in
-    record (fun eddsa_priv -> { eddsa_priv })
-    |+ field (bytes 32) (fun t -> t.eddsa_priv)
-    |> sealr
-end
-
-module MAKE_EDDSA_SIG () = struct
-  (* 64 bytes *)
-  type t = { eddsa_signature: string }
-
-  let bin =
-    let open Bin in
-    record (fun eddsa_signature -> { eddsa_signature })
-    |+ field (bytes 64) (fun t -> t.eddsa_signature)
-    |> sealr
-end
-
-module MAKE_ECDHE_PUB () = struct
-  type t = { ecdhe_pub: string }
-
-  let bin =
-    let open Bin in
-    record (fun ecdhe_pub -> { ecdhe_pub })
-    |+ field (bytes 32) (fun t -> t.ecdhe_pub)
-    |> sealr
-end
-
-module MAKE_ECDHE_PRIV () = struct
-  type t = { ecdhe_priv: string }
-
-  let bin =
-    let open Bin in
-    record (fun ecdhe_priv -> { ecdhe_priv })
-    |+ field (bytes 32) (fun t -> t.ecdhe_priv)
-    |> sealr
-end
-
-module Ecdh_ephemeral_public_key_p = struct
-  type t = { ecdh_pub: string (* = uint8_t ecdh_pub[32] *) }
-
-  let bin =
-    let open Bin in
-    record (fun ecdh_pub -> { ecdh_pub })
-    |+ field (bytes 32) (fun t -> t.ecdh_pub)
-    |> sealr
-end
-
-module Reserve_public_key_p = MAKE_EDDSA_PUB ()
-module Reserve_private_key_p = MAKE_EDDSA_PRIV ()
-module Reserve_signature_p = MAKE_EDDSA_SIG ()
-module Merchant_public_key_p = MAKE_EDDSA_PUB ()
-module Merchant_private_key_p = MAKE_EDDSA_PRIV ()
-(*module Merchant_signature_p = MAKE_EDDSA_SIG ()*)
-
-module Transfert_public_key_p = MAKE_ECDHE_PUB ()
-module Transfert_private_key_p = MAKE_ECDHE_PRIV ()
 
 (*
 enum TALER_AmlDecisionState {
@@ -194,32 +139,26 @@ enum TALER_AmlDecisionState {
 };
 *)
 
-module Aml_officer_public_key_p = MAKE_EDDSA_PUB ()
+module Aml_officer_public_key_p = MK_32 ()
-module Aml_officer_private_key_p = MAKE_EDDSA_PRIV ()
+module Aml_officer_private_key_p = MK_32 ()
-module Exchange_public_key_p = MAKE_EDDSA_PUB ()
+module Exchange_public_key_p = MK_32 ()
-module Exchange_private_key_p = MAKE_EDDSA_PRIV ()
+module Exchange_private_key_p = MK_32 ()
-module Exchange_signature_p = MAKE_EDDSA_SIG ()
+module Exchange_signature_p = MK_64 ()
-module Master_public_key_p = MAKE_EDDSA_PUB ()
+module Master_public_key_p = MK_32 ()
-module Master_private_key_p = MAKE_EDDSA_PRIV ()
+module Master_private_key_p = MK_32 ()
-module Master_signature_p = MAKE_EDDSA_SIG ()
+module Master_signature_p = MK_64 ()
-
+module Wire_transfert_identifier_raw_p = MK_BASIC_32 ()
-module Wire_transfert_identifier_raw_p = struct
-  (* uint8_t raw[32]; *)
-  type t = { raw: string }
-
-  let bin =
-    let open Bin in
-    record (fun raw -> { raw }) |+ field (bytes 32) (fun t -> t.raw) |> sealr
-end
 
 module UUID = struct
   (* uint32_t value[4]; *)
   type t = { value: string }
 
+  let size = 4 * int32_size
+
   let bin =
     let open Bin in
     record (fun value -> { value })
-    |+ field (bytes (4 * 4)) (fun t -> t.value)
+    |+ field (bytes size) (fun t -> t.value)
     |> sealr
 end
 
@@ -227,11 +166,11 @@ module Wad_id = struct
   (* uint32_t value[6]; *)
   type t = { raw: string }
 
+  let size = 6 * int32_size
+
   let bin =
     let open Bin in
-    record (fun raw -> { raw })
+    record (fun raw -> { raw }) |+ field (bytes size) (fun t -> t.raw) |> sealr
-    |+ field (bytes (4 * 6)) (fun t -> t.raw)
-    |> sealr
 end
 
 (* TODO not sure what to do of union, probably not needed *)
@@ -245,9 +184,9 @@ union TALER_CoinSpendPrivateKeyP {
   uint8_t ecdhe_priv[32];
 };
 *)
-module Coin_spend_public_key_p = MAKE_EDDSA_PUB ()
+module Coin_spend_public_key_p = MK_32 ()
-module Coin_spend_private_key_p = MAKE_EDDSA_PRIV ()
+module Coin_spend_private_key_p = MK_32 ()
-module Coin_spend_signature_p = MAKE_EDDSA_SIG ()
+module Coin_spend_signature_p = MK_64 ()
 
 (* TODO padding: sizeof used here (assume no padding for now) *)
 (*
@@ -260,9 +199,9 @@ struct TALER_EncryptedLinkSecretP {
   uint8_t enc[sizeof (struct TALER_LinkSecretP)];
 };
 *)
-module Transfert_secret_p = MAKE_H (Hash_code)
+module Transfert_secret_p = MK_64 ()
-module Link_secret_p = MAKE_H (Hash_code)
+module Link_secret_p = MK_64 ()
-module Encrypted_link_secret_p = MAKE_H (Hash_code)
+module Encrypted_link_secret_p = MK_64 ()
 
 (*
 union TALER_TokenPublicKeyP {
@@ -270,7 +209,7 @@ union TALER_TokenPublicKeyP {
   uint8_t ecdhe_pub[32];
 };
 *)
-module Token_public_key_p = MAKE_EDDSA_PUB ()
+module Token_public_key_p = MK_32 ()
 
 (* -- Signatures -- *)
 
@@ -287,7 +226,7 @@ module Purpose = struct
     purpose: int32;
   }
 
-  let size = 4 + 4
+  let size = 2 * int32_size
 
   let bin =
     let open Bin in
@@ -296,7 +235,7 @@ module Purpose = struct
     |+ field beint32 (fun t -> t.purpose)
     |> sealr
 
-  let make size purpose = { size= Int32.of_int size; purpose }
+  let make ~size purpose = { size= Int32.of_int size; purpose }
 end
 
 (* This is the running SHA512-hash over all
@@ -304,7 +243,7 @@ end
    Note that each `TALER_BlindedCoinHashP` itself
    captures the hash of the corresponding denomination's
    public key. *)
-module Hash_planchets_p = MAKE_H (Hash_code)
+module Hash_planchets_p = MK_64 ()
 
 (* Binary representation of the age groups.
    The bits set in the mask mark the edges at the beginning of a next age
@@ -321,6 +260,8 @@ module Hash_planchets_p = MAKE_H (Hash_code)
 module Age_mask = 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
@@ -391,6 +332,8 @@ module Amount = struct
     currency: string;
   }
 
+  let size = int64_size + int32_size + currency_len
+
   (* TODO BE here? *)
   let bin =
     let open Bin in
@@ -408,6 +351,8 @@ 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 })
@@ -417,13 +362,13 @@ module AmountNBO = struct
     |> sealr
 end
 
+module Blinding_master_seed = MK_BASIC_32 ()
+
 (* Format used for to generate the signature on a request to withdraw
    coins from a reserve. *)
 module Withdraw_request_ps = struct
-  type t = {
-    (* TODO set it in encode/decode *)
   (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
-    purpose: Purpose.t;
+  type t = {
     (* Amount to withdraw, excluding fees, i.e.
        the total sum of the denominations of the coins.
        Note that the reserve must have a value of at least amount+fee. *)
@@ -450,7 +395,7 @@ module Withdraw_request_ps = struct
        or all zeros, if no denomination of cipher type Clause-Schnorr is used. *)
     (* TODO TALER doc
        `TALER_BlindingMasterSecretP` in doc, but probably TALER_BlindingMasterSeed *)
-    blinding_seed: string;
+    blinding_seed: Blinding_master_seed.t;
     (* If age restriction proof is required, the maximum age _group_
        to commit to, 0 otherwise. Note that in this case, all
        denominations for all coins MUST support age restriction.
@@ -464,24 +409,26 @@ module Withdraw_request_ps = struct
     mask: Age_mask.t;
   }
 
+  let size =
+    Purpose.size
+    + (2 * Amount.size)
+    + Hash_planchets_p.size
+    + Blinding_master_seed.size
+    + int32_size
+    + Age_mask.size
+
+  let purpose = Purpose.make ~size Taler_signatures.wallet_reserve_withdraw
+
   let bin =
     let open Bin in
     record
-      (fun purpose 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 })
-          purpose;
+    |+ field Purpose.bin (Fun.const purpose)
-          amount;
-          fee;
-          h_planchets;
-          blinding_seed;
-          max_age_group;
-          mask;
-        })
-    |+ field Purpose.bin (fun t -> t.purpose)
     |+ field Amount.bin (fun t -> t.amount)
     |+ field Amount.bin (fun t -> t.fee)
     |+ field Hash_planchets_p.bin (fun t -> t.h_planchets)
-    |+ field cstring (fun t -> t.blinding_seed)
+    |+ field Blinding_master_seed.bin (fun t -> t.blinding_seed)
     |+ field beint32 (fun t -> t.max_age_group)
     |+ field Age_mask.bin (fun t -> t.mask)
     |> sealr
@@ -506,8 +453,8 @@ module Withdraw_confirmation_ps = struct
     noreveal_index: int32;
   }
 
-  let size = Purpose.size + Hash_planchets_p.size + 4
+  let size = Purpose.size + Hash_planchets_p.size + int32_size
-  let purpose = Purpose.make size Taler_signatures.exchange_confirm_withdraw
+  let purpose = Purpose.make ~size Taler_signatures.exchange_confirm_withdraw
 
   let bin =
     let open Bin in

test/test.ml

@@ -75,9 +75,7 @@ let () =
 let () =
   let open Binary_formats.Withdraw_confirmation_ps in
   let str64 = String.make 64 '0' in
-  let dummy_t =
+  let dummy_t = { h_planchets= { v= { v= str64 } }; noreveal_index= 0_l } in
-    { h_planchets= { hash= { hash= str64 } }; noreveal_index= 0_l }
-  in
   let size' = Bin.size_of_value bin dummy_t |> Option.get in
   assert (size = size');
   assert (size = 76);