+ more binary_formats refacto
This commit is contained in:
parent
3dbe7eb370
commit
e72ed3e972
3 changed files with 144 additions and 85 deletions
|
|
@ -41,27 +41,43 @@
|
|||
let int32_size = 4
|
||||
let int64_size = 8
|
||||
|
||||
(* TODO clean up
|
||||
? rm all of UTIL_FUNC
|
||||
? Bin.map int64 to Ptime.t here *)
|
||||
module UTIL_FUNC = struct
|
||||
(* microseconds since the UNIX Epoch
|
||||
(* -- Time -- *)
|
||||
|
||||
(* microseconds since the UNIX Epoch
|
||||
UINT64_MAX represents "never" *)
|
||||
module MK_TIME () = struct
|
||||
type t = { v: int64 }
|
||||
module MK_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
|
||||
(* not BE (?) *)
|
||||
let bin =
|
||||
let open Bin in
|
||||
record (fun v -> { v }) |+ field neint64 (fun t -> t.v) |> sealr
|
||||
end
|
||||
|
||||
module MK_TIME_NBO () = struct
|
||||
type t = { v: int64 }
|
||||
module MK_TIME_NBO () = struct
|
||||
type t = { v: int64 }
|
||||
|
||||
let bin =
|
||||
let open Bin in
|
||||
record (fun v -> { v }) |+ field beint64 (fun t -> t.v) |> sealr
|
||||
let bin =
|
||||
let open Bin in
|
||||
record (fun v -> { v }) |+ field beint64 (fun t -> t.v) |> sealr
|
||||
end
|
||||
|
||||
module TimeAbsolute = MK_TIME ()
|
||||
module TimeAbsoluteNBO = MK_TIME_NBO ()
|
||||
module TimeRelative = MK_TIME ()
|
||||
module TimeRelativeNBO = MK_TIME_NBO ()
|
||||
module Timestamp = MK_TIME ()
|
||||
module TimestampNBO = MK_TIME_NBO ()
|
||||
|
||||
(* TODO clean up
|
||||
? rm all of UTIL
|
||||
? Bin.map int64 to Ptime.t here *)
|
||||
module UTIL = struct
|
||||
module type Bytes_sig = sig
|
||||
type t = { v: string }
|
||||
|
||||
val of_octets : string -> t
|
||||
val bin : t Bin.t
|
||||
end
|
||||
|
||||
(* MK_XX functor for structs like:
|
||||
|
|
@ -70,68 +86,35 @@ module UTIL_FUNC = struct
|
|||
taler doc:
|
||||
- Taler uses 512-bit hash codes (64 bytes).
|
||||
- usually SHA-512 *)
|
||||
module MK_32 () = struct
|
||||
module MK_32 () : Bytes_sig = struct
|
||||
type t = { v: string }
|
||||
|
||||
let of_octets v =
|
||||
match String.length v = 32 with
|
||||
| false -> Fmt.failwith "of_octets failure: data is not 32 bytes"
|
||||
| true -> { v }
|
||||
|
||||
let bin =
|
||||
let open Bin in
|
||||
record (fun v -> { v }) |+ field (bytes 32) (fun t -> t.v) |> sealr
|
||||
end
|
||||
|
||||
module MK_64 () = struct
|
||||
module MK_64 () : Bytes_sig = struct
|
||||
type t = { v: string }
|
||||
|
||||
let of_octets v =
|
||||
match String.length v = 64 with
|
||||
| false -> Fmt.failwith "of_octets failure: data is not 64 bytes"
|
||||
| true -> { v }
|
||||
|
||||
let bin =
|
||||
let open Bin in
|
||||
record (fun v -> { v }) |+ field (bytes 64) (fun t -> t.v) |> sealr
|
||||
end
|
||||
|
||||
module MK_HASH_32 () : sig
|
||||
type t = private { hash: string }
|
||||
module Bytes_32 = MK_32 ()
|
||||
module Bytes_64 = MK_64 ()
|
||||
|
||||
val of_octets : string -> t
|
||||
val bin : t Bin.t
|
||||
end = struct
|
||||
type t = { hash: string }
|
||||
|
||||
let of_octets s =
|
||||
match String.length s = 32 with
|
||||
| false -> Fmt.failwith "SHA256 failure: data is not 32 bytes"
|
||||
| true ->
|
||||
let hash = Digestif.SHA256.(to_raw_string (digest_string s)) in
|
||||
{ hash }
|
||||
|
||||
let bin =
|
||||
let open Bin in
|
||||
record (fun hash -> { hash })
|
||||
|+ field (bytes 32) (fun t -> t.hash)
|
||||
|> sealr
|
||||
end
|
||||
|
||||
module MK_HASH_64 () : sig
|
||||
type t = private { hash: string }
|
||||
|
||||
val of_string : string -> t
|
||||
val bin : t Bin.t
|
||||
end = struct
|
||||
type t = { hash: string }
|
||||
|
||||
let of_string s =
|
||||
match String.length s = 64 with
|
||||
| false -> Fmt.failwith "SHA512 failure: data is not 64bytes"
|
||||
| true ->
|
||||
let hash = Digestif.SHA512.(to_raw_string (digest_string s)) in
|
||||
{ hash }
|
||||
|
||||
let bin =
|
||||
let open Bin in
|
||||
record (fun hash -> { hash })
|
||||
|+ field (bytes 64) (fun t -> t.hash)
|
||||
|> sealr
|
||||
end
|
||||
end
|
||||
|
||||
module UTIL_HASH = struct
|
||||
module type H_sig = sig
|
||||
type t
|
||||
|
||||
|
|
@ -176,21 +159,87 @@ module UTIL_HASH = struct
|
|||
let s = s ^ "\x00" in
|
||||
hash s
|
||||
end
|
||||
|
||||
module MK_HASH_64 () : H_sig = struct
|
||||
include HHH_64
|
||||
end
|
||||
|
||||
module HHH_32 : H_sig = struct
|
||||
type t = { hash: Digestif.SHA256.t }
|
||||
|
||||
let hash s =
|
||||
let hash = Digestif.SHA256.(digest_string s) in
|
||||
{ hash }
|
||||
|
||||
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
|
||||
end
|
||||
|
||||
(* sha256 with string size check *)
|
||||
module Hash_32 : H_sig = struct
|
||||
include HHH_32
|
||||
|
||||
let hash s =
|
||||
match String.length s = 32 with
|
||||
| false -> Fmt.failwith "SHA256 failure: data is not 32 bytes"
|
||||
| true -> hash s
|
||||
end
|
||||
|
||||
(* sha256 but add a null termination to the given string
|
||||
this is "HashCode" in GNU TALER
|
||||
|
||||
todo: maybe need to have a cstring.ml *)
|
||||
module Cstring_hash_32 : H_sig = struct
|
||||
include HHH_32
|
||||
|
||||
let hash s =
|
||||
let s = s ^ "\x00" in
|
||||
hash s
|
||||
end
|
||||
|
||||
module MK_HASH_32 () : H_sig = struct
|
||||
include HHH_32
|
||||
end
|
||||
|
||||
module MK_SRC_HASH_64 (M : sig
|
||||
type src
|
||||
|
||||
val to_octets : src -> string
|
||||
end) : sig
|
||||
type t
|
||||
|
||||
val bin : t Bin.t
|
||||
val hash : M.src -> t
|
||||
end = struct
|
||||
include Hash_64
|
||||
|
||||
let hash src = hash (M.to_octets src)
|
||||
end
|
||||
|
||||
module MK_SRC_HASH_32 (M : sig
|
||||
type src
|
||||
|
||||
val to_octets : src -> string
|
||||
end) : sig
|
||||
type t
|
||||
|
||||
val bin : t Bin.t
|
||||
val hash : M.src -> t
|
||||
end = struct
|
||||
include Hash_32
|
||||
|
||||
let hash src = hash (M.to_octets src)
|
||||
end
|
||||
end
|
||||
|
||||
open UTIL_FUNC
|
||||
include UTIL_HASH
|
||||
include UTIL
|
||||
module Taler_signatures = Include.Taler_signatures
|
||||
|
||||
(* -- Time -- *)
|
||||
|
||||
module TimeAbsolute = MK_TIME ()
|
||||
module TimeAbsoluteNBO = MK_TIME_NBO ()
|
||||
module TimeRelative = MK_TIME ()
|
||||
module TimeRelativeNBO = MK_TIME_NBO ()
|
||||
module Timestamp = MK_TIME ()
|
||||
module TimestampNBO = MK_TIME_NBO ()
|
||||
|
||||
(* -- Cryptographic primitives -- *)
|
||||
|
||||
(* GNUNET_CRYPTO format *)
|
||||
|
|
@ -255,16 +304,24 @@ module GNUNET_RsaPublicKey = struct
|
|||
t
|
||||
end
|
||||
|
||||
module DenominationHash = struct
|
||||
include Hash_64
|
||||
module DenominationHash = MK_SRC_HASH_32 (struct
|
||||
type src = Mirage_crypto_pk.Rsa.pub
|
||||
|
||||
let hash (pub : Mirage_crypto_pk.Rsa.pub) =
|
||||
pub
|
||||
|> GNUNET_RsaPublicKey.of_pub
|
||||
|> Bin.to_string GNUNET_RsaPublicKey.bin
|
||||
|> hash
|
||||
let to_octets pub =
|
||||
GNUNET_RsaPublicKey.of_pub pub |> Bin.to_string GNUNET_RsaPublicKey.bin
|
||||
end)
|
||||
|
||||
module ExchangePublicKeyP = struct
|
||||
type t = Mirage_crypto_ec.Ed25519.pub
|
||||
|
||||
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 })
|
||||
end
|
||||
|
||||
(* --- Hashes --- *)
|
||||
|
||||
(* Hash over a full payto://-URI, including receiver-name
|
||||
|
|
@ -312,7 +369,8 @@ module TransferPublicKeyP = MK_32 ()
|
|||
module TransferPrivateKeyP = MK_32 ()
|
||||
module AmlOfficerPublicKeyP = MK_32 ()
|
||||
module AmlOfficerPrivateKeyP = MK_32 ()
|
||||
module ExchangePublicKeyP = MK_32 ()
|
||||
|
||||
(*module ExchangePublicKeyP = MK_32 ()*)
|
||||
module ExchangePrivateKeyP = MK_32 ()
|
||||
module MasterPublicKeyP = MK_32 ()
|
||||
module MasterPrivateKeyP = MK_32 ()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue