This commit is contained in:
parent
3dbe7eb370
commit
68cdd220ac
3 changed files with 85 additions and 53 deletions
|
|
@ -42,9 +42,9 @@ let int32_size = 4
|
||||||
let int64_size = 8
|
let int64_size = 8
|
||||||
|
|
||||||
(* TODO clean up
|
(* TODO clean up
|
||||||
? rm all of UTIL_FUNC
|
? rm all of UTIL
|
||||||
? Bin.map int64 to Ptime.t here *)
|
? Bin.map int64 to Ptime.t here *)
|
||||||
module UTIL_FUNC = struct
|
module UTIL = struct
|
||||||
(* microseconds since the UNIX Epoch
|
(* microseconds since the UNIX Epoch
|
||||||
UINT64_MAX represents "never" *)
|
UINT64_MAX represents "never" *)
|
||||||
module MK_TIME () = struct
|
module MK_TIME () = struct
|
||||||
|
|
@ -64,74 +64,48 @@ module UTIL_FUNC = struct
|
||||||
record (fun v -> { v }) |+ field beint64 (fun t -> t.v) |> sealr
|
record (fun v -> { v }) |+ field beint64 (fun t -> t.v) |> sealr
|
||||||
end
|
end
|
||||||
|
|
||||||
|
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:
|
(* MK_XX functor for structs like:
|
||||||
struct Foo { uint8t thing[XX]; }
|
struct Foo { uint8t thing[XX]; }
|
||||||
MK_HASH_XX for hashed value
|
MK_HASH_XX for hashed value
|
||||||
taler doc:
|
taler doc:
|
||||||
- Taler uses 512-bit hash codes (64 bytes).
|
- Taler uses 512-bit hash codes (64 bytes).
|
||||||
- usually SHA-512 *)
|
- usually SHA-512 *)
|
||||||
module MK_32 () = struct
|
module MK_32 () : Bytes_sig = struct
|
||||||
type t = { v: string }
|
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 bin =
|
||||||
let open Bin in
|
let open Bin in
|
||||||
record (fun v -> { v }) |+ field (bytes 32) (fun t -> t.v) |> sealr
|
record (fun v -> { v }) |+ field (bytes 32) (fun t -> t.v) |> sealr
|
||||||
end
|
end
|
||||||
|
|
||||||
module MK_64 () = struct
|
module MK_64 () : Bytes_sig = struct
|
||||||
type t = { v: string }
|
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 bin =
|
||||||
let open Bin in
|
let open Bin in
|
||||||
record (fun v -> { v }) |+ field (bytes 64) (fun t -> t.v) |> sealr
|
record (fun v -> { v }) |+ field (bytes 64) (fun t -> t.v) |> sealr
|
||||||
end
|
end
|
||||||
|
|
||||||
module MK_HASH_32 () : sig
|
module Bytes_32 = MK_32 ()
|
||||||
type t = private { hash: string }
|
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
|
module type H_sig = sig
|
||||||
type t
|
type t
|
||||||
|
|
||||||
|
|
@ -176,10 +150,55 @@ module UTIL_HASH = struct
|
||||||
let s = s ^ "\x00" in
|
let s = s ^ "\x00" in
|
||||||
hash s
|
hash s
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module MK_HASH_64 () : H_sig = struct
|
||||||
|
include HHH_64
|
||||||
end
|
end
|
||||||
|
|
||||||
open UTIL_FUNC
|
module HHH_32 : H_sig = struct
|
||||||
include UTIL_HASH
|
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
|
||||||
|
end
|
||||||
|
|
||||||
|
include UTIL
|
||||||
module Taler_signatures = Include.Taler_signatures
|
module Taler_signatures = Include.Taler_signatures
|
||||||
|
|
||||||
(* -- Time -- *)
|
(* -- Time -- *)
|
||||||
|
|
@ -265,6 +284,17 @@ module DenominationHash = struct
|
||||||
|> hash
|
|> hash
|
||||||
end
|
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 --- *)
|
(* --- Hashes --- *)
|
||||||
|
|
||||||
(* Hash over a full payto://-URI, including receiver-name
|
(* Hash over a full payto://-URI, including receiver-name
|
||||||
|
|
@ -312,7 +342,8 @@ module TransferPublicKeyP = MK_32 ()
|
||||||
module TransferPrivateKeyP = MK_32 ()
|
module TransferPrivateKeyP = MK_32 ()
|
||||||
module AmlOfficerPublicKeyP = MK_32 ()
|
module AmlOfficerPublicKeyP = MK_32 ()
|
||||||
module AmlOfficerPrivateKeyP = MK_32 ()
|
module AmlOfficerPrivateKeyP = MK_32 ()
|
||||||
module ExchangePublicKeyP = MK_32 ()
|
|
||||||
|
(*module ExchangePublicKeyP = MK_32 ()*)
|
||||||
module ExchangePrivateKeyP = MK_32 ()
|
module ExchangePrivateKeyP = MK_32 ()
|
||||||
module MasterPublicKeyP = MK_32 ()
|
module MasterPublicKeyP = MK_32 ()
|
||||||
module MasterPrivateKeyP = MK_32 ()
|
module MasterPrivateKeyP = MK_32 ()
|
||||||
|
|
|
||||||
|
|
@ -67,7 +67,7 @@ let mk_future_sign_key signkey_secmod_sign_f
|
||||||
({ pub; sign= _; stamp_start; stamp_expire; stamp_end } : Secmod_keys.t) =
|
({ pub; sign= _; stamp_start; stamp_expire; stamp_end } : Secmod_keys.t) =
|
||||||
let signkey_secmod_sig =
|
let signkey_secmod_sig =
|
||||||
let open Binary_formats in
|
let open Binary_formats in
|
||||||
let exchange_pub = ExchangePublicKeyP.{ v= EddsaPublicKey.to_octets pub } in
|
let exchange_pub = pub in
|
||||||
let anchor_time =
|
let anchor_time =
|
||||||
TimeAbsoluteNBO.{ v= Util.ptime_to_int64_us stamp_start }
|
TimeAbsoluteNBO.{ v= Util.ptime_to_int64_us stamp_start }
|
||||||
in
|
in
|
||||||
|
|
|
||||||
|
|
@ -83,6 +83,7 @@ module EddsaPublicKey = struct
|
||||||
type t = Mirage_crypto_ec.Ed25519.pub
|
type t = Mirage_crypto_ec.Ed25519.pub
|
||||||
|
|
||||||
let to_octets t = Mirage_crypto_ec.Ed25519.pub_to_octets t
|
let to_octets t = Mirage_crypto_ec.Ed25519.pub_to_octets t
|
||||||
|
let of_octets t = Mirage_crypto_ec.Ed25519.pub_of_octets t
|
||||||
|
|
||||||
let of_b32 s =
|
let of_b32 s =
|
||||||
let open Syntax in
|
let open Syntax in
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue