add binary_formats.ml

This commit is contained in:
swrup 2025-10-06 23:56:10 +02:00
parent b7b28af6fe
commit 7cc01ca1e4
4 changed files with 130 additions and 24 deletions

View file

@ -42,7 +42,9 @@ let () =
let l = parse Data.content in
assert (List.length l = 74);
let pp ppf { name; value } = Fmt.pf ppf "let %s = %d@." name value in
let pp ppf { name; value } =
Fmt.pf ppf "let %s : int32 = %d_l@." name value
in
Fmt.pr "%a" (Fmt.list pp) l;
()

126
src/binary_formats.ml Normal file
View file

@ -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

View file

@ -13,6 +13,7 @@
;
include
;
bin
angstrom
zarith ;
mirage-crypto

View file

@ -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