From 22f8a1d26eb8f18b9b5ef1bcc37d9843da1c0adc Mon Sep 17 00:00:00 2001 From: swrup Date: Fri, 21 Nov 2025 19:29:04 +0100 Subject: [PATCH] split binary_types + improve --- src/{binary_formats.ml => bin_signature.ml} | 483 ++------------------ src/bin_type.ml | 326 +++++++++++++ src/crypto.ml | 50 +- src/denomination.ml | 8 +- src/dune | 2 - src/management.ml | 41 +- src/pg.ml | 42 +- src/util.ml | 12 +- 8 files changed, 449 insertions(+), 515 deletions(-) rename src/{binary_formats.ml => bin_signature.ml} (60%) create mode 100644 src/bin_type.ml diff --git a/src/binary_formats.ml b/src/bin_signature.ml similarity index 60% rename from src/binary_formats.ml rename to src/bin_signature.ml index 059b0948..1d6af428 100644 --- a/src/binary_formats.ml +++ b/src/bin_signature.ml @@ -1,434 +1,7 @@ -(* https://docs.taler.net/core/api-common.html#binary-formats +(* Packed Signature *) - numeric values are in network byte order (big endian) *) - -(* structs that are 'packed' and do not contain pointers and are - thus suitable for hashing or similar operations are distinguished - by adding a 'P' at the end of the name. - (NEW) Note that this convention does not hold for the GNUnet-structs (yet). - - structs that are used with a purpose for signatures, - additionally get an 'S' at the end of the name. - - (from https://docs.taler.net/taler-developer-manual.html) *) - -(* TODO - - check that our struct are well packed - - it looks like Bin only define packed structs - - we don't need to worry about struct having "P" suffix - remove them - - test them - - union: not sure what to do of them - not needed or relevant i think - - some purpose (`TALER_SIGNATURE_XXX`) are missing - - exchange and gana master branch are not in sync - and we should use a specific git tag instead - - outdated doc(?) - - some missing struct documentation - - - correctly handle endianness *) - -(* TODO hash and C(ancer)-terminated strings - - - "A JSON object is canonicalized by converting it to an ASCII byte array - with the algorithm specified in RFC 8785. The resulting bytes are - terminated with a single 0-byte and then hashed with SHA512." - - from the code it looks like its the same for all stringy-strings - ! not strings that are raw-bytes-data-like - ? only for "HashCode" and "ShortHashCode" - *) - -module Taler_signatures = Include.Taler_signatures - -let int32_size = 4 -let int64_size = 8 - -(* -- Time -- *) - -(* microseconds since the UNIX Epoch - UINT64_MAX represents "never" *) -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 - -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 -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: - struct Foo { uint8t thing[XX]; } - MK_HASH_XX for hashed value - taler doc: - - Taler uses 512-bit hash codes (64 bytes). - - usually SHA-512 *) - 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 () : 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 Bytes_32 = MK_32 () - module Bytes_64 = MK_64 () - - module type H_sig = sig - type t - - val hash : string -> t - val bin : t Bin.t - end - - module HHH_64 : H_sig = 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 - - 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 : H_sig = 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 - end - - (* sha512 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_64 : H_sig = struct - include HHH_64 - - let hash s = - 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, instead is %d" - (String.length s) - | 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 HHH_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 HHH_32 - - let hash src = hash (M.to_octets src) - end -end - -include UTIL - -(* -- Cryptographic primitives -- *) - -module DenominationHash = MK_SRC_HASH_32 (struct - type src = Crypto.RsaPublicKey.t - - let to_octets = Crypto.RsaPublicKey.to_octets -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 - (and possibly BIC and other optional fields). *) -module FullPaytoHash = MK_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 () - -(* TODO missing doc *) -module AgeCommitmentHash = MK_HASH_64 () - -(* 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_CoinEvHash` - in libtalerexchange for details. *) -module BlindedCoinHash = MK_HASH_64 () -module CoinPubHash = MK_HASH_64 () -module OutputCommitmentHash = MK_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 () - -(* --- Keys --- *) - -module PursePublicKey = MK_32 () (* missing doc *) -module AuditorPublicKeyP = MK_32 () (* missing doc *) -module BlindingMasterSeed = MK_32 () -module BlindingMasterSecret = MK_32 () -module ReservePublicKeyP = MK_32 () -module ReservePrivateKeyP = MK_32 () -module MerchantPublicKeyP = MK_32 () -module MerchantPrivateKeyP = MK_32 () -module TransferPublicKeyP = MK_32 () -module TransferPrivateKeyP = MK_32 () -module AmlOfficerPublicKeyP = MK_32 () -module AmlOfficerPrivateKeyP = MK_32 () - -(*module ExchangePublicKeyP = MK_32 ()*) -module ExchangePrivateKeyP = MK_32 () -module MasterPublicKeyP = MK_32 () -module MasterPrivateKeyP = MK_32 () -module WireTransferIdentifierRawP = MK_32 () -module CoinSpendPublicKeyP = MK_32 () (* union *) -module CoinSpendPrivateKeyP = MK_32 () (* union *) -module TokenPublicKeyP = MK_32 () (* union *) -module PublicRefreshCoinNonceP = MK_64 () (* missing doc *) -module ReserveSignatureP = MK_64 () -module ExchangeSignatureP = MK_64 () -module MasterSignatureP = MK_64 () -module CoinSpendSignatureP = MK_64 () -module TransferSecretP = MK_64 () -module LinkSecretP = MK_64 () -module EncryptedLinkSecretP = MK_64 () - -(* TODO ? need to use/save a specific nonce for cryptographic blinding *) -(* Secret for blinding/unblinding. - An RSA blinding secret, which is basically - a 256-bit nonce, converted to Crockford `Base32`. - - type DenominationBlindingKeyP = string; *) -module DenominationBlindingKeyP = MK_32 () - -(* --- Various --- *) - -module RefreshCommitmentP = MK_64 () - -module UUID = struct - (* uint32t value[4]; *) - type t = { value: string } - - let size = 4 * int32_size - - let bin = - let open Bin in - record (fun value -> { value }) - |+ field (bytes size) (fun t -> t.value) - |> sealr -end - -module WadId = struct - (* uint32t value[6]; *) - type t = { raw: string } - - let size = 6 * int32_size - - let bin = - let open Bin in - record (fun raw -> { raw }) |+ field (bytes size) (fun t -> t.raw) |> sealr -end - -module AgeMask = struct - type t = { mask: int32 } - - let bin = - let open Bin in - record (fun mask -> { mask }) |+ field beint32 (fun t -> t.mask) |> sealr -end - -(* TODO - - why is the non-NBO version only used in TALER_WithdrawRequestPS? - - correctly do the padding and 0-termination - - handle "invalid" values *) -(* documentation: *) -(* Number of characters (plus 1 for 0-termination) for currency names. - typically an ISO 4217 currency code when an alphanumeric 3-digit code is used. - For regional currencies, the first character should be a "*" followed - by a region-specific name (i.e. "*BRETAGNEFR"). - Currency codes are compared case-insensitively. - - Currency string, left adjusted and padded with zeros. - All zeros for "invalid" values. - - Name of the currency, using either a three-character ISO 4217 currency - code, or a regional currency identifier between 4 and 11 characters, - consisting of ASCII alphabetic characters ("a-zA-Z"). - Should be padded to 12 bytes with 0-characters. - Currency codes are compared case-insensitively. *) -let currency_len = 12 - -(* TODO missing doc - found in src/include/taler/taler_amount_lib.h *) -module Amount = struct - type t = { - value: int64; - fraction: int32; - currency: string; - } - - (* TODO BE here? *) - let bin = - let open Bin in - record (fun value fraction currency -> { value; fraction; currency }) - |+ field beint64 (fun t -> t.value) - |+ field beint32 (fun t -> t.fraction) - |+ field (bytes currency_len) (fun t -> t.currency) - |> sealr -end - -module AmountNBO = struct - type t = { - value: int64; - fraction: int32; - currency: string; - } - - let bin = - let open Bin in - record (fun value fraction currency -> { value; fraction; currency }) - |+ field beint64 (fun t -> t.value) - |+ field beint32 (fun t -> t.fraction) - |+ field (bytes currency_len) (fun t -> t.currency) - |> sealr -end - -(* -- Signatures -- *) -(* PS: Packed Signature *) +open Bin_type +open Bin_type.Aliases (* EccSignaturePurpose *) module Purpose = struct @@ -517,7 +90,7 @@ module DenominationKeyAnnouncementPS = struct (* purpose.purpose = TALER_SIGNATURE_SM_DENOMINATION_KEY *) type t = { h_denom_pub: DenominationHash.t; - h_section_name: Cstring_hash_64.t; + h_section_name: Hash_64_cstr.t; anchor_time: TimeAbsoluteNBO.t; duration_withdraw: TimeRelativeNBO.t; } @@ -530,7 +103,7 @@ module DenominationKeyAnnouncementPS = struct { h_denom_pub; h_section_name; anchor_time; duration_withdraw }) |+ Purpose.field purpose |+ field DenominationHash.bin (fun t -> t.h_denom_pub) - |+ field Cstring_hash_64.bin (fun t -> t.h_section_name) + |+ field Hash_64_cstr.bin (fun t -> t.h_section_name) |+ field TimeAbsoluteNBO.bin (fun t -> t.anchor_time) |+ field TimeRelativeNBO.bin (fun t -> t.duration_withdraw) |> sealr @@ -580,7 +153,7 @@ module DepositRequestPS = struct amount_with_fee: AmountNBO.t; deposit_fee: AmountNBO.t; merchant: MerchantPublicKeyP.t; - wallet_data_hash: Cstring_hash_64.t; + wallet_data_hash: Hash_64_cstr.t; } end @@ -631,7 +204,7 @@ module ExchangeKeySetPS = struct (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_KEY_SET *) type t = { list_issue_date: TimeAbsoluteNBO.t; - hc: Cstring_hash_64.t; + hc: Hash_64_cstr.t; } end @@ -655,16 +228,16 @@ module MasterWireDetailsPS = struct (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_DETAILS *) type t = { h_wire_details: FullPaytoHash.t; - h_conversion_url: Cstring_hash_64.t; - h_credit_restrictions: Cstring_hash_64.t; - h_debit_restrictions: Cstring_hash_64.t; + h_conversion_url: Hash_64_cstr.t; + h_credit_restrictions: Hash_64_cstr.t; + h_debit_restrictions: Hash_64_cstr.t; } end module MasterWireFeePS = struct (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_FEES *) type t = { - h_wire_method: Cstring_hash_64.t; + h_wire_method: Hash_64_cstr.t; start_date: TimeAbsoluteNBO.t; end_date: TimeAbsoluteNBO.t; wire_fee: AmountNBO.t; @@ -694,7 +267,7 @@ module MasterDrainProfitPS = struct wtid: WireTransferIdentifierRawP.t; date: TimeAbsoluteNBO.t; amount: AmountNBO.t; - h_section: Cstring_hash_64.t; + h_section: Hash_64_cstr.t; h_payto: FullPaytoHash.t; } end @@ -725,14 +298,14 @@ module WireDepositDataPS = struct wire_fee: AmountNBO.t; merchant_pub: MerchantPublicKeyP.t; h_wire: MerchantWireHash.t; - h_details: Cstring_hash_64.t; + h_details: Hash_64_cstr.t; } end module ExchangeKeyValidityPS = struct (* purpose.purpose = TALER_SIGNATURE_AUDITOR_EXCHANGE_KEYS *) type t = { - auditor_url_hash: Cstring_hash_64.t; + auditor_url_hash: Hash_64_cstr.t; master: MasterPublicKeyP.t; start: TimeAbsoluteNBO.t; expire_withdraw: TimeAbsoluteNBO.t; @@ -803,7 +376,7 @@ end module MerchantRefundConfirmationPS = struct (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND_OK *) (* Hash of the order ID (a string), hashed without the 0-termination. *) - type t = { h_order_id: Cstring_hash_64.t } + type t = { h_order_id: Hash_64_cstr.t } end module RecoupRequestPS = struct @@ -928,7 +501,7 @@ module PurseDepositSignaturePS = struct h_denom_pub: DenominationHash.t; h_age_commitment: AgeCommitmentHash.t; purse_pub: PursePublicKey.t; - h_exchange_base_url: Cstring_hash_64.t; + h_exchange_base_url: Hash_64_cstr.t; } end @@ -995,7 +568,7 @@ module WadDataSignaturePS = struct type t = { wad_execution_time: TimeAbsoluteNBO.t; total_amount: AmountNBO.t; - h_items: Cstring_hash_64.t; + h_items: Hash_64_cstr.t; wad_id: WadId.t; } end @@ -1003,7 +576,7 @@ end module WadPartnerSignaturePS = struct (* purpose.purpose = TALER_SIGNATURE_MASTER_PARTNER_DETAILS *) type t = { - h_partner_base_url: Cstring_hash_64.t; + h_partner_base_url: Hash_64_cstr.t; master_public_key: MasterPublicKeyP.t; start_date: TimeAbsoluteNBO.t; end_date: TimeAbsoluteNBO.t; @@ -1052,7 +625,7 @@ module MasterAddAuditorPS = struct type t = { start_date: TimeAbsoluteNBO.t; auditor_pub: AuditorPublicKeyP.t; - h_auditor_url: Cstring_hash_64.t; + h_auditor_url: Hash_64_cstr.t; } end @@ -1069,9 +642,9 @@ module MasterAddWirePS = struct type t = { start_date: TimeAbsoluteNBO.t; h_wire: FullPaytoHash.t; - h_conversion_url: Cstring_hash_64.t; - h_credit_restrictions: Cstring_hash_64.t; - h_debit_restrictions: Cstring_hash_64.t; + h_conversion_url: Hash_64_cstr.t; + h_credit_restrictions: Hash_64_cstr.t; + h_debit_restrictions: Hash_64_cstr.t; } end @@ -1088,7 +661,7 @@ module MasterAmlOfficerStatusPS = struct type t = { change_date: TimestampNBO.t; officer_pub: AmlOfficerPublicKeyP.t; - h_officer_name: Cstring_hash_64.t; + h_officer_name: Hash_64_cstr.t; is_active: int; } end @@ -1096,11 +669,11 @@ end module AmlDecisionPS = struct (* purpose.purpose = TALER_SIGNATURE_AML_DECISION *) type t = { - h_justification: Cstring_hash_64.t; + h_justification: Hash_64_cstr.t; decision_time: TimestampNBO.t; new_threshold: AmountNBO.t; h_payto: NormalizedPaytoHash.t; - h_kyc_requirements: Cstring_hash_64.t; + h_kyc_requirements: Hash_64_cstr.t; new_state: int; } end @@ -1113,7 +686,7 @@ module PartnerConfigurationPS = struct end_date: TimestampNBO.t; wad_frequency: TimeRelativeNBO.t; wad_fee: AmountNBO.t; - h_url: Cstring_hash_64.t; + h_url: Hash_64_cstr.t; } end @@ -1139,7 +712,7 @@ module ReserveAttestRequestPS = struct (* purpose.purpose = TALER_SIGNATURE_WALLET_ATTEST_REQUEST *) type t = { request_timestamp: TimestampNBO.t; - h_details: Cstring_hash_64.t; + h_details: Hash_64_cstr.t; } end @@ -1149,6 +722,6 @@ module ExchangeAttestPS = struct attest_timestamp: TimestampNBO.t; expiration_time: TimestampNBO.t; reserve_pub: ReservePublicKeyP.t; - h_attributes: Cstring_hash_64.t; + h_attributes: Hash_64_cstr.t; } end diff --git a/src/bin_type.ml b/src/bin_type.ml new file mode 100644 index 00000000..75d5fd5f --- /dev/null +++ b/src/bin_type.ml @@ -0,0 +1,326 @@ +(* https://docs.taler.net/core/api-common.html#binary-formats + + numeric values are in network byte order (big endian) *) + +(* structs that are 'packed' and do not contain pointers and are + thus suitable for hashing or similar operations are distinguished + by adding a 'P' at the end of the name. + (NEW) Note that this convention does not hold for the GNUnet-structs (yet). + + structs that are used with a purpose for signatures, + additionally get an 'S' at the end of the name. + + (from https://docs.taler.net/taler-developer-manual.html) *) + +(* TODO + - correctly handle endianness + - check that our struct are well packed + - it looks like Bin only define packed structs + - we don't need to worry about struct having "P" suffix + remove them + - test them + - union: not sure what to do of them + not needed or relevant i think + - some purpose (`TALER_SIGNATURE_XXX`) are missing + - exchange and gana master branch are not in sync + and we should use a specific git tag instead + - outdated doc(?) + - some missing struct documentation + + - better way to have module aliases? + *) + +(* TODO hash and C(ancer)-terminated strings + + - "A JSON object is canonicalized by converting it to an ASCII byte array + with the algorithm specified in RFC 8785. The resulting bytes are + terminated with a single 0-byte and then hashed with SHA512." + - from the code it looks like its the same for all stringy-strings + ! not strings that are raw-bytes-data-like + ? only for "HashCode" and "ShortHashCode" + *) + +module Taler_signatures = Include.Taler_signatures +open Crypto + +let int32_size = 4 +let int64_size = 8 + +module Bytes_32 = struct + type t = string + + let bin = Bin.bytes 32 +end + +module Bytes_64 = struct + type t = string + + let bin = Bin.bytes 64 +end + +(* microseconds since the UNIX Epoch + UINT64_MAX represents "never" *) +module INT64 = struct + type t = int64 + + let bin = Bin.neint64 + let of_ptime v = Util.ptime_to_int64 v +end + +module INT64_NBO = struct + type t = int64 + + let bin = Bin.beint64 + let of_ptime = Util.ptime_to_int64 +end + +(* -- Time -- *) +module type Time_S = sig + type t + + val bin : t Bin.t + val of_ptime : Ptime.t -> t +end + +module TimeAbsolute : Time_S = INT64 +module TimeAbsoluteNBO : Time_S = INT64_NBO +module TimeRelative : Time_S = INT64 +module TimeRelativeNBO : Time_S = INT64_NBO +module Timestamp : Time_S = INT64 +module TimestampNBO : Time_S = INT64_NBO + +(* -- Cryptographic primitives -- *) + +(* Hashes *) + +module Hash_32 = struct + type t = Digestif.SHA256.t + + let hash s = Digestif.SHA256.(digest_string s) + + let of_octets s = + match String.length s = 32 with + | false -> Fmt.failwith "Hash.of_octets failure: data is not 32 bytes" + | true -> Digestif.SHA256.of_raw_string s + + let to_octets = Digestif.SHA256.to_raw_string + + let bin = + let open Bin in + map (bytes 32) of_octets to_octets +end + +module Hash_64 = struct + type t = Digestif.SHA512.t + + let hash s = Digestif.SHA512.(digest_string s) + + let of_octets s = + match String.length s = 64 with + | false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes" + | true -> Digestif.SHA512.of_raw_string s + + let to_octets = Digestif.SHA512.to_raw_string + + let bin = + let open Bin in + map (bytes 64) of_octets to_octets +end + +(* Hash over string + '\0' *) +module Hash_32_cstr = struct + type t = Digestif.SHA256.t + + let hash s = + let s = s ^ "\x00" in + Digestif.SHA256.(digest_string s) + + let of_octets s = + match String.length s = 32 with + | false -> Fmt.failwith "Hash.of_octets failure: data is not 32 bytes" + | true -> Digestif.SHA256.of_raw_string s + + let to_octets = Digestif.SHA256.to_raw_string + + let bin = + let open Bin in + map (bytes 32) of_octets to_octets +end + +module Hash_64_cstr = struct + type t = Digestif.SHA512.t + + let hash s = + let s = s ^ "\x00" in + Digestif.SHA512.(digest_string s) + + let of_octets s = + match String.length s = 64 with + | false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes" + | true -> Digestif.SHA512.of_raw_string s + + let to_octets = Digestif.SHA512.to_raw_string + + let bin = + let open Bin in + map (bytes 64) of_octets to_octets +end + +module type Hash_S = sig + type t + + val bin : t Bin.t + val hash : string -> t + val of_octets : string -> t + val to_octets : t -> string +end + +module FullPaytoHash : Hash_S = Hash_32 +module NormalizedPaytoHash : Hash_S = Hash_32 +module DenominationHash : Hash_S = Hash_64 +module PrivateContractHash : Hash_S = Hash_64 +module ExtensionsPolicyHash : Hash_S = Hash_64 +module MerchantWireHash : Hash_S = Hash_64 +module AgeCommitmentHash : Hash_S = Hash_64 +module BlindedCoinHash : Hash_S = Hash_64 +module CoinPubHash : Hash_S = Hash_64 +module OutputCommitmentHash : Hash_S = Hash_64 +module HashPlanchetsP : Hash_S = Hash_64 + +(* --- Various --- *) + +module TransferSecretP = Bytes_64 +module LinkSecretP = Bytes_64 +module EncryptedLinkSecretP = Bytes_64 +module BlindingMasterSeed = Bytes_32 +module BlindingMasterSecret = Bytes_32 +module WireTransferIdentifierRawP = Bytes_32 +module PublicRefreshCoinNonceP = Bytes_64 + +(* TODO ? need to use/save a specific nonce for cryptographic blinding *) +(* Secret for blinding/unblinding. + An RSA blinding secret, which is basically + a 256-bit nonce, converted to Crockford `Base32`. + + type DenominationBlindingKeyP = string; *) +module DenominationBlindingKeyP = Bytes_32 +module RefreshCommitmentP = Bytes_64 + +(* -- TODO better: -- *) +module UUID = struct + (* uint32t value[4]; *) + type t = { value: string } + + let size = 4 * int32_size + + let bin = + let open Bin in + record (fun value -> { value }) + |+ field (bytes size) (fun t -> t.value) + |> sealr +end + +module WadId = struct + (* uint32t value[6]; *) + type t = { raw: string } + + let size = 6 * int32_size + + let bin = + let open Bin in + record (fun raw -> { raw }) |+ field (bytes size) (fun t -> t.raw) |> sealr +end + +module AgeMask = struct + type t = { mask: int32 } + + let bin = + let open Bin in + record (fun mask -> { mask }) |+ field beint32 (fun t -> t.mask) |> sealr +end + +(* TODO + - why is the non-NBO version only used in TALER_WithdrawRequestPS? + - correctly do the padding and 0-termination + - handle "invalid" values *) +(* documentation: *) +(* Number of characters (plus 1 for 0-termination) for currency names. + typically an ISO 4217 currency code when an alphanumeric 3-digit code is used. + For regional currencies, the first character should be a "*" followed + by a region-specific name (i.e. "*BRETAGNEFR"). + Currency codes are compared case-insensitively. + + Currency string, left adjusted and padded with zeros. + All zeros for "invalid" values. + + Name of the currency, using either a three-character ISO 4217 currency + code, or a regional currency identifier between 4 and 11 characters, + consisting of ASCII alphabetic characters ("a-zA-Z"). + Should be padded to 12 bytes with 0-characters. + Currency codes are compared case-insensitively. *) +let currency_len = 12 + +(* TODO missing doc + found in src/include/taler/taler_amount_lib.h *) +module AmountP = struct + type t = { + value: int64; + fraction: int32; + currency: string; + } + + (* TODO BE here? *) + let bin = + let open Bin in + record (fun value fraction currency -> { value; fraction; currency }) + |+ field beint64 (fun t -> t.value) + |+ field beint32 (fun t -> t.fraction) + |+ field (bytes currency_len) (fun t -> t.currency) + |> sealr +end + +module AmountNBO = struct + type t = { + value: int64; + fraction: int32; + currency: string; + } + + let bin = + let open Bin in + record (fun value fraction currency -> { value; fraction; currency }) + |+ field beint64 (fun t -> t.value) + |+ field beint32 (fun t -> t.fraction) + |+ field (bytes currency_len) (fun t -> t.currency) + |> sealr +end + +(* TODO keep this? + some of those are actuall ecdhe, or union of eddsa|ecdhe *) +module Aliases = struct + (* TODO add Amount.bin *) + module Amount = AmountP + + (* - Keys - *) + module PursePublicKey = EddsaPublicKey + module AuditorPublicKeyP = EddsaPublicKey + module ReservePublicKeyP = EddsaPublicKey + module MerchantPublicKeyP = EddsaPublicKey + module TransferPublicKeyP = EddsaPublicKey + module AmlOfficerPublicKeyP = EddsaPublicKey + module ExchangePublicKeyP = EddsaPublicKey + module MasterPublicKeyP = EddsaPublicKey + module CoinSpendPublicKeyP = EddsaPublicKey + module TokenPublicKeyP = EddsaPublicKey + module ReservePrivateKeyP = EddsaPrivateKey + module MerchantPrivateKeyP = EddsaPrivateKey + module TransferPrivateKeyP = EddsaPrivateKey + module AmlOfficerPrivateKeyP = EddsaPrivateKey + module ExchangePrivateKeyP = EddsaPrivateKey + module MasterPrivateKeyP = EddsaPrivateKey + module CoinSpendPrivateKeyP = EddsaPrivateKey + module MasterSignatureP = EddsaSignature + module ReserveSignatureP = EddsaSignature + module ExchangeSignatureP = EddsaSignature + module CoinSpendSignatureP = EddsaSignature +end diff --git a/src/crypto.ml b/src/crypto.ml index 3fe4171f..f7bd9921 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -10,7 +10,11 @@ module EddsaPublicKey = struct type t = pub let to_octets t = pub_to_octets t - let of_octets t = pub_of_octets t + let of_octets t = pub_of_octets t |> Result.get_ok + + let bin = + let open Bin in + map (bytes 32) of_octets to_octets let of_b32 s = let open Syntax in @@ -23,14 +27,42 @@ module EddsaPublicKey = struct let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32 end +module EddsaPrivateKey = struct + (* EdDSA and ECDHE public keys always point on Curve25519 + and represented using the standard 256 bits Ed25519 compact format, + converted to Crockford Base32. *) + open Mirage_crypto_ec.Ed25519 + + type t = priv + + let to_octets t = priv_to_octets t + let of_octets t = priv_of_octets t |> Result.get_ok + + let bin = + let open Bin in + map (bytes 32) of_octets to_octets + + let of_b32 s = + let open Syntax in + let* octets = B32.decode s in + match priv_of_octets octets with + | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e + | Ok priv -> Ok priv + + let to_b32 t = B32.encode (to_octets t) + let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32 +end + module EddsaSignature : sig type t - val to_octets : t -> string val sign : key:Mirage_crypto_ec.Ed25519.priv -> string -> t val of_b32 : string -> (t, string) result val to_b32 : t -> string + val to_octets : t -> string + val of_octets : string -> t val jsont : t Jsont.t + val bin : t Bin.t end = struct (* TODO key format endianess issue? *) @@ -42,6 +74,16 @@ end = struct let to_octets t = t + let of_octets v = + match String.length v = 64 with + | false -> + Fmt.failwith "EddsaSignature.of_octets failure: data is not 64 bytes." + | true -> v + + let bin = + let open Bin in + map (bytes 64) of_octets to_octets + let sign ~key s = (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *) Mirage_crypto_ec.Ed25519.sign ~key s @@ -96,6 +138,8 @@ module RsaPublicKey = struct | true -> Ok () in fun s -> + Result.get_ok + @@ let open Syntax in let len = String.length s in let* () = check (len >= 4) in @@ -115,7 +159,7 @@ module RsaPublicKey = struct let of_b32 s = let open Syntax in let* s = B32.decode s in - let* v = of_octets s in + let v = of_octets s in let+ v = Rsa.pub ~n:v.n ~e:v.e |> unwrap_err_msg in v diff --git a/src/denomination.ml b/src/denomination.ml index 073ab646..d74ca172 100644 --- a/src/denomination.ml +++ b/src/denomination.ml @@ -12,15 +12,11 @@ type t = { fee_deposit: Amount.t; fee_refresh: Amount.t; fee_refund: Amount.t; - h_pub: Binary_formats.DenominationHash.t; + h_pub: Bin_type.DenominationHash.t; sign: string -> RsaSignature.t; master_sig: EddsaSignature.t option; } -let hash_pub _pub = - (* todo public key converted to Crockford Base32 *) - assert false - let make ({ section_name; @@ -51,7 +47,7 @@ let make let open Mirage_crypto_pk.Rsa in let priv = generate ~bits:rsa_keysize () in let pub = pub_of_priv priv in - let h_pub = Binary_formats.DenominationHash.hash pub in + let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in let sign = RsaSignature.sign ~key:priv in let master_sig = None in { diff --git a/src/dune b/src/dune index b378bc9e..f092e1ad 100644 --- a/src/dune +++ b/src/dune @@ -20,8 +20,6 @@ caqti-miou.unix caqti-driver-pgx bin - angstrom - zarith ; mirage-crypto digestif duration diff --git a/src/management.ml b/src/management.ml index 2d9f0d89..f743dd70 100644 --- a/src/management.ml +++ b/src/management.ml @@ -23,23 +23,18 @@ let mk_future_denom denom_key_signf DenominationKey.Rsa RsaDenominationKey.{ age_mask= 0; rsa_pub= pub } in let denom_secmod_sig = - let open Binary_formats in + let open Bin_type in + let open Bin_signature.DenominationKeyAnnouncementPS in let h_denom_pub = h_pub in - let h_section_name = Cstring_hash_64.hash section_name in - let anchor_time = TimeAbsoluteNBO.{ v= Util.ptime_to_int64 stamp_start } in + let h_section_name = Hash_64_cstr.hash section_name in + let anchor_time = TimeAbsoluteNBO.of_ptime stamp_start in let duration_withdraw = - let v = - Ptime.diff stamp_start stamp_expire_withdraw - |> Util.ptime_of_span_exn - |> Util.ptime_to_int64 - in - TimeRelativeNBO.{ v } + Ptime.diff stamp_start stamp_expire_withdraw + |> Util.ptime_of_span_exn + |> TimeRelativeNBO.of_ptime in - let ps = - DenominationKeyAnnouncementPS. - { h_denom_pub; h_section_name; anchor_time; duration_withdraw } - in - ps |> Bin.to_string DenominationKeyAnnouncementPS.bin |> denom_key_signf + let ps = { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in + ps |> Bin.to_string bin |> denom_key_signf in FutureDenom. { @@ -61,19 +56,17 @@ let mk_future_signkey signkey_signf ({ pub; stamp_start; stamp_expire; stamp_end; sign= _; master_sig= _ } : Signkey.t) = let signkey_secmod_sig = - let open Binary_formats in + let open Bin_type in + let open Bin_signature.SigningKeyAnnouncementPS in let exchange_pub = pub in - let anchor_time = TimeAbsoluteNBO.{ v= Util.ptime_to_int64 stamp_start } in + let anchor_time = TimeAbsoluteNBO.of_ptime stamp_start in let duration = - let v = - Ptime.diff stamp_start stamp_expire - |> Util.ptime_of_span_exn - |> Util.ptime_to_int64 - in - TimeRelativeNBO.{ v } + Ptime.diff stamp_start stamp_expire + |> Util.ptime_of_span_exn + |> TimeRelativeNBO.of_ptime in - let ps = SigningKeyAnnouncementPS.{ exchange_pub; anchor_time; duration } in - ps |> Bin.to_string SigningKeyAnnouncementPS.bin |> signkey_signf + let ps = { exchange_pub; anchor_time; duration } in + ps |> Bin.to_string bin |> signkey_signf in FutureSignKey. { diff --git a/src/pg.ml b/src/pg.ml index 631d5432..c38a0fd9 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -12,7 +12,10 @@ module Caqti_type = struct Caqti_type.custom ~encode ~decode Caqti_type.(int64) end -let pg_amount : Amount.t Caqti_type.t = +open Crypto +(*open Bin_type*) + +let amount_t : Amount.t Caqti_type.t = let open Amount in Caqti_type.custom ~encode:(fun amount -> Ok (amount.value, amount.fraction)) @@ -20,16 +23,37 @@ let pg_amount : Amount.t Caqti_type.t = Amount.make ~sign:None ~currency:Config.currency ~value ~fraction) Caqti_type.(t2 int64 int32) +let eddsa_signature_t : EddsaSignature.t Caqti_type.t = + let open EddsaSignature in + Caqti_type.custom + ~encode:(fun master_sig -> Ok (to_octets master_sig)) + ~decode:(fun s -> Ok (of_octets s)) + Caqti_type.octets + (* WIP: minimum db functions for basic /management *) let pg_todo () = assert false +open Caqti_request.Infix + (* signkey *) (* todo: - what type to use for TALER_ExchangePublicKeyP + TALER_EXCHANGEDB_SignkeyMetaData -> I think it could be something = to FutureSignKey.t - master signature: over smthing? *) -let activate_signing_key _cls _exchange_public_key _master_signature = pg_todo +let activate_signing_key _cls (exchange_public_key : Signkey.t) = + (*let open Bin_type in*) + let _exchange_pub = EddsaPublicKey.(to_octets exchange_public_key.pub) in + let _master_sig = + exchange_public_key.master_sig |> Option.get + (*|> EddsaSignature.to_octets*) + in + let _insert_signkey = + Caqti_type.(t5 string ptime ptime ptime string ->! int) + "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \ + expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5);" + in + pg_todo () (* @@ -49,20 +73,6 @@ TEH_PG_activate_signing_key ( GNUNET_PQ_query_param_auto_from_type (master_sig), GNUNET_PQ_query_param_end }; - - PREPARE (pg, - "insert_signkey", - "INSERT INTO exchange_sign_keys " - "(exchange_pub" - ",valid_from" - ",expire_sign" - ",expire_legal" - ",master_sig" - ") VALUES " - "($1, $2, $3, $4, $5);"); - return GNUNET_PQ_eval_prepared_non_select (pg->conn, - "insert_signkey", - iparams); } *) diff --git a/src/util.ml b/src/util.ml index 608f3ed5..9ad5f311 100644 --- a/src/util.ml +++ b/src/util.ml @@ -1,14 +1,8 @@ -module Protocol_version = struct - (* TODO *) - (* libtool version format *) - let current = 0 - let revision = 0 - let age = 0 - let v = Fmt.str "%d:%d:%d" -end - (* -- Ptime -- *) +(* TODO have a Time.t = int64 + -> avoid having conversion everywhere + -> avoid using Caqti_type.ptime *) let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float let ptime_of_int64 i =