functo refacto ~!

This commit is contained in:
swrup 2025-10-07 14:20:32 +02:00
parent 0fef7fbd10
commit 6ed9916974
2 changed files with 115 additions and 170 deletions

View file

@ -4,13 +4,8 @@
open Include
(* TODO
less boilerplate?
- type t abstract
- type t = { v = string }
padding issues?
how to encode union? not really needed?
test *)
let int32_size = 4
let int64_size = 8
(* -- Time -- *)
@ -19,6 +14,8 @@ module Time = struct
type t = { timestamp_us: int64 }
type t_nbo = { abs_value_us__: int64 }
let size = int64_size
(* not BE here? never used? *)
let bin =
let open Bin in
@ -37,6 +34,8 @@ module Time = struct
type t = { timestamp_us: int64 }
type t_nbo = { rel_value_us__: int64 }
let size = int64_size
let bin =
let open Bin in
record (fun timestamp_us -> { timestamp_us })
@ -53,59 +52,67 @@ end
(* -- Cryptographic primitives -- *)
module Hash_code = struct
(* usually SHA-512 *)
type t = { hash: string (* = uint8_t hash[64] *) }
let size = 64
let bin =
let open Bin in
record (fun hash -> { hash })
|+ field (bytes size) (fun t -> t.hash)
|> sealr
end
module Short_hash_code = struct
type t = { hash: string }
let size = 32
let bin =
let open Bin in
record (fun hash -> { hash })
|+ field (bytes size) (fun t -> t.hash)
|> sealr
end
module MAKE_H (H : sig
type t = { hash: string }
val size : int
val bin : t Bin.t
(* MK_BASIC_XX functor for structs like:
struct Foo { uint8_t bar[XX]; } *)
module MKMK_BASIC (Size : sig
val v : int
end) =
struct
type t = { hash: H.t }
type t = { v: string }
let size = Size.v
let bin =
let open Bin in
record (fun v -> { v }) |+ field (bytes size) (fun t -> t.v) |> sealr
end
module SIZE_32 = struct
let v = 32
end
module SIZE_64 = struct
let v = 64
end
module MK_BASIC_32 () = MKMK_BASIC (SIZE_32)
module MK_BASIC_64 () = MKMK_BASIC (SIZE_64)
(* MK_XX functor for structs like:
struct FooWrap { struct Foo { uint8_t bar[XX]; } } *)
module MKMK (Size : sig
val v : int
end) =
struct
module H = MKMK_BASIC (Size)
type t = { v: H.t }
let size = H.size
let bin =
let open Bin in
record (fun hash -> { hash }) |+ field H.bin (fun t -> t.hash) |> sealr
record (fun v -> { v }) |+ field H.bin (fun t -> t.v) |> 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)
module MK_32 () = MKMK (SIZE_32)
module MK_64 () = MKMK (SIZE_64)
(* - *)
module ShortHashCode = MK_BASIC_32 ()
module HashCode = MK_BASIC_64 ()
module Denomination_hash = MK_64 ()
module Private_contract_hash = MK_64 ()
module Extensions_policy_hash = MK_64 ()
module Merchant_wire_hash = MK_64 ()
(* 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)
module Full_payto_hash = MK_32 ()
(* 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)
module Normalized_payto_hash = MK_32 ()
(* Hash over:
a) the hash of the denomination's public key,
@ -113,80 +120,18 @@ module Normalized_payto_hash = MAKE_H (Short_hash_code)
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)
module Blinded_coin_hash = MK_64 ()
module Coin_pub_hash = MK_64 ()
module Output_commitment_hash = MK_64 ()
module Reserve_public_key_p = MK_32 ()
module Reserve_private_key_p = MK_32 ()
module Reserve_signature_p = MK_64 ()
module Merchant_public_key_p = MK_32 ()
module Merchant_private_key_p = MK_32 ()
(*module Merchant_signature_p = MK_64 () *)
module MAKE_EDDSA_PUB () = struct
type t = { eddsa_pub: string }
let bin =
let open Bin in
record (fun eddsa_pub -> { eddsa_pub })
|+ field (bytes 32) (fun t -> t.eddsa_pub)
|> sealr
end
module MAKE_EDDSA_PRIV () = struct
type t = { eddsa_priv: string }
let bin =
let open Bin in
record (fun eddsa_priv -> { eddsa_priv })
|+ field (bytes 32) (fun t -> t.eddsa_priv)
|> sealr
end
module MAKE_EDDSA_SIG () = struct
(* 64 bytes *)
type t = { eddsa_signature: string }
let bin =
let open Bin in
record (fun eddsa_signature -> { eddsa_signature })
|+ field (bytes 64) (fun t -> t.eddsa_signature)
|> sealr
end
module MAKE_ECDHE_PUB () = struct
type t = { ecdhe_pub: string }
let bin =
let open Bin in
record (fun ecdhe_pub -> { ecdhe_pub })
|+ field (bytes 32) (fun t -> t.ecdhe_pub)
|> sealr
end
module MAKE_ECDHE_PRIV () = struct
type t = { ecdhe_priv: string }
let bin =
let open Bin in
record (fun ecdhe_priv -> { ecdhe_priv })
|+ field (bytes 32) (fun t -> t.ecdhe_priv)
|> sealr
end
module Ecdh_ephemeral_public_key_p = struct
type t = { ecdh_pub: string (* = uint8_t ecdh_pub[32] *) }
let bin =
let open Bin in
record (fun ecdh_pub -> { ecdh_pub })
|+ field (bytes 32) (fun t -> t.ecdh_pub)
|> sealr
end
module Reserve_public_key_p = MAKE_EDDSA_PUB ()
module Reserve_private_key_p = MAKE_EDDSA_PRIV ()
module Reserve_signature_p = MAKE_EDDSA_SIG ()
module Merchant_public_key_p = MAKE_EDDSA_PUB ()
module Merchant_private_key_p = MAKE_EDDSA_PRIV ()
(*module Merchant_signature_p = MAKE_EDDSA_SIG ()*)
module Transfert_public_key_p = MAKE_ECDHE_PUB ()
module Transfert_private_key_p = MAKE_ECDHE_PRIV ()
module Transfert_public_key_p = MK_32 ()
module Transfert_private_key_p = MK_32 ()
(*
enum TALER_AmlDecisionState {
@ -194,32 +139,26 @@ enum TALER_AmlDecisionState {
};
*)
module Aml_officer_public_key_p = MAKE_EDDSA_PUB ()
module Aml_officer_private_key_p = MAKE_EDDSA_PRIV ()
module Exchange_public_key_p = MAKE_EDDSA_PUB ()
module Exchange_private_key_p = MAKE_EDDSA_PRIV ()
module Exchange_signature_p = MAKE_EDDSA_SIG ()
module Master_public_key_p = MAKE_EDDSA_PUB ()
module Master_private_key_p = MAKE_EDDSA_PRIV ()
module Master_signature_p = MAKE_EDDSA_SIG ()
module Wire_transfert_identifier_raw_p = struct
(* uint8_t raw[32]; *)
type t = { raw: string }
let bin =
let open Bin in
record (fun raw -> { raw }) |+ field (bytes 32) (fun t -> t.raw) |> sealr
end
module Aml_officer_public_key_p = MK_32 ()
module Aml_officer_private_key_p = MK_32 ()
module Exchange_public_key_p = MK_32 ()
module Exchange_private_key_p = MK_32 ()
module Exchange_signature_p = MK_64 ()
module Master_public_key_p = MK_32 ()
module Master_private_key_p = MK_32 ()
module Master_signature_p = MK_64 ()
module Wire_transfert_identifier_raw_p = MK_BASIC_32 ()
module UUID = struct
(* uint32_t value[4]; *)
type t = { value: string }
let size = 4 * int32_size
let bin =
let open Bin in
record (fun value -> { value })
|+ field (bytes (4 * 4)) (fun t -> t.value)
|+ field (bytes size) (fun t -> t.value)
|> sealr
end
@ -227,11 +166,11 @@ module Wad_id = struct
(* uint32_t value[6]; *)
type t = { raw: string }
let size = 6 * int32_size
let bin =
let open Bin in
record (fun raw -> { raw })
|+ field (bytes (4 * 6)) (fun t -> t.raw)
|> sealr
record (fun raw -> { raw }) |+ field (bytes size) (fun t -> t.raw) |> sealr
end
(* TODO not sure what to do of union, probably not needed *)
@ -245,9 +184,9 @@ union TALER_CoinSpendPrivateKeyP {
uint8_t ecdhe_priv[32];
};
*)
module Coin_spend_public_key_p = MAKE_EDDSA_PUB ()
module Coin_spend_private_key_p = MAKE_EDDSA_PRIV ()
module Coin_spend_signature_p = MAKE_EDDSA_SIG ()
module Coin_spend_public_key_p = MK_32 ()
module Coin_spend_private_key_p = MK_32 ()
module Coin_spend_signature_p = MK_64 ()
(* TODO padding: sizeof used here (assume no padding for now) *)
(*
@ -260,9 +199,9 @@ struct TALER_EncryptedLinkSecretP {
uint8_t enc[sizeof (struct TALER_LinkSecretP)];
};
*)
module Transfert_secret_p = MAKE_H (Hash_code)
module Link_secret_p = MAKE_H (Hash_code)
module Encrypted_link_secret_p = MAKE_H (Hash_code)
module Transfert_secret_p = MK_64 ()
module Link_secret_p = MK_64 ()
module Encrypted_link_secret_p = MK_64 ()
(*
union TALER_TokenPublicKeyP {
@ -270,7 +209,7 @@ union TALER_TokenPublicKeyP {
uint8_t ecdhe_pub[32];
};
*)
module Token_public_key_p = MAKE_EDDSA_PUB ()
module Token_public_key_p = MK_32 ()
(* -- Signatures -- *)
@ -287,7 +226,7 @@ module Purpose = struct
purpose: int32;
}
let size = 4 + 4
let size = 2 * int32_size
let bin =
let open Bin in
@ -296,7 +235,7 @@ module Purpose = struct
|+ field beint32 (fun t -> t.purpose)
|> sealr
let make size purpose = { size= Int32.of_int size; purpose }
let make ~size purpose = { size= Int32.of_int size; purpose }
end
(* This is the running SHA512-hash over all
@ -304,7 +243,7 @@ end
Note that each `TALER_BlindedCoinHashP` itself
captures the hash of the corresponding denomination's
public key. *)
module Hash_planchets_p = MAKE_H (Hash_code)
module Hash_planchets_p = MK_64 ()
(* Binary representation of the age groups.
The bits set in the mask mark the edges at the beginning of a next age
@ -321,6 +260,8 @@ module Hash_planchets_p = MAKE_H (Hash_code)
module Age_mask = struct
type t = { mask: int32 }
let size = int32_size
let bin =
let open Bin in
record (fun mask -> { mask }) |+ field beint32 (fun t -> t.mask) |> sealr
@ -391,6 +332,8 @@ module Amount = struct
currency: string;
}
let size = int64_size + int32_size + currency_len
(* TODO BE here? *)
let bin =
let open Bin in
@ -408,6 +351,8 @@ module AmountNBO = struct
currency: string;
}
let size = int64_size + int32_size + currency_len
let bin =
let open Bin in
record (fun value fraction currency -> { value; fraction; currency })
@ -417,13 +362,13 @@ module AmountNBO = struct
|> sealr
end
module Blinding_master_seed = MK_BASIC_32 ()
(* Format used for to generate the signature on a request to withdraw
coins from a reserve. *)
module Withdraw_request_ps = struct
(* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
type t = {
(* TODO set it in encode/decode *)
(* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
purpose: Purpose.t;
(* Amount to withdraw, excluding fees, i.e.
the total sum of the denominations of the coins.
Note that the reserve must have a value of at least amount+fee. *)
@ -450,7 +395,7 @@ module Withdraw_request_ps = struct
or all zeros, if no denomination of cipher type Clause-Schnorr is used. *)
(* TODO TALER doc
`TALER_BlindingMasterSecretP` in doc, but probably TALER_BlindingMasterSeed *)
blinding_seed: string;
blinding_seed: Blinding_master_seed.t;
(* If age restriction proof is required, the maximum age _group_
to commit to, 0 otherwise. Note that in this case, all
denominations for all coins MUST support age restriction.
@ -464,24 +409,26 @@ module Withdraw_request_ps = struct
mask: Age_mask.t;
}
let size =
Purpose.size
+ (2 * Amount.size)
+ Hash_planchets_p.size
+ Blinding_master_seed.size
+ int32_size
+ Age_mask.size
let purpose = Purpose.make ~size Taler_signatures.wallet_reserve_withdraw
let bin =
let open Bin in
record
(fun purpose amount fee h_planchets blinding_seed max_age_group mask ->
{
purpose;
amount;
fee;
h_planchets;
blinding_seed;
max_age_group;
mask;
})
|+ field Purpose.bin (fun t -> t.purpose)
(fun _purpose amount fee h_planchets blinding_seed max_age_group mask ->
{ amount; fee; h_planchets; blinding_seed; max_age_group; mask })
|+ field Purpose.bin (Fun.const purpose)
|+ field Amount.bin (fun t -> t.amount)
|+ field Amount.bin (fun t -> t.fee)
|+ field Hash_planchets_p.bin (fun t -> t.h_planchets)
|+ field cstring (fun t -> t.blinding_seed)
|+ field Blinding_master_seed.bin (fun t -> t.blinding_seed)
|+ field beint32 (fun t -> t.max_age_group)
|+ field Age_mask.bin (fun t -> t.mask)
|> sealr
@ -506,8 +453,8 @@ module Withdraw_confirmation_ps = struct
noreveal_index: int32;
}
let size = Purpose.size + Hash_planchets_p.size + 4
let purpose = Purpose.make size Taler_signatures.exchange_confirm_withdraw
let size = Purpose.size + Hash_planchets_p.size + int32_size
let purpose = Purpose.make ~size Taler_signatures.exchange_confirm_withdraw
let bin =
let open Bin in