From 47b815269b1492c7e8b31f84ef2b96f03698c719 Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 22 Nov 2025 17:25:05 +0100 Subject: [PATCH] --- src/{binary_formats.ml => bin_signature.ml} | 482 ++------------------ src/bin_type.ml | 470 +++++++++++++++++++ src/crypto.ml | 9 +- src/denomination.ml | 4 +- src/management.ml | 44 +- src/pg.ml | 43 +- src/signkey.ml | 2 +- 7 files changed, 555 insertions(+), 499 deletions(-) rename src/{binary_formats.ml => bin_signature.ml} (59%) create mode 100644 src/bin_type.ml diff --git a/src/binary_formats.ml b/src/bin_signature.ml similarity index 59% rename from src/binary_formats.ml rename to src/bin_signature.ml index 028d4258..e2d5aef5 100644 --- a/src/binary_formats.ml +++ b/src/bin_signature.ml @@ -1,433 +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 -open Crypto - -let int32_size = 4 -let int64_size = 8 - -module UTIL = struct - (* microseconds since the UNIX Epoch - UINT64_MAX represents "never" *) - module 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 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 - - (* taler doc: - - Taler uses 512-bit hash codes (64 bytes). - - usually SHA-512 *) - module Bytes_32 = 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 Bytes_64 = 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 - - (* sha512 with string size check *) - module Hash_64 = struct - type t = { hash: Digestif.SHA512.t } - - 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 - - let hash s = - match String.length s = 64 with - | false -> Fmt.failwith "SHA512 failure: data is not 64 bytes" - | true -> - let hash = Digestif.SHA512.(digest_string s) in - { hash } - 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 = struct - type t = { hash: Digestif.SHA512.t } - - 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 - - let hash s = - let s = s ^ "\x00" in - let hash = Digestif.SHA512.(digest_string s) in - { hash } - end - - (* sha256 with string size check *) - module Hash_32 = struct - type t = { hash: Digestif.SHA256.t } - - 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 - - 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 -> - let hash = Digestif.SHA256.(digest_string s) in - { hash } - 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 = struct - type t = { hash: Digestif.SHA256.t } - - 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 - - let hash s = - let s = s ^ "\x00" in - let hash = Digestif.SHA256.(digest_string s) in - { hash } - end - - module MK_HASH_64_of_src (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 - type t = { hash: Digestif.SHA512.t } - - 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 - - let hash src = - let s = M.to_octets src in - let hash = Digestif.SHA512.(digest_string s) in - { hash } - end - - module MK_HASH_32_of_src (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 - type t = { hash: Digestif.SHA256.t } - - 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 - - let hash src = - let s = M.to_octets src in - let hash = Digestif.SHA256.(digest_string s) in - { hash } - end -end - -open UTIL -module Cstring_hash_32 = Cstring_hash_32 -module Cstring_hash_64 = Cstring_hash_64 - -(* -- Time -- *) - -module TimeAbsolute = TIME -module TimeAbsoluteNBO = TIME_NBO -module TimeRelative = TIME -module TimeRelativeNBO = TIME_NBO -module Timestamp = TIME -module TimestampNBO = TIME_NBO - -(* -- Cryptographic primitives -- *) - -module DenominationHash = MK_HASH_32_of_src (struct - type src = RsaPublicKey.t - - let to_octets = RsaPublicKey.to_octets -end) - -module ExchangePublicKeyP = struct - type t = EddsaPublicKey.t - - let bin = - let open Bin in - let open EddsaPublicKey in - map Bytes_32.bin - (fun { v } -> of_octets v |> Result.get_ok) - (fun pub -> { v= to_octets pub }) -end -(* --- Hashes --- *) - -(* Hash over a full payto://-URI, including receiver-name - (and possibly BIC and other optional fields). *) -module FullPaytoHash = Hash_32 - -(* Hash over a normalized payto://-URI, including all optional - fields and also with account-part canonicalized (so no BIC). *) -module NormalizedPaytoHash = Hash_32 -module PrivateContractHash = Hash_64 -module ExtensionsPolicyHash = Hash_64 -module MerchantWireHash = Hash_64 - -(* TODO missing doc *) -module AgeCommitmentHash = 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 = Hash_64 -module CoinPubHash = Hash_64 -module OutputCommitmentHash = 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 = Hash_64 - -(* --- Keys --- *) - -module PursePublicKey = Bytes_32 (* missing doc *) -module AuditorPublicKeyP = Bytes_32 (* missing doc *) -module BlindingMasterSeed = Bytes_32 -module BlindingMasterSecret = Bytes_32 -module ReservePublicKeyP = Bytes_32 -module ReservePrivateKeyP = Bytes_32 -module MerchantPublicKeyP = Bytes_32 -module MerchantPrivateKeyP = Bytes_32 -module TransferPublicKeyP = Bytes_32 -module TransferPrivateKeyP = Bytes_32 -module AmlOfficerPublicKeyP = Bytes_32 -module AmlOfficerPrivateKeyP = Bytes_32 - -(*module ExchangePublicKeyP = Bytes_32*) -module ExchangePrivateKeyP = Bytes_32 -module MasterPublicKeyP = Bytes_32 -module MasterPrivateKeyP = Bytes_32 -module WireTransferIdentifierRawP = Bytes_32 -module CoinSpendPublicKeyP = Bytes_32 (* union *) -module CoinSpendPrivateKeyP = Bytes_32 (* union *) -module TokenPublicKeyP = Bytes_32 (* union *) -module PublicRefreshCoinNonceP = Bytes_64 (* missing doc *) -module ReserveSignatureP = Bytes_64 -module ExchangeSignatureP = Bytes_64 -module MasterSignatureP = Bytes_64 -module CoinSpendSignatureP = Bytes_64 -module TransferSecretP = Bytes_64 -module LinkSecretP = Bytes_64 -module EncryptedLinkSecretP = 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 - -(* --- Various --- *) - -module RefreshCommitmentP = Bytes_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 +module Amount = Bin_amount (* EccSignaturePurpose *) module Purpose = struct @@ -516,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; } @@ -529,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 @@ -579,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 @@ -630,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 @@ -654,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; @@ -693,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 @@ -724,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; @@ -802,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 @@ -927,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 @@ -994,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 @@ -1002,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; @@ -1051,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 @@ -1068,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 @@ -1087,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 @@ -1095,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 @@ -1112,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 @@ -1138,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 @@ -1148,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..3002e3bb --- /dev/null +++ b/src/bin_type.ml @@ -0,0 +1,470 @@ +(* 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 + - 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" + *) +(* TODO + - no need to wrap types in records? + - roll back to functor mess to avoid type confusion + - or just have HashXX/BytesXX ? *) + +module Taler_signatures = Include.Taler_signatures +open Crypto + +let int32_size = 4 +let int64_size = 8 + +module type Time_S = sig + type t + + val bin : t Bin.t + val of_ptime : Ptime.t -> t +end + +module UTIL = struct + (* microseconds since the UNIX Epoch + UINT64_MAX represents "never" *) + module TIME : Time_S = struct + type t = int64 + + let bin = + let open Bin in + record Fun.id |+ field neint64 Fun.id |> sealr + + let of_ptime v = Util.ptime_to_int64 v + end + + module TIME_NBO : Time_S = struct + type t = int64 + + let bin = + let open Bin in + record Fun.id |+ field beint64 Fun.id |> sealr + + let of_ptime = Util.ptime_to_int64 + end + + (* taler doc: + - Taler uses 512-bit hash codes (64 bytes). + - usually SHA-512 *) + module Bytes_32 = 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 Bytes_64 = 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 + + (* sha256 with string size check *) + module Hash_32 = struct + type t = { hash: Digestif.SHA256.t } + + 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 + + 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 -> + let hash = Digestif.SHA256.(digest_string s) in + { hash } + end + + (* sha512 with string size check *) + module Hash_64 = struct + type t = { hash: Digestif.SHA512.t } + + 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 + + let hash s = + match String.length s = 64 with + | false -> Fmt.failwith "SHA512 failure: data is not 64 bytes" + | true -> + let hash = Digestif.SHA512.(digest_string s) in + { hash } + end + + module MK_HASH_32_of_src (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 + type t = { hash: Digestif.SHA256.t } + + 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 + + let hash src = + let s = M.to_octets src in + let hash = Digestif.SHA256.(digest_string s) in + { hash } + end + + module MK_HASH_64_of_src (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 + type t = { hash: Digestif.SHA512.t } + + 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 + + let hash src = + let s = M.to_octets src in + let hash = Digestif.SHA512.(digest_string s) in + { hash } + end +end + +open UTIL + +(* -- Time -- *) + +module TimeAbsolute : Time_S = TIME +module TimeAbsoluteNBO : Time_S = TIME_NBO +module TimeRelative : Time_S = TIME +module TimeRelativeNBO : Time_S = TIME_NBO +module Timestamp : Time_S = TIME +module TimestampNBO : Time_S = TIME_NBO + +(* -- Cryptographic primitives -- *) + +(* Hashes *) + +(* Hash over string + '\0' *) +module Hash_64_cstr = struct + type t = { hash: Digestif.SHA512.t } + + 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 + + let hash s = + let s = s ^ "\x00" in + let hash = Digestif.SHA512.(digest_string s) in + { hash } +end + +module Hash_32_cstr = struct + type t = { hash: Digestif.SHA256.t } + + 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 + + let hash s = + let s = s ^ "\x00" in + let hash = Digestif.SHA256.(digest_string s) in + { hash } +end + +module DenominationHash = MK_HASH_32_of_src (struct + type src = RsaPublicKey.t + + let to_octets = RsaPublicKey.to_octets +end) + +(* Hash over a full payto://-URI, including receiver-name + (and possibly BIC and other optional fields). *) +module FullPaytoHash = Hash_32 + +(* Hash over a normalized payto://-URI, including all optional + fields and also with account-part canonicalized (so no BIC). *) +module NormalizedPaytoHash = Hash_32 +module PrivateContractHash = Hash_64 +module ExtensionsPolicyHash = Hash_64 +module MerchantWireHash = Hash_64 + +(* TODO missing doc *) +module AgeCommitmentHash = 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 = Hash_64 +module CoinPubHash = Hash_64 +module OutputCommitmentHash = 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 = Hash_64 + +(* --- Keys --- *) + +module ExchangePublicKeyP : sig + type t + + val bin : t Bin.t + val to_string : t -> string + val of_string : string -> (t, string) result + val of_value : EddsaPublicKey.t -> t + val to_value : t -> EddsaPublicKey.t +end = struct + open EddsaPublicKey + + type t = EddsaPublicKey.t + + let bin = + let of_octets s = of_octets s |> Result.get_ok in + let open Bin in + map (bytes 32) of_octets to_octets + + let to_string t = Bin.to_string bin t + let of_string s = Util.bin_of_string bin s + let of_value = Fun.id + let to_value = Fun.id +end + +module MasterSignatureP : sig + type t + + val bin : t Bin.t + val to_string : t -> string + val of_string : string -> (t, string) result + val of_value : EddsaSignature.t -> t + val to_value : t -> EddsaSignature.t +end = struct + open EddsaSignature + + type t = EddsaSignature.t + + let bin = + let open Bin in + map (bytes 64) of_octets to_octets + + let to_string t = Bin.to_string bin t + let of_string s = Util.bin_of_string bin s + let of_value = Fun.id + let to_value = Fun.id +end + +module PursePublicKey = Bytes_32 (* missing doc *) +module AuditorPublicKeyP = Bytes_32 (* missing doc *) +module BlindingMasterSeed = Bytes_32 +module BlindingMasterSecret = Bytes_32 +module ReservePublicKeyP = Bytes_32 +module ReservePrivateKeyP = Bytes_32 +module MerchantPublicKeyP = Bytes_32 +module MerchantPrivateKeyP = Bytes_32 +module TransferPublicKeyP = Bytes_32 +module TransferPrivateKeyP = Bytes_32 +module AmlOfficerPublicKeyP = Bytes_32 +module AmlOfficerPrivateKeyP = Bytes_32 + +(*module ExchangePublicKeyP = Bytes_32*) +module ExchangePrivateKeyP = Bytes_32 +module MasterPublicKeyP = Bytes_32 +module MasterPrivateKeyP = Bytes_32 +module WireTransferIdentifierRawP = Bytes_32 +module CoinSpendPublicKeyP = Bytes_32 (* union *) +module CoinSpendPrivateKeyP = Bytes_32 (* union *) +module TokenPublicKeyP = Bytes_32 (* union *) +module PublicRefreshCoinNonceP = Bytes_64 (* missing doc *) +module ReserveSignatureP = Bytes_64 +module ExchangeSignatureP = Bytes_64 +module CoinSpendSignatureP = Bytes_64 +module TransferSecretP = Bytes_64 +module LinkSecretP = Bytes_64 +module EncryptedLinkSecretP = 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 + +(* --- Various --- *) + +module RefreshCommitmentP = Bytes_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 *) +(* note: added 'Bin_' preffix to avoid conflict with Amount + when opening Bin_type *) +module Bin_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 diff --git a/src/crypto.ml b/src/crypto.ml index 3fe4171f..6d42ddf6 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -26,10 +26,11 @@ 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 end = struct (* TODO key format @@ -42,6 +43,12 @@ 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 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 diff --git a/src/denomination.ml b/src/denomination.ml index 17346abd..03e3f13b 100644 --- a/src/denomination.ml +++ b/src/denomination.ml @@ -12,7 +12,7 @@ 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; } @@ -47,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 pub in let sign = RsaSignature.sign ~key:priv in let master_sig = None in { diff --git a/src/management.ml b/src/management.ml index 2d9f0d89..5ca286da 100644 --- a/src/management.ml +++ b/src/management.ml @@ -23,23 +23,19 @@ 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 _huhu = BlindedCoinHash.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 +57,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 exchange_pub = pub in - let anchor_time = TimeAbsoluteNBO.{ v= Util.ptime_to_int64 stamp_start } in + let open Bin_type in + let open Bin_signature.SigningKeyAnnouncementPS in + let exchange_pub = ExchangePublicKeyP.of_value pub 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..44bc4948 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,38 @@ let pg_amount : Amount.t Caqti_type.t = Amount.make ~sign:None ~currency:Config.currency ~value ~fraction) Caqti_type.(t2 int64 int32) +let master_signature_t : MasterSignatureP.t Caqti_type.t = + let open MasterSignatureP in + Caqti_type.custom + ~encode:(fun master_sig -> Ok (to_string master_sig)) + ~decode:(fun s -> of_string s) + Caqti_type.string + (* 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 = + ExchangePublicKeyP.(to_string (of_value exchange_public_key.pub)) + in + let _master_sig = + exchange_public_key.master_sig |> Option.get |> MasterSignatureP.to_string + 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 +74,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/signkey.ml b/src/signkey.ml index 01095f00..824f7892 100644 --- a/src/signkey.ml +++ b/src/signkey.ml @@ -7,7 +7,7 @@ type t = { stamp_end: Ptime.t; sign: string -> EddsaSignature.t; (* signature of this key by offline master key *) - master_sig: EddsaSignature.t option; + master_sig: Bin_type.MasterSignatureP.t option; } let generate () =