src/binary_formats.ml

@@ -39,42 +39,31 @@
  *)
 
 module Taler_signatures = Include.Taler_signatures
+open Crypto
 
 let int32_size = 4
 let int64_size = 8
 
-(* -- Time -- *)
-
-(* microseconds since the UNIX Epoch
-   UINT64_MAX represents "never" *)
-module TIME = struct
-  type t = { v: int64 }
-
-  (* not BE (?) *)
-  let bin =
-    let open Bin in
-    record (fun v -> { v }) |+ field neint64 (fun t -> t.v) |> sealr
-end
-
-module TIME_NBO = struct
-  type t = { v: int64 }
-
-  let bin =
-    let open Bin in
-    record (fun v -> { v }) |+ field beint64 (fun t -> t.v) |> sealr
-end
-
-module TimeAbsolute = TIME
-module TimeAbsoluteNBO = TIME_NBO
-module TimeRelative = TIME
-module TimeRelativeNBO = TIME_NBO
-module Timestamp = TIME
-module TimestampNBO = TIME_NBO
-
-(* TODO clean up
-   ? rm all of UTIL
-   ? Bin.map int64 to Ptime.t here *)
 module UTIL = struct
+  (* microseconds since the UNIX Epoch
+   UINT64_MAX represents "never" *)
+  module TIME = struct
+    type t = { v: int64 }
+
+    (* not BE (?) *)
+    let bin =
+      let open Bin in
+      record (fun v -> { v }) |+ field neint64 (fun t -> t.v) |> sealr
+  end
+
+  module TIME_NBO = struct
+    type t = { v: int64 }
+
+    let bin =
+      let open Bin in
+      record (fun v -> { v }) |+ field beint64 (fun t -> t.v) |> sealr
+  end
+
   (* taler doc:
       - Taler uses 512-bit hash codes (64 bytes).
       - usually SHA-512 *)
@@ -104,13 +93,10 @@ module UTIL = struct
       record (fun v -> { v }) |+ field (bytes 64) (fun t -> t.v) |> sealr
   end
 
-  module HHH_64 = struct
+  (* sha512 with string size check *)
+  module Hash_64 = struct
     type t = { hash: Digestif.SHA512.t }
 
-    let hash s =
-      let hash = Digestif.SHA512.(digest_string s) in
-      { hash }
-
     let hash_bin =
       let open Bin in
       map (bytes 64) Digestif.SHA512.of_raw_string Digestif.SHA512.to_raw_string
@@ -118,16 +104,13 @@ module UTIL = struct
     let bin =
       let open Bin in
       record (fun hash -> { hash }) |+ field hash_bin (fun t -> t.hash) |> sealr
-  end
-
-  (* sha512 with string size check *)
-  module Hash_64 = struct
-    include HHH_64
 
     let hash s =
       match String.length s = 64 with
       | false -> Fmt.failwith "SHA512 failure: data is not 64 bytes"
-      | true -> hash s
+      | true ->
+          let hash = Digestif.SHA512.(digest_string s) in
+          { hash }
   end
 
   (* sha512 but add a null termination to the given string
@@ -135,23 +118,25 @@ module UTIL = struct
 
      todo: maybe need to have a cstring.ml *)
   module Cstring_hash_64 = struct
-    include HHH_64
+    type t = { hash: Digestif.SHA512.t }
+
+    let hash_bin =
+      let open Bin in
+      map (bytes 64) Digestif.SHA512.of_raw_string Digestif.SHA512.to_raw_string
+
+    let bin =
+      let open Bin in
+      record (fun hash -> { hash }) |+ field hash_bin (fun t -> t.hash) |> sealr
 
     let hash s =
       let s = s ^ "\x00" in
-      hash s
-  end
-
-  module MK_HASH_64 () = struct
-    include HHH_64
-  end
-
-  module HHH_32 = struct
-    type t = { hash: Digestif.SHA256.t }
-
-    let hash s =
-      let hash = Digestif.SHA256.(digest_string s) in
+      let hash = Digestif.SHA512.(digest_string s) in
       { hash }
+  end
+
+  (* sha256 with string size check *)
+  module Hash_32 = struct
+    type t = { hash: Digestif.SHA256.t }
 
     let hash_bin =
       let open Bin in
@@ -160,18 +145,15 @@ module UTIL = struct
     let bin =
       let open Bin in
       record (fun hash -> { hash }) |+ field hash_bin (fun t -> t.hash) |> sealr
-  end
-
-  (* sha256 with string size check *)
-  module Hash_32 = struct
-    include HHH_32
 
     let hash s =
       match String.length s = 32 with
       | false ->
           Fmt.failwith "SHA256 failure: data is not 32 bytes, instead is %d"
             (String.length s)
-      | true -> hash s
+      | true ->
+          let hash = Digestif.SHA256.(digest_string s) in
+          { hash }
   end
 
   (* sha256 but add a null termination to the given string
@@ -179,18 +161,23 @@ module UTIL = struct
 
      todo: maybe need to have a cstring.ml *)
   module Cstring_hash_32 = struct
-    include HHH_32
+    type t = { hash: Digestif.SHA256.t }
+
+    let hash_bin =
+      let open Bin in
+      map (bytes 32) Digestif.SHA256.of_raw_string Digestif.SHA256.to_raw_string
+
+    let bin =
+      let open Bin in
+      record (fun hash -> { hash }) |+ field hash_bin (fun t -> t.hash) |> sealr
 
     let hash s =
       let s = s ^ "\x00" in
