diff --git a/src/binary_formats.ml b/src/binary_formats.ml index 4a7f04ee..028d4258 100644 --- a/src/binary_formats.ml +++ b/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 --- *)