add binary_formats.ml

include/gen_taler_signatures.ml

@@ -42,7 +42,9 @@ let () =
   let l = parse Data.content in
   assert (List.length l = 74);
 
-  let pp ppf { name; value } = Fmt.pf ppf "let %s = %d@." name value in
+  let pp ppf { name; value } =
+    Fmt.pf ppf "let %s : int32 = %d_l@." name value
+  in
   Fmt.pr "%a" (Fmt.list pp) l;
 
   ()

src/binary_formats.ml

@@ -0,0 +1,122 @@
+(* https://docs.taler.net/core/api-common.html#binary-formats
+
+   - numeric values are in network byte order (big endian) *)
+
+(* -- Time -- *)
+
+module Time = struct
+  module Absolute = struct
+    type t = { timestamp_us: int64 }
+    type t_nbo = { abs_value_us__: int64 }
+
+    let bin =
+      let open Bin in
+      record (fun timestamp_us -> { timestamp_us })
+      |+ field neint64 (fun t -> t.timestamp_us) (* not BE here? *)
+      |> sealr
+
+    let nbo_bin =
+      let open Bin in
+      record (fun abs_value_us__ -> { abs_value_us__ })
+      |+ field beint64 (fun t -> t.abs_value_us__)
+      |> sealr
+  end
+
+  module Relative = struct
+    type t = { timestamp_us: int64 }
+    type t_nbo = { rel_value_us__: int64 }
+
+    let bin =
+      let open Bin in
+      record (fun timestamp_us -> { timestamp_us })
+      |+ field neint64 (fun t -> t.timestamp_us)
+      |> sealr
+
+    let nbo_bin =
+      let open Bin in
+      record (fun rel_value_us__ -> { rel_value_us__ })
+      |+ field beint64 (fun t -> t.rel_value_us__)
+      |> sealr
+  end
+end
+
+(* -- Cryptographic primitives -- *)
+
+module Hash_code = struct
+  (* usually SHA-512 *)
+  type t = { hash: string (* = uint8_t hash[64] *) }
+
+  let bin =
+    let open Bin in
+    record (fun hash -> { hash }) |+ field (bytes 64) (fun t -> t.hash) |> sealr
+end
+
+module Denomination_hash = struct
+  type t = { hash: Hash_code.t }
+
+  let bin =
+    let open Bin in
+    record (fun hash -> { hash })
+    |+ field Hash_code.bin (fun t -> t.hash)
+    |> sealr
+end
+
+module Private_contract_hash = struct
+  type t = { hash: Hash_code.t }
+
+  let bin =
+    let open Bin in
+    record (fun hash -> { hash })
+    |+ field Hash_code.bin (fun t -> t.hash)
+    |> sealr
+end
+
+module Extensions_policy_hash = struct
+  type t = { hash: Hash_code.t }
+
+  let bin =
+    let open Bin in
+    record (fun hash -> { hash })
+    |+ field Hash_code.bin (fun t -> t.hash)
+    |> sealr
+end
+
+module Merchant_wire_hash = struct
+  type t = { hash: Hash_code.t }
+
+  let bin =
+    let open Bin in
+    record (fun hash -> { hash })
+    |+ field Hash_code.bin (fun t -> t.hash)
+    |> sealr
+end
+
+(* -- Signatures -- *)
+
+module Purpose = struct
+  (* defined in gnunet_crypto_lib.h *)
+  type t = {
+    (* This field equals the number of bytes being signed,
+       namely 'sizeof (struct Data)'. *)
+    size: int32; (* = uint32_t *)
+    (* This field is used to express the context in
+       which the signature is made, ensuring that a
+       signature cannot be lifted from one part of the protocol
+       to another. *)
+    purpose: int32; (* = uint32_t *)
+  }
+
+  let t_bin =
+    let open Bin in
+    record (fun size purpose -> { size; purpose })
+    |+ field beint32 (fun t -> t.size)
+    |+ field beint32 (fun t -> t.purpose)
+    |> sealr
+end
+
+module Data = struct
+  type t = {
+    purpose: Purpose.t;
+    payloads: string list;
+  }
+end

src/dune

@@ -13,6 +13,7 @@
   ;
   include
   ;
+  bin
   angstrom
   zarith ;
   mirage-crypto

src/signatures.ml

@@ -1,23 +0,0 @@
-(* https://docs.taler.net/core/api-common.html#id7 *)
-
-module Purpose = struct
-  (* defined in gnunet_crypto_lib.h *)
-  type t = {
-    (* This field equals the number of bytes being signed,
-       namely 'sizeof (struct Data)'. *)
-    size: Int32.t; (* = uint32_t *)
-    (* This field is used to express the context in
-       which the signature is made, ensuring that a
-       signature cannot be lifted from one part of the protocol
-       to another. See `src/include/taler/taler_signatures.h` within the
-       exchange's codebase (git://taler.net/exchange). *)
-    purpose: Int32.t; (* = uint32_t *)
-  }
-end
-
-module Data = struct
-  type t = {
-    purpose: Purpose.t;
-    payloads: string list;
-  }
-end