-      hash s
+      let hash = Digestif.SHA256.(digest_string s) in
+      { hash }
   end
 
-  module MK_HASH_32 () = struct
-    include HHH_32
-  end
-
-  module MK_SRC_HASH_64 (M : sig
+  module MK_HASH_64_of_src (M : sig
     type src
 
     val to_octets : src -> string
@@ -200,12 +187,23 @@ module UTIL = struct
     val bin : t Bin.t
     val hash : M.src -> t
   end = struct
-    include HHH_64
+    type t = { hash: Digestif.SHA512.t }
 
-    let hash src = hash (M.to_octets src)
+    let hash_bin =
+      let open Bin in
+      map (bytes 64) Digestif.SHA512.of_raw_string Digestif.SHA512.to_raw_string
+
+    let bin =
+      let open Bin in
+      record (fun hash -> { hash }) |+ field hash_bin (fun t -> t.hash) |> sealr
+
+    let hash src =
+      let s = M.to_octets src in
+      let hash = Digestif.SHA512.(digest_string s) in
+      { hash }
   end
 
-  module MK_SRC_HASH_32 (M : sig
+  module MK_HASH_32_of_src (M : sig
     type src
 
     val to_octets : src -> string
@@ -215,48 +213,69 @@ module UTIL = struct
     val bin : t Bin.t
     val hash : M.src -> t
   end = struct
-    include HHH_32
+    type t = { hash: Digestif.SHA256.t }
 
-    let hash src = hash (M.to_octets src)
+    let hash_bin =
+      let open Bin in
+      map (bytes 32) Digestif.SHA256.of_raw_string Digestif.SHA256.to_raw_string
+
+    let bin =
+      let open Bin in
+      record (fun hash -> { hash }) |+ field hash_bin (fun t -> t.hash) |> sealr
+
+    let hash src =
+      let s = M.to_octets src in
+      let hash = Digestif.SHA256.(digest_string s) in
+      { hash }
   end
 end
 
-include UTIL
+open UTIL
+module Cstring_hash_32 = Cstring_hash_32
+module Cstring_hash_64 = Cstring_hash_64
+
+(* -- Time -- *)
+
+module TimeAbsolute = TIME
+module TimeAbsoluteNBO = TIME_NBO
+module TimeRelative = TIME
+module TimeRelativeNBO = TIME_NBO
+module Timestamp = TIME
+module TimestampNBO = TIME_NBO
 
 (* -- Cryptographic primitives -- *)
 
-module DenominationHash = MK_SRC_HASH_32 (struct
-  type src = Crypto.RsaPublicKey.t
+module DenominationHash = MK_HASH_32_of_src (struct
+  type src = RsaPublicKey.t
 
-  let to_octets = Crypto.RsaPublicKey.to_octets
+  let to_octets = RsaPublicKey.to_octets
 end)
 
 module ExchangePublicKeyP = struct
-  type t = Mirage_crypto_ec.Ed25519.pub
+  type t = EddsaPublicKey.t
 
   let bin =
-    let open Mirage_crypto_ec.Ed25519 in
     let open Bin in
-    let open Bytes_32 in
-    map bin
-      (fun { v } -> pub_of_octets v |> Result.get_ok)
-      (fun pub -> { v= pub_to_octets pub })
+    let open EddsaPublicKey in
+    map Bytes_32.bin
+      (fun { v } -> of_octets v |> Result.get_ok)
+      (fun pub -> { v= to_octets pub })
 end
 (* --- Hashes --- *)
 
 (* Hash over a full payto://-URI, including receiver-name
    (and possibly BIC and other optional fields). *)
-module FullPaytoHash = MK_HASH_32 ()
+module FullPaytoHash = Hash_32
 
 (* Hash over a normalized payto://-URI, including all optional
    fields and also with account-part canonicalized (so no BIC). *)
-module NormalizedPaytoHash = MK_HASH_32 ()
-module PrivateContractHash = MK_HASH_64 ()
-module ExtensionsPolicyHash = MK_HASH_64 ()
-module MerchantWireHash = MK_HASH_64 ()
+module NormalizedPaytoHash = Hash_32
+module PrivateContractHash = Hash_64
+module ExtensionsPolicyHash = Hash_64
+module MerchantWireHash = Hash_64
 
 (* TODO missing doc *)
-module AgeCommitmentHash = MK_HASH_64 ()
+module AgeCommitmentHash = Hash_64
 
 (* Hash over:
      a) the hash of the denomination's public key,
@@ -264,16 +283,16 @@ module AgeCommitmentHash = MK_HASH_64 ()
      c) cipher-dependant blinded information.
    See implementation of `TALER_CoinEvHash`
    in libtalerexchange for details. *)
-module BlindedCoinHash = MK_HASH_64 ()
-module CoinPubHash = MK_HASH_64 ()
-module OutputCommitmentHash = MK_HASH_64 ()
+module BlindedCoinHash = Hash_64
+module CoinPubHash = Hash_64
+module OutputCommitmentHash = Hash_64
 
 (* This is the running SHA512-hash over all
    `TALER_BlindedCoinHashP` values of an array of coins.
    Note that each `TALER_BlindedCoinHashP` itself
    captures the hash of the corresponding denomination's
    public key. *)
-module HashPlanchetsP = MK_HASH_64 ()
+module HashPlanchetsP = Hash_64
 
 (* --- Keys --- *)