add binary_formats.ml

src/binary_formats.ml

@@ -0,0 +1,126 @@
+(* 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 Short_hash_code = struct
+  type t = { hash: string }
+
+  let bin =
+    let open Bin in
+    record (fun hash -> { hash }) |+ field (bytes 32) (fun t -> t.hash) |> sealr
+end
+
+module MAKE_H (H : sig
+  type t
+
+  val bin : t Bin.t
+end) =
+struct
+  type t = { hash: H.t }
+
+  let bin =
+    let open Bin in
+    record (fun hash -> { hash }) |+ field H.bin (fun t -> t.hash) |> sealr
+end
+
+module Denomination_hash = MAKE_H (Hash_code)
+module Private_contract_hash = MAKE_H (Hash_code)
+module Extensions_policy_hash = MAKE_H (Hash_code)
+module Merchant_wire_hash = MAKE_H (Hash_code)
+
+(* 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)
+
+(* 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)
+
+(* Hash over:
+     a) the hash of the denomination's public key,
+     b) an enum value identifying the cipher, and
+     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 Coin_pub_hash = MAKE_H (Hash_code)
+module Output_commitment_hash = MAKE_H (Hash_code)
+
+(* -- 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