diff --git a/.gitignore b/.gitignore index 94938f7e..dbd4866f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,3 @@ _build - -# default output files of offline-tool -response.json -request.json +data/secmod/* +!data/secmod/.gitkeep diff --git a/data/assets/default.config b/data/assets/default.config index ea32f28a..798e22b8 100644 --- a/data/assets/default.config +++ b/data/assets/default.config @@ -27,6 +27,7 @@ max_keys_caching = "4 weeks" enable_kyc = NO terms_etag = "0" privacy_etag = "0" +base_url = localhost [exchangedb] idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds" diff --git a/data/auditor_private_key b/data/auditor_private_key new file mode 100644 index 00000000..82aad694 --- /dev/null +++ b/data/auditor_private_key @@ -0,0 +1 @@ +Iî÷q¸àwÇ´Y—›gbÙ'R+5µ™â°ƒˆyë> \ No newline at end of file diff --git a/data/auditor_public_key b/data/auditor_public_key new file mode 100644 index 00000000..2824b9ce --- /dev/null +++ b/data/auditor_public_key @@ -0,0 +1 @@ +A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0==== diff --git a/data/secmod_denom/.gitkeep b/data/secmod/.gitkeep similarity index 100% rename from data/secmod_denom/.gitkeep rename to data/secmod/.gitkeep diff --git a/data/secmod_signkey/.gitkeep b/data/secmod_signkey/.gitkeep deleted file mode 100644 index e69de29b..00000000 diff --git a/src/amount.ml b/src/amount.ml index 2a49a548..65fde44d 100644 --- a/src/amount.ml +++ b/src/amount.ml @@ -117,3 +117,5 @@ let bin_nbo = |+ field beint32 (fun t -> t.fraction) |+ field (bytes currency_len) (fun t -> pad_currency t.currency) |> sealr + +let dummy_value = "DUMMY:0.0" |> of_string |> Result.get_ok diff --git a/src/amount.mli b/src/amount.mli index e2572401..920bed18 100644 --- a/src/amount.mli +++ b/src/amount.mli @@ -1,3 +1,6 @@ +(* TODO + ? have a currency agnostic amount_lib.ml and specialize amount.ml to Config.currency *) + type sign = | Sign_plus | Sign_minus @@ -25,3 +28,7 @@ val jsont : t Jsont.t (* only for encoding *) val bin : t Bin.t val bin_nbo : t Bin.t + +(* TODO + dummy value to use as placeholder for WIP *) +val dummy_value : t diff --git a/src/api.ml b/src/api.ml index 47d2156e..42c98345 100644 --- a/src/api.ml +++ b/src/api.ml @@ -1,77 +1,242 @@ (* TODO - number + + ppx? + + normalized JSON-object + for signature of ExchangeKeysResponse.exetensions field + why is this one not defined by a struct? + + how to handle protocol versions: + - "@deprecated" fields + - "@since protocol xx" + + use of _monotonic_ time + + option: correct use opt_mem or Jsont.option + + better types: + - payto_uri + - uri + + number: - number is "float", but we probably want int everywhere instead - - numeric values capped at 2^53 -1 inclusive because json - time - - better types - - issues with "never" = uint64_max *) + - numeric values capped at 2^53 -1 inclusive because json *) open Crypto +open Bin_sig +open Jsont.Object let encode_exn jsont v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok let encode jsont v = Jsont_bytesrw.encode_string jsont v let decode jsont v = Jsont_bytesrw.decode_string jsont v -module ErrorDetail = struct - (* TODO GANA error codes +module DenominationHash = Bin_type.DenominationHash + +module Account_operation = struct + type t = + | Withdraw + | Deposit + | Merge + | Balance + | Close + | Aggregate + | Transaction + | Refund + + let to_string t = + String.uppercase_ascii + @@ + match t with + | Withdraw -> "withdraw" + | Deposit -> "deposit" + | Merge -> "merge" + | Balance -> "balance" + | Close -> "close" + | Aggregate -> "aggregate" + | Transaction -> "transaction" + | Refund -> "refund" + + let jsont = + [ Withdraw; Deposit; Merge; Balance; Close; Aggregate; Transaction; Refund ] + |> List.map (fun t -> (to_string t, t)) + |> Jsont.enum ~kind:"account operation type" +end + +module B32 = struct + include B32 + + let jsont = Jsont.of_of_string ~kind:"B32" B32.decode ~enc:B32.encode + + let caqti = + Caqti_type.custom + ~encode:(fun v -> Ok (B32.encode v)) + ~decode:B32.decode Caqti_type.string +end + +(* TODO error response + - use GANA error codes https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *) +module ErrorDetail = struct type t = { code: int; hint: string option; + detail: string option; + parameter: string option; + path: string option; + offset: string option; + index: string option; + object_: string option; + currency: string option; + type_expected: string option; + type_actual: string option; + extra: Jsont.json option; + } + + let make code hint detail parameter path offset index object_ currency + type_expected type_actual extra = + { + code; + hint; + detail; + parameter; + path; + offset; + index; + object_; + currency; + type_expected; + type_actual; + extra; + } + + let jsont = + let code v = v.code in + let hint v = v.hint in + let detail v = v.detail in + let parameter v = v.parameter in + let path v = v.path in + let offset v = v.offset in + let index v = v.index in + let object_ v = v.object_ in + let currency v = v.currency in + let type_expected v = v.type_expected in + let type_actual v = v.type_actual in + let extra v = v.extra in + + let open Jsont.Object in + map ~kind:"ErrorDetail" make + |> mem "code" Jsont.int ~enc:code + |> opt_mem "hint" Jsont.string ~enc:hint + |> opt_mem "detail" Jsont.string ~enc:detail + |> opt_mem "parameter" Jsont.string ~enc:parameter + |> opt_mem "path" Jsont.string ~enc:path + |> opt_mem "offset" Jsont.string ~enc:offset + |> opt_mem "index" Jsont.string ~enc:index + |> opt_mem "object" Jsont.string ~enc:object_ + |> opt_mem "currency" Jsont.string ~enc:currency + |> opt_mem "type_expected" Jsont.string ~enc:type_expected + |> opt_mem "type_actual" Jsont.string ~enc:type_actual + |> opt_mem "extra" (Jsont.any ()) ~enc:extra + |> finish + + let make ?hint ?detail ?parameter ?path ?offset ?index ?object_ ?currency + ?type_expected ?type_actual ?extra code = + make code hint detail parameter path offset index object_ currency + type_expected type_actual extra +end + +module CurrencySpecification = struct + type t = { + name: string; + num_fractional_input_digits: int; + num_fractional_normal_digits: int; + num_fractional_trailing_zero_digits: int; + alt_unit_names: string; + common_amounts: Amount.t list; } let jsont = - let make code hint = { code; hint } in - let enc_code v = v.code in - let enc_hint v = v.hint in - Jsont.Object.map ~kind:"ErrorDetail" make - |> Jsont.Object.mem "code" Jsont.int ~enc:enc_code - |> Jsont.Object.opt_mem "hint" Jsont.(string) ~enc:enc_hint - |> Jsont.Object.finish + let make name num_fractional_input_digits num_fractional_normal_digits + num_fractional_trailing_zero_digits alt_unit_names common_amounts = + { + name; + num_fractional_input_digits; + num_fractional_normal_digits; + num_fractional_trailing_zero_digits; + alt_unit_names; + common_amounts; + } + in + let name v = v.name in + let num_fractional_input_digits v = v.num_fractional_input_digits in + let num_fractional_normal_digits v = v.num_fractional_normal_digits in + let num_fractional_trailing_zero_digits v = + v.num_fractional_trailing_zero_digits + in + let alt_unit_names v = v.alt_unit_names in + let common_amounts v = v.common_amounts in + map ~kind:"CurrencySpecification" make + |> mem "name" Jsont.string ~enc:name + |> mem "num_fractional_input_digits" Jsont.int + ~enc:num_fractional_input_digits + |> mem "num_fractional_normal_digits" Jsont.int + ~enc:num_fractional_normal_digits + |> mem "num_fractional_trailing_zero_digits" Jsont.int + ~enc:num_fractional_trailing_zero_digits + |> mem "alt_unit_names" Jsont.string ~enc:alt_unit_names + |> mem "common_amounts" (Jsont.list Amount.jsont) ~enc:common_amounts + |> finish end -module HashCode : sig - type t - - val hash : string -> t - val jsont : t Jsont.t -end = struct - type t = B32.t - - let hash s = - let open Digestif.SHA512 in - s |> digest_string |> to_raw_string - - let jsont = Jsont.of_of_string ~kind:"HashCode" B32.decode ~enc:B32.encode -end - -module RelativeTime = struct - type t = - | Microseconds of float - | Forever - - let number_or_forever_jsont = - let forever = - let dec s = - match s with - | "forever" -> Forever - | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" - in - let enc = function Forever -> "forever" | _ -> assert false in - Jsont.map ~dec ~enc Jsont.string - in - let number = - let dec n = Microseconds n in - let enc = function Microseconds n -> n | _ -> assert false in - Jsont.map ~dec ~enc Jsont.number - in - let enc = function Forever -> forever | Microseconds _ -> number in - Jsont.any ~dec_string:forever ~dec_number:number ~enc () +module ExchangeVersionResponse = struct + type t = { + version: string; + (* todo: const string + name: "taler-exchange";*) + implementation: string option; + currency: string; + shopping_url: string option; + open_banking_gateway: string option; + currency_specification: CurrencySpecification.t; + supported_kyc_requirements: string list; + aml_spa_dialect: string option; + } let jsont = - let make t_s = t_s in - Jsont.Object.map ~kind:"RelativeTime" make - |> Jsont.Object.mem "t_s" number_or_forever_jsont ~enc:Fun.id - |> Jsont.Object.finish + let make version implementation currency shopping_url open_banking_gateway + currency_specification supported_kyc_requirements aml_spa_dialect = + { + version; + implementation; + currency; + shopping_url; + open_banking_gateway; + currency_specification; + supported_kyc_requirements; + aml_spa_dialect; + } + in + let version v = v.version in + let implementation v = v.implementation in + let currency v = v.currency in + let shopping_url v = v.shopping_url in + let open_banking_gateway v = v.open_banking_gateway in + let currency_specification v = v.currency_specification in + let supported_kyc_requirements v = v.supported_kyc_requirements in + let aml_spa_dialect v = v.aml_spa_dialect in + map ~kind:"ExchangeVersionResponse" make + |> mem "version" Jsont.string ~enc:version + |> mem "implementation" (Jsont.option Jsont.string) ~enc:implementation + |> mem "currency" Jsont.string ~enc:currency + |> mem "shopping_url" (Jsont.option Jsont.string) ~enc:shopping_url + |> mem "open_banking_gateway" + (Jsont.option Jsont.string) + ~enc:open_banking_gateway + |> mem "currency_specification" CurrencySpecification.jsont + ~enc:currency_specification + |> mem "supported_kyc_requirements" (Jsont.list Jsont.string) + ~enc:supported_kyc_requirements + |> mem "aml_spa_dialect" (Jsont.option Jsont.string) ~enc:aml_spa_dialect + |> finish end module RsaDenominationKey = struct @@ -91,28 +256,8 @@ module RsaDenominationKey = struct end (* ! Clause Schnorr cipher is not supported *) -module CSDenominationKey = struct - type t = { - age_mask: int; - cs_pub: B32.t; - } - - (* TODO B32.jsont *) - let b32_jsont = Jsont.of_of_string ~kind:"B32" B32.decode ~enc:B32.encode - - let jsont = - let make age_mask cs_pub = { age_mask; cs_pub } in - let age_mask v = v.age_mask in - let cs_pub v = v.cs_pub in - Jsont.Object.map ~kind:"CSDenominationKey" make - |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask - |> Jsont.Object.mem "cs_pub" b32_jsont ~enc:cs_pub - |> Jsont.Object.finish -end - module DenominationKey = struct type t = Rsa of RsaDenominationKey.t - (*| CS of CSDenominationKey.t*) let to_octets = function Rsa denom -> RsaPublicKey.to_octets denom.rsa_pub @@ -122,9 +267,8 @@ module DenominationKey = struct let of_rsa v = Rsa v let jsont = - let open Jsont.Object in let rsa = Case.map "RSA" RsaDenominationKey.jsont ~dec:of_rsa in - let cs = Case.map "CS" CSDenominationKey.jsont ~dec:of_cs in + let cs = Case.map "CS" zero ~dec:of_cs in let enc_case = function Rsa v -> Case.value rsa v in let cases = Case.[ make rsa; make cs ] in map ~kind:"DenominationKey" Fun.id @@ -138,7 +282,7 @@ module FutureSignKey = struct stamp_start: Timestamp.t; stamp_expire: Timestamp.t; stamp_end: Timestamp.t; - signkey_secmod_sig: EddsaSignature.t; + signkey_secmod_sig: SigningKeyAnnouncement.t; } let jsont = @@ -150,13 +294,13 @@ module FutureSignKey = struct let stamp_expire v = v.stamp_expire in let stamp_end v = v.stamp_end in let signkey_secmod_sig v = v.signkey_secmod_sig in - let open Jsont.Object in map ~kind:"FutureSignKey" make |> mem "key" EddsaPublicKey.jsont ~enc:key |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end - |> mem "signkey_secmod_sig" EddsaSignature.jsont ~enc:signkey_secmod_sig + |> mem "signkey_secmod_sig" SigningKeyAnnouncement.jsont + ~enc:signkey_secmod_sig |> finish end @@ -173,7 +317,7 @@ module FutureDenom = struct fee_deposit: Amount.t; fee_refresh: Amount.t; fee_refund: Amount.t; - denom_secmod_sig: Bin_signature.DenominationKeyAnnouncementPS.Sig.t; + denom_secmod_sig: DenominationKeyAnnouncement.t; } let jsont = @@ -207,7 +351,6 @@ module FutureDenom = struct let fee_refresh t = t.fee_refresh in let fee_refund t = t.fee_refund in let denom_secmod_sig t = t.denom_secmod_sig in - let open Jsont.Object in map ~kind:"FutureDenom" make |> mem "section_name" Jsont.string ~enc:section_name |> mem "value" Amount.jsont ~enc:value @@ -220,8 +363,7 @@ module FutureDenom = struct |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh |> mem "fee_refund" Amount.jsont ~enc:fee_refund - |> mem "denom_secmod_sig" - Bin_signature.DenominationKeyAnnouncementPS.Sig.jsont + |> mem "denom_secmod_sig" DenominationKeyAnnouncement.jsont ~enc:denom_secmod_sig |> finish end @@ -251,7 +393,6 @@ module FutureKeysResponse = struct let master_pub t = t.master_pub in let denom_secmod_public_key t = t.denom_secmod_public_key in let signkey_secmod_public_key t = t.signkey_secmod_public_key in - let open Jsont.Object in map ~kind:"FutureKeysResponse" make |> mem "future_denoms" (Jsont.list FutureDenom.jsont) ~enc:future_denoms |> mem "future_signkeys" @@ -268,34 +409,32 @@ end module SignKeySignature = struct type t = { key: EddsaPublicKey.t; - master_sig: EddsaSignature.t; + master_sig: ExchangeSigningKeyValidity.t; } let jsont = let make key master_sig = { key; master_sig } in let key v = v.key in let master_sig v = v.master_sig in - let open Jsont.Object in map ~kind:"SignKeySignature" make |> mem "key" EddsaPublicKey.jsont ~enc:key - |> mem "master_sig" EddsaSignature.jsont ~enc:master_sig + |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig |> finish end module DenomSignature = struct type t = { - h_denom_pub: HashCode.t; - master_sig: EddsaSignature.t; + h_denom_pub: DenominationHash.t; + master_sig: DenominationKeyValidity.t; } let jsont = let make h_denom_pub master_sig = { h_denom_pub; master_sig } in let h_denom_pub v = v.h_denom_pub in let master_sig v = v.master_sig in - let open Jsont.Object in map ~kind:"DenomSignature" make - |> mem "h_denom_pub" HashCode.jsont ~enc:h_denom_pub - |> mem "master_sig" EddsaSignature.jsont ~enc:master_sig + |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub + |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig |> finish end @@ -309,9 +448,912 @@ module MasterSignatures = struct let make denom_sigs signkey_sigs = { denom_sigs; signkey_sigs } in let denom_sigs v = v.denom_sigs in let signkey_sigs v = v.signkey_sigs in - let open Jsont.Object in map ~kind:"MasterSignatures" make |> mem "denom_sigs" (Jsont.list DenomSignature.jsont) ~enc:denom_sigs |> mem "signkey_sigs" (Jsont.list SignKeySignature.jsont) ~enc:signkey_sigs |> finish end + +module DenomRevocationSignature = struct + type t = { master_sig: MasterDenominationKeyRevocation.t } + + let jsont = + let make master_sig = { master_sig } in + let enc v = v.master_sig in + map ~kind:"DenomRevocationSignature" make + |> mem "master_sig" MasterDenominationKeyRevocation.jsont ~enc + |> finish +end + +module SignkeyRevocationSignature = struct + type t = { master_sig: MasterSigningKeyRevocation.t } + + let jsont = + let make master_sig = { master_sig } in + let enc v = v.master_sig in + map ~kind:"SignkeyRevocationSignature" make + |> mem "master_sig" MasterSigningKeyRevocation.jsont ~enc + |> finish +end + +module AuditorSetupMessage = struct + type t = { + auditor_url: string; + auditor_name: string; + auditor_pub: EddsaPublicKey.t; + master_sig: MasterAddAuditor.t; + (* TODO monotonic time + something about using monotonic system time here! *) + validity_start: Timestamp.t; + } + + let jsont = + let make auditor_url auditor_name auditor_pub master_sig validity_start = + { auditor_url; auditor_name; auditor_pub; master_sig; validity_start } + in + let auditor_url v = v.auditor_url in + let auditor_name v = v.auditor_name in + let auditor_pub v = v.auditor_pub in + let master_sig v = v.master_sig in + let validity_start v = v.validity_start in + map ~kind:"AuditorSetupMessage" make + |> mem "auditor_url" Jsont.string ~enc:auditor_url + |> mem "auditor_name" Jsont.string ~enc:auditor_name + |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub + |> mem "master_sig" MasterAddAuditor.jsont ~enc:master_sig + |> mem "validity_start" Timestamp.jsont ~enc:validity_start + |> finish +end + +module AuditorTeardownMessage = struct + type t = { + master_sig: MasterDelAuditor.t; + (* TODO monotonic time *) + validity_end: Timestamp.t; + } + + let jsont = + let make master_sig validity_end = { master_sig; validity_end } in + let master_sig v = v.master_sig in + let validity_end v = v.validity_end in + map ~kind:"AuditorTeardownMessage" make + |> mem "master_sig" MasterDelAuditor.jsont ~enc:master_sig + |> mem "validity_end" Timestamp.jsont ~enc:validity_end + |> finish +end + +module WireFeeSetupMessage = struct + type t = { + wire_method: string; + master_sig_wire: MasterWireFee.t; + fee_start: Timestamp.t; + fee_end: Timestamp.t; + closing_fee: Amount.t; + wire_fee: Amount.t; + } + + let jsont = + let make wire_method master_sig_wire fee_start fee_end closing_fee wire_fee + = + { + wire_method; + master_sig_wire; + fee_start; + fee_end; + closing_fee; + wire_fee; + } + in + let wire_method v = v.wire_method in + let master_sig_wire v = v.master_sig_wire in + let fee_start v = v.fee_start in + let fee_end v = v.fee_end in + let closing_fee v = v.closing_fee in + let wire_fee v = v.wire_fee in + map ~kind:"WireFeeSetupMessage" make + |> mem "wire_method" Jsont.string ~enc:wire_method + |> mem "master_sig_wire" MasterWireFee.jsont ~enc:master_sig_wire + |> mem "fee_start" Timestamp.jsont ~enc:fee_start + |> mem "fee_end" Timestamp.jsont ~enc:fee_end + |> mem "closing_fee" Amount.jsont ~enc:closing_fee + |> mem "wire_fee" Amount.jsont ~enc:wire_fee + |> finish +end + +module GlobalFees = struct + type t = { + start_date: Timestamp.t; + end_date: Timestamp.t; + history_fee: Amount.t; + account_fee: Amount.t; + purse_fee: Amount.t; + history_expiration: Timestamp.Span.t; + purse_account_limit: int32; + purse_timeout: Timestamp.Span.t; + master_sig: GlobalFees.t; + } + + let jsont = + let make start_date end_date history_fee account_fee purse_fee + history_expiration purse_account_limit purse_timeout master_sig = + { + start_date; + end_date; + history_fee; + account_fee; + purse_fee; + history_expiration; + purse_account_limit; + purse_timeout; + master_sig; + } + in + let start_date v = v.start_date in + let end_date v = v.end_date in + let history_fee v = v.history_fee in + let account_fee v = v.account_fee in + let purse_fee v = v.purse_fee in + let history_expiration v = v.history_expiration in + let purse_account_limit v = v.purse_account_limit in + let purse_timeout v = v.purse_timeout in + let master_sig v = v.master_sig in + map ~kind:"GlobalFees" make + |> mem "start_date" Timestamp.jsont ~enc:start_date + |> mem "end_date" Timestamp.jsont ~enc:end_date + |> mem "history_fee" Amount.jsont ~enc:history_fee + |> mem "account_fee" Amount.jsont ~enc:account_fee + |> mem "purse_fee" Amount.jsont ~enc:purse_fee + |> mem "history_expiration" Timestamp.Span.jsont ~enc:history_expiration + |> mem "purse_account_limit" Jsont.int32 ~enc:purse_account_limit + |> mem "purse_timeout" Timestamp.Span.jsont ~enc:purse_timeout + |> mem "master_sig" GlobalFees.jsont ~enc:master_sig + |> finish +end + +module WireSetupMessage = struct + type t = { + payto_uri: string; + master_sig_wire: MasterWireDetails.t; + master_sig_add: MasterAddWire.t; + (* TODO monotonic time *) + validity_start: Timestamp.t; + bank_label: string option; + priority: int option; + } + + let jsont = + let make payto_uri master_sig_wire master_sig_add validity_start bank_label + priority = + { + payto_uri; + master_sig_wire; + master_sig_add; + validity_start; + bank_label; + priority; + } + in + let payto_uri v = v.payto_uri in + let master_sig_wire v = v.master_sig_wire in + let master_sig_add v = v.master_sig_add in + let validity_start v = v.validity_start in + let bank_label v = v.bank_label in + let priority v = v.priority in + map ~kind:"WireSetupMessage" make + |> mem "payto_uri" Jsont.string ~enc:payto_uri + |> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire + |> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add + |> mem "validity_start" Timestamp.jsont ~enc:validity_start + |> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label + |> mem "priority" (Jsont.option Jsont.int) ~enc:priority + |> finish +end + +module WireTeardownMessage = struct + type t = { + payto_uri: string; + master_sig_del: MasterDelWire.t; + (* TODO monotonic time *) + validity_end: Timestamp.t; + } + + let jsont = + let make payto_uri master_sig_del validity_end = + { payto_uri; master_sig_del; validity_end } + in + let payto_uri v = v.payto_uri in + let master_sig_del v = v.master_sig_del in + let validity_end v = v.validity_end in + map ~kind:"WireTeardownMessage" make + |> mem "payto_uri" Jsont.string ~enc:payto_uri + |> mem "master_sig_del" MasterDelWire.jsont ~enc:master_sig_del + |> mem "validity_end" Timestamp.jsont ~enc:validity_end + |> finish +end + +module DrainProfitsMessage = struct + type t = { + wtid: B32.t; + debit_account_section: string; + credit_payto_uri: string; + date: Timestamp.t; + amount: Amount.t; + master_sig: MasterDrainProfit.t; + } + + let jsont = + let make debit_account_section credit_payto_uri wtid master_sig date amount + = + { + debit_account_section; + credit_payto_uri; + wtid; + master_sig; + date; + amount; + } + in + let debit_account_section v = v.debit_account_section in + let credit_payto_uri v = v.credit_payto_uri in + let wtid v = v.wtid in + let master_sig v = v.master_sig in + let date v = v.date in + let amount v = v.amount in + map ~kind:"DrainProfitsMessage" make + |> mem "debit_account_section" Jsont.string ~enc:debit_account_section + |> mem "credit_payto_uri" Jsont.string ~enc:credit_payto_uri + |> mem "wtid" B32.jsont ~enc:wtid + |> mem "master_sig" MasterDrainProfit.jsont ~enc:master_sig + |> mem "date" Timestamp.jsont ~enc:date + |> mem "amount" Amount.jsont ~enc:amount + |> finish +end + +module AmlOfficerSetup = struct + type t = { + officer_pub: EddsaPublicKey.t; + master_sig: MasterAmlOfficerStatus.t; + officer_name: string; + is_active: bool; + read_only: bool; + change_date: Timestamp.t; + } + + let jsont = + let make officer_pub officer_name is_active read_only master_sig change_date + = + { + officer_pub; + officer_name; + is_active; + read_only; + master_sig; + change_date; + } + in + let officer_pub v = v.officer_pub in + let officer_name v = v.officer_name in + let is_active v = v.is_active in + let read_only v = v.read_only in + let master_sig v = v.master_sig in + let change_date v = v.change_date in + map ~kind:"AmlOfficerSetup" make + |> mem "officer_pub" EddsaPublicKey.jsont ~enc:officer_pub + |> mem "officer_name" Jsont.string ~enc:officer_name + |> mem "is_active" Jsont.bool ~enc:is_active + |> mem "read_only" Jsont.bool ~enc:read_only + |> mem "master_sig" MasterAmlOfficerStatus.jsont ~enc:master_sig + |> mem "change_date" Timestamp.jsont ~enc:change_date + |> finish +end + +module ExchangePartnerSetupRequest = struct + type t = { + partner_base_url: string; + partner_pub: EddsaPublicKey.t; + wad_frequency: Timestamp.Span.t; + master_sig: PartnerConfiguration.t; + start_date: Timestamp.t; + end_date: Timestamp.t; + wad_fee: Amount.t; + } + + let jsont = + let make partner_base_url partner_pub wad_frequency master_sig start_date + end_date wad_fee = + { + partner_base_url; + partner_pub; + wad_frequency; + master_sig; + start_date; + end_date; + wad_fee; + } + in + let partner_base_url v = v.partner_base_url in + let partner_pub v = v.partner_pub in + let wad_frequency v = v.wad_frequency in + let master_sig v = v.master_sig in + let start_date v = v.start_date in + let end_date v = v.end_date in + let wad_fee v = v.wad_fee in + map ~kind:"ExchangePartnerSetupRequest" make + |> mem "partner_base_url" Jsont.string ~enc:partner_base_url + |> mem "partner_pub" EddsaPublicKey.jsont ~enc:partner_pub + |> mem "wad_frequency" Timestamp.Span.jsont ~enc:wad_frequency + |> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig + |> mem "start_date" Timestamp.jsont ~enc:start_date + |> mem "end_date" Timestamp.jsont ~enc:end_date + |> mem "wad_fee" Amount.jsont ~enc:wad_fee + |> finish +end + +(* -- types for /keys -- *) + +module ExchangePartnerListEntry = struct + type t = { + partner_base_url: string; + partner_master_pub: EddsaPublicKey.t; + wad_fee: Amount.t; + wad_frequency: Timestamp.Span.t; + start_date: Timestamp.t; + end_date: Timestamp.t; + master_sig: WadPartnerSignature.t; + } + + let jsont = + let make partner_base_url partner_master_pub wad_fee wad_frequency + start_date end_date master_sig = + { + partner_base_url; + partner_master_pub; + wad_fee; + wad_frequency; + start_date; + end_date; + master_sig; + } + in + let partner_base_url v = v.partner_base_url in + let partner_master_pub v = v.partner_master_pub in + let wad_fee v = v.wad_fee in + let wad_frequency v = v.wad_frequency in + let start_date v = v.start_date in + let end_date v = v.end_date in + let master_sig v = v.master_sig in + map ~kind:"ExchangePartnerListEntry" make + |> mem "partner_base_url" Jsont.string ~enc:partner_base_url + |> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub + |> mem "wad_fee" Amount.jsont ~enc:wad_fee + |> mem "wad_frequency" Timestamp.Span.jsont ~enc:wad_frequency + |> mem "start_date" Timestamp.jsont ~enc:start_date + |> mem "end_date" Timestamp.jsont ~enc:end_date + |> mem "master_sig" WadPartnerSignature.jsont ~enc:master_sig + |> finish +end + +module AggregateTransferFee = struct + type t = { + wire_fee: Amount.t; + closing_fee: Amount.t; + start_date: Timestamp.t; + end_date: Timestamp.t; + sig_: MasterWireFee.t; + } + + let jsont = + let make wire_fee closing_fee start_date end_date sig_ = + { wire_fee; closing_fee; start_date; end_date; sig_ } + in + let wire_fee v = v.wire_fee in + let closing_fee v = v.closing_fee in + let start_date v = v.start_date in + let end_date v = v.end_date in + let sig_ v = v.sig_ in + map ~kind:"AggregateTransferFee" make + |> mem "wire_fee" Amount.jsont ~enc:wire_fee + |> mem "closing_fee" Amount.jsont ~enc:closing_fee + |> mem "start_date" Timestamp.jsont ~enc:start_date + |> mem "end_date" Timestamp.jsont ~enc:end_date + |> mem "sig" MasterWireFee.jsont ~enc:sig_ + |> finish +end + +module AuditorDenominationKey = struct + type t = { + denom_pub_h: DenominationHash.t; + auditor_sig: ExchangeKeyValidity.t; + } + + let jsont = + let make denom_pub_h auditor_sig = { denom_pub_h; auditor_sig } in + let denom_pub_h v = v.denom_pub_h in + let auditor_sig v = v.auditor_sig in + map ~kind:"AuditorDenominationKey" make + |> mem "denom_pub_h" DenominationHash.jsont ~enc:denom_pub_h + |> mem "auditor_sig" ExchangeKeyValidity.jsont ~enc:auditor_sig + |> finish +end + +module AuditorKeys = struct + type t = { + auditor_pub: EddsaPublicKey.t; + auditor_url: string; + auditor_name: string; + denomination_keys: AuditorDenominationKey.t list; + } + + let jsont = + let make auditor_pub auditor_url auditor_name denomination_keys = + { auditor_pub; auditor_url; auditor_name; denomination_keys } + in + let auditor_pub v = v.auditor_pub in + let auditor_url v = v.auditor_url in + let auditor_name v = v.auditor_name in + let denomination_keys v = v.denomination_keys in + map ~kind:"AuditorKeys" make + |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub + |> mem "auditor_url" Jsont.string ~enc:auditor_url + |> mem "auditor_name" Jsont.string ~enc:auditor_name + |> mem "denomination_keys" + (Jsont.list AuditorDenominationKey.jsont) + ~enc:denomination_keys + |> finish +end + +module SignKey = struct + type t = { + key: EddsaPublicKey.t; + stamp_start: Timestamp.t; + stamp_expire: Timestamp.t; + stamp_end: Timestamp.t; + master_sig: ExchangeSigningKeyValidity.t; + } + + let jsont = + let make key stamp_start stamp_expire stamp_end master_sig = + { key; stamp_start; stamp_expire; stamp_end; master_sig } + in + let key v = v.key in + let stamp_start v = v.stamp_start in + let stamp_expire v = v.stamp_expire in + let stamp_end v = v.stamp_end in + let master_sig v = v.master_sig in + map ~kind:"SignKey" make + |> mem "key" EddsaPublicKey.jsont ~enc:key + |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start + |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire + |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end + |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig + |> finish +end + +module RecoupDenoms = struct + type t = { h_denom_pub: DenominationHash.t } + + let jsont = + let make h_denom_pub = { h_denom_pub } in + let h_denom_pub v = v.h_denom_pub in + map ~kind:"RecoupDenoms" make + |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub + |> finish +end + +module RsaDenom = struct + (* correspond to: ({ rsa_pub: RsaPublicKey;} & DenomCommon) *) + type t = { + rsa_pub: RsaPublicKey.t; + master_sig: DenominationKeyValidity.t; + stamp_start: Timestamp.t; + stamp_expire_withdraw: Timestamp.t; + stamp_expire_deposit: Timestamp.t; + stamp_expire_legal: Timestamp.t; + lost: bool option; + } + + let jsont = + let make rsa_pub master_sig stamp_start stamp_expire_withdraw + stamp_expire_deposit stamp_expire_legal lost = + { + rsa_pub; + master_sig; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + lost; + } + in + let rsa_pub v = v.rsa_pub in + let master_sig v = v.master_sig in + let stamp_start v = v.stamp_start in + let stamp_expire_withdraw v = v.stamp_expire_withdraw in + let stamp_expire_deposit v = v.stamp_expire_deposit in + let stamp_expire_legal v = v.stamp_expire_legal in + let lost v = v.lost in + map ~kind:"RsaDenom" make + |> mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub + |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig + |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start + |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw + |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit + |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal + |> mem "lost" (Jsont.option Jsont.bool) ~enc:lost + |> finish +end + +module RsaDenomGroup = struct + type t = { + denoms: RsaDenom.t list; + value: Amount.t; + fee_withdraw: Amount.t; + fee_deposit: Amount.t; + fee_refresh: Amount.t; + fee_refund: Amount.t; + } + + let jsont = + let make denoms value fee_withdraw fee_deposit fee_refresh fee_refund = + { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund } + in + let denoms v = v.denoms in + let value v = v.value in + let fee_withdraw v = v.fee_withdraw in + let fee_deposit v = v.fee_deposit in + let fee_refresh v = v.fee_refresh in + let fee_refund v = v.fee_refund in + map ~kind:"RsaDenomGroup" make + |> mem "denoms" (Jsont.list RsaDenom.jsont) ~enc:denoms + |> mem "value" Amount.jsont ~enc:value + |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw + |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit + |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh + |> mem "fee_refund" Amount.jsont ~enc:fee_refund + |> finish +end + +module DenomGroup = struct + type t = Rsa of RsaDenomGroup.t + + let of_rsa v = Rsa v + + let of_cs _v = + Jsont.Error.msg Jsont.Meta.none "CSDenomGroup are not supported" + + let of_rsa_age_restricted _v = + Jsont.Error.msg Jsont.Meta.none + "DenomGroupRsaAgeRestricted are not supported" + + let jsont = + let rsa = Case.map "RSA" RsaDenomGroup.jsont ~dec:of_rsa in + let cs = Case.map "CS" zero ~dec:of_cs in + let rsa_age_restricted = + Case.map "RSA+age_restricted" zero ~dec:of_rsa_age_restricted + in + let cs_age_restricted = Case.map "CS+age_restricted" zero ~dec:of_cs in + let enc_case = function Rsa v -> Case.value rsa v in + let cases = + Case. + [ make rsa; make cs; make rsa_age_restricted; make cs_age_restricted ] + in + map ~kind:"DenomGroup" Fun.id + |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases + |> finish +end + +module AccountLimit = struct + type t = { + operation_type: Account_operation.t; + timeframe: Timestamp.Span.t; + threshold: Amount.t; + soft_limit: bool option; + } + + let jsont = + let make operation_type timeframe threshold soft_limit = + { operation_type; timeframe; threshold; soft_limit } + in + let operation_type v = v.operation_type in + let timeframe v = v.timeframe in + let threshold v = v.threshold in + let soft_limit v = v.soft_limit in + map ~kind:"AccountLimit" make + |> mem "operation_type" Account_operation.jsont ~enc:operation_type + |> mem "timeframe" Timestamp.Span.jsont ~enc:timeframe + |> mem "threshold" Amount.jsont ~enc:threshold + |> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit + |> finish +end + +module ZeroLimitedOperation = struct + type t = { operation_type: Account_operation.t } + + let jsont = + let make operation_type = { operation_type } in + let operation_type v = v.operation_type in + map ~kind:"ZeroLimitedOperation" make + |> mem "operation_type" Account_operation.jsont ~enc:operation_type + |> finish +end + +module RegexAccountRestriction = struct + type t = { + payto_regex: string; + human_hint: string; + (* Map from IETF BCP 47 language tags to localized human hints. *) + human_hint_i18n: string option; + } + + let jsont = + let make payto_regex human_hint human_hint_i18n = + { payto_regex; human_hint; human_hint_i18n } + in + let payto_regex v = v.payto_regex in + let human_hint v = v.human_hint in + let human_hint_i18n v = v.human_hint_i18n in + map ~kind:"RegexAccountRestriction" make + |> mem "payto_regex" Jsont.string ~enc:payto_regex + |> mem "human_hint" Jsont.string ~enc:human_hint + |> opt_mem "human_hint_i18n" Jsont.string ~enc:human_hint_i18n + |> finish +end + +module AccountRestriction = struct + type t = + | Deny + | Regex of RegexAccountRestriction.t + + let of_regex v = Regex v + let of_deny () = Deny + + let jsont = + let regex = Case.map "regex" RegexAccountRestriction.jsont ~dec:of_regex in + let deny = Case.map "deny" zero ~dec:of_deny in + let enc_case = function + | Regex v -> Case.value regex v + | Deny -> Case.value deny () + in + let cases = Case.[ make regex; make deny ] in + map ~kind:"AccountRestriction" Fun.id + |> case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases + |> finish +end + +module ExchangeWireAccount = struct + type t = { + payto_uri: string; + conversion_url: string option; + credit_restrictions: AccountRestriction.t list; + debit_restrictions: AccountRestriction.t list; + master_sig: MasterWireDetails.t; + bank_label: string option; + priority: int option; + } + + let jsont = + let make payto_uri conversion_url credit_restrictions debit_restrictions + master_sig bank_label priority = + { + payto_uri; + conversion_url; + credit_restrictions; + debit_restrictions; + master_sig; + bank_label; + priority; + } + in + let payto_uri v = v.payto_uri in + let conversion_url v = v.conversion_url in + let credit_restrictions v = v.credit_restrictions in + let debit_restrictions v = v.debit_restrictions in + let master_sig v = v.master_sig in + let bank_label v = v.bank_label in + let priority v = v.priority in + map ~kind:"ExchangeWireAccount" make + |> mem "payto_uri" Jsont.string ~enc:payto_uri + |> opt_mem "conversion_url" Jsont.string ~enc:conversion_url + |> mem "credit_restrictions" + (Jsont.list AccountRestriction.jsont) + ~enc:credit_restrictions + |> mem "debit_restrictions" + (Jsont.list AccountRestriction.jsont) + ~enc:debit_restrictions + |> mem "master_sig" MasterWireDetails.jsont ~enc:master_sig + |> opt_mem "bank_label" Jsont.string ~enc:bank_label + |> opt_mem "priority" Jsont.int ~enc:priority + |> finish +end + +module ExtensionManifest = struct + type t = { + critical: bool; + version: string; + config: Jsont.json option; + } + + let jsont = + let make critical version config = { critical; version; config } in + let critical v = v.critical in + let version v = v.version in + let config v = v.config in + map ~kind:"ExtensionManifest" make + |> mem "critical" Jsont.bool ~enc:critical + |> mem "version" Jsont.string ~enc:version + |> opt_mem "config" (Jsont.any ()) ~enc:config + |> finish +end + +module ExchangeKeysResponse = struct + module String_map = Map.Make (String) + + type t = { + version: string; + base_url: string; + currency: string; + shopping_url: string option; + open_banking_gateway: string option; + bank_compliance_language: string option; + currency_specification: CurrencySpecification.t; + tiny_amount: Amount.t option; + stefan_abs: Amount.t; + stefan_log: Amount.t; + stefan_lin: Float.t; + asset_type: string; + accounts: ExchangeWireAccount.t list; + wire_fees: AggregateTransferFee.t list Stdlib.Map.Make(Stdlib.String).t; + wads: ExchangePartnerListEntry.t list; + rewards_allowed: bool; + kyc_enabled: bool; + disable_direct_deposit: bool; + master_public_key: EddsaPublicKey.t; + reserve_closing_delay: Timestamp.Span.t; + wallet_balance_limit_without_kyc: Amount.t list option; + hard_limits: AccountLimit.t list; + zero_limits: ZeroLimitedOperation.t list; + denominations: DenomGroup.t list; + (* Compact EdDSA signature (binary-only) over the + contatentation of all of the master_sigs (in reverse + chronological order by group) in the arrays under + "denominations" *) + exchange_sig: ExchangeKeySet.t; + exchange_pub: EddsaPublicKey.t; + recoup: RecoupDenoms.t list; + global_fees: GlobalFees.t list; + list_issue_date: Timestamp.t; + auditors: AuditorKeys.t list; + signkeys: SignKey.t list; + extensions: ExtensionManifest.t Stdlib.Map.Make(Stdlib.String).t option; + (* Signature by the exchange master key of the SHA-256 hash of the + normalized JSON-object of field extensions, if it was set. + The signature has purpose TALER_SIGNATURE_MASTER_EXTENSIONS. *) + extensions_sig: EddsaSignature.t option; + } + + let jsont = + let make version base_url currency shopping_url open_banking_gateway + bank_compliance_language currency_specification tiny_amount stefan_abs + stefan_log stefan_lin asset_type accounts wire_fees wads rewards_allowed + kyc_enabled disable_direct_deposit master_public_key + reserve_closing_delay wallet_balance_limit_without_kyc hard_limits + zero_limits denominations exchange_sig exchange_pub recoup global_fees + list_issue_date auditors signkeys extensions extensions_sig = + { + version; + base_url; + currency; + shopping_url; + open_banking_gateway; + bank_compliance_language; + currency_specification; + tiny_amount; + stefan_abs; + stefan_log; + stefan_lin; + asset_type; + accounts; + wire_fees; + wads; + rewards_allowed; + kyc_enabled; + disable_direct_deposit; + master_public_key; + reserve_closing_delay; + wallet_balance_limit_without_kyc; + hard_limits; + zero_limits; + denominations; + exchange_sig; + exchange_pub; + recoup; + global_fees; + list_issue_date; + auditors; + signkeys; + extensions; + extensions_sig; + } + in + + let version v = v.version in + let base_url v = v.base_url in + let currency v = v.currency in + let shopping_url v = v.shopping_url in + let open_banking_gateway v = v.open_banking_gateway in + let bank_compliance_language v = v.bank_compliance_language in + let currency_specification v = v.currency_specification in + let tiny_amount v = v.tiny_amount in + let stefan_abs v = v.stefan_abs in + let stefan_log v = v.stefan_log in + let stefan_lin v = v.stefan_lin in + let asset_type v = v.asset_type in + let accounts v = v.accounts in + let wire_fees v = v.wire_fees in + let wads v = v.wads in + let rewards_allowed v = v.rewards_allowed in + let kyc_enabled v = v.kyc_enabled in + let disable_direct_deposit v = v.disable_direct_deposit in + let master_public_key v = v.master_public_key in + let reserve_closing_delay v = v.reserve_closing_delay in + let wallet_balance_limit_without_kyc v = + v.wallet_balance_limit_without_kyc + in + let hard_limits v = v.hard_limits in + let zero_limits v = v.zero_limits in + let denominations v = v.denominations in + let exchange_sig v = v.exchange_sig in + let exchange_pub v = v.exchange_pub in + let recoup v = v.recoup in + let global_fees v = v.global_fees in + let list_issue_date v = v.list_issue_date in + let auditors v = v.auditors in + let signkeys v = v.signkeys in + let extensions v = v.extensions in + let extensions_sig v = v.extensions_sig in + map ~kind:"ExchangeKeysResponse" make + |> mem "version" Jsont.string ~enc:version + |> mem "base_url" Jsont.string ~enc:base_url + |> mem "currency" Jsont.string ~enc:currency + |> opt_mem "shopping_url" Jsont.string ~enc:shopping_url + |> opt_mem "open_banking_gateway" Jsont.string ~enc:open_banking_gateway + |> opt_mem "bank_compliance_language" Jsont.string + ~enc:bank_compliance_language + |> mem "currency_specification" CurrencySpecification.jsont + ~enc:currency_specification + |> opt_mem "tiny_amount" Amount.jsont ~enc:tiny_amount + |> mem "stefan_abs" Amount.jsont ~enc:stefan_abs + |> mem "stefan_log" Amount.jsont ~enc:stefan_log + |> mem "stefan_lin" Jsont.number ~enc:stefan_lin + |> mem "asset_type" Jsont.string ~enc:asset_type + |> mem "accounts" (Jsont.list ExchangeWireAccount.jsont) ~enc:accounts + |> mem "wire_fees" + (Jsont.Object.as_string_map (Jsont.list AggregateTransferFee.jsont)) + ~enc:wire_fees + |> mem "wads" (Jsont.list ExchangePartnerListEntry.jsont) ~enc:wads + |> mem "rewards_allowed" Jsont.bool ~enc:rewards_allowed + |> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled + |> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit + |> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key + |> mem "reserve_closing_delay" Timestamp.Span.jsont + ~enc:reserve_closing_delay + |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont) + ~enc:wallet_balance_limit_without_kyc + |> mem "hard_limits" (Jsont.list AccountLimit.jsont) ~enc:hard_limits + |> mem "zero_limits" + (Jsont.list ZeroLimitedOperation.jsont) + ~enc:zero_limits + |> mem "denominations" (Jsont.list DenomGroup.jsont) ~enc:denominations + |> mem "exchange_sig" ExchangeKeySet.jsont ~enc:exchange_sig + |> mem "exchange_pub" EddsaPublicKey.jsont ~enc:exchange_pub + |> mem "recoup" (Jsont.list RecoupDenoms.jsont) ~enc:recoup + |> mem "global_fees" (Jsont.list GlobalFees.jsont) ~enc:global_fees + |> mem "list_issue_date" Timestamp.jsont ~enc:list_issue_date + |> mem "auditors" (Jsont.list AuditorKeys.jsont) ~enc:auditors + |> mem "signkeys" (Jsont.list SignKey.jsont) ~enc:signkeys + |> opt_mem "extensions" + (Jsont.Object.as_string_map ExtensionManifest.jsont) + ~enc:extensions + |> opt_mem "extensions_sig" EddsaSignature.jsont ~enc:extensions_sig + |> finish +end diff --git a/src/bin_sig.ml b/src/bin_sig.ml new file mode 100644 index 00000000..6caece8b --- /dev/null +++ b/src/bin_sig.ml @@ -0,0 +1,1243 @@ +(* Packed Signature *) + +open Bin_type + +(* TODO keep this? + some of those are actuall ecdhe, or union of eddsa|ecdhe *) +module Aliases = struct + module TimestampNBO = TimeAbsoluteNBO + + module AmountNBO = struct + type t = Amount.t + + let bin = Amount.bin_nbo + end + + (* - Keys - *) + open Crypto + 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 + +open Aliases + +(* EccSignaturePurpose *) +module Purpose = struct + type t = { + size: int32; + purpose: int32; + } + + let bin = + let open Bin in + record (fun size purpose -> { size; purpose }) + |+ field beint32 (fun t -> t.size) + |+ field beint32 (fun t -> t.purpose) + |> sealr + + let make ~size purpose = { size= Int32.of_int size; purpose } + let dummy = make ~size:0 0_l + + (* helper function to make ['signature Bin.t] + to compute [t.size], we first build a bin with a dummy purpose *) + let make_bin = + let get_size f = + let open Bin in + match Size.of_value (Size.size_of (f dummy)) with + | Dynamic _ | Unknown -> + Fmt.failwith "size_of failure: size is not Static" + | Static n -> n + in + fun code f -> make ~size:(get_size f) code |> f + + let field purpose = Bin.field bin (fun _t -> purpose) +end + +module MK (R : sig + type r + + val bin : r Bin.t +end) : sig + open Crypto + + type r = R.r + type t + + val sign_f : f:(string -> eddsa_sig) -> r -> t + + val verify_f : + f:(eddsa_sig -> msg:string -> (unit, string) result) -> + t -> + r -> + (unit, string) result + + val jsont : t Jsont.t + val caqti : t Caqti_type.t + + (* TODO rm *) + (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *) + val to_octets : t -> string +end = struct + open Crypto + + type r = R.r + type t = EddsaSignature.t + + let sign_f ~f r = f (Bin.to_string R.bin r) + let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin r) + let jsont = EddsaSignature.jsont + let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti + let to_octets t = EddsaSignature.to_octets t +end + +module DenominationKeyAnnouncement = struct + module R = struct + (* TODO taler_signatures purpose + we use TALER_SIGNATURE_SM_RSA_DENOMINATION_KEY instead here *) + (* purpose.purpose = TALER_SIGNATURE_SM_DENOMINATION_KEY *) + type r = { + h_denom_pub: DenominationHash.t; + h_section_name: Hash_64_cstr.t; + anchor_time: TimeAbsoluteNBO.t; + duration_withdraw: TimeRelativeNBO.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.sm_rsa_denomination_key + @@ fun purpose -> + record + (fun + _purpose h_denom_pub h_section_name anchor_time duration_withdraw -> + { h_denom_pub; h_section_name; anchor_time; duration_withdraw }) + |+ Purpose.field purpose + |+ field DenominationHash.bin (fun t -> t.h_denom_pub) + |+ 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 + end + + include R + include MK (R) +end + +module SigningKeyAnnouncement = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_SM_SIGNING_KEY *) + type r = { + exchange_pub: ExchangePublicKeyP.t; + anchor_time: TimeAbsoluteNBO.t; + duration: TimeRelativeNBO.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.sm_signing_key @@ fun purpose -> + record (fun _purpose exchange_pub anchor_time duration -> + { exchange_pub; anchor_time; duration }) + |+ Purpose.field purpose + |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub) + |+ field TimeAbsoluteNBO.bin (fun t -> t.anchor_time) + |+ field TimeRelativeNBO.bin (fun t -> t.duration) + |> sealr + end + + include R + include MK (R) +end + +module DenominationKeyValidity = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_VALIDITY *) + type r = { + master: MasterPublicKeyP.t; + start: TimeAbsoluteNBO.t; + expire_withdraw: TimeAbsoluteNBO.t; + expire_spend: TimeAbsoluteNBO.t; + expire_legal: TimeAbsoluteNBO.t; + value: AmountNBO.t; + fee_withdraw: AmountNBO.t; + fee_deposit: AmountNBO.t; + fee_refresh: AmountNBO.t; + denom_hash: DenominationHash.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_denomination_key_validity + @@ fun purpose -> + record + (fun + _purpose + master + start + expire_withdraw + expire_spend + expire_legal + value + fee_withdraw + fee_deposit + fee_refresh + denom_hash + -> + { + master; + start; + expire_withdraw; + expire_spend; + expire_legal; + value; + fee_withdraw; + fee_deposit; + fee_refresh; + denom_hash; + }) + |+ Purpose.field purpose + |+ field MasterPublicKeyP.bin (fun t -> t.master) + |+ field TimeAbsoluteNBO.bin (fun t -> t.start) + |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_withdraw) + |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_spend) + |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_legal) + |+ field AmountNBO.bin (fun t -> t.value) + |+ field AmountNBO.bin (fun t -> t.fee_withdraw) + |+ field AmountNBO.bin (fun t -> t.fee_deposit) + |+ field AmountNBO.bin (fun t -> t.fee_refresh) + |+ field DenominationHash.bin (fun t -> t.denom_hash) + |> sealr + end + + include R + include MK (R) +end + +module ExchangeSigningKeyValidity = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_VALIDITY *) + type r = { + start: TimeAbsoluteNBO.t; + expire: TimeAbsoluteNBO.t; + end_: TimeAbsoluteNBO.t; + signkey_pub: ExchangePublicKeyP.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_signing_key_validity + @@ fun purpose -> + record (fun _purpose start expire end_ signkey_pub -> + { start; expire; end_; signkey_pub }) + |+ Purpose.field purpose + |+ field TimeAbsoluteNBO.bin (fun t -> t.start) + |+ field TimeAbsoluteNBO.bin (fun t -> t.expire) + |+ field TimeAbsoluteNBO.bin (fun t -> t.end_) + |+ field ExchangePublicKeyP.bin (fun t -> t.signkey_pub) + |> sealr + end + + include R + include MK (R) +end + +module MasterDenominationKeyRevocation = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_REVOKED. *) + type r = { h_denom_pub: DenominationHash.t } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_denomination_key_revoked + @@ fun purpose -> + record (fun _purpose h_denom_pub -> { h_denom_pub }) + |+ Purpose.field purpose + |+ field DenominationHash.bin (fun t -> t.h_denom_pub) + |> sealr + end + + include R + include MK (R) +end + +module MasterSigningKeyRevocation = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_REVOKED *) + type r = { exchange_pub: ExchangePublicKeyP.t } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_signing_key_revoked + @@ fun purpose -> + record (fun _purpose exchange_pub -> { exchange_pub }) + |+ Purpose.field purpose + |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub) + |> sealr + end + + include R + include MK (R) +end + +module MasterAddAuditor = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_AUDITOR *) + type r = { + start_date: TimeAbsoluteNBO.t; + auditor_pub: AuditorPublicKeyP.t; + h_auditor_url: Hash_64_cstr.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_add_auditor @@ fun purpose -> + record (fun _purpose start_date auditor_pub h_auditor_url -> + { start_date; auditor_pub; h_auditor_url }) + |+ Purpose.field purpose + |+ field TimeAbsoluteNBO.bin (fun t -> t.start_date) + |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub) + |+ field Hash_64_cstr.bin (fun t -> t.h_auditor_url) + |> sealr + end + + include R + include MK (R) +end + +module MasterDelAuditor = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_AUDITOR *) + type r = { + end_date: TimeAbsoluteNBO.t; + auditor_pub: AuditorPublicKeyP.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_del_auditor @@ fun purpose -> + record (fun _purpose end_date auditor_pub -> { end_date; auditor_pub }) + |+ Purpose.field purpose + |+ field TimeAbsoluteNBO.bin (fun t -> t.end_date) + |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub) + |> sealr + end + + include R + include MK (R) +end + +module GlobalFees = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *) + type r = { + start_date: TimeAbsoluteNBO.t; + end_date: TimeAbsoluteNBO.t; + purse_timeout: TimeRelativeNBO.t; + kyc_timeout: TimeRelativeNBO.t; + history_expiration: TimeRelativeNBO.t; + history_fee: AmountNBO.t; + kyc_fee: AmountNBO.t; + account_fee: AmountNBO.t; + purse_fee: AmountNBO.t; + purse_account_limit: int32; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_global_fees @@ fun purpose -> + record + (fun + _purpose + start_date + end_date + purse_timeout + kyc_timeout + history_expiration + history_fee + kyc_fee + account_fee + purse_fee + purse_account_limit + -> + { + start_date; + end_date; + purse_timeout; + kyc_timeout; + history_expiration; + history_fee; + kyc_fee; + account_fee; + purse_fee; + purse_account_limit; + }) + |+ Purpose.field purpose + |+ field TimeAbsoluteNBO.bin (fun t -> t.start_date) + |+ field TimeAbsoluteNBO.bin (fun t -> t.end_date) + |+ field TimeRelativeNBO.bin (fun t -> t.purse_timeout) + |+ field TimeRelativeNBO.bin (fun t -> t.kyc_timeout) + |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration) + |+ field AmountNBO.bin (fun t -> t.history_fee) + |+ field AmountNBO.bin (fun t -> t.kyc_fee) + |+ field AmountNBO.bin (fun t -> t.account_fee) + |+ field AmountNBO.bin (fun t -> t.purse_fee) + |+ field beint32 (fun t -> t.purse_account_limit) + |> sealr + end + + include R + include MK (R) +end + +module MasterWireDetails = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_DETAILS *) + type r = { + h_wire_details: FullPaytoHash.t; + h_conversion_url: Hash_64_cstr.t; + h_credit_restrictions: Hash_64_cstr.t; + h_debit_restrictions: Hash_64_cstr.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_wire_details @@ fun purpose -> + record + (fun + _purpose + h_wire_details + h_conversion_url + h_credit_restrictions + h_debit_restrictions + -> + { + h_wire_details; + h_conversion_url; + h_credit_restrictions; + h_debit_restrictions; + }) + |+ Purpose.field purpose + |+ field FullPaytoHash.bin (fun t -> t.h_wire_details) + |+ field Hash_64_cstr.bin (fun t -> t.h_conversion_url) + |+ field Hash_64_cstr.bin (fun t -> t.h_credit_restrictions) + |+ field Hash_64_cstr.bin (fun t -> t.h_debit_restrictions) + |> sealr + end + + include R + include MK (R) +end + +module MasterAddWire = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_WIRE *) + type r = { + start_date: TimeAbsoluteNBO.t; + h_wire: FullPaytoHash.t; + h_conversion_url: Hash_64_cstr.t; + h_credit_restrictions: Hash_64_cstr.t; + h_debit_restrictions: Hash_64_cstr.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_add_wire @@ fun _purpose -> + record + (fun + _purpose + start_date + h_wire + h_conversion_url + h_credit_restrictions + h_debit_restrictions + -> + { + start_date; + h_wire; + h_conversion_url; + h_credit_restrictions; + h_debit_restrictions; + }) + |+ Purpose.field _purpose + |+ field TimeAbsoluteNBO.bin (fun t -> t.start_date) + |+ field FullPaytoHash.bin (fun t -> t.h_wire) + |+ field Hash_64_cstr.bin (fun t -> t.h_conversion_url) + |+ field Hash_64_cstr.bin (fun t -> t.h_credit_restrictions) + |+ field Hash_64_cstr.bin (fun t -> t.h_debit_restrictions) + |> sealr + end + + include R + include MK (R) +end + +module MasterDelWire = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_WIRE *) + type r = { + end_date: TimeAbsoluteNBO.t; + h_wire: FullPaytoHash.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_del_wire @@ fun _purpose -> + record (fun _purpose end_date h_wire -> { end_date; h_wire }) + |+ Purpose.field _purpose + |+ field TimeAbsoluteNBO.bin (fun t -> t.end_date) + |+ field FullPaytoHash.bin (fun t -> t.h_wire) + |> sealr + end + + include R + include MK (R) +end + +module MasterDrainProfit = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_DRAIN_PROFITS *) + type r = { + wtid: WireTransferIdentifierRawP.t; + date: TimeAbsoluteNBO.t; + amount: AmountNBO.t; + h_section: Hash_64_cstr.t; + h_payto: FullPaytoHash.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_drain_profit @@ fun _purpose -> + record (fun _purpose wtid date amount h_section h_payto -> + { wtid; date; amount; h_section; h_payto }) + |+ Purpose.field _purpose + |+ field WireTransferIdentifierRawP.bin (fun t -> t.wtid) + |+ field TimeAbsoluteNBO.bin (fun t -> t.date) + |+ field AmountNBO.bin (fun t -> t.amount) + |+ field Hash_64_cstr.bin (fun t -> t.h_section) + |+ field FullPaytoHash.bin (fun t -> t.h_payto) + |> sealr + end + + include R + include MK (R) +end + +module MasterAmlOfficerStatus = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_AML_KEY *) + type r = { + change_date: TimestampNBO.t; + officer_pub: AmlOfficerPublicKeyP.t; + h_officer_name: Hash_64_cstr.t; + is_active: int32; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_aml_key @@ fun _purpose -> + record (fun _purpose change_date officer_pub h_officer_name is_active -> + { change_date; officer_pub; h_officer_name; is_active }) + |+ Purpose.field _purpose + |+ field TimestampNBO.bin (fun t -> t.change_date) + |+ field AmlOfficerPublicKeyP.bin (fun t -> t.officer_pub) + |+ field Hash_64_cstr.bin (fun t -> t.h_officer_name) + |+ field beint32 (fun t -> t.is_active) + |> sealr + end + + include R + include MK (R) +end + +module PartnerConfiguration = struct + module R = struct + (* TODO purpose + this purpose is used 2 times!? *) + (* purpose.purpose = TALER_SIGNATURE_MASTER_PARNTER_DETAILS *) + type r = { + partner_pub: MasterPublicKeyP.t; + start_date: TimestampNBO.t; + end_date: TimestampNBO.t; + wad_frequency: TimeRelativeNBO.t; + wad_fee: AmountNBO.t; + h_url: Hash_64_cstr.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_partner_details + @@ fun _purpose -> + record + (fun + _purpose + partner_pub + start_date + end_date + wad_frequency + wad_fee + h_url + -> { partner_pub; start_date; end_date; wad_frequency; wad_fee; h_url }) + |+ Purpose.field _purpose + |+ field MasterPublicKeyP.bin (fun t -> t.partner_pub) + |+ field TimestampNBO.bin (fun t -> t.start_date) + |+ field TimestampNBO.bin (fun t -> t.end_date) + |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency) + |+ field AmountNBO.bin (fun t -> t.wad_fee) + |+ field Hash_64_cstr.bin (fun t -> t.h_url) + |> sealr + end + + include R + include MK (R) +end + +module WadPartnerSignature = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_PARTNER_DETAILS *) + type r = { + h_partner_base_url: Hash_64_cstr.t; + master_public_key: MasterPublicKeyP.t; + start_date: TimeAbsoluteNBO.t; + end_date: TimeAbsoluteNBO.t; + wad_fee: AmountNBO.t; + wad_frequency: TimeRelativeNBO.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_partner_details + @@ fun _purpose -> + record + (fun + _purpose + h_partner_base_url + master_public_key + start_date + end_date + wad_fee + wad_frequency + -> + { + h_partner_base_url; + master_public_key; + start_date; + end_date; + wad_fee; + wad_frequency; + }) + |+ Purpose.field _purpose + |+ field Hash_64_cstr.bin (fun t -> t.h_partner_base_url) + |+ field MasterPublicKeyP.bin (fun t -> t.master_public_key) + |+ field TimeAbsoluteNBO.bin (fun t -> t.start_date) + |+ field TimeAbsoluteNBO.bin (fun t -> t.end_date) + |+ field AmountNBO.bin (fun t -> t.wad_fee) + |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency) + |> sealr + end + + include R + include MK (R) +end + +module MasterWireFee = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_FEES *) + type r = { + h_wire_method: Hash_64_cstr.t; + start_date: TimeAbsoluteNBO.t; + end_date: TimeAbsoluteNBO.t; + wire_fee: AmountNBO.t; + closing_fee: AmountNBO.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.master_wire_fees @@ fun _purpose -> + record + (fun _purpose h_wire_method start_date end_date wire_fee closing_fee -> + { h_wire_method; start_date; end_date; wire_fee; closing_fee }) + |+ Purpose.field _purpose + |+ field Hash_64_cstr.bin (fun t -> t.h_wire_method) + |+ field TimeAbsoluteNBO.bin (fun t -> t.start_date) + |+ field TimeAbsoluteNBO.bin (fun t -> t.end_date) + |+ field AmountNBO.bin (fun t -> t.wire_fee) + |+ field AmountNBO.bin (fun t -> t.closing_fee) + |> sealr + end + + include R + include MK (R) +end + +module ExchangeKeyValidity = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_AUDITOR_EXCHANGE_KEYS *) + type r = { + auditor_url_hash: Hash_64_cstr.t; + master: MasterPublicKeyP.t; + start: TimeAbsoluteNBO.t; + expire_withdraw: TimeAbsoluteNBO.t; + expire_spend: TimeAbsoluteNBO.t; + expire_legal: TimeAbsoluteNBO.t; + value: AmountNBO.t; + fee_withdraw: AmountNBO.t; + fee_deposit: AmountNBO.t; + fee_refresh: AmountNBO.t; + denom_hash: DenominationHash.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.auditor_exchange_keys @@ fun _purpose -> + record + (fun + _purpose + auditor_url_hash + master + start + expire_withdraw + expire_spend + expire_legal + value + fee_withdraw + fee_deposit + fee_refresh + denom_hash + -> + { + auditor_url_hash; + master; + start; + expire_withdraw; + expire_spend; + expire_legal; + value; + fee_withdraw; + fee_deposit; + fee_refresh; + denom_hash; + }) + |+ Purpose.field _purpose + |+ field Hash_64_cstr.bin (fun t -> t.auditor_url_hash) + |+ field MasterPublicKeyP.bin (fun t -> t.master) + |+ field TimeAbsoluteNBO.bin (fun t -> t.start) + |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_withdraw) + |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_spend) + |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_legal) + |+ field AmountNBO.bin (fun t -> t.value) + |+ field AmountNBO.bin (fun t -> t.fee_withdraw) + |+ field AmountNBO.bin (fun t -> t.fee_deposit) + |+ field AmountNBO.bin (fun t -> t.fee_refresh) + |+ field DenominationHash.bin (fun t -> t.denom_hash) + |> sealr + end + + include R + include MK (R) +end + +module ExchangeKeySet = struct + module R = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_KEY_SET *) + type r = { + list_issue_date: TimeAbsoluteNBO.t; + hc: Hash_64.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.exchange_key_set @@ fun _purpose -> + record (fun _purpose list_issue_date hc -> { list_issue_date; hc }) + |+ Purpose.field _purpose + |+ field TimeAbsoluteNBO.bin (fun t -> t.list_issue_date) + |+ field Hash_64.bin (fun t -> t.hc) + |> sealr + end + + include R + include MK (R) +end + +(* ### BIN IMPL END ### *) + +module WithdrawRequest = struct + (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *) + type t = { + amount: Amount.t; + fee: Amount.t; + h_planchets: HashPlanchetsP.t; + blinding_seed: BlindingMasterSecret.t; + max_age_group: int32; + mask: AgeMask.t; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.wallet_reserve_withdraw @@ fun purpose -> + record + (fun _purpose amount fee h_planchets blinding_seed max_age_group mask -> + { amount; fee; h_planchets; blinding_seed; max_age_group; mask }) + |+ Purpose.field purpose + |+ field Amount.bin (fun t -> t.amount) + |+ field Amount.bin (fun t -> t.fee) + |+ field HashPlanchetsP.bin (fun t -> t.h_planchets) + |+ field BlindingMasterSecret.bin (fun t -> t.blinding_seed) + |+ field beint32 (fun t -> t.max_age_group) + |+ field AgeMask.bin (fun t -> t.mask) + |> sealr +end + +module WithdrawConfirmation = struct + (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW. + Signed by a `struct TALER_ExchangePrivateKeyP` using EdDSA. *) + type t = { + (* TODO TALER doc + missing TALER_HashBlindedPlanchetsP*) + h_planchets: HashPlanchetsP.t; + noreveal_index: int32; + } + + let bin = + let open Bin in + Purpose.make_bin Taler_signatures.exchange_confirm_withdraw + @@ fun purpose -> + record (fun _purpose h_planchets noreveal_index -> + { h_planchets; noreveal_index }) + |+ Purpose.field purpose + |+ field HashPlanchetsP.bin (fun t -> t.h_planchets) + |+ field beint32 (fun t -> t.noreveal_index) + |> sealr +end + +module SingleWithdrawRequest = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *) + type t = { + amount_with_fee: AmountNBO.t; + h_denomination_pub: DenominationHash.t; + h_coin_envelope: BlindedCoinHash.t; + } +end + +module DepositRequest = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_DEPOSIT *) + type t = { + h_contract_terms: PrivateContractHash.t; + h_age_commitment: AgeCommitmentHash.t; + h_policy: ExtensionsPolicyHash.t; + h_wire: MerchantWireHash.t; + h_denom_pub: DenominationHash.t; + timestamp: TimeAbsoluteNBO.t; + refund_deadline: TimeAbsoluteNBO.t; + amount_with_fee: AmountNBO.t; + deposit_fee: AmountNBO.t; + merchant: MerchantPublicKeyP.t; + wallet_data_hash: Hash_64_cstr.t; + } +end + +module DepositConfirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_DEPOSIT *) + type t = { + h_contract_terms: PrivateContractHash.t; + h_wire: MerchantWireHash.t; + h_policy: ExtensionsPolicyHash.t; + timestamp: TimeAbsoluteNBO.t; + refund_deadline: TimeAbsoluteNBO.t; + amount_without_fee: AmountNBO.t; + coin_pub: CoinSpendPublicKeyP.t; + merchant: MerchantPublicKeyP.t; + } +end + +module RefreshMeltCoinAffirmation = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_MELT *) + type t = { + session_hash: RefreshCommitmentP.t; + h_denom_pub: DenominationHash.t; + h_age_commitment: AgeCommitmentHash.t; + amount_with_fee: AmountNBO.t; + melt_fee: AmountNBO.t; + } +end + +module RefreshMeltConfirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_MELT *) + type t = { + session_hash: RefreshCommitmentP.t; + noreveal_index: int; (* uint16_t mapped to OCaml int *) + } +end + +module DepositTrack = struct + (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *) + type t = { + h_contract_terms: PrivateContractHash.t; + h_wire: MerchantWireHash.t; + coin_pub: CoinSpendPublicKeyP.t; + } +end + +module WireDepositDetailP = struct + type t = { + h_contract_terms: PrivateContractHash.t; + execution_time: TimeAbsoluteNBO.t; + coin_pub: CoinSpendPublicKeyP.t; + deposit_value: AmountNBO.t; + deposit_fee: AmountNBO.t; + } +end + +module WireDepositData = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE_DEPOSIT *) + type t = { + total: AmountNBO.t; + wire_fee: AmountNBO.t; + merchant_pub: MerchantPublicKeyP.t; + h_wire: MerchantWireHash.t; + h_details: Hash_64_cstr.t; + } +end + +module PaymentResponse = struct + (* purpose.purpose = TALER_SIGNATURE_MERCHANT_PAYMENT_OK *) + type t = { h_contract_terms: PrivateContractHash.t } +end + +module Contract = struct + (* purpose.purpose = TALER_SIGNATURE_MERCHANT_CONTRACT *) + type t = { h_contract_terms: PrivateContractHash.t } +end + +module ConfirmWire = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE *) + type t = { + h_wire: MerchantWireHash.t; + h_contract_terms: PrivateContractHash.t; + wtid: WireTransferIdentifierRawP.t; + coin_pub: CoinSpendPublicKeyP.t; + execution_time: TimeAbsoluteNBO.t; + coin_contribution: AmountNBO.t; + } +end + +module RefundConfirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_REFUND *) + type t = { + h_contract_terms: PrivateContractHash.t; + coin_pub: CoinSpendPublicKeyP.t; + merchant: MerchantPublicKeyP.t; + rtransaction_id: int64; + refund_amount: AmountNBO.t; + } +end + +module DepositTrackPS2 = struct + (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *) + type t = { + h_contract_terms: PrivateContractHash.t; + h_wire: MerchantWireHash.t; + merchant: MerchantPublicKeyP.t; + coin_pub: CoinSpendPublicKeyP.t; + } +end + +module RefundRequest = struct + (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND *) + type t = { + h_contract_terms: PrivateContractHash.t; + coin_pub: CoinSpendPublicKeyP.t; + rtransaction_id: int64; + refund_amount: AmountNBO.t; + refund_fee: AmountNBO.t; + } +end + +module MerchantRefundConfirmation = 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: Hash_64_cstr.t } +end + +module RecoupRequest = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_RECOUP or TALER_SIGNATURE_WALLET_COIN_RECOUP_REFRESH *) + type t = { + h_denom_pub: DenominationHash.t; + coin_blind: DenominationBlindingKeyP.t; + } +end + +module RecoupRefreshConfirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP_REFRESH *) + type t = { + timestamp: TimeAbsoluteNBO.t; + recoup_amount: AmountNBO.t; + coin_pub: CoinSpendPublicKeyP.t; + old_coin_pub: CoinSpendPublicKeyP.t; + } +end + +module RecoupConfirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP *) + type t = { + timestamp: TimeAbsoluteNBO.t; + recoup_amount: AmountNBO.t; + coin_pub: CoinSpendPublicKeyP.t; + reserve_pub: ReservePublicKeyP.t; + } +end + +module DenominationUnknownAffirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_AFFIRM_DENOM_UNKNOWN *) + type t = { + timestamp: TimeAbsoluteNBO.t; + h_denom_pub: DenominationHash.t; + } +end + +module DenominationExpiredAffirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_GENERIC_DENOMINATIN_EXPIRED *) + type t = { + timestamp: TimeAbsoluteNBO.t; + operation: string; (* char[8] → string *) + h_denom_pub: DenominationHash.t; + } +end + +module ReserveCloseConfirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_CLOSED *) + type t = { + timestamp: TimeAbsoluteNBO.t; + closing_amount: AmountNBO.t; + reserve_pub: ReservePublicKeyP.t; + h_wire: FullPaytoHash.t; + } +end + +module CoinLinkSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *) + type t = { + h_denom_pub: DenominationHash.t; + old_coin_pub: CoinSpendPublicKeyP.t; + transfer_pub: TransferPublicKeyP.t; + coin_envelope_hash: BlindedCoinHash.t; + } +end + +module RefreshNonceSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *) + type t = { nonce: PublicRefreshCoinNonceP.t } +end + +module ReserveStatusRequestSignature = struct + (* purpose.purpose = TALER_SIGNATURE_RESERVE_STATUS_REQUEST *) + type t = { request_timestamp: TimeAbsoluteNBO.t } +end + +module ReserveHistoryRequestSignature = struct + (* purpose.purpose = TALER_SIGNATURE_RESERVE_HISTORY_REQUEST *) + type t = { + history_fee: AmountNBO.t; + request_timestamp: TimeAbsoluteNBO.t; + } +end + +module PurseStatusRequestSignature = struct + (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_REQUEST *) + type t = unit +end + +module PurseStatusResponseSignature = struct + (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_RESPONSE *) + type t = { + total_purse_amount: AmountNBO.t; + total_deposit_amount: AmountNBO.t; + max_deposit_fees: AmountNBO.t; + purse_expiration: TimeAbsoluteNBO.t; + status_timestamp: TimeAbsoluteNBO.t; + h_contract_terms: PrivateContractHash.t; + } +end + +module ReserveCloseRequestSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *) + type t = unit +end + +module PurseRequestSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_CREATE *) + type t = { + purse_expiration: TimeAbsoluteNBO.t; + merge_value_after_fees: AmountNBO.t; + h_contract_terms: PrivateContractHash.t; + min_age: int; + } +end + +module PurseDepositSignature = struct + (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT *) + type t = { + coin_contribution: AmountNBO.t; + h_denom_pub: DenominationHash.t; + h_age_commitment: AgeCommitmentHash.t; + purse_pub: PursePublicKey.t; + h_exchange_base_url: Hash_64_cstr.t; + } +end + +module PurseDepositSignaturePS2 = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN_DEPOSIT *) + type t = { + reserve_sig: ReserveSignatureP.t; + coin_contribution: AmountNBO.t; + } +end + +module PurseDepositConfirmedSignature = struct + (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT_CONFIRMED *) + type t = { + total_purse_amount: AmountNBO.t; + total_deposit_fees: AmountNBO.t; + purse_pub: PursePublicKey.t; + purse_expiration: TimeAbsoluteNBO.t; + h_contract_terms: PrivateContractHash.t; + } +end + +module PurseMergeSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_MERGE *) + type t = { + merge_timestamp: TimeAbsoluteNBO.t; + h_wire: NormalizedPaytoHash.t; + } +end + +module AccountMergeSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_MERGE *) + type t = { + reserve_pub: ReservePublicKeyP.t; + purse_pub: PursePublicKey.t; + merge_amount_after_fees: AmountNBO.t; + merge_timestamp: TimeAbsoluteNBO.t; + purse_expiration: TimeAbsoluteNBO.t; + h_contract_terms: PrivateContractHash.t; + min_age: int; + } +end + +module AccountSetupRequestSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_SETUP *) + type t = { threshold: AmountNBO.t } +end + +module PurseMergeSuccessSignature = struct + (* purpose.purpose = TALER_SIGNATURE_PURSE_MERGE_SUCCESS *) + type t = { + reserve_pub: ReservePublicKeyP.t; + purse_pub: PursePublicKey.t; + merge_amount_after_fees: AmountNBO.t; + contract_time: TimeAbsoluteNBO.t; + h_contract_terms: PrivateContractHash.t; + h_wire: NormalizedPaytoHash.t; + min_age: int; + } +end + +module WadDataSignature = struct + (* purpose.purpose = TALER_SIGNATURE_WAD_DATA *) + type t = { + wad_execution_time: TimeAbsoluteNBO.t; + total_amount: AmountNBO.t; + h_items: Hash_64_cstr.t; + wad_id: WadId.t; + } +end + +module P2PFees = struct + (* purpose.purpose = TALER_SIGNATURE_P2P_FEES *) + type t = { + start_date: TimeAbsoluteNBO.t; + end_date: TimeAbsoluteNBO.t; + kyc_fee: AmountNBO.t; + purse_fee: AmountNBO.t; + account_history_fee: AmountNBO.t; + account_annual_fee: AmountNBO.t; + account_kyc_timeout: TimeRelativeNBO.t; + purse_timeout: TimeRelativeNBO.t; + purse_account_limit: int; + } +end + +module CoinPurseRefundConfirmation = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_PURSE_REFUND *) + type t = { + purse_pub: PursePublicKey.t; + coin_pub: CoinSpendPublicKeyP.t; + refunded_amount: AmountNBO.t; + refund_fee: AmountNBO.t; + } +end + +module AmlDecision = struct + (* purpose.purpose = TALER_SIGNATURE_AML_DECISION *) + type t = { + h_justification: Hash_64_cstr.t; + decision_time: TimestampNBO.t; + new_threshold: AmountNBO.t; + h_payto: NormalizedPaytoHash.t; + h_kyc_requirements: Hash_64_cstr.t; + new_state: int; + } +end + +module ReserveOpen = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN *) + type t = { + reserve_payment: AmountNBO.t; + request_timestamp: TimestampNBO.t; + reserve_expiration: TimestampNBO.t; + purse_limit: int; + } +end + +module ReserveClose = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *) + type t = { + request_timestamp: TimestampNBO.t; + target_account_h_payto: FullPaytoHash.t; + } +end + +module ReserveAttestRequest = struct + (* purpose.purpose = TALER_SIGNATURE_WALLET_ATTEST_REQUEST *) + type t = { + request_timestamp: TimestampNBO.t; + h_details: Hash_64_cstr.t; + } +end + +module ExchangeAttest = struct + (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_ATTEST_DETAILS *) + type t = { + attest_timestamp: TimestampNBO.t; + expiration_time: TimestampNBO.t; + reserve_pub: ReservePublicKeyP.t; + h_attributes: Hash_64_cstr.t; + } +end diff --git a/src/bin_signature.ml b/src/bin_signature.ml deleted file mode 100644 index f7d30051..00000000 --- a/src/bin_signature.ml +++ /dev/null @@ -1,801 +0,0 @@ -(* Packed Signature *) - -open Bin_type -open Bin_type.Aliases - -(* EccSignaturePurpose *) -module Purpose = struct - type t = { - size: int32; - purpose: int32; - } - - let bin = - let open Bin in - record (fun size purpose -> { size; purpose }) - |+ field beint32 (fun t -> t.size) - |+ field beint32 (fun t -> t.purpose) - |> sealr - - let make ~size purpose = { size= Int32.of_int size; purpose } - let dummy = make ~size:0 0_l - - (* helper function to make ['signature Bin.t] - to compute [t.size], we first build a bin with a dummy purpose *) - let make_bin = - let get_size f = - let open Bin in - match Size.of_value (Size.size_of (f dummy)) with - | Dynamic _ | Unknown -> - Fmt.failwith "size_of failure: size is not Static" - | Static n -> n - in - fun code f -> make ~size:(get_size f) code |> f - - let field purpose = Bin.field bin (fun _t -> purpose) -end - -module WithdrawRequestPS = struct - (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *) - type t = { - amount: Amount.t; - fee: Amount.t; - h_planchets: HashPlanchetsP.t; - blinding_seed: BlindingMasterSecret.t; - max_age_group: int32; - mask: AgeMask.t; - } - - let bin = - let open Bin in - Purpose.make_bin Taler_signatures.wallet_reserve_withdraw @@ fun purpose -> - record - (fun _purpose amount fee h_planchets blinding_seed max_age_group mask -> - { amount; fee; h_planchets; blinding_seed; max_age_group; mask }) - |+ Purpose.field purpose - |+ field Amount.bin (fun t -> t.amount) - |+ field Amount.bin (fun t -> t.fee) - |+ field HashPlanchetsP.bin (fun t -> t.h_planchets) - |+ field BlindingMasterSecret.bin (fun t -> t.blinding_seed) - |+ field beint32 (fun t -> t.max_age_group) - |+ field AgeMask.bin (fun t -> t.mask) - |> sealr -end - -module WithdrawConfirmationPS = struct - (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW. - Signed by a `struct TALER_ExchangePrivateKeyP` using EdDSA. *) - type t = { - (* TODO TALER doc - missing TALER_HashBlindedPlanchetsP*) - h_planchets: HashPlanchetsP.t; - noreveal_index: int32; - } - - let bin = - let open Bin in - Purpose.make_bin Taler_signatures.exchange_confirm_withdraw - @@ fun purpose -> - record (fun _purpose h_planchets noreveal_index -> - { h_planchets; noreveal_index }) - |+ Purpose.field purpose - |+ field HashPlanchetsP.bin (fun t -> t.h_planchets) - |+ field beint32 (fun t -> t.noreveal_index) - |> sealr -end - -module DenominationKeyAnnouncementPS = struct - (* TODO taler_signatures purpose - we use TALER_SIGNATURE_SM_RSA_DENOMINATION_KEY instead here *) - (* purpose.purpose = TALER_SIGNATURE_SM_DENOMINATION_KEY *) - type r = { - h_denom_pub: DenominationHash.t; - h_section_name: Hash_64_cstr.t; - anchor_time: TimeAbsoluteNBO.t; - duration_withdraw: TimeRelativeNBO.t; - } - - let bin = - let open Bin in - Purpose.make_bin Taler_signatures.sm_rsa_denomination_key @@ fun purpose -> - record - (fun _purpose h_denom_pub h_section_name anchor_time duration_withdraw -> - { h_denom_pub; h_section_name; anchor_time; duration_withdraw }) - |+ Purpose.field purpose - |+ field DenominationHash.bin (fun t -> t.h_denom_pub) - |+ 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 - - module type SIG = sig - type t - - val sign : (string -> string) -> r -> t - val verify : (string -> msg:string -> bool) -> t -> r -> bool - val jsont : t Jsont.t - end - - module Sig : SIG = struct - type t = string - - let sign f r = f @@ Bin.to_string bin r - let verify f s r = f s ~msg:(Bin.to_string bin r) - - (* TODO B32.jsont, for others types too *) - let jsont = Jsont.string - end -end - -module SigningKeyAnnouncementPS = struct - (* purpose.purpose = TALER_SIGNATURE_SM_SIGNING_KEY *) - type t = { - exchange_pub: ExchangePublicKeyP.t; - anchor_time: TimeAbsoluteNBO.t; - duration: TimeRelativeNBO.t; - } - - let bin = - let open Bin in - Purpose.make_bin Taler_signatures.sm_signing_key @@ fun purpose -> - record (fun _purpose exchange_pub anchor_time duration -> - { exchange_pub; anchor_time; duration }) - |+ Purpose.field purpose - |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub) - |+ field TimeAbsoluteNBO.bin (fun t -> t.anchor_time) - |+ field TimeRelativeNBO.bin (fun t -> t.duration) - |> sealr -end - -module DenominationKeyValidityPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_VALIDITY *) - type t = { - master: MasterPublicKeyP.t; - start: TimeAbsoluteNBO.t; - expire_withdraw: TimeAbsoluteNBO.t; - expire_spend: TimeAbsoluteNBO.t; - expire_legal: TimeAbsoluteNBO.t; - value: AmountNBO.t; - fee_withdraw: AmountNBO.t; - fee_deposit: AmountNBO.t; - fee_refresh: AmountNBO.t; - denom_hash: DenominationHash.t; - } - - let bin = - let open Bin in - Purpose.make_bin Taler_signatures.master_denomination_key_validity - @@ fun purpose -> - record - (fun - _purpose - master - start - expire_withdraw - expire_spend - expire_legal - value - fee_withdraw - fee_deposit - fee_refresh - denom_hash - -> - { - master; - start; - expire_withdraw; - expire_spend; - expire_legal; - value; - fee_withdraw; - fee_deposit; - fee_refresh; - denom_hash; - }) - |+ Purpose.field purpose - |+ field MasterPublicKeyP.bin (fun t -> t.master) - |+ field TimeAbsoluteNBO.bin (fun t -> t.start) - |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_withdraw) - |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_spend) - |+ field TimeAbsoluteNBO.bin (fun t -> t.expire_legal) - |+ field AmountNBO.bin (fun t -> t.value) - |+ field AmountNBO.bin (fun t -> t.fee_withdraw) - |+ field AmountNBO.bin (fun t -> t.fee_deposit) - |+ field AmountNBO.bin (fun t -> t.fee_refresh) - |+ field DenominationHash.bin (fun t -> t.denom_hash) - |> sealr -end - -module ExchangeSigningKeyValidityPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_VALIDITY *) - type t = { - start: TimeAbsoluteNBO.t; - expire: TimeAbsoluteNBO.t; - end_: TimeAbsoluteNBO.t; (* "end" renamed to end_ *) - signkey_pub: ExchangePublicKeyP.t; - } - - let bin = - let open Bin in - Purpose.make_bin Taler_signatures.master_signing_key_validity - @@ fun purpose -> - record (fun _purpose start expire end_ signkey_pub -> - { start; expire; end_; signkey_pub }) - |+ Purpose.field purpose - |+ field TimeAbsoluteNBO.bin (fun t -> t.start) - |+ field TimeAbsoluteNBO.bin (fun t -> t.expire) - |+ field TimeAbsoluteNBO.bin (fun t -> t.end_) - |+ field ExchangePublicKeyP.bin (fun t -> t.signkey_pub) - |> sealr -end - -(* ### BIN IMPL END ### *) - -module SingleWithdrawRequestPS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *) - type t = { - amount_with_fee: AmountNBO.t; - h_denomination_pub: DenominationHash.t; - h_coin_envelope: BlindedCoinHash.t; - } -end - -module DepositRequestPS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_DEPOSIT *) - type t = { - h_contract_terms: PrivateContractHash.t; - h_age_commitment: AgeCommitmentHash.t; - h_policy: ExtensionsPolicyHash.t; - h_wire: MerchantWireHash.t; - h_denom_pub: DenominationHash.t; - timestamp: TimeAbsoluteNBO.t; - refund_deadline: TimeAbsoluteNBO.t; - amount_with_fee: AmountNBO.t; - deposit_fee: AmountNBO.t; - merchant: MerchantPublicKeyP.t; - wallet_data_hash: Hash_64_cstr.t; - } -end - -module DepositConfirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_DEPOSIT *) - type t = { - h_contract_terms: PrivateContractHash.t; - h_wire: MerchantWireHash.t; - h_policy: ExtensionsPolicyHash.t; - timestamp: TimeAbsoluteNBO.t; - refund_deadline: TimeAbsoluteNBO.t; - amount_without_fee: AmountNBO.t; - coin_pub: CoinSpendPublicKeyP.t; - merchant: MerchantPublicKeyP.t; - } -end - -module RefreshMeltCoinAffirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_MELT *) - type t = { - session_hash: RefreshCommitmentP.t; - h_denom_pub: DenominationHash.t; - h_age_commitment: AgeCommitmentHash.t; - amount_with_fee: AmountNBO.t; - melt_fee: AmountNBO.t; - } -end - -module RefreshMeltConfirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_MELT *) - type t = { - session_hash: RefreshCommitmentP.t; - noreveal_index: int; (* uint16_t mapped to OCaml int *) - } -end - -module ExchangeKeySetPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_KEY_SET *) - type t = { - list_issue_date: TimeAbsoluteNBO.t; - hc: Hash_64_cstr.t; - } -end - -module MasterWireDetailsPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_DETAILS *) - type t = { - h_wire_details: FullPaytoHash.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: Hash_64_cstr.t; - start_date: TimeAbsoluteNBO.t; - end_date: TimeAbsoluteNBO.t; - wire_fee: AmountNBO.t; - closing_fee: AmountNBO.t; - } -end - -module GlobalFeesPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *) - type t = { - start_date: TimeAbsoluteNBO.t; - end_date: TimeAbsoluteNBO.t; - purse_timeout: TimeRelativeNBO.t; - kyc_timeout: TimeRelativeNBO.t; - history_expiration: TimeRelativeNBO.t; - history_fee: AmountNBO.t; - kyc_fee: AmountNBO.t; - account_fee: AmountNBO.t; - purse_fee: AmountNBO.t; - purse_account_limit: int; (* uint32_t → int *) - } -end - -module MasterDrainProfitPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_DRAIN_PROFITS *) - type t = { - wtid: WireTransferIdentifierRawP.t; - date: TimeAbsoluteNBO.t; - amount: AmountNBO.t; - h_section: Hash_64_cstr.t; - h_payto: FullPaytoHash.t; - } -end - -module DepositTrackPS = struct - (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *) - type t = { - h_contract_terms: PrivateContractHash.t; - h_wire: MerchantWireHash.t; - coin_pub: CoinSpendPublicKeyP.t; - } -end - -module WireDepositDetailP = struct - type t = { - h_contract_terms: PrivateContractHash.t; - execution_time: TimeAbsoluteNBO.t; - coin_pub: CoinSpendPublicKeyP.t; - deposit_value: AmountNBO.t; - deposit_fee: AmountNBO.t; - } -end - -module WireDepositDataPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE_DEPOSIT *) - type t = { - total: AmountNBO.t; - wire_fee: AmountNBO.t; - merchant_pub: MerchantPublicKeyP.t; - h_wire: MerchantWireHash.t; - h_details: Hash_64_cstr.t; - } -end - -module ExchangeKeyValidityPS = struct - (* purpose.purpose = TALER_SIGNATURE_AUDITOR_EXCHANGE_KEYS *) - type t = { - auditor_url_hash: Hash_64_cstr.t; - master: MasterPublicKeyP.t; - start: TimeAbsoluteNBO.t; - expire_withdraw: TimeAbsoluteNBO.t; - expire_spend: TimeAbsoluteNBO.t; - expire_legal: TimeAbsoluteNBO.t; - value: AmountNBO.t; - fee_withdraw: AmountNBO.t; - fee_deposit: AmountNBO.t; - fee_refresh: AmountNBO.t; - denom_hash: DenominationHash.t; - } -end - -module PaymentResponsePS = struct - (* purpose.purpose = TALER_SIGNATURE_MERCHANT_PAYMENT_OK *) - type t = { h_contract_terms: PrivateContractHash.t } -end - -module ContractPS = struct - (* purpose.purpose = TALER_SIGNATURE_MERCHANT_CONTRACT *) - type t = { h_contract_terms: PrivateContractHash.t } -end - -module ConfirmWirePS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE *) - type t = { - h_wire: MerchantWireHash.t; - h_contract_terms: PrivateContractHash.t; - wtid: WireTransferIdentifierRawP.t; - coin_pub: CoinSpendPublicKeyP.t; - execution_time: TimeAbsoluteNBO.t; - coin_contribution: AmountNBO.t; - } -end - -module RefundConfirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_REFUND *) - type t = { - h_contract_terms: PrivateContractHash.t; - coin_pub: CoinSpendPublicKeyP.t; - merchant: MerchantPublicKeyP.t; - rtransaction_id: int64; - refund_amount: AmountNBO.t; - } -end - -module DepositTrackPS2 = struct - (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *) - type t = { - h_contract_terms: PrivateContractHash.t; - h_wire: MerchantWireHash.t; - merchant: MerchantPublicKeyP.t; - coin_pub: CoinSpendPublicKeyP.t; - } -end - -module RefundRequestPS = struct - (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND *) - type t = { - h_contract_terms: PrivateContractHash.t; - coin_pub: CoinSpendPublicKeyP.t; - rtransaction_id: int64; - refund_amount: AmountNBO.t; - refund_fee: AmountNBO.t; - } -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: Hash_64_cstr.t } -end - -module RecoupRequestPS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_RECOUP or TALER_SIGNATURE_WALLET_COIN_RECOUP_REFRESH *) - type t = { - h_denom_pub: DenominationHash.t; - coin_blind: DenominationBlindingKeyP.t; - } -end - -module RecoupRefreshConfirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP_REFRESH *) - type t = { - timestamp: TimeAbsoluteNBO.t; - recoup_amount: AmountNBO.t; - coin_pub: CoinSpendPublicKeyP.t; - old_coin_pub: CoinSpendPublicKeyP.t; - } -end - -module RecoupConfirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP *) - type t = { - timestamp: TimeAbsoluteNBO.t; - recoup_amount: AmountNBO.t; - coin_pub: CoinSpendPublicKeyP.t; - reserve_pub: ReservePublicKeyP.t; - } -end - -module DenominationUnknownAffirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_AFFIRM_DENOM_UNKNOWN *) - type t = { - timestamp: TimeAbsoluteNBO.t; - h_denom_pub: DenominationHash.t; - } -end - -module DenominationExpiredAffirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_GENERIC_DENOMINATIN_EXPIRED *) - type t = { - timestamp: TimeAbsoluteNBO.t; - operation: string; (* char[8] → string *) - h_denom_pub: DenominationHash.t; - } -end - -module ReserveCloseConfirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_CLOSED *) - type t = { - timestamp: TimeAbsoluteNBO.t; - closing_amount: AmountNBO.t; - reserve_pub: ReservePublicKeyP.t; - h_wire: FullPaytoHash.t; - } -end - -module CoinLinkSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *) - type t = { - h_denom_pub: DenominationHash.t; - old_coin_pub: CoinSpendPublicKeyP.t; - transfer_pub: TransferPublicKeyP.t; - coin_envelope_hash: BlindedCoinHash.t; - } -end - -module RefreshNonceSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *) - type t = { nonce: PublicRefreshCoinNonceP.t } -end - -module ReserveStatusRequestSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_RESERVE_STATUS_REQUEST *) - type t = { request_timestamp: TimeAbsoluteNBO.t } -end - -module ReserveHistoryRequestSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_RESERVE_HISTORY_REQUEST *) - type t = { - history_fee: AmountNBO.t; - request_timestamp: TimeAbsoluteNBO.t; - } -end - -module PurseStatusRequestSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_REQUEST *) - type t = unit -end - -module PurseStatusResponseSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_RESPONSE *) - type t = { - total_purse_amount: AmountNBO.t; - total_deposit_amount: AmountNBO.t; - max_deposit_fees: AmountNBO.t; - purse_expiration: TimeAbsoluteNBO.t; - status_timestamp: TimeAbsoluteNBO.t; - h_contract_terms: PrivateContractHash.t; - } -end - -module ReserveCloseRequestSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *) - type t = unit -end - -module PurseRequestSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_CREATE *) - type t = { - purse_expiration: TimeAbsoluteNBO.t; - merge_value_after_fees: AmountNBO.t; - h_contract_terms: PrivateContractHash.t; - min_age: int; - } -end - -module PurseDepositSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT *) - type t = { - coin_contribution: AmountNBO.t; - h_denom_pub: DenominationHash.t; - h_age_commitment: AgeCommitmentHash.t; - purse_pub: PursePublicKey.t; - h_exchange_base_url: Hash_64_cstr.t; - } -end - -module PurseDepositSignaturePS2 = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN_DEPOSIT *) - type t = { - reserve_sig: ReserveSignatureP.t; - coin_contribution: AmountNBO.t; - } -end - -module PurseDepositConfirmedSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT_CONFIRMED *) - type t = { - total_purse_amount: AmountNBO.t; - total_deposit_fees: AmountNBO.t; - purse_pub: PursePublicKey.t; - purse_expiration: TimeAbsoluteNBO.t; - h_contract_terms: PrivateContractHash.t; - } -end - -module PurseMergeSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_MERGE *) - type t = { - merge_timestamp: TimeAbsoluteNBO.t; - h_wire: NormalizedPaytoHash.t; - } -end - -module AccountMergeSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_MERGE *) - type t = { - reserve_pub: ReservePublicKeyP.t; - purse_pub: PursePublicKey.t; - merge_amount_after_fees: AmountNBO.t; - merge_timestamp: TimeAbsoluteNBO.t; - purse_expiration: TimeAbsoluteNBO.t; - h_contract_terms: PrivateContractHash.t; - min_age: int; - } -end - -module AccountSetupRequestSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_SETUP *) - type t = { threshold: AmountNBO.t } -end - -module PurseMergeSuccessSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_PURSE_MERGE_SUCCESS *) - type t = { - reserve_pub: ReservePublicKeyP.t; - purse_pub: PursePublicKey.t; - merge_amount_after_fees: AmountNBO.t; - contract_time: TimeAbsoluteNBO.t; - h_contract_terms: PrivateContractHash.t; - h_wire: NormalizedPaytoHash.t; - min_age: int; - } -end - -module WadDataSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_WAD_DATA *) - type t = { - wad_execution_time: TimeAbsoluteNBO.t; - total_amount: AmountNBO.t; - h_items: Hash_64_cstr.t; - wad_id: WadId.t; - } -end - -module WadPartnerSignaturePS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_PARTNER_DETAILS *) - type t = { - h_partner_base_url: Hash_64_cstr.t; - master_public_key: MasterPublicKeyP.t; - start_date: TimeAbsoluteNBO.t; - end_date: TimeAbsoluteNBO.t; - wad_fee: AmountNBO.t; - wad_frequency: TimeRelativeNBO.t; - } -end - -module P2PFeesPS = struct - (* purpose.purpose = TALER_SIGNATURE_P2P_FEES *) - type t = { - start_date: TimeAbsoluteNBO.t; - end_date: TimeAbsoluteNBO.t; - kyc_fee: AmountNBO.t; - purse_fee: AmountNBO.t; - account_history_fee: AmountNBO.t; - account_annual_fee: AmountNBO.t; - account_kyc_timeout: TimeRelativeNBO.t; - purse_timeout: TimeRelativeNBO.t; - purse_account_limit: int; - } -end - -module CoinPurseRefundConfirmationPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_PURSE_REFUND *) - type t = { - purse_pub: PursePublicKey.t; - coin_pub: CoinSpendPublicKeyP.t; - refunded_amount: AmountNBO.t; - refund_fee: AmountNBO.t; - } -end - -module MasterDenominationKeyRevocationPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_REVOKED *) - type t = { h_denom_pub: DenominationHash.t } -end - -module MasterSigningKeyRevocationPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_REVOKED *) - type t = { exchange_pub: ExchangePublicKeyP.t } -end - -module MasterAddAuditorPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_AUDITOR *) - type t = { - start_date: TimeAbsoluteNBO.t; - auditor_pub: AuditorPublicKeyP.t; - h_auditor_url: Hash_64_cstr.t; - } -end - -module MasterDelAuditorPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_AUDITOR *) - type t = { - end_date: TimeAbsoluteNBO.t; - auditor_pub: AuditorPublicKeyP.t; - } -end - -module MasterAddWirePS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_WIRE *) - type t = { - start_date: TimeAbsoluteNBO.t; - h_wire: FullPaytoHash.t; - h_conversion_url: Hash_64_cstr.t; - h_credit_restrictions: Hash_64_cstr.t; - h_debit_restrictions: Hash_64_cstr.t; - } -end - -module MasterDelWirePS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_WIRE *) - type t = { - end_date: TimeAbsoluteNBO.t; - h_wire: FullPaytoHash.t; - } -end - -module MasterAmlOfficerStatusPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_AML_KEY *) - type t = { - change_date: TimestampNBO.t; - officer_pub: AmlOfficerPublicKeyP.t; - h_officer_name: Hash_64_cstr.t; - is_active: int; - } -end - -module AmlDecisionPS = struct - (* purpose.purpose = TALER_SIGNATURE_AML_DECISION *) - type t = { - h_justification: Hash_64_cstr.t; - decision_time: TimestampNBO.t; - new_threshold: AmountNBO.t; - h_payto: NormalizedPaytoHash.t; - h_kyc_requirements: Hash_64_cstr.t; - new_state: int; - } -end - -module PartnerConfigurationPS = struct - (* purpose.purpose = TALER_SIGNATURE_MASTER_PARNTER_DETAILS *) - type t = { - partner_pub: MasterPublicKeyP.t; - start_date: TimestampNBO.t; - end_date: TimestampNBO.t; - wad_frequency: TimeRelativeNBO.t; - wad_fee: AmountNBO.t; - h_url: Hash_64_cstr.t; - } -end - -module ReserveOpenPS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN *) - type t = { - reserve_payment: AmountNBO.t; - request_timestamp: TimestampNBO.t; - reserve_expiration: TimestampNBO.t; - purse_limit: int; - } -end - -module ReserveClosePS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *) - type t = { - request_timestamp: TimestampNBO.t; - target_account_h_payto: FullPaytoHash.t; - } -end - -module ReserveAttestRequestPS = struct - (* purpose.purpose = TALER_SIGNATURE_WALLET_ATTEST_REQUEST *) - type t = { - request_timestamp: TimestampNBO.t; - h_details: Hash_64_cstr.t; - } -end - -module ExchangeAttestPS = struct - (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_ATTEST_DETAILS *) - type t = { - attest_timestamp: TimestampNBO.t; - expiration_time: TimestampNBO.t; - reserve_pub: ReservePublicKeyP.t; - h_attributes: Hash_64_cstr.t; - } -end diff --git a/src/bin_type.ml b/src/bin_type.ml index 38d047b5..99a40dd0 100644 --- a/src/bin_type.ml +++ b/src/bin_type.ml @@ -41,7 +41,6 @@ *) module Taler_signatures = Include.Taler_signatures -open Crypto let int32_size = 4 let int64_size = 8 @@ -59,28 +58,29 @@ module Bytes_64 = struct end (* -- Time -- *) -module type Time_S = sig - type t = Timestamp.t - - val bin : t Bin.t -end - -module TIME : Time_S = struct +module TimeAbsolute = struct type t = Timestamp.t let bin = Timestamp.bin end -module TIME_NBO : Time_S = struct +module TimeAbsoluteNBO = struct type t = Timestamp.t let bin = Timestamp.bin_nbo end -module TimeAbsolute : Time_S = TIME -module TimeAbsoluteNBO : Time_S = TIME_NBO -module TimeRelative : Time_S = TIME -module TimeRelativeNBO : Time_S = TIME_NBO +module TimeRelative = struct + type t = Timestamp.Span.t + + let bin = Timestamp.Span.bin +end + +module TimeRelativeNBO = struct + type t = Timestamp.Span.t + + let bin = Timestamp.Span.bin_nbo +end (* -- Cryptographic primitives -- *) @@ -97,17 +97,23 @@ module Hash_32 = struct | true -> Digestif.SHA256.of_raw_string s let to_octets = Digestif.SHA256.to_raw_string + let of_b32 s = Result.map of_octets (B32.decode s) let bin = let open Bin in map (bytes 32) of_octets to_octets + (* hashes are not b32 encoded in the database *) let caqti : t Caqti_type.t = let open Caqti_type in custom ~encode:(fun v -> Ok (to_octets v)) ~decode:(fun v -> Ok (of_octets v)) octets + + let jsont = + let enc v = B32.encode (to_octets v) in + Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc end module Hash_64 = struct @@ -126,16 +132,23 @@ module Hash_64 = struct | false -> Fmt.failwith "Hash.to_octets failure: data is not 64 bytes" | true -> s + let of_b32 s = Result.map of_octets (B32.decode s) + let bin = let open Bin in map (bytes 64) of_octets to_octets + (* hashes are not b32 encoded in the database *) let caqti : t Caqti_type.t = let open Caqti_type in custom ~encode:(fun v -> Ok (to_octets v)) ~decode:(fun v -> Ok (of_octets v)) octets + + let jsont = + let enc v = B32.encode (to_octets v) in + Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc end (* Hash over string + '\0' *) @@ -160,9 +173,11 @@ module type Hash_S = sig val bin : t Bin.t val caqti : t Caqti_type.t + val jsont : t Jsont.t val hash : string -> t val of_octets : string -> t val to_octets : t -> string + val of_b32 : B32.t -> (t, string) result end module FullPaytoHash : Hash_S = Hash_32 @@ -228,42 +243,3 @@ module AgeMask = struct let open Bin in record (fun mask -> { mask }) |+ field beint32 (fun t -> t.mask) |> sealr end - -(* TODO keep this? - some of those are actuall ecdhe, or union of eddsa|ecdhe *) -module Aliases = struct - module TimestampNBO : Time_S = struct - type t = Timestamp.t - - let bin = Timestamp.bin_nbo - end - - module AmountNBO = struct - type t = Amount.t - - let bin = Amount.bin_nbo - end - - (* - 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/config.ml b/src/config.ml index e3c112ee..fd098af0 100644 --- a/src/config.ml +++ b/src/config.ml @@ -20,9 +20,13 @@ module Exchange = struct let port = get "port" |> int let bind_to = get "bind_to" let master_public_key = get "master_public_key" |> ed25519 + + (* TODO Defaults to 0.0 if not specified. *) let stefan_abs = get "stefan_abs" |> amount let stefan_log = get "stefan_log" |> amount - let stefan_lin = get_opt "stefan_lin" |> Option.map float + + let stefan_lin = + get_opt "stefan_lin" |> Option.map float |> Option.value ~default:0.0 let aggregator_idle_sleep_interval = get "aggregator_idle_sleep_interval" |> duration @@ -40,17 +44,16 @@ module Exchange = struct let enable_kyc = get "enable_kyc" |> yes_no let terms_etag = get "terms_etag" let privacy_etag = get "privacy_etag" + let base_url = get "base_url" + let shopping_url = get_opt "shopping_url" + let open_banking_gateway_url = get_opt "open_banking_gateway_url" + let bank_compliance_language = get_opt "bank_compliance_language" + let aml_spa_dialect = get_opt "aml_spa_dialect" + let toplevel_redirect_url = get_opt "toplevel_redirect_url" + let tiny_amount = get_opt "tiny_amount" |> Option.map amount - (* optional: - tiny_amount - shopping_url - open_banking_gateway_url - aml_spa_dialect - bank_compliance_language - toplevel_redirect_url *) (* not implemented or not relevant to MTE: let max_requests = get "max_requests" |> int - base_url aggregator_shard_size serve unixpath @@ -105,7 +108,8 @@ module Currency = struct fractional_normal_digits= get "fractional_normal_digits" |> int; fractional_trailing_zero_digits= get "fractional_trailing_zero_digits" |> int; - alt_unit_names= get "alt_unit_names" |> Parse_alt_unit_names.parse; + alt_unit_names= + get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap_res; } let all_currencies = List.map parse_currency currency_sections diff --git a/src/crypto.ml b/src/crypto.ml index 8fda65f3..c304962b 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -10,18 +10,32 @@ module EddsaPublicKey = struct type t = pub let to_octets t = pub_to_octets t - let of_octets t = pub_of_octets t |> Result.get_ok - let bin = Bin.map (Bin.bytes 32) of_octets to_octets + + let of_octets t = + pub_of_octets t |> function + | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e + | Ok v -> Ok v + + let bin = + let of_octets o = + match of_octets o with Error e -> raise (Util.Bin_error e) | Ok v -> v + in + Bin.map (Bin.bytes 32) of_octets to_octets let of_b32 s = let open Syntax in let* octets = B32.decode s in - match pub_of_octets octets with - | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e - | Ok pub -> Ok pub + let* pub = of_octets octets in + Ok pub let to_b32 t = B32.encode (to_octets t) let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32 + + let caqti = + Caqti_type.custom + ~encode:(fun v -> Ok (to_octets v)) + ~decode:(fun v -> of_octets v) + Caqti_type.octets end module EddsaPrivateKey = struct @@ -34,69 +48,88 @@ module EddsaPrivateKey = struct let pub_of_priv = pub_of_priv let to_octets t = priv_to_octets t - let of_octets t = priv_of_octets t |> Result.get_ok - let bin = Bin.map (Bin.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 of_octets t = + priv_of_octets t |> function + | Error err -> + let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in + Error err + | Ok v -> Ok v - let to_b32 t = B32.encode (to_octets t) - let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32 + let bin = + let of_octets_exn t = of_octets t |> Result.get_ok in + Bin.map (Bin.bytes 32) of_octets_exn to_octets + + let jsont = + let of_b32 s = + let open Syntax in + let* octets = B32.decode s in + of_octets octets + in + let to_b32 t = B32.encode (to_octets t) in + Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32 end module EddsaSignature : sig type t - val sign : key:Mirage_crypto_ec.Ed25519.priv -> string -> t - val sign_as_string : key:Mirage_crypto_ec.Ed25519.priv -> string -> string - val of_b32 : string -> (t, string) result - val to_b32 : t -> string + val sign : key:EddsaPrivateKey.t -> string -> t + + (* Ok () on verification success *) + val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result val to_octets : t -> string - val of_octets : string -> t + val of_octets : string -> (t, string) result val jsont : t Jsont.t val bin : t Bin.t + val caqti : t Caqti_type.t end = struct (* TODO key format endianess issue? *) - (* EdDSA signatures are transmitted as 64-bytes base32 - binary-encoded objects with just the R and S values (base32_ binary-only). - - They are signature over a c-struct like `TALER_xxxPS` + with a purpose *) + (* transmitted as 64-bytes base32 + binary-encoded objects with just the R and S values *) type t = string + (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *) + let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s + + let verify ~key s ~msg = + let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in + match b with + | false -> Error "signature verification failure: invalid signature" + | true -> Ok () + 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 + Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes." + | true -> Ok v - let bin = Bin.map (Bin.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 - - let sign_as_string ~key s = sign ~key s + let bin = + let of_octets_exn t = of_octets t |> Result.get_ok in + Bin.map (Bin.bytes 64) of_octets_exn to_octets let check_size t = match String.length t = 64 with | false -> Error "EddsaSignature: invalid string length" | true -> Ok () - let of_b32 s = - let open Syntax in - let* t = B32.decode s in - let+ () = check_size t in - t + let jsont = + let of_b32 s = + let open Syntax in + let* t = B32.decode s in + let+ () = check_size t in + t + in + let to_b32 = B32.encode in + Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32 - let to_b32 = B32.encode - let jsont = Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32 + let caqti = + Caqti_type.custom + ~encode:(fun v -> Ok (to_octets v)) + ~decode:(fun s -> of_octets s) + Caqti_type.octets end module RsaPublicKey = struct @@ -104,18 +137,24 @@ module RsaPublicKey = struct type t = Rsa.pub - let of_octets = Util.Bin_rsa.pub_of_octets let to_octets = Util.Bin_rsa.pub_to_octets + let of_octets = Util.Bin_rsa.pub_of_octets - let of_b32 s = - let open Syntax in - let* s = B32.decode s in - let v = Util.Bin_rsa.pub_of_octets s in - let+ v = Rsa.pub ~n:v.n ~e:v.e |> unwrap_err_msg in - v + let jsont = + let of_b32 s = + let open Syntax in + let* s = B32.decode s in + let+ v = of_octets s in + v + in + let to_b32 t = B32.encode (to_octets t) in + Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32 - let to_b32 t = B32.encode (to_octets t) - let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32 + let caqti : t Caqti_type.t = + Caqti_type.custom + ~encode:(fun v -> Ok (to_octets v)) + ~decode:(fun v -> of_octets v) + Caqti_type.octets end module RsaPrivateKey = struct @@ -123,37 +162,49 @@ module RsaPrivateKey = struct type t = priv + let generate ~bits () = + let priv = generate ~bits () in + let pub = pub_of_priv priv in + (priv, pub) + let pub_of_priv = pub_of_priv let of_octets = Util.Bin_rsa.priv_of_octets let to_octets = Util.Bin_rsa.priv_to_octets - let of_b32 s = - let open Syntax in - let* s = B32.decode s in - Ok (of_octets s) - - let to_b32 t = B32.encode (to_octets t) - let jsont = Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32 + let jsont = + let of_b32 s = + let open Syntax in + let* s = B32.decode s in + let+ v = of_octets s in + v + in + let to_b32 t = B32.encode (to_octets t) in + Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32 end module RsaSignature : sig type t - val to_octets : t -> string val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t - val of_b32 : string -> (t, string) result - val to_b32 : t -> string val jsont : t Jsont.t end = struct type t = string - let to_octets t = t - (* TODO rsa sign *) let sign ~key s = Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s - let of_b32 s = B32.decode s - let to_b32 t = B32.encode t - let jsont = Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32 + let jsont = + let of_b32 s = B32.decode s in + let to_b32 t = B32.encode t in + Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32 end + +(* some type aliases, just for prettier .mli *) +type eddsa_priv = EddsaPrivateKey.t +type eddsa_pub = EddsaPublicKey.t +type eddsa_sig = EddsaSignature.t +type rsa_priv = RsaPrivateKey.t +type rsa_pub = RsaPublicKey.t +type rsa_sig = RsaSignature.t +type denomination_hash = Bin_type.DenominationHash.t diff --git a/src/data_file.ml b/src/data_file.ml index 125f6f9a..9fa34674 100644 --- a/src/data_file.ml +++ b/src/data_file.ml @@ -3,91 +3,33 @@ open Syntax open Crypto let read fname = - let* b = File.exists fname in + let* b = File.exists fname |> Syntax.unwrap_err_msg in match b with | false -> Ok None | true -> - let+ content = File.read fname in + let+ content = File.read fname |> Syntax.unwrap_err_msg in Some content +let write_eddsa fname priv = + EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg + +let write_rsa fname priv = + RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg + let read_eddsa fname = - let+ content_opt = read fname in - Option.map EddsaPrivateKey.of_octets content_opt + let* opt = read fname in + match opt with + | None -> Ok None + | Some data -> ( + EddsaPrivateKey.of_octets data |> function + | Error e -> Error e + | Ok v -> Ok (Some v)) let read_rsa fname = - let+ content_opt = read fname in - Option.map RsaPrivateKey.of_octets content_opt - -let write_eddsa fname priv = EddsaPrivateKey.to_octets priv |> File.write fname -let write_rsa fname priv = RsaPrivateKey.to_octets priv |> File.write fname - -let load_signkey conn fname = - let* opt = read_eddsa fname in + let* opt = read fname in match opt with | None -> Ok None - | Some priv -> ( - let pub = EddsaPrivateKey.pub_of_priv priv in - let* opt = Pg.lookup_signing_key conn pub in - match opt with - | None -> - Fmt.error_msg - "load_signkey error no associated metadata found in database for \ - signkey `%s`." - (Fpath.to_string fname) - | Some (stamp_start, stamp_expire, stamp_end) -> - (* TODO master_sig *) - let master_sig = None in - let v = - Signkey. - { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig } - in - Ok (Some v)) - -let load_denom conn ~section_name fname = - let* opt = read_rsa fname in - match opt with - | None -> Ok None - | Some priv -> ( - let pub = RsaPrivateKey.pub_of_priv priv in - let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in - let* opt = Pg.lookup_denomination_key conn h_pub in - match opt with - | None -> - Fmt.error_msg - "load_denom error no associated metadata found in database for \ - denom `%s`." - (Fpath.to_string fname) - | Some - ( stamp_start, - stamp_expire_withdraw, - stamp_expire_deposit, - stamp_expire_legal, - value, - fee_withdraw, - fee_deposit, - fee_refresh, - fee_refund, - age_mask ) -> - (* TODO master_sig *) - let master_sig = None in - let v = - Denomination. - { - pub; - priv; - section_name; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask; - h_pub; - master_sig; - } - in - Ok (Some v)) + | Some data -> ( + RsaPrivateKey.of_octets data |> function + | Error e -> Error e + | Ok v -> Ok (Some v)) diff --git a/src/database.ml b/src/database.ml deleted file mode 100644 index 07f5661e..00000000 --- a/src/database.ml +++ /dev/null @@ -1,33 +0,0 @@ -(* TODO - - GNU Taler db-events? - it seems caqti/pgx does not support it *) - -let on_ok req () = - let open Vif.Response.Syntax in - let* () = - Vif.Response.add ~field:"content-type" "text/plain; charset= utf-8" - in - let* () = - Vif.Response.with_string req (Fmt.str "activate_signing_key done~~@.") - in - Vif.Response.respond `OK - -let on_error req err = - (* TODO be sure to not leak private data in error messages *) - let open Vif.Response.Syntax in - let str = Fmt.str "Database error: %a." Caqti_error.pp err in - Logs.err (fun m -> m "%s" str); - let* () = Vif.Response.with_string req str in - Vif.Response.respond `Internal_server_error - -(* TODO master_sig *) -let dummy_master_sig = - Option.some @@ Crypto.EddsaSignature.of_octets (String.make 64 '\x00') - -let test_activate req server _ = - let db_conn = Vif.Server.device Devices.db_connection server in - let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in - let sm_key = secmod_signkey.sm_key in - let sm_key = { sm_key with master_sig= dummy_master_sig } in - let res = Pg.activate_signing_key db_conn sm_key in - Result.fold ~ok:(on_ok req) ~error:(on_error req) res diff --git a/src/denom_data.ml b/src/denom_data.ml new file mode 100644 index 00000000..c9cb8615 --- /dev/null +++ b/src/denom_data.ml @@ -0,0 +1,18 @@ +open Crypto + +type t = { + pub: rsa_pub; + value: Amount.t; + stamp_start: Timestamp.t; + stamp_expire_withdraw: Timestamp.t; + stamp_expire_deposit: Timestamp.t; + stamp_expire_legal: Timestamp.t; + fee_withdraw: Amount.t; + fee_deposit: Amount.t; + fee_refresh: Amount.t; + fee_refund: Amount.t; + age_mask: int; + h_pub: denomination_hash; + master_sig: Bin_sig.DenominationKeyValidity.t option; + revoked_sig: Bin_sig.MasterDenominationKeyRevocation.t option; +} diff --git a/src/denomination.ml b/src/denomination.ml deleted file mode 100644 index 32eb469d..00000000 --- a/src/denomination.ml +++ /dev/null @@ -1,71 +0,0 @@ -open Crypto - -type t = { - pub: RsaPublicKey.t; - priv: RsaPrivateKey.t; - section_name: string; - value: Amount.t; - stamp_start: Timestamp.t; - stamp_expire_withdraw: Timestamp.t; - stamp_expire_deposit: Timestamp.t; - stamp_expire_legal: Timestamp.t; - fee_withdraw: Amount.t; - fee_deposit: Amount.t; - fee_refresh: Amount.t; - fee_refund: Amount.t; - age_mask: int; - h_pub: Bin_type.DenominationHash.t; - master_sig: EddsaSignature.t option; -} - -let make - ({ - section_name; - value; - duration_withdraw; - duration_spend; - duration_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - cipher; - rsa_keysize; - age_restricted= _; - } : - Config.Coin.t) = - assert (cipher = `RSA); - - let stamp_start = Ptime_clock.now () |> Option.some in - let stamp_expire_withdraw = - Timestamp.add_span_exn stamp_start (Some duration_withdraw) - in - let stamp_expire_deposit = - Timestamp.add_span_exn stamp_start (Some duration_spend) - in - let stamp_expire_legal = - Timestamp.add_span_exn stamp_start (Some duration_legal) - in - - let open Mirage_crypto_pk.Rsa in - let priv = generate ~bits:rsa_keysize () in - let pub = pub_of_priv priv in - let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in - let master_sig = None in - { - pub; - priv; - section_name; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask= 0; - h_pub; - master_sig; - } diff --git a/src/devices.ml b/src/devices.ml index 34538354..7da26428 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -1,5 +1,3 @@ -open Syntax - type env = { caqti_switch: Caqti_miou.Switch.t; db_uri: Uri.t; @@ -20,129 +18,9 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device = Logs.info (fun m -> m "database connection initialized"); conn) -module Secmod_signkey = struct - (* TODO - - key rotation - - how many signkey to use? - we just use 1 for now *) - type t = { - sm_key: Signkey.t; - keys: Signkey.t list; - } - - let dir = Fpath.(v "data" / "secmod_signkey") - - let store_secmod_data t = - let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in - t.keys - |> List.mapi (fun i key -> - let fname = Fpath.(dir / string_of_int i) in - (fname, key.Signkey.priv)) - |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key) - - let load conn = - let error_invalid_state = - Fmt.error_msg "secmod_signkey load error: invalid store state." - in - let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in - let* keys = - let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in - let* l = - Syntax.list_map (fun fname -> Data_file.load_signkey conn fname) l - in - match Syntax.opt_list l with - | Error () -> error_invalid_state - | Ok opt -> Ok opt - in - match (sm_key, keys) with - | None, None -> Ok None - | Some sm_key, Some keys -> Ok (Some { sm_key; keys }) - | _, _ -> error_invalid_state - - let generate_fresh_secmod_data () = - let sm_key = Signkey.generate () in - let keys = [ Signkey.generate () ] in - { sm_key; keys } - - let v = - let finally _key = () in - Vif.Device.v ~name:"secmod_signkey" ~finally - [ Vif.Device.value db_connection ] - @@ fun conn (_env : env) -> - match load conn with - | Ok None -> - let t = generate_fresh_secmod_data () in - Logs.info (fun m -> m "secmod_signkey initialized with fresh keys"); - t - | Ok (Some v) -> - Logs.info (fun m -> m "secmod_signkey initialized from storage"); - v - | Error _ -> - (* TODO error: pretty print *) - Fmt.failwith "secmod_signkey init failure." -end - -module Secmod_denom = struct - type t = { - sm_key: Signkey.t; - keys: Denomination.t list; - } - - let dir = Fpath.(v "data" / "secmod_signkey") - - let store_secmod_data t = - let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in - t.keys - |> List.mapi (fun i key -> - let fname = Fpath.(dir / string_of_int i) in - (fname, key.Denomination.priv)) - |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key) - - let load conn = - let error_invalid_state = - Fmt.error_msg "secmod_denom load error: invalid store state." - in - let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in - let* keys = - let* l = - let open Config.Coin in - Syntax.list_map - (fun coin -> - let section_name = coin.section_name in - let fname = Fpath.(dir / section_name) in - (* todo: could check that coin config match db values *) - Data_file.load_denom conn ~section_name fname) - all_coins - in - match Syntax.opt_list l with - | Error () -> error_invalid_state - | Ok opt -> Ok opt - in - match (sm_key, keys) with - | None, None -> Ok None - | Some sm_key, Some keys -> Ok (Some { sm_key; keys }) - | _, _ -> error_invalid_state - - let generate_fresh_secmod_data () = - let sm_key = Signkey.generate () in - let keys = List.map Denomination.make Config.Coin.all_coins in - { sm_key; keys } - - let v = - let finally _key = () in - Vif.Device.v ~name:"secmod_denom" ~finally - [ Vif.Device.value db_connection ] - @@ fun conn (_env : env) -> - match load conn with - | Ok None -> - let t = generate_fresh_secmod_data () in - Logs.info (fun m -> m "secmod_denom initialized with fresh keys"); - t - | Ok (Some v) -> - Logs.info (fun m -> m "secmod_denom initialized from storage"); - v - | Error _ -> Fmt.failwith "secmod_denom init failure." -end - -let secmod_signkey = Secmod_signkey.v -let secmod_denom = Secmod_denom.v +let secmod = + let finally _key = () in + Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ] + @@ fun (module Conn : Pg.CONN) (_env : env) -> + let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in + sm diff --git a/src/http_keys.ml b/src/http_keys.ml new file mode 100644 index 00000000..58e58594 --- /dev/null +++ b/src/http_keys.ml @@ -0,0 +1,266 @@ +open Syntax +open Api +module String_map = Stdlib.Map.Make (Stdlib.String) + +(* TODO + for now we only have one item in each "denom group" + change this once we have denom/signkey rotation *) +let denomgroup_of_denomdata + Denom_data. + { + pub; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask= _; + h_pub= _; + master_sig; + revoked_sig= _; + } = + let master_sig = match master_sig with None -> assert false | Some v -> v in + let denoms = + [ + RsaDenom. + { + rsa_pub= pub; + master_sig; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + lost= None; + }; + ] + in + DenomGroup.Rsa + RsaDenomGroup. + { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund } + +let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = + let version = "0" in + let base_url = Config.base_url in + let currency = Config.currency in + let shopping_url = Config.shopping_url in + let open_banking_gateway = Config.open_banking_gateway_url in + let bank_compliance_language = Config.bank_compliance_language in + let currency_specification = + let v = Config.Currency.v in + let alt_unit_names = + Parse_config.Alt_unit_names.encode_exn v.alt_unit_names + in + CurrencySpecification. + { + name= v.name; + num_fractional_input_digits= v.fractional_input_digits; + num_fractional_normal_digits= v.fractional_normal_digits; + num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits; + alt_unit_names; + common_amounts= []; + } + in + let tiny_amount = Config.tiny_amount in + let stefan_abs = Config.stefan_abs in + let stefan_log = Config.stefan_log in + let stefan_lin = Config.stefan_lin in + (* todo asset_type + Type of the asset. "fiat", "crypto", "regional" or "stock". *) + let asset_type = "xxx" in + let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in + let* wire_fees = + (* todo + where does wire_methods comes from? *) + let wire_method = "xxx" in + let+ wire_fees = + Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti + in + String_map.singleton wire_method wire_fees + in + let wads = + (* TODO wads *) + [] + in + let rewards_allowed = false in + let kyc_enabled = false in + let disable_direct_deposit = (* todo *) false in + let master_public_key = Config.master_public_key in + let reserve_closing_delay = + Some Config.Exchangedb.idle_reserve_expiration_time + in + (* todo *) + let wallet_balance_limit_without_kyc = None in + let hard_limits = [] in + let zero_limits = [] in + let denom_data_l = + (* TODO sm-db *) + (*Pg.get_denominations db_conn |> unwrap_err_caqti *) + Sm.get_denoms_data () + in + let denom_data_l = + (* reverse chronological order *) + List.sort + (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start) + denom_data_l + in + let list_issue_date = + match denom_data_l with [] -> None | v :: _ -> v.Denom_data.stamp_start + in + let denominations = + let open Denom_data in + (* TODO time + truncated timestamps to int for comparison *) + let timestamp_to_int = function + | None -> 0 + | Some ptime -> ptime |> Ptime.to_float_s |> Int.of_float + in + (* if `?last_issue_date` query param does not exactly match the `stamp_start` + of one of the denomination keys, all keys are returned *) + let l = + match last_issue_date with + | None -> denom_data_l + | Some last_issue_date -> ( + match + List.find_opt + (fun v -> timestamp_to_int v.stamp_start = last_issue_date) + denom_data_l + with + | None -> denom_data_l + | Some _ -> + List.filter + (fun v -> timestamp_to_int v.stamp_start >= last_issue_date) + denom_data_l) + in + List.map denomgroup_of_denomdata l + in + + let signkeys = + (* TODO sm-db + use database signkey data / verify secmod and database are in sync *) + (*let+ signkey_data_l = Pg.get_active_signkeys db_conn |> unwrap_err_caqti in*) + let signkey_data_l = Sm.get_signkeys_data () in + let signkey_data_l = + List.sort + (fun a b -> + let open Signkey_data in + Stdlib.compare b.stamp_start a.stamp_start) + signkey_data_l + in + List.filter_map + (fun Signkey_data. + { + pub; + stamp_start; + stamp_expire; + stamp_end; + master_sig; + revoked_sig= _; + } -> + match master_sig with + | None -> None + | Some master_sig -> + Some + SignKey. + { key= pub; stamp_start; stamp_expire; stamp_end; master_sig }) + signkey_data_l + in + + let exchange_pub = + (* the eddsa pub key used to sign exchange_sig *) + match signkeys with + | [] -> Fmt.failwith "exchange has no active signkey" + | v :: _ -> v.SignKey.key + in + let exchange_sig = + (* Compact EdDSA signature (binary-only) over the + contatentation of all of the master_sigs (in reverse + chronological order by group) in the arrays under "denominations". *) + let hc = + denom_data_l + |> List.filter_map (fun v -> v.Denom_data.master_sig) + |> List.map Bin_sig.DenominationKeyValidity.to_octets + |> String.concat "" + |> Bin_type.Hash_64.hash + in + let open Bin_sig.ExchangeKeySet in + sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc } + in + + let recoup = (* TODO /recoup *) [] in + let* global_fees = + Pg.get_global_fees db_conn ~start_date:Timestamp.epoch |> unwrap_err_caqti + in + let* auditors = + (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) + (* does not contains auditor_keys with empty denomination_keys *) + Pg.get_auditor_keys db_conn + in + let extensions = None in + let extensions_sig = None in + Ok + ExchangeKeysResponse. + { + version; + base_url; + currency; + shopping_url; + open_banking_gateway; + bank_compliance_language; + currency_specification; + tiny_amount; + stefan_abs; + stefan_log; + stefan_lin; + asset_type; + accounts; + wire_fees; + wads; + rewards_allowed; + kyc_enabled; + disable_direct_deposit; + master_public_key; + reserve_closing_delay; + wallet_balance_limit_without_kyc; + hard_limits; + zero_limits; + denominations; + exchange_sig; + exchange_pub; + recoup; + global_fees; + list_issue_date; + auditors; + signkeys; + extensions; + extensions_sig; + } + +let jsont = ExchangeKeysResponse.jsont + +(* TODO query param ?last_issue_date *) +let f req server _env = + Logs.info (fun m -> m "GET /keys/"); + let db_conn = Vif.Server.device Devices.db_connection server in + let sm = Vif.Server.device Devices.secmod server in + let last_issue_date = + match Vif.Queries.get req "last_issue_date" with + | [] -> None + | v :: _ -> ( + (* TODO time *) + match float_of_string_opt v with + | None -> + Fmt.failwith + "invalid `?last_issue_date` query param, float_of_string failure" + | Some v -> Some (Int.of_float v)) + in + let res = + (*let last_issue_date = Ptime_clock.now () |> Option.some in*) + let* v = mk_keys ~db_conn sm ~last_issue_date in + let s = Api.encode_exn jsont v in + Ok s + in + Respond_util.respond_with_res res req diff --git a/src/http_management.ml b/src/http_management.ml new file mode 100644 index 00000000..dce80c96 --- /dev/null +++ b/src/http_management.ml @@ -0,0 +1,752 @@ +open Syntax +open Api + +module Keys_get = struct + let mk_future_denom (module Sm : Secmod.S) ~section_name + ({ + pub; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask; + h_pub; + master_sig= _; + revoked_sig= _; + } : + Denom_data.t) = + let denom_pub = + DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub } + in + let denom_secmod_sig = + let open Bin_sig.DenominationKeyAnnouncement in + let h_denom_pub = h_pub in + let h_section_name = Bin_type.Hash_64_cstr.hash section_name in + let anchor_time = stamp_start in + let duration_withdraw = + Timestamp.diff stamp_start stamp_expire_withdraw + in + sign_f ~f:Sm.sign_with_sm_key + { h_denom_pub; h_section_name; anchor_time; duration_withdraw } + in + FutureDenom. + { + section_name; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + denom_pub; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + denom_secmod_sig; + } + + let mk_future_signkey (module Sm : Secmod.S) + ({ + pub; + stamp_start; + stamp_expire; + stamp_end; + master_sig= _; + revoked_sig= _; + } : + Signkey_data.t) = + let signkey_secmod_sig = + let open Bin_sig.SigningKeyAnnouncement in + let exchange_pub = pub in + let anchor_time = stamp_start in + let duration = Timestamp.diff stamp_start stamp_expire in + sign_f ~f:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration } + in + FutureSignKey. + { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } + + let mk_future_keys_response (module Sm : Secmod.S) = + let future_signkeys = + Sm.get_signkeys_data () + |> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig) + |> List.map (fun signkey -> mk_future_signkey (module Sm) signkey) + in + let future_denoms = + Sm.get_denoms_data () + |> List.filter (fun k -> Option.is_none k.Denom_data.master_sig) + |> List.map (fun dn_data -> + let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in + match opt with + | None -> Fmt.failwith "section_name not found." + | Some section_name -> + mk_future_denom (module Sm) ~section_name dn_data) + in + let master_pub = Config.Exchange.master_public_key in + let denom_secmod_public_key = Sm.get_sm_key_pub () in + let signkey_secmod_public_key = Sm.get_sm_key_pub () in + FutureKeysResponse. + { + future_denoms; + future_signkeys; + master_pub; + denom_secmod_public_key; + signkey_secmod_public_key; + } + + let jsont = FutureKeysResponse.jsont + + let f req server _env = + Logs.info (fun m -> m "GET /management/keys/"); + let sm = Vif.Server.device Devices.secmod server in + let res = + let v = mk_future_keys_response sm in + let s = Api.encode_exn jsont v in + Ok s + in + Respond_util.respond_with_res res req +end + +module Keys_post = struct + let verify_denom_signature (module Sm : Secmod.S) + DenomSignature.{ h_denom_pub; master_sig } = + let* denom = + match Sm.find_denom_data h_denom_pub with + | None -> + Fmt.error + "404 not found, One of the keys for which a signature was provided \ + is unknown to the exchange." + | Some denom -> Ok denom + in + let open Bin_sig.DenominationKeyValidity in + let r : r = + { + master= Config.master_public_key; + start= denom.stamp_start; + expire_withdraw= denom.stamp_expire_withdraw; + expire_spend= denom.stamp_expire_deposit; + expire_legal= denom.stamp_expire_legal; + value= denom.value; + fee_withdraw= denom.fee_withdraw; + fee_deposit= denom.fee_deposit; + fee_refresh= denom.fee_refresh; + denom_hash= h_denom_pub; + } + in + verify_f ~f:Sm.verify_with_master_key master_sig r + + let verify_signkey_signature (module Sm : Secmod.S) + SignKeySignature.{ key; master_sig } = + let* signkey = + match Sm.find_signkey_data key with + | None -> + Fmt.error + "404 not found, One of the keys for which a signature was provided \ + is unknown to the exchange." + | Some signkey -> Ok signkey + in + let open Bin_sig.ExchangeSigningKeyValidity in + let r : r = + { + start= signkey.stamp_start; + expire= signkey.stamp_expire; + end_= signkey.stamp_end; + signkey_pub= signkey.pub; + } + in + verify_f ~f:Sm.verify_with_master_key master_sig r + + let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } = + let* () = list_iter (verify_denom_signature sm) denom_sigs in + let* () = list_iter (verify_signkey_signature sm) signkey_sigs in + Ok () + + (* TODO move to test *) + let check_master_signatures_update ~db_conn (module Sm : Secmod.S) = + Sm.get_denoms_data () + |> list_iter (fun denom -> + let error = Error "update_master_signatures sanity check failure" in + let* opt = + Pg.find_denom db_conn denom.Denom_data.h_pub |> unwrap_err_caqti + in + let* v = match opt with None -> error | Some v -> Ok v in + let check = function false -> error | true -> Ok () in + let* () = + check (Timestamp.compare v.stamp_start denom.stamp_start = Some 0) + in + let* () = check (v.value = denom.value) in + let* () = check (v.fee_refund = denom.fee_refund) in + let* () = check (v.age_mask = denom.age_mask) in + Ok ()) + + let do_ ~db_conn (module Sm : Secmod.S) + MasterSignatures.{ denom_sigs; signkey_sigs } = + let* () = + signkey_sigs + |> List.map (fun SignKeySignature.{ key; master_sig } -> + (key, master_sig)) + |> Sm.add_signkey_master_signatures + in + let* () = + denom_sigs + |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } -> + (h_denom_pub, master_sig)) + |> Sm.add_denom_master_signatures + in + let* () = Sm.store () in + let* () = check_master_signatures_update ~db_conn (module Sm) in + Ok () + + let jsont = MasterSignatures.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/keys/"); + let db_conn = Vif.Server.device Devices.db_connection server in + let sm = Vif.Server.device Devices.secmod server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn sm v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Denom_revoke = struct + let verify (module Sm : Secmod.S) h_denom_pub + DenomRevocationSignature.{ master_sig } = + let open Bin_sig.MasterDenominationKeyRevocation in + verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub } + + let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub + DenomRevocationSignature.{ master_sig } = + let* () = Sm.revoke_denomination h_denom_pub master_sig in + let+ () = + Pg.insert_denomination_revocation db_conn h_denom_pub master_sig + |> unwrap_err_caqti + in + () + + let jsont = DenomRevocationSignature.jsont + + let f req h_denom_pub server _env = + Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); + let db_conn = Vif.Server.device Devices.db_connection server in + let sm = Vif.Server.device Devices.secmod server in + let res = + let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm h_denom_pub v in + let* () = do_ ~db_conn sm h_denom_pub v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Signkey_revoke = struct + let verify (module Sm : Secmod.S) exchange_pub + SignkeyRevocationSignature.{ master_sig } = + let open Bin_sig.MasterSigningKeyRevocation in + verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub } + + let do_ ~db_conn (module Sm : Secmod.S) exchange_pub + SignkeyRevocationSignature.{ master_sig } = + let* () = Sm.revoke_signkey exchange_pub master_sig in + let+ () = + Pg.insert_signkey_revocation db_conn exchange_pub master_sig + |> unwrap_err_caqti + in + () + + let jsont = SignkeyRevocationSignature.jsont + + let f req exchange_pub server _env = + Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); + let db_conn = Vif.Server.device Devices.db_connection server in + let sm = Vif.Server.device Devices.secmod server in + let res = + let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm exchange_pub v in + let* () = do_ ~db_conn sm exchange_pub v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Auditors = struct + let verify (module Sm : Secmod.S) + AuditorSetupMessage. + { + auditor_url; + auditor_name= _; + auditor_pub; + master_sig; + validity_start; + } = + let open Bin_sig.MasterAddAuditor in + verify_f ~f:Sm.verify_with_master_key master_sig + { + start_date= validity_start; + auditor_pub; + h_auditor_url= Bin_type.Hash_64_cstr.hash auditor_url; + } + + (* TODO timestamps last_change +/- checks *) + (* todo: there is something about use of monotonic time + + protection against replay attack that I don't understand *) + let do_ ~db_conn v = + let auditor_pub = v.AuditorSetupMessage.auditor_pub in + let validity_start = v.AuditorSetupMessage.validity_start in + let* last_date_opt = + Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti + in + match last_date_opt with + | None -> + let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in + Logs.info (fun m -> m "enabled auditor"); + () + | Some last_date -> + let cmp = Timestamp.compare last_date validity_start |> Option.get in + if cmp > 0 then + Error + "database has more recent auditor data for this auditor public key" + else + let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in + Logs.info (fun m -> m "updated auditor"); + () + + let jsont = AuditorSetupMessage.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/auditors/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Auditors_disable = struct + let verify (module Sm : Secmod.S) auditor_pub + AuditorTeardownMessage.{ master_sig; validity_end } = + let open Bin_sig.MasterDelAuditor in + verify_f ~f:Sm.verify_with_master_key master_sig + { end_date= validity_end; auditor_pub } + + let do_ ~db_conn auditor_pub + AuditorTeardownMessage.{ master_sig= _; validity_end } = + let* last_date_opt = + Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti + in + match last_date_opt with + | None -> Error "auditor not found" + | Some last_date -> + let cmp = Timestamp.compare last_date validity_end |> Option.get in + if cmp > 0 then + Error + "database has more recent auditor data for this auditor public key" + else + let+ () = + Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end + |> unwrap_err_caqti + in + () + + let jsont = AuditorTeardownMessage.jsont + + let f req auditor_pub server _env = + Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm auditor_pub v in + let* () = do_ ~db_conn auditor_pub v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Wire_fee = struct + let verify (module Sm : Secmod.S) + WireFeeSetupMessage. + { + wire_method; + master_sig_wire; + fee_start; + fee_end; + closing_fee; + wire_fee; + } = + let open Bin_sig.MasterWireFee in + verify_f ~f:Sm.verify_with_master_key master_sig_wire + { + h_wire_method= Bin_type.Hash_64_cstr.hash wire_method; + start_date= fee_start; + end_date= fee_end; + wire_fee; + closing_fee; + } + + let do_ ~db_conn (v : WireFeeSetupMessage.t) = + let* wire_fees = + Pg.get_wire_fees_by_time db_conn ~wire_method:v.wire_method + ~start_date:v.fee_start ~end_date:v.fee_end + |> unwrap_err_caqti + in + match wire_fees with + | [] -> + let+ () = Pg.insert_wire_fee db_conn v |> unwrap_err_caqti in + Logs.info (fun m -> m "added wire fee"); + () + | [ vv ] -> ( + match v.master_sig_wire = vv.sig_ with + | false -> + Error "a different wire-fee was already setup for this time frame" + | true -> + Logs.info (fun m -> m "an identical wire-fee was already setup"); + Ok ()) + | _ -> + Error + "invalid database state, multiple wire-fee found in database for \ + this time frame" + + let jsont = WireFeeSetupMessage.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/wire-fee/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Global_fees = struct + let verify (module Sm : Secmod.S) + GlobalFees. + { + start_date; + end_date; + history_fee; + account_fee; + purse_fee; + history_expiration; + purse_account_limit; + purse_timeout; + master_sig; + } = + (* TODO KYC + what is kyc_timeout, kyc_fee ? *) + let kyc_timeout = None in + let kyc_fee = Amount.dummy_value in + (* * *) + let open Bin_sig.GlobalFees in + verify_f ~f:Sm.verify_with_master_key master_sig + { + start_date; + end_date; + purse_timeout; + kyc_timeout; + history_expiration; + history_fee; + kyc_fee; + account_fee; + purse_fee; + purse_account_limit; + } + + let do_ ~db_conn v = + let* global_fees = + let start_date = v.GlobalFees.start_date in + let end_date = v.GlobalFees.end_date in + Pg.get_global_fees_by_time db_conn ~start_date ~end_date + |> unwrap_err_caqti + in + match global_fees with + | [] -> + let+ () = Pg.insert_global_fees db_conn v |> unwrap_err_caqti in + Logs.info (fun m -> m "added global fees"); + () + | [ vv ] -> ( + match v.master_sig = vv.master_sig with + | false -> + Error + "a different global-fees was already setup for this time frame" + | true -> + Logs.info (fun m -> m "an identical global-fees was already setup"); + Ok ()) + | _ -> + Error + "invalid database state, multiple global-fees found in database for \ + this time frame" + + let jsont = GlobalFees.jsont + + (* TODO global_fees + ensure it is defined for the current time. + there should be only one global_fees for each moment in time + and once set for a timeframe, it should not change. *) + let f req server _env = + Logs.info (fun m -> m "POST /management/global-fees/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Wire = struct + let verify (module Sm : Secmod.S) + WireSetupMessage. + { + payto_uri; + master_sig_wire; + master_sig_add; + validity_start; + bank_label= _; + priority= _; + } = + (* TODO wire *) + let conversion_url = "" in + let credit_restrictions = "" in + let debit_restrictions = "" in + let open Bin_type in + let* () = + let open Bin_sig.MasterWireDetails in + verify_f ~f:Sm.verify_with_master_key master_sig_wire + { + h_wire_details= FullPaytoHash.hash payto_uri; + h_conversion_url= Hash_64_cstr.hash conversion_url; + h_credit_restrictions= Hash_64_cstr.hash credit_restrictions; + h_debit_restrictions= Hash_64_cstr.hash debit_restrictions; + } + in + let* () = + let open Bin_sig.MasterAddWire in + verify_f ~f:Sm.verify_with_master_key master_sig_add + { + start_date= validity_start; + h_wire= FullPaytoHash.hash payto_uri; + h_conversion_url= Hash_64_cstr.hash conversion_url; + h_credit_restrictions= Hash_64_cstr.hash credit_restrictions; + h_debit_restrictions= Hash_64_cstr.hash debit_restrictions; + } + in + Ok () + + let do_ ~db_conn v = + let* last_change_opt = + let payto_uri = v.WireSetupMessage.payto_uri in + Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti + in + match last_change_opt with + | Some _ -> Error "wire already setup" + | None -> + (* TODO wire *) + let last_change = Ptime_clock.now () |> Option.some in + let v = + ExchangeWireAccount. + { + payto_uri= v.payto_uri; + conversion_url= None; + debit_restrictions= []; + credit_restrictions= []; + master_sig= v.master_sig_wire; + bank_label= v.bank_label; + priority= v.priority; + } + in + let+ () = Pg.insert_wire db_conn ~last_change v |> unwrap_err_caqti in + () + + let jsont = WireSetupMessage.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/wire/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Wire_disable = struct + let verify (module Sm : Secmod.S) + WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } = + let open Bin_sig.MasterDelWire in + verify_f ~f:Sm.verify_with_master_key master_sig_del + { end_date= validity_end; h_wire= Bin_type.FullPaytoHash.hash payto_uri } + + let do_ ~db_conn + WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } = + let* last_change_opt = + Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti + in + match last_change_opt with + | None -> Error "wire not found" + | Some _ -> + let+ () = + Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti + in + () + + let jsont = WireTeardownMessage.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/wire/disable/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Drain = struct + let verify (module Sm : Secmod.S) + DrainProfitsMessage. + { + debit_account_section; + credit_payto_uri; + wtid; + master_sig; + date; + amount; + } = + let open Bin_sig.MasterDrainProfit in + let open Bin_type in + verify_f ~f:Sm.verify_with_master_key master_sig + { + wtid; + date; + amount; + h_section= Hash_64_cstr.hash debit_account_section; + h_payto= FullPaytoHash.hash credit_payto_uri; + } + + let do_ ~db_conn v = + let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in + () + + let jsont = DrainProfitsMessage.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/drain/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module AmlOfficer = struct + let verify (module Sm : Secmod.S) + AmlOfficerSetup. + { + officer_pub; + officer_name; + is_active; + read_only= _; + master_sig; + change_date; + } = + let open Bin_sig.MasterAmlOfficerStatus in + let is_active = match is_active with true -> 1_l | false -> 0_l in + verify_f ~f:Sm.verify_with_master_key master_sig + { + change_date; + officer_pub; + h_officer_name= Bin_type.Hash_64_cstr.hash officer_name; + is_active; + } + + let do_ ~db_conn v = + let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_err_caqti in + () + + let jsont = AmlOfficerSetup.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/aml-officers/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end + +module Partners = struct + let verify (module Sm : Secmod.S) + ExchangePartnerSetupRequest. + { + partner_base_url; + partner_pub; + wad_frequency; + master_sig; + start_date; + end_date; + wad_fee; + } = + let open Bin_sig.PartnerConfiguration in + verify_f ~f:Sm.verify_with_master_key master_sig + { + partner_pub; + start_date; + end_date; + wad_frequency; + wad_fee; + h_url= Bin_type.Hash_64_cstr.hash partner_base_url; + } + + let do_ ~db_conn v = + let+ () = Pg.insert_partner db_conn v |> unwrap_err_caqti in + () + + let jsont = ExchangePartnerSetupRequest.jsont + + let f req server _env = + Logs.info (fun m -> m "POST /management/partners/"); + let sm = Vif.Server.device Devices.secmod server in + let db_conn = Vif.Server.device Devices.db_connection server in + let res = + let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* () = verify sm v in + let* () = do_ ~db_conn v in + Ok "" + in + Respond_util.respond_with_res res req +end diff --git a/src/management.ml b/src/management.ml deleted file mode 100644 index 1aff93fe..00000000 --- a/src/management.ml +++ /dev/null @@ -1,112 +0,0 @@ -open Api -open Devices - -let mk_future_denom denom_key_signf - ({ - pub; - priv= _; - section_name; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask; - h_pub; - master_sig= _; - } : - Denomination.t) = - let denom_pub = - DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub } - in - let denom_secmod_sig = - let open Bin_signature.DenominationKeyAnnouncementPS in - let h_denom_pub = h_pub in - let h_section_name = Bin_type.Hash_64_cstr.hash section_name in - let anchor_time = stamp_start in - let duration_withdraw = - Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn - in - Sig.sign denom_key_signf - { h_denom_pub; h_section_name; anchor_time; duration_withdraw } - in - FutureDenom. - { - section_name; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - denom_pub; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - denom_secmod_sig; - } - -let mk_future_signkey signkey_signf - ({ pub; priv= _; stamp_start; stamp_expire; stamp_end; master_sig= _ } : - Signkey.t) = - let signkey_secmod_sig = - let open Bin_signature.SigningKeyAnnouncementPS in - let exchange_pub = pub in - let anchor_time = stamp_start in - let duration = - Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn - in - { exchange_pub; anchor_time; duration } - |> Bin.to_string bin - |> signkey_signf - in - FutureSignKey. - { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } - -let mk_future_keys_response (secmod_signkey : Secmod_signkey.t) - (secmod_denom : Secmod_denom.t) = - let future_denoms = - secmod_denom.keys - |> List.filter (fun k -> Option.is_none k.Denomination.master_sig) - |> List.map (fun denom -> - let signf s = - Crypto.EddsaSignature.sign_as_string - ~key:secmod_denom.sm_key.Signkey.priv s - in - mk_future_denom signf denom) - in - let future_signkeys = - secmod_signkey.keys - |> List.filter (fun k -> Option.is_none k.Signkey.master_sig) - |> List.map (fun signkey -> - let signf s = - Crypto.EddsaSignature.sign ~key:secmod_denom.sm_key.Signkey.priv s - in - mk_future_signkey signf signkey) - in - let master_pub = Config.Exchange.master_public_key in - let denom_secmod_public_key = secmod_denom.sm_key.pub in - let signkey_secmod_public_key = secmod_signkey.sm_key.pub in - FutureKeysResponse. - { - future_denoms; - future_signkeys; - master_pub; - denom_secmod_public_key; - signkey_secmod_public_key; - } - -let keys_get req server _env = - let open Vif.Response in - let open Syntax in - let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in - let secmod_denom = Vif.Server.device Devices.secmod_denom server in - let v = mk_future_keys_response secmod_signkey secmod_denom in - let s = Api.encode_exn Api.FutureKeysResponse.jsont v in - let* () = with_string req s in - let* () = add ~field:"content-type" "application/json" in - respond `OK diff --git a/src/mte.ml b/src/mte.ml index 4f660718..f98ee88f 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -23,13 +23,40 @@ let hello req _server _env = let routes = let open Vif.Uri in let open Vif.Route in - (*let open Vif.Type in*) - [ - get (rel /?? nil) --> hello; - get (rel / "terms" /?? nil) --> Static.terms; - get (rel / "privacy" /?? nil) --> Static.privacy; - get (rel / "management" / "keys" /?? nil) --> Management.keys_get; - ] + let get_ path = get (path /?? any) in + let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in + let tos = + let v s = rel / s in + [ + get_ rel --> hello; + get_ (v "terms") --> Static.terms; + get_ (v "privacy") --> Static.privacy; + ] + in + let status_info = [ get_ (rel / "keys") --> Http_keys.f ] in + let management = + let open Http_management in + let v s = rel / "management" / s in + [ + get_ (v "keys") --> Keys_get.f; + post (v "keys") Keys_post.jsont --> Keys_post.f; + post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont + --> Denom_revoke.f; + post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont + --> Signkey_revoke.f; + post (v "auditors") Auditors.jsont --> Auditors.f; + post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont + --> Auditors_disable.f; + post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f; + post (v "global-fees") Global_fees.jsont --> Global_fees.f; + post (v "wire") Wire.jsont --> Wire.f; + post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f; + post (v "drain") Drain.jsont --> Drain.f; + post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f; + post (v "partners") Partners.jsont --> Partners.f; + ] + in + tos @ status_info @ management let () = Util.Log_reporter.setup (); @@ -43,10 +70,7 @@ let () = let env : Devices.env = { caqti_switch; db_uri= Config.Exchangedb_postgres.config } in - let devices = - Vif.Devices. - [ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ] - in + let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in let middlewares = Vif.Middlewares.[] in Logs.info (fun m -> m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server"); diff --git a/src/parse_config.ml b/src/parse_config.ml index 0fd672a3..f40f1885 100644 --- a/src/parse_config.ml +++ b/src/parse_config.ml @@ -228,43 +228,35 @@ let ed25519 s = |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e) |> unwrap_res -module Parse_alt_unit_names = struct - let rm_brackets s = - let s = String.trim s in - match - String.starts_with ~prefix:"{" s && String.ends_with ~suffix:"}" s - with - | false -> fail "expected json, got `%s`" s - | true -> - let s = String.sub s 1 (String.length s - 2) in - s +(* TODO + move to another module + can we type the json as a Int_map directly? *) +module Alt_unit_names = struct + open Syntax + module String_map = Map.Make (String) - let rm_quotes s = - let s = String.trim s in - match - String.starts_with ~prefix:"\"" s && String.ends_with ~suffix:"\"" s - with - | false -> fail "expected quoted string, got `%s`" s - | true -> - let s = String.sub s 1 (String.length s - 2) in - s + let string_map_jsont = Jsont.Object.as_string_map Jsont.string - let parse s = - let s = rm_brackets s in - String.split_on_char ',' s - |> List.map (String.split_on_char ':') - |> List.map (function - | [ k; v ] -> (k, v) - | _ -> fail "invalid json key-value map") - |> List.map (fun (k, v) -> - let k = rm_quotes k in - let v = rm_quotes v in - let k = + let decode s = + let* string_map = Jsont_bytesrw.decode_string string_map_jsont s in + let l = String_map.to_list string_map in + let* l = + list_map + (fun (k, v) -> match int_of_string_opt k with - | None -> - fail "invalid json key-value map, expected integer key, got `%s`" - k - | Some k -> k - in - (k, v)) + | None -> Error "alt_unit_names has a non-integer key" + | Some k -> Ok (k, v)) + l + in + match List.find_opt (fun (i, _) -> i = 0) l with + | None -> Error "alt_unit_names with no entry for base value \"0\"" + | Some _ -> Ok l + + let encode l = + let l = List.map (fun (k, v) -> (string_of_int k, v)) l in + let string_map = String_map.of_list l in + let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in + s + + let encode_exn l = encode l |> Result.get_ok end diff --git a/src/pg.ml b/src/pg.ml index b6f6264e..0d877ba6 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -1,69 +1,32 @@ -open Crypto +(* TODO -module Caqti_type = struct - include Caqti_type + check there is no issues with signed/unsigned integers - (* TODO add a dune stanza like for prelude: - "(flags (:standard -open Prelude))" *) - (* we want to use int64 timestamps, - not postgresql built-in timestamp type *) - let ptime : Ptime.t option t = Timestamp.caqti - let time = Timestamp.caqti + how to fix postgres/caqti tuple type? + try something with OID? + need to add boilerplate in each query for amounts - let amount : Amount.t t = - let open Amount in - custom - ~encode:(fun amount -> Ok (amount.value, amount.fraction)) - ~decode:(fun (value, fraction) -> - Amount.make ~sign:None ~currency:Config.currency ~value ~fraction) - (t2 int64 int32) + GNU Taler db-events? + it seems caqti/pgx does not support it - let age_mask : int t = Caqti_type.int + transaction - let rsa_public : RsaPublicKey.t t = - let open RsaPublicKey in - custom - ~encode:(fun v -> Ok (to_octets v)) - ~decode:(fun v -> Ok (of_octets v)) - octets + should check validity of signatures got from db, for /management at least - let eddsa_public : EddsaPublicKey.t t = - let open EddsaPublicKey in - custom - ~encode:(fun v -> Ok (to_octets v)) - ~decode:(fun v -> Ok (of_octets v)) - octets - - let eddsa_signature : EddsaSignature.t t = - let open EddsaSignature in - custom - ~encode:(fun v -> Ok (to_octets v)) - ~decode:(fun s -> Ok (of_octets s)) - octets - - include struct - (* alias for hash *) - open Bin_type - - let fullpayto_hash = FullPaytoHash.caqti - let nomalizaedpayto_hash = NormalizedPaytoHash.caqti - let denomination_hash = DenominationHash.caqti - let privatecontract_hash = PrivateContractHash.caqti - let extensionspolicy_hash = ExtensionsPolicyHash.caqti - let merchantwire_hash = MerchantWireHash.caqti - let agecommitment_hash = AgeCommitmentHash.caqti - let blindedcoin_hash = BlindedCoinHash.caqti - let coinpub_hash = CoinPubHash.caqti - let outputcommitment_hash = OutputCommitmentHash.caqti - let planchets_hash = HashPlanchetsP.caqti - end - - include Caqti_request.Infix -end + clean up caqti error type *) +(* TODO time + fix comparison with timestamp footgun *) module type CONN = Caqti_miou.CONNECTION -open Bin_type +module Caqti_type = struct + include Caqti_type + include Pg_type + include Caqti_request.Infix +end + +open Crypto +open Api let preflight = let l = @@ -78,87 +41,336 @@ let preflight = "SET search_path TO exchange;"; ] in - fun (module Conn : Caqti_miou.CONNECTION) -> - Syntax.list_iter (fun p -> Conn.exec p ()) l + fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l -let lookup_signing_key = - let lookup_signing_key = - Caqti_type.(eddsa_public ->? t3 time time time) - "SELECT valid_from, expire_sign, expire_legal FROM exchange_sign_keys \ - WHERE exchange_pub=$1" +let find_signkey = + let find_signkey = + Caqti_type.(eddsa_pub ->? signkey_data) + "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ + esk.expire_legal, esk.master_sig, skr.master_sig FROM \ + exchange_sign_keys AS esk LEFT JOIN signkey_revocations AS skr ON \ + esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1" in fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) -> - Conn.find_opt lookup_signing_key exchange_pub + Conn.find_opt find_signkey exchange_pub -let activate_signing_key = +let get_active_signkeys = + let get_active_signkeys = + Caqti_type.(time ->* signkey_data) + "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ + esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \ + WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \ + signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)" + in + fun (module Conn : CONN) -> + let now = Ptime_clock.now () |> Option.some in + Conn.collect_list get_active_signkeys now + +(* note: does not update revocation *) +let insert_signkey = let insert_signkey = - Caqti_type.(t5 eddsa_public time time time eddsa_signature ->. unit) + Caqti_type.(signkey_data ->. unit) "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \ expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)" in + fun (module Conn : CONN) v -> Conn.exec insert_signkey v + +let find_denom = + let find_denom = + Caqti_type.(denomination_hash ->? denom_data) + "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \ + dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \ + (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \ + dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \ + dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \ + = dnr.denominations_serial WHERE dn.denom_pub_hash=$1" + in + fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub + +let get_denominations = + let get_denominations = + Caqti_type.(unit ->* denom_data) + "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \ + dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \ + (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \ + dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \ + dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \ + = dnr.denominations_serial" + in + fun (module Conn : CONN) -> Conn.collect_list get_denominations () + +(* note: does not update revocation *) +let insert_denom = + let insert_denom = + Caqti_type.(denom_data ->. unit) + "INSERT INTO denominations (denom_pub, coin, valid_from, \ + expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \ + fee_deposit, fee_refresh, fee_refund, age_mask, denom_pub_hash, \ + master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \ + ($12,$13), ($14,$15), $16, $17, $18)" + in + fun (module Conn : CONN) v -> Conn.exec insert_denom v + +let insert_denomination_revocation = + let denomination_revocation_insert = + let master_sig = Bin_sig.MasterDenominationKeyRevocation.caqti in + Caqti_type.(t2 denomination_hash master_sig ->. unit) + "INSERT INTO denomination_revocations (denominations_serial, master_sig) \ + SELECT denominations_serial, $2 FROM denominations WHERE \ + denom_pub_hash=$1" + in + fun (module Conn : CONN) h_denom_pub master_sig -> + Conn.exec denomination_revocation_insert (h_denom_pub, master_sig) + +let insert_signkey_revocation = + let signkey_revocation_insert = + let master_sig = Bin_sig.MasterSigningKeyRevocation.caqti in + Caqti_type.(t2 eddsa_pub master_sig ->. unit) + "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \ + esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1" + in + fun (module Conn : CONN) exchange_pub master_sig -> + Conn.exec signkey_revocation_insert (exchange_pub, master_sig) + +let get_auditor_timestamp = + let get_auditor_timestamp = + Caqti_type.(eddsa_pub ->? time) + "SELECT last_change FROM auditors WHERE auditor_pub=$1" + in + fun (module Conn : CONN) auditor_pub -> + Conn.find_opt get_auditor_timestamp auditor_pub + +let insert_auditor = + let insert_auditor = + Caqti_type.(t4 eddsa_pub string string time ->. unit) + "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \ + is_active, last_change) VALUES ($1, $2, $3, true, $4)" + in fun (module Conn : CONN) - Signkey.{ pub; priv= _; stamp_start; stamp_expire; stamp_end; master_sig } + AuditorSetupMessage. + { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start } -> - (* TODO master_sig *) - let master_sig = master_sig |> Option.get in - Conn.exec insert_signkey - (pub, stamp_start, stamp_expire, stamp_end, master_sig) + Conn.exec insert_auditor + (auditor_pub, auditor_name, auditor_url, validity_start) -let lookup_denomination_key = - let lookup_denomination_key = - Caqti_type.( - denomination_hash - ->? t10 time time time time amount amount amount amount amount age_mask) - "SELECT valid_from, expire_withdraw, expire_deposit, expire_legal, coin, \ - fee_withdraw, fee_deposit, fee_refresh, fee_refund, age_mask FROM \ - denominations WHERE denom_pub_hash=$1" - in - fun (module Conn : CONN) (h_denom_pub : DenominationHash.t) -> - Conn.find_opt lookup_denomination_key h_denom_pub - -let add_denomination_key = - let denomination_insert = - Caqti_type.( - t12 denomination_hash rsa_public eddsa_signature time time time time - amount amount amount amount (t2 amount age_mask) - ->. unit) - "INSERT INTO denominations (denom_pub_hash, denom_pub, master_sig, \ - valid_from, expire_withdraw, expire_deposit, expire_legal, coin, \ - fee_withdraw, fee_deposit, fee_refresh, fee_refund, age_mask) VALUES \ - ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13)" +let update_auditor = + let update_auditor = + Caqti_type.(t5 eddsa_pub string string bool time ->. unit) + "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \ + last_change=$5 WHERE auditor_pub=$1" in fun (module Conn : CONN) - Denomination. + AuditorSetupMessage. + { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start } + -> + Conn.exec update_auditor + (auditor_pub, auditor_url, auditor_name, true, validity_start) + +let disable_auditor = + let update_auditor = + Caqti_type.(t5 eddsa_pub string string bool time ->. unit) + "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \ + last_change=$5 WHERE auditor_pub=$1" + in + fun (module Conn : CONN) ~auditor_pub ~change_date -> + Conn.exec update_auditor (auditor_pub, "", "", false, change_date) + +let insert_auditor_denom_sig = + let insert_auditor_denom_sig = + let auditor_sig = Bin_sig.ExchangeKeyValidity.caqti in + Caqti_type.(t3 eddsa_pub denomination_hash auditor_sig ->. unit) + "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \ + INSERT INTO auditor_denom_sigs (auditor_uuid, denominations_serial, \ + auditor_sig) SELECT ax.auditor_uuid, denominations_serial, $3 FROM \ + denominations CROSS JOIN ax WHERE denom_pub_hash=$2 ON CONFLICT DO \ + NOTHING" + in + fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig -> + Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig) + +(* todo auditors + maybe check that url and name are unique/same for each auditor_pub + and do the ht logic out of pg.ml? *) +(* this does not return auditors that are not auditing any denom *) +let get_auditor_keys = + let get_auditor_keys = + let auditor_sig = Bin_sig.ExchangeKeyValidity.caqti in + Caqti_type.( + unit ->* t5 eddsa_pub string string denomination_hash auditor_sig) + "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \ + ads.auditor_sig FROM auditor_denom_sigs AS ads JOIN auditors AS a USING \ + (auditor_uuid) JOIN denominations AS dn USING (denominations_serial) \ + WHERE a.is_active" + in + fun (module Conn : CONN) -> + let open Syntax in + let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in + let ht = Hashtbl.create 0xff in + List.iter + (fun (pub, url, name, denom_pub_h, auditor_sig) -> + let k = (pub, url, name) in + match Hashtbl.find_opt ht k with + | None -> Hashtbl.replace ht k [ (denom_pub_h, auditor_sig) ] + | Some l -> Hashtbl.replace ht k ((denom_pub_h, auditor_sig) :: l)) + l; + let l = Hashtbl.to_seq ht |> List.of_seq in + let l = + List.map + (fun ((auditor_pub, auditor_url, auditor_name), auditor_denoms) -> + let denomination_keys = + List.map + (fun (denom_pub_h, auditor_sig) -> + AuditorDenominationKey.{ denom_pub_h; auditor_sig }) + auditor_denoms + in + AuditorKeys. + { auditor_pub; auditor_url; auditor_name; denomination_keys }) + l + in + Ok l + +let insert_wire_fee = + let insert_wire_fee = + let master_sig = Bin_sig.MasterWireFee.caqti in + Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit) + "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \ + closing_fee, master_sig) VALUES ($1, $2, $3, ($4,$5), ($6,$7), $8)" + in + fun (module Conn : CONN) + WireFeeSetupMessage. { - pub; - priv= _; - section_name= _; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask; - h_pub; - master_sig; + wire_method; + master_sig_wire; + fee_start; + fee_end; + closing_fee; + wire_fee; } -> - (* TODO master_sig *) - let master_sig = master_sig |> Option.get in - Conn.exec denomination_insert - ( h_pub, - pub, - master_sig, - stamp_start, - stamp_expire_withdraw, - stamp_expire_deposit, - stamp_expire_legal, - value, - fee_withdraw, - fee_deposit, - fee_refresh, - (fee_refund, age_mask) ) + Conn.exec insert_wire_fee + (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire) + +let get_wire_fees_by_time = + let get_wire_fee_by_time = + Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee) + "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \ + FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \ + $3" + in + fun (module Conn : CONN) ~wire_method ~start_date ~end_date -> + Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date) + +let get_wire_fees = + let get_wire_fees = + Caqti_type.(string ->* aggregate_transfer_fee) + "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \ + FROM wire_fee WHERE wire_method=$1" + in + fun (module Conn : CONN) ~wire_method -> + Conn.collect_list get_wire_fees wire_method + +let get_global_fees = + let get_global_fees = + Caqti_type.(time ->* global_fee) + "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \ + (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \ + master_sig FROM global_fee WHERE start_date >= $1" + in + fun (module Conn : CONN) ~start_date -> + Conn.collect_list get_global_fees start_date + +let get_global_fees_by_time = + let get_global_fees_by_time = + Caqti_type.(t2 time time ->* global_fee) + "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \ + (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \ + master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2" + in + fun (module Conn : CONN) ~start_date ~end_date -> + Conn.collect_list get_global_fees_by_time (start_date, end_date) + +let insert_global_fees = + let insert_global_fees = + Caqti_type.(global_fee ->. unit) + "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \ + purse_fee, history_expiration, purse_account_limit, purse_timeout, \ + master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \ + $12)" + in + fun (module Conn : CONN) v -> Conn.exec insert_global_fees v + +let get_wire_timestamp = + let get_wire_timestamp = + Caqti_type.(payto_uri ->? time) + "SELECT last_change FROM wire_accounts WHERE payto_uri=$1" + in + fun (module Conn : CONN) ~payto_uri -> + Conn.find_opt get_wire_timestamp payto_uri + +let insert_wire = + let insert_wire = + Caqti_type.(t3 exchange_wire_account bool time ->. unit) + "INSERT INTO wire_accounts (payto_uri, conversion_url, \ + credit_restrictions, debit_restrictions, master_sig, bank_label, \ + priority, is_active, last_change) VALUES \ + ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)" + in + fun (module Conn : CONN) ~last_change v -> + let is_active = true in + Conn.exec insert_wire (v, is_active, last_change) + +let update_wire = + let update_wire = + Caqti_type.(t3 exchange_wire_account bool time ->. unit) + "UPDATE wire_accounts SET conversion_url=$2, \ + debit_restrictions=$3::TEXT::JSONB, \ + credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \ + priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1" + in + fun (module Conn : CONN) ~is_active ~last_change v -> + Conn.exec update_wire (v, is_active, last_change) + +let disable_wire = + let disable_wire = + (* TODO check syntax on this *) + Caqti_type.(t2 payto_uri time ->. unit) + "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \ + credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \ + priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1" + in + fun (module Conn : CONN) ~payto_uri ~validity_end -> + Conn.exec disable_wire (payto_uri, validity_end) + +let get_wire_accounts = + let get_wire_accounts = + Caqti_type.(unit ->* exchange_wire_account) + "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \ + credit_restrictions::TEXT, master_sig, bank_label, priority FROM \ + wire_accounts WHERE is_active" + in + fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts () + +let insert_drain_profit = + let insert_drain_profit = + Caqti_type.(drain_profit_message ->. unit) + "INSERT INTO profit_drains (wtid, account_section, payto_uri, \ + trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)" + in + fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v + +let insert_aml_officer = + let exchange_do_insert_aml_officer = + Caqti_type.(aml_officer_setup ->! time) + "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \ + $4, $5, $6)" + in + fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v + +let insert_partner = + let insert_partner = + Caqti_type.(exchange_partner_setup ->. unit) + "INSERT INTO partners (partner_master_pub, start_date, end_date, \ + wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \ + $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING" + in + fun (module Conn : CONN) v -> Conn.exec insert_partner v diff --git a/src/pg_type.ml b/src/pg_type.ml new file mode 100644 index 00000000..4a1ed95b --- /dev/null +++ b/src/pg_type.ml @@ -0,0 +1,377 @@ +(* this module defines caqti encoding/decodings *) +open Crypto +open Bin_type +open Api +open Caqti_type + +(* TODO + check that we use Caqti_type.octets for binary data *) + +let amount : Amount.t t = + let open Amount in + custom + ~encode:(fun amount -> Ok (amount.value, amount.fraction)) + ~decode:(fun (value, fraction) -> + Amount.make ~sign:None ~currency:Config.currency ~value ~fraction) + (t2 int64 int32) + +(* we want to use int64 timestamps, + not postgresql built-in timestamp type *) +let ptime : Ptime.t option t = Timestamp.caqti +let time = Timestamp.caqti +let time_span = Timestamp.Span.caqti +let age_mask : int t = Caqti_type.int +let rsa_pub = RsaPublicKey.caqti +let eddsa_pub = EddsaPublicKey.caqti +let eddsa_sig = EddsaSignature.caqti + +(* todo: enum type for wire_method? *) +let wire_method = Caqti_type.string +let payto_uri = Caqti_type.string +let b32 = B32.caqti + +include struct + (* alias for hash *) + + let fullpayto_hash = FullPaytoHash.caqti + let nomalizaedpayto_hash = NormalizedPaytoHash.caqti + let denomination_hash = DenominationHash.caqti + let privatecontract_hash = PrivateContractHash.caqti + let extensionspolicy_hash = ExtensionsPolicyHash.caqti + let merchantwire_hash = MerchantWireHash.caqti + let agecommitment_hash = AgeCommitmentHash.caqti + let blindedcoin_hash = BlindedCoinHash.caqti + let coinpub_hash = CoinPubHash.caqti + let outputcommitment_hash = OutputCommitmentHash.caqti + let planchets_hash = HashPlanchetsP.caqti +end + +let signkey_data = + let master_sig = Bin_sig.ExchangeSigningKeyValidity.caqti in + let revoked_sig = option Bin_sig.MasterSigningKeyRevocation.caqti in + custom + ~encode:(fun + Signkey_data. + { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig } + -> + match master_sig with + | None -> Error "signkey_data master_sig is none" + | Some master_sig -> + Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig)) + ~decode:(fun + (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig) -> + Ok + { + pub; + stamp_start; + stamp_expire; + stamp_end; + master_sig= Some master_sig; + revoked_sig; + }) + (t6 eddsa_pub time time time master_sig revoked_sig) + +let denom_data = + let master_sig = Bin_sig.DenominationKeyValidity.caqti in + let revoked_sig = option Bin_sig.MasterDenominationKeyRevocation.caqti in + custom + ~encode:(fun + Denom_data. + { + pub; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask; + h_pub; + master_sig; + revoked_sig; + } + -> + match master_sig with + | None -> Error "denom_data master_sig is none" + | Some master_sig -> + Ok + ( pub, + value, + stamp_start, + stamp_expire_withdraw, + stamp_expire_deposit, + stamp_expire_legal, + fee_withdraw, + fee_deposit, + fee_refresh, + fee_refund, + age_mask, + (h_pub, master_sig, revoked_sig) )) + ~decode:(fun + ( pub, + value, + stamp_start, + stamp_expire_withdraw, + stamp_expire_deposit, + stamp_expire_legal, + fee_withdraw, + fee_deposit, + fee_refresh, + fee_refund, + age_mask, + (h_pub, master_sig, revoked_sig) ) + -> + Ok + { + pub; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask; + h_pub; + master_sig= Some master_sig; + revoked_sig; + }) + (t12 rsa_pub amount time time time time amount amount amount amount int + (t3 denomination_hash master_sig revoked_sig)) + +let account_restrictions = + custom + ~encode:(fun l -> Api.encode (Jsont.list AccountRestriction.jsont) l) + ~decode:(fun s -> Api.decode (Jsont.list AccountRestriction.jsont) s) + string + +let global_fee = + let master_sig = Bin_sig.GlobalFees.caqti in + custom + ~encode:(fun + GlobalFees. + { + start_date; + end_date; + history_fee; + account_fee; + purse_fee; + history_expiration; + purse_account_limit; + purse_timeout; + master_sig; + } + -> + Ok + ( start_date, + end_date, + history_fee, + account_fee, + purse_fee, + history_expiration, + purse_account_limit, + purse_timeout, + master_sig )) + ~decode:(fun + ( start_date, + end_date, + history_fee, + account_fee, + purse_fee, + history_expiration, + purse_account_limit, + purse_timeout, + master_sig ) + -> + Ok + { + start_date; + end_date; + history_fee; + account_fee; + purse_fee; + history_expiration; + purse_account_limit; + purse_timeout; + master_sig; + }) + Caqti_type.( + t9 time time amount amount amount time_span int32 time_span master_sig) + +let aggregate_transfer_fee = + let master_sig = Bin_sig.MasterWireFee.caqti in + Caqti_type.custom + ~encode:(fun + AggregateTransferFee. + { wire_fee; closing_fee; start_date; end_date; sig_ } + -> Ok (wire_fee, closing_fee, start_date, end_date, sig_)) + ~decode:(fun (wire_fee, closing_fee, start_date, end_date, sig_) -> + Ok + AggregateTransferFee. + { wire_fee; closing_fee; start_date; end_date; sig_ }) + Caqti_type.(t5 amount amount time time master_sig) + +let exchange_wire_account = + let master_sig = Bin_sig.MasterWireDetails.caqti in + Caqti_type.custom + ~encode:(fun + ExchangeWireAccount. + { + payto_uri; + conversion_url; + debit_restrictions; + credit_restrictions; + master_sig; + bank_label; + priority; + } + -> + Ok + ( payto_uri, + conversion_url, + debit_restrictions, + credit_restrictions, + master_sig, + bank_label, + priority )) + ~decode:(fun + ( payto_uri, + conversion_url, + debit_restrictions, + credit_restrictions, + master_sig, + bank_label, + priority ) + -> + Ok + { + payto_uri; + conversion_url; + debit_restrictions; + credit_restrictions; + master_sig; + bank_label; + priority; + }) + Caqti_type.( + t7 payto_uri (option string) account_restrictions account_restrictions + master_sig (option string) (option int)) + +let drain_profit_message = + let master_sig = Bin_sig.MasterDrainProfit.caqti in + Caqti_type.custom + ~encode:(fun + DrainProfitsMessage. + { + wtid; + debit_account_section; + credit_payto_uri; + date; + amount; + master_sig; + } + -> + Ok + (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig)) + ~decode:(fun + (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig) + -> + Ok + { + wtid; + debit_account_section; + credit_payto_uri; + date; + amount; + master_sig; + }) + Caqti_type.(t6 b32 string string time amount master_sig) + +let aml_officer_setup = + let master_sig = Bin_sig.MasterAmlOfficerStatus.caqti in + Caqti_type.custom + ~encode:(fun + AmlOfficerSetup. + { + officer_pub; + master_sig; + officer_name; + is_active; + read_only; + change_date; + } + -> + Ok + ( officer_pub, + master_sig, + officer_name, + is_active, + read_only, + change_date )) + ~decode:(fun + ( officer_pub, + master_sig, + officer_name, + is_active, + read_only, + change_date ) + -> + Ok + { + officer_pub; + master_sig; + officer_name; + is_active; + read_only; + change_date; + }) + Caqti_type.(t6 eddsa_pub master_sig string bool bool time) + +let exchange_partner_setup = + let master_sig = Bin_sig.PartnerConfiguration.caqti in + Caqti_type.custom + ~encode:(fun + ExchangePartnerSetupRequest. + { + partner_pub; + start_date; + end_date; + wad_frequency; + wad_fee; + master_sig; + partner_base_url; + } + -> + Ok + ( partner_pub, + start_date, + end_date, + wad_frequency, + wad_fee, + master_sig, + partner_base_url )) + ~decode:(fun + ( partner_pub, + start_date, + end_date, + wad_frequency, + wad_fee, + master_sig, + partner_base_url ) + -> + Ok + { + partner_base_url; + partner_pub; + wad_frequency; + master_sig; + start_date; + end_date; + wad_fee; + }) + Caqti_type.(t7 eddsa_pub time time time_span amount master_sig string) diff --git a/src/respond_util.ml b/src/respond_util.ml new file mode 100644 index 00000000..3c4faf5d --- /dev/null +++ b/src/respond_util.ml @@ -0,0 +1,22 @@ +let respond_with_plain_text_error ?status e req = + let open Vif.Response in + let open Syntax in + let status = Option.value ~default:`Bad_request status in + let* () = add ~field:"content-type" "text/plain; charset=utf-8" in + let* () = with_string req e in + respond status + +let respond_with_ok_json content req = + let open Vif.Response in + let open Syntax in + let* () = add ~field:"content-type" "application/json" in + let* () = with_string req content in + respond `OK + +let respond_with_res res req = + match res with + | Error err -> + Logs.err (fun m -> m "%s." err); + let err = Fmt.str "%s@." err in + respond_with_plain_text_error err req + | Ok content -> respond_with_ok_json content req diff --git a/src/secmod.ml b/src/secmod.ml new file mode 100644 index 00000000..65068174 --- /dev/null +++ b/src/secmod.ml @@ -0,0 +1,401 @@ +module type S = sig + open Crypto + + val sign_with_sm_key : string -> eddsa_sig + val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig + val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result + val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result + + val verify_with_signkey : + pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result + + (* TODO query database instead? *) + val get_sm_key_pub : unit -> eddsa_pub + val get_signkeys_data : unit -> Signkey_data.t list + val get_denoms_data : unit -> Denom_data.t list + val find_signkey_data : eddsa_pub -> Signkey_data.t option + val find_denom_data : denomination_hash -> Denom_data.t option + val find_denom_section_name : denomination_hash -> string option + + (* - management operations - *) + (* TODO + problem of keeping db and secmod state syncronized + do db interaction from secmod? *) + + val add_signkey_master_signatures : + (eddsa_pub * Bin_sig.ExchangeSigningKeyValidity.t) list -> + (unit, string) result + + val add_denom_master_signatures : + (denomination_hash * Bin_sig.DenominationKeyValidity.t) list -> + (unit, string) result + + val revoke_signkey : + eddsa_pub -> Bin_sig.MasterSigningKeyRevocation.t -> (unit, string) result + + val revoke_denomination : + denomination_hash -> + Bin_sig.MasterDenominationKeyRevocation.t -> + (unit, string) result + + val store : unit -> (unit, string) result +end + +module Make (Conn : Pg.CONN) = struct + (* TODO + - key rotation + - how many signkey to use? + we just use 1 for now + - does the secmod's own key as metadata/expiration date? + - something to refer to valid sk/dn + + - eddsa.ml with phantom type for key-kind + signed-data-kind *) + open Syntax + open Crypto + + type signkey = { + priv: eddsa_priv; + sk_data: Signkey_data.t; + } + + type denom = { + priv: rsa_priv; + dn_data: Denom_data.t; + } + + type t = { + lock: Miou.Mutex.t; + sm_key_priv: eddsa_priv; + sm_key_pub: eddsa_pub; + sk_ht: (eddsa_pub, signkey) Hashtbl.t; + dn_ht: (denomination_hash, denom) Hashtbl.t; + dn_section_name_ht: (denomination_hash, string) Hashtbl.t; + } + + let dir = Fpath.(v "data" / "secmod") + + let db_lookup_signkey_data conn fname pub = + let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in + match opt with + | None -> + Fmt.error + "load_signkey error, no associated data found in database for \ + signkey `%s`." + (Fpath.to_string fname) + | Some sk_data -> Ok sk_data + + let db_lookup_denom_data conn ~section_name priv = + let pub = RsaPrivateKey.pub_of_priv priv in + let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in + let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in + match opt with + | None -> + Fmt.error + "load_denom error no associated metadata found in database for \ + denomination `%s`." + section_name + | Some dn_data -> Ok dn_data + + let load_signkey conn fname = + let* opt = Data_file.read_eddsa fname in + match opt with + | None -> Ok None + | Some priv -> + let pub = EddsaPrivateKey.pub_of_priv priv in + let* sk_data = db_lookup_signkey_data conn fname pub in + let signkey = { priv; sk_data } in + Ok (Some signkey) + + let load conn = + let error_invalid_state = + Fmt.error "secmod load error: invalid store state." + in + let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sk_sm") in + let* signkeys = + let l = List.init 1 (fun i -> Fpath.(dir / Fmt.str "sk_%d" i)) in + let* l = list_map (fun fname -> load_signkey conn fname) l in + match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt + in + let dn_section_name_ht = Hashtbl.create 0xff in + let* denoms = + let* l = + let open Config.Coin in + list_map + (fun coin -> + let section_name = coin.section_name in + let fname = Fpath.(dir / section_name) in + let* opt = Data_file.read_rsa fname in + match opt with + | None -> Ok None + | Some priv -> + (* todo: could check that coin config match db values *) + let* dn_data = db_lookup_denom_data conn ~section_name priv in + Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name; + let denom = { priv; dn_data } in + Ok (Some denom)) + all_coins + in + match Syntax.opt_list l with + | Error () -> error_invalid_state + | Ok opt -> Ok opt + in + match (sm_key_priv, signkeys, denoms) with + | None, None, None -> Ok None + | Some sm_key_priv, Some signkeys, Some denoms -> + let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in + let lock = Miou.Mutex.create () in + let sk_ht = + signkeys + |> List.map (fun v -> (v.sk_data.pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + let dn_ht = + denoms + |> List.map (fun v -> (v.dn_data.h_pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + Ok + (Some + { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }) + | _, _, _ -> error_invalid_state + + let make_new_signkey () = + let stamp_start = Ptime_clock.now () |> Option.some in + let stamp_expire = + Timestamp.add_span_exn stamp_start + (Some Config.Exchange.signkey_legal_duration) + in + let stamp_end = stamp_expire in + let priv, pub = Mirage_crypto_ec.Ed25519.generate () in + let master_sig = None in + let revoked_sig = None in + let sk_data = + Signkey_data. + { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig } + in + { priv; sk_data } + + let make_new_denom + Config.Coin. + { + section_name= _; + value; + duration_withdraw; + duration_spend; + duration_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + cipher; + rsa_keysize; + age_restricted= _; + } = + assert (cipher = `RSA); + let stamp_start = Ptime_clock.now () |> Option.some in + let stamp_expire_withdraw = + Timestamp.add_span_exn stamp_start (Some duration_withdraw) + in + let stamp_expire_deposit = + Timestamp.add_span_exn stamp_start (Some duration_spend) + in + let stamp_expire_legal = + Timestamp.add_span_exn stamp_start (Some duration_legal) + in + let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in + let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in + let master_sig = None in + let revoked_sig = None in + let dn_data = + Denom_data. + { + pub; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask= 0; + h_pub; + master_sig; + revoked_sig; + } + in + { priv; dn_data } + + let make_new () = + let lock = Miou.Mutex.create () in + let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in + let sk_ht = + [ make_new_signkey () ] + |> List.map (fun v -> (v.sk_data.pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + let dn_section_name_ht = Hashtbl.create 0xff in + let dn_ht = + Config.Coin.all_coins + |> List.map (fun coin -> + let denom = make_new_denom coin in + Hashtbl.replace dn_section_name_ht denom.dn_data.h_pub + coin.section_name; + (denom.dn_data.h_pub, denom)) + |> List.to_seq + |> Hashtbl.of_seq + in + { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht } + + let t = + match load (module Conn) with + | Ok None -> + let t = make_new () in + Logs.info (fun m -> m "secmod initialized with fresh keys"); + t + | Ok (Some t) -> + Logs.info (fun m -> m "secmod initialized from storage"); + t + | Error e -> Fmt.failwith "secmod init failure: %s." e + + (* note: don't expose a signing function if we want a real "security module" one day *) + let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s + let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_key_pub s ~msg + + let verify_with_master_key s ~msg = + EddsaSignature.verify ~key:Config.master_public_key s ~msg + + (* TODO + - do something to force `pub` to be one of the valid signkey + how to handle revocation? + raise exn for now *) + let sign_with_signkey ~pub s = + Miou.Mutex.protect t.lock @@ fun () -> + match Hashtbl.find_opt t.sk_ht pub with + | None -> Fmt.failwith "secmod failure: public key not found." + | Some signkey -> + let v = EddsaSignature.sign ~key:signkey.priv s in + v + + let verify_with_signkey ~pub s ~msg = + Miou.Mutex.protect t.lock @@ fun () -> + match Hashtbl.find_opt t.sk_ht pub with + | None -> Error "secmod failure: public key not found." + | Some signkey -> EddsaSignature.verify ~key:signkey.sk_data.pub s ~msg + + let get_sm_key_pub () = t.sm_key_pub + + let get_signkeys () = + Miou.Mutex.protect t.lock @@ fun () -> + Hashtbl.to_seq_values t.sk_ht |> List.of_seq + + let get_denoms () = + Miou.Mutex.protect t.lock @@ fun () -> + Hashtbl.to_seq_values t.dn_ht |> List.of_seq + + let find_signkey pub = + Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub + + let find_denom h_denom = + Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.dn_ht h_denom + + let get_signkeys_data () = get_signkeys () |> List.map (fun v -> v.sk_data) + let get_denoms_data () = get_denoms () |> List.map (fun v -> v.dn_data) + + let find_signkey_data pub = + find_signkey pub |> Option.map (fun v -> v.sk_data) + + let find_denom_data h_denom = + find_denom h_denom |> Option.map (fun v -> v.dn_data) + + let find_denom_section_name h_denom = + Miou.Mutex.protect t.lock @@ fun () -> + Hashtbl.find_opt t.dn_section_name_ht h_denom + + let add_signkey_master_signatures l = + Miou.Mutex.protect t.lock @@ fun () -> + list_iter + (fun (pub, master_sig) -> + match Hashtbl.find_opt t.sk_ht pub with + | None -> Error "secmod failure: public key not found." + | Some signkey -> + let sk_data = + { signkey.sk_data with master_sig= Some master_sig } + in + let signkey = { signkey with sk_data } in + let* () = + Pg.insert_signkey (module Conn) sk_data |> unwrap_err_caqti + in + Hashtbl.replace t.sk_ht pub signkey; + Ok ()) + l + + let add_denom_master_signatures l = + Miou.Mutex.protect t.lock @@ fun () -> + list_iter + (fun (h_denom_pub, master_sig) -> + match Hashtbl.find_opt t.dn_ht h_denom_pub with + | None -> Error "secmod failure: denomination hash not found." + | Some denom -> + let dn_data = { denom.dn_data with master_sig= Some master_sig } in + let denom = { denom with dn_data } in + let* () = + Pg.insert_denom (module Conn) dn_data |> unwrap_err_caqti + in + Hashtbl.replace t.dn_ht h_denom_pub denom; + Ok ()) + l + + let revoke_signkey exchange_pub revoked_sig = + Miou.Mutex.protect t.lock @@ fun () -> + match Hashtbl.find_opt t.sk_ht exchange_pub with + | None -> Error "secmod failure: denomination hash not found." + | Some signkey -> + let sk_data = { signkey.sk_data with revoked_sig= Some revoked_sig } in + let signkey = { signkey with sk_data } in + Hashtbl.replace t.sk_ht exchange_pub signkey; + Ok () + + let revoke_denomination h_denom_pub revoked_sig = + Miou.Mutex.protect t.lock @@ fun () -> + match Hashtbl.find_opt t.dn_ht h_denom_pub with + | None -> Error "secmod failure: denomination hash not found." + | Some denom -> + let dn_data = { denom.dn_data with revoked_sig= Some revoked_sig } in + let denom = { denom with dn_data } in + Hashtbl.replace t.dn_ht h_denom_pub denom; + Ok () + + let store () = + Miou.Mutex.protect t.lock @@ fun () -> + let* () = Data_file.write_eddsa Fpath.(dir / "sk_sm") t.sm_key_priv in + let* () = + Hashtbl.to_seq_values t.sk_ht + |> List.of_seq + |> List.mapi (fun i (key : signkey) -> + let fname = Fpath.(dir / Fmt.str "sk_%d" i) in + (fname, key.priv)) + |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key) + in + let* () = + let* l = + Hashtbl.to_seq_values t.dn_ht + |> List.of_seq + |> Syntax.list_map (fun (key : denom) -> + let+ section_name = + match Hashtbl.find_opt t.dn_section_name_ht key.dn_data.h_pub with + | None -> Error "invalid state, section_name not found" + | Some s -> Ok s + in + let fname = Fpath.(dir / section_name) in + (fname, key.priv)) + in + list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l + in + Logs.info (fun m -> m "stored secmod data to file"); + Ok () +end diff --git a/src/secmod.mli b/src/secmod.mli new file mode 100644 index 00000000..33b6aa21 --- /dev/null +++ b/src/secmod.mli @@ -0,0 +1,44 @@ +module type S = sig + open Crypto + + val sign_with_sm_key : string -> eddsa_sig + val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig + val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result + val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result + + val verify_with_signkey : + pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result + + (* TODO query database instead? *) + val get_sm_key_pub : unit -> eddsa_pub + val get_signkeys_data : unit -> Signkey_data.t list + val get_denoms_data : unit -> Denom_data.t list + val find_signkey_data : eddsa_pub -> Signkey_data.t option + val find_denom_data : denomination_hash -> Denom_data.t option + val find_denom_section_name : denomination_hash -> string option + + (* - management operations - *) + (* TODO + problem of keeping db and secmod state syncronized + do db interaction from secmod? *) + + val add_signkey_master_signatures : + (eddsa_pub * Bin_sig.ExchangeSigningKeyValidity.t) list -> + (unit, string) result + + val add_denom_master_signatures : + (denomination_hash * Bin_sig.DenominationKeyValidity.t) list -> + (unit, string) result + + val revoke_signkey : + eddsa_pub -> Bin_sig.MasterSigningKeyRevocation.t -> (unit, string) result + + val revoke_denomination : + denomination_hash -> + Bin_sig.MasterDenominationKeyRevocation.t -> + (unit, string) result + + val store : unit -> (unit, string) result +end + +module Make (_ : Pg.CONN) : S diff --git a/src/signkey.ml b/src/signkey.ml deleted file mode 100644 index 2b29662b..00000000 --- a/src/signkey.ml +++ /dev/null @@ -1,29 +0,0 @@ -open Crypto - -(* TODO master_sig - not sur how to handle master_sig initialization *) -type t = { - pub: EddsaPublicKey.t; - priv: EddsaPrivateKey.t; - stamp_start: Timestamp.t; - stamp_expire: Timestamp.t; - stamp_end: Timestamp.t; - (* signature of this key by offline master key *) - master_sig: EddsaSignature.t option; -} - -let generate () = - (* TODO - - look if it exists - - if not, create it (TOFU initialization scheme) - - write it *) - let stamp_start = Ptime_clock.now () |> Option.some in - let stamp_expire = - Timestamp.add_span_exn stamp_start - (Some Config.Exchange.signkey_legal_duration) - in - let stamp_end = stamp_expire in - - let priv, pub = Mirage_crypto_ec.Ed25519.generate () in - let master_sig = None in - { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig } diff --git a/src/signkey_data.ml b/src/signkey_data.ml new file mode 100644 index 00000000..e5700d64 --- /dev/null +++ b/src/signkey_data.ml @@ -0,0 +1,10 @@ +open Crypto + +type t = { + pub: eddsa_pub; + stamp_start: Timestamp.t; + stamp_expire: Timestamp.t; + stamp_end: Timestamp.t; + master_sig: Bin_sig.ExchangeSigningKeyValidity.t option; + revoked_sig: Bin_sig.MasterSigningKeyRevocation.t option; +} diff --git a/src/static.ml b/src/static.ml index a69d2dc0..57b24dcd 100644 --- a/src/static.ml +++ b/src/static.ml @@ -17,7 +17,8 @@ module Respond_with = struct let error_detail ?hint _status = let open Api in let code = -1 in - let s = encode_exn ErrorDetail.jsont { code; hint } in + let err = ErrorDetail.make ?hint code in + let s = encode_exn ErrorDetail.jsont err in s end diff --git a/src/syntax.ml b/src/syntax.ml index f354ca6c..c61aba15 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -4,6 +4,9 @@ let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e (* TODO use polymorphic variant for errors *) let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v +let unwrap_err_caqti o = + match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v + let list_iter f l = let err = ref None in try diff --git a/src/timestamp.ml b/src/timestamp.ml index 710ac992..506d8f2e 100644 --- a/src/timestamp.ml +++ b/src/timestamp.ml @@ -1,6 +1,8 @@ type t = Ptime.t option type span = Ptime.Span.t option +let epoch = Some Ptime.epoch + let diff a b = match (a, b) with | None, _ | _, None -> None @@ -23,6 +25,23 @@ let of_span_exn = function (* -- *) +(* TODO + this doesn't handle "never" value, and truncate time *) +let of_string s = + match Float.of_string_opt s with + | None -> Error "Timestamp.of_string failure: not a float" + | Some v -> ( + match Ptime.of_float_s v with + | None -> Error "Timestamp.of_string failure" + | Some v -> Ok (Some v)) + +let pp fmt t = + match t with + | None -> Fmt.pf fmt {|"never"|} + | Some v -> + let v = Ptime.to_float_s v in + Fmt.pf fmt {|%f|} v + (* microseconds since the UNIX Epoch, or "never" if None *) let jsont = let number_or_never_jsont = @@ -48,7 +67,6 @@ let jsont = |> Jsont.Object.mem "t_s" number_or_never_jsont ~enc:Fun.id |> Jsont.Object.finish -(* TODO exn *) let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float let ptime_of_int64 i = @@ -63,7 +81,93 @@ let decode_int64 i = if i = Int64.max_int then None else Some (ptime_of_int64 i) let bin = Bin.map Bin.neint64 decode_int64 encode_int64 let bin_nbo = Bin.map Bin.beint64 decode_int64 encode_int64 -let caqti : Ptime.t option Caqti_type.t = +let caqti : t Caqti_type.t = let encode v = Ok (encode_int64 v) in let decode v = Ok (decode_int64 v) in Caqti_type.custom ~encode ~decode Caqti_type.int64 + +let compare a b = + match (a, b) with + | None, None -> Some 0 + | None, _ | _, None -> None + | Some a, Some b -> + let a = ptime_to_int64 a in + let b = ptime_to_int64 b in + let c = Int64.compare a b in + Some c + +module Span = struct + type t = span + + (* TODO + this doesn't handle "never" value, and truncate time *) + let of_string s = + match Float.of_string_opt s with + | None -> Error "Timestamp.Span.of_string failure: not a float" + | Some v -> ( + match Ptime.Span.of_float_s v with + | None -> Error "Timestamp.Span.of_string failure" + | Some v -> Ok (Some v)) + + let pp fmt t = + match t with + | None -> Fmt.pf fmt {|"forever"|} + | Some v -> + let v = Ptime.Span.to_float_s v in + Fmt.pf fmt {|%f|} v + + let to_int64 ptime = ptime |> Ptime.Span.to_float_s |> Int64.of_float + + let of_int64 i = + match Ptime.Span.of_float_s (Int64.to_float i) with + | None -> + Fmt.failwith + "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i + | Some ts -> ts + + let encode_int64 = function None -> Int64.max_int | Some p -> to_int64 p + let decode_int64 i = if i = Int64.max_int then None else Some (of_int64 i) + + (* UINT64_MAX represents "forever" *) + let bin = Bin.map Bin.neint64 decode_int64 encode_int64 + let bin_nbo = Bin.map Bin.beint64 decode_int64 encode_int64 + + let caqti : t Caqti_type.t = + let encode v = Ok (encode_int64 v) in + let decode v = Ok (decode_int64 v) in + Caqti_type.custom ~encode ~decode Caqti_type.int64 + + let jsont = + let number_or_forever_jsont = + let forever = + let dec s = + match s with + | "forever" -> None + | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" + in + let enc = function None -> "forever" | _ -> assert false in + Jsont.map ~dec ~enc Jsont.string + in + let number = + let dec n = + (* relative time is in us *) + let n = n /. 1_000_000. in + Ptime.Span.of_float_s n + in + let enc = function + | Some span -> + let n = Ptime.Span.to_float_s span in + n *. 1_000_000. + | _ -> assert false + in + Jsont.map ~dec ~enc Jsont.number + in + let enc = function None -> forever | Some _ -> number in + Jsont.any ~dec_string:forever ~dec_number:number ~enc () + in + + let make t_s = t_s in + Jsont.Object.map ~kind:"RelativeTime" make + |> Jsont.Object.mem "t_s" number_or_forever_jsont ~enc:Fun.id + |> Jsont.Object.finish +end diff --git a/src/timestamp.mli b/src/timestamp.mli index c1ac00ab..5a9276b6 100644 --- a/src/timestamp.mli +++ b/src/timestamp.mli @@ -1,15 +1,38 @@ (* TODO time - not sure about this *) + uhuh! + need to be int64 for binary/pg round trip + really need to fix this module + don't use option for never/forever *) type t = Ptime.t option type span = Ptime.Span.t option +module Span : sig + type t = span + + val of_string : string -> (t, string) result + val pp : Stdlib.Format.formatter -> t -> unit + + (* - *) + + val jsont : t Jsont.t + val bin : t Bin.t + val bin_nbo : t Bin.t + val caqti : t Caqti_type.t +end + +val epoch : t val diff : t -> t -> span val add_span_exn : t -> span -> t val of_span_exn : span -> t +val compare : t -> t -> int option + +(* used for offline tool argument conversion *) +val of_string : string -> (t, string) result +val pp : Stdlib.Format.formatter -> t -> unit (* - *) val jsont : t Jsont.t val bin : t Bin.t val bin_nbo : t Bin.t -val caqti : Ptime.t option Caqti_type.t +val caqti : t Caqti_type.t diff --git a/src/util.ml b/src/util.ml index 52691564..5d6bac8e 100644 --- a/src/util.ml +++ b/src/util.ml @@ -1,3 +1,5 @@ +exception Bin_error of string + (* TODO bin - no [Bin.of_string] ? *) let bin_of_string bin s = @@ -31,8 +33,6 @@ module Bin_rsa = struct let bits = Z.to_bits z in rev_string (String.length bits) bits - let check = function false -> Error (`Msg "invalid data") | true -> Ok () - let z_array_to_octets (arr : Z.t array) = let nb = Array.length arr in let bits_arr = Array.map z_to_bits_be arr in @@ -53,6 +53,10 @@ module Bin_rsa = struct bits_arr; Bytes.unsafe_to_string b + let check = function + | false -> Error "rsa of_octets error, invalid data" + | true -> Ok () + let z_array_of_octets ~nb s = let s_len = String.length s in let* () = check (s_len > 2 * nb) in @@ -83,34 +87,26 @@ module Bin_rsa = struct z_array_to_octets [| n; e |] let pub_of_octets s = - let pub_of_octets s = - let* arr = z_array_of_octets ~nb:2 s in - match arr with - | [| n; e |] -> - let* pub = Mirage_crypto_pk.Rsa.pub ~n ~e in - Ok pub - | _ -> assert false - in - match pub_of_octets s with - | Error (`Msg e) -> Fmt.failwith "rsa pub_of_octets failure: %s@." e - | Ok v -> v + let* arr = z_array_of_octets ~nb:2 s in + match arr with + | [| n; e |] -> + let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg in + pub + | _ -> assert false let priv_to_octets ({ e; d; n; p; q; dp; dq; q' } : Mirage_crypto_pk.Rsa.priv) = z_array_to_octets [| e; d; n; p; q; dp; dq; q' |] let priv_of_octets s = - let priv_of_octets s = - let* arr = z_array_of_octets ~nb:8 s in - match arr with - | [| e; d; n; p; q; dp; dq; q' |] -> - let* priv = Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' in - Ok priv - | _ -> assert false - in - match priv_of_octets s with - | Error (`Msg e) -> Fmt.failwith "rsa priv_of_octets failure: %s@." e - | Ok v -> v + let* arr = z_array_of_octets ~nb:8 s in + match arr with + | [| e; d; n; p; q; dp; dq; q' |] -> + let+ priv = + Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_err_msg + in + priv + | _ -> assert false end module Log_reporter = struct diff --git a/test/offline_management.sh b/test/offline_management.sh new file mode 100755 index 00000000..867a460b --- /dev/null +++ b/test/offline_management.sh @@ -0,0 +1,44 @@ +#!/bin/bash + +set -e + +a="tmp_a.json" +b="tmp_b.json" + +auditor_pub=$(<"./data/auditor_public_key") + +dune exec offline -- download --output $a +dune exec offline -- sign --input $a --output $b +dune exec offline -- upload --input $b --url "/management/keys" + +dune exec offline -- enable-auditor \ +--output $b \ +--auditor_url "auditor.example.com" \ +--auditor_name "auditor example" \ +--auditor_pub $auditor_pub \ +--validity_start "0.0" +dune exec offline -- upload --input $b --url "/management/auditors" + +dune exec offline -- wire-fee \ +--output $b \ +--wire_method "magic" \ +--fee_start "0.0" \ +--fee_end "99999999.9" \ +--closing_fee "EUR:0.0" \ +--wire_fee "EUR:0.0" +dune exec offline -- upload --input $b --url "/management/wire-fee" + +dune exec offline -- global-fees \ +--output $b \ +--start_date "0.0" \ +--end_date "99999999.9" \ +--history_fee "EUR:0.0" \ +--account_fee "EUR:0.0" \ +--purse_fee "EUR:0.0" \ +--history_expiration "9999999.0" \ +--purse_account_limit 1 \ +--purse_timeout "9999999.0" +dune exec offline -- upload --input $b --url "/management/global-fees" + +rm $a +rm $b diff --git a/test/test.ml b/test/test.ml index 4377e198..03831efc 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1,22 +1,21 @@ let () = Mirage_crypto_rng_unix.use_default () +let get_ok = function Error e -> failwith e | Ok v -> v let () = let priv = Mirage_crypto_pk.Rsa.generate ~bits:2048 () in let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in let () = let open Crypto.RsaPrivateKey in - let priv' = priv |> to_octets |> of_octets in + let priv' = priv |> to_octets |> of_octets |> get_ok in assert (to_octets priv = to_octets priv') in let () = let open Crypto.RsaPublicKey in - let pub' = pub |> to_octets |> of_octets in + let pub' = pub |> to_octets |> of_octets |> get_ok in assert (to_octets pub = to_octets pub') in () -let get_ok = function Error e -> failwith e | Ok v -> v - let () = let open Api in let check jsont s = diff --git a/tools/dune b/tools/dune index dc7b5c6a..f500902e 100644 --- a/tools/dune +++ b/tools/dune @@ -1,7 +1,7 @@ (executable (public_name offline) (name offline) - (modules offline offline_impl offline_bin) + (modules offline offline_impl offline_sig) (libraries cmdliner bos fmt mirage-crypto ptime mte vif)) ; todo depends on curl diff --git a/tools/offline.ml b/tools/offline.ml index ba191e35..d749813d 100644 --- a/tools/offline.ml +++ b/tools/offline.ml @@ -1,17 +1,78 @@ +(* TODO + all management operations: + /management/wire + /management/wire/disable + -> how to build WireSetupMessage? + we need additional data to craft master_sig + maybe supposed to be found in the full payto-uri? + + /management/aml-officers + -> /aml + /management/partners + -> /wads *) + open Cmdliner open Cmdliner.Term.Syntax open Offline_impl +module Arg = struct + include Arg + + let timestamp = + Arg.Conv.make ~docv:"timestamp argument" ~parser:Timestamp.of_string + ~pp:Timestamp.pp () + + let relative_time = + Arg.Conv.make ~docv:"relative time argument" + ~parser:Timestamp.Span.of_string ~pp:Timestamp.Span.pp () + + let b32 = + let pp fmt v = Fmt.pf fmt "%s" (B32.encode v) in + Arg.Conv.make ~docv:"Crockford's Base32 encoded argument" ~parser:B32.decode + ~pp () + + let amount = + Arg.Conv.make ~docv:"amount argument" ~parser:Amount.of_string ~pp:Amount.pp + () + + let eddsa_pub = + let parser s = Crypto.EddsaPublicKey.of_b32 s in + let pp fmt key = + let s = Crypto.EddsaPublicKey.to_b32 key in + Fmt.pf fmt "%s" s + in + Arg.Conv.make ~docv:"eddsa public key argument" ~parser ~pp () +end + let default_master_offline_key_file = "data/master_offline_private_key" +(* let default_response_file = "response.json" let default_request_file = "request.json" +*) -(*let to_term_ret = function Error e -> `Error (false, e) | Ok () -> `Ok ()*) -let to_term_ret = Fun.id +let master_key = + let doc = "Master offline Eddsa private key file." in + Arg.( + value + & opt file default_master_offline_key_file + & info [ "master_key_file" ] ~doc) + +let input = + let doc = "input file" in + Arg.(required & opt (some file) None & info [ "i"; "input" ] ~doc) + +let output = + let doc = "output file" in + Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc) + +let url = + let doc = "url" in + Arg.(required & opt (some string) None & info [ "url" ] ~doc) let setup_cmd = let doc = "Generate offline master keys" in let output = + let doc = "output file" in Arg.( value & opt filepath default_master_offline_key_file @@ -20,59 +81,212 @@ let setup_cmd = Cmd.make (Cmd.info "setup" ~doc) @@ let+ output = output in - setup ~output |> to_term_ret + setup ~output let download_cmd = let doc = "GET /management/keys/" in let man = [ `S Manpage.s_description; `P "$(cmd) download /management/keys." ] in - let output = - Arg.( - value & opt filepath default_response_file & info [ "o"; "output" ] ~doc) - in Cmd.make (Cmd.info "download" ~doc ~man) @@ let+ output = output in - download ~output |> to_term_ret + download ~output let upload_cmd = - let doc = "POST /management/keys/" in - let man = - [ `S Manpage.s_description; `P "$(cmd) upload /management/keys." ] - in - let input = - Arg.(value & opt file default_request_file & info [ "i"; "input" ] ~doc) - in - Cmd.make (Cmd.info "upload" ~doc ~man) + let doc = "POST input.json data to url (default /management/keys)" in + Cmd.make (Cmd.info "upload" ~doc) @@ - let+ input = input in - upload ~input |> to_term_ret + let+ input = input and+ url = url in + upload ~input ~url let sign_cmd = let doc = "Sign FutureKeysResponse." in - let master_key = - let doc = "Master offline Eddsa private key file." in - Arg.(value & opt file default_master_offline_key_file & info [ "key" ] ~doc) - in - let input = - Arg.(value & opt file default_response_file & info [ "i"; "input" ] ~doc) - in - let output = - Arg.( - value & opt filepath default_request_file & info [ "o"; "output" ] ~doc) - in Cmd.make (Cmd.info "sign" ~doc) @@ let+ input = input and+ output = output and+ master_key = master_key in - sign ~input ~output ~master_key |> to_term_ret + sign ~input ~output ~master_key + +let revoke_denom_cmd = + let doc = "Revoke denomination." in + let h_denom = + let doc = "hash of denomination public key" in + Arg.(required & pos 0 (some string) None & info [] ~doc) + in + Cmd.make (Cmd.info "revoke-denom" ~doc) + @@ + let+ output = output and+ master_key = master_key and+ h_denom = h_denom in + revoke_denom ~output ~master_key ~h_denom + +let revoke_signkey_cmd = + let doc = "Revoke signkey." in + let signkey = + let doc = "public signing key" in + Arg.(required & pos 0 (some eddsa_pub) None & info [] ~doc) + in + Cmd.make (Cmd.info "revoke-signkey" ~doc) + @@ + let+ output = output and+ master_key = master_key and+ signkey = signkey in + revoke_signkey ~output ~master_key ~signkey + +let enable_auditor_cmd = + let doc = "Enable auditor." in + let auditor_url = + Arg.(required & opt (some string) None & info [ "auditor_url" ]) + in + let auditor_name = + Arg.(required & opt (some string) None & info [ "auditor_name" ]) + in + let auditor_pub = + Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ]) + in + let validity_start = + Arg.(required & opt (some timestamp) None & info [ "validity_start" ]) + in + Cmd.make (Cmd.info "enable-auditor" ~doc) + @@ + let+ output = output + and+ master_key = master_key + and+ auditor_url = auditor_url + and+ auditor_name = auditor_name + and+ auditor_pub = auditor_pub + and+ validity_start = validity_start in + enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub + ~validity_start + +let disable_auditor_cmd = + let doc = "Disable auditor." in + let auditor_pub = + Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ]) + in + let validity_end = + Arg.(required & opt (some timestamp) None & info [ "validity_end" ]) + in + Cmd.make (Cmd.info "disable-auditor" ~doc) + @@ + let+ output = output + and+ master_key = master_key + and+ auditor_pub = auditor_pub + and+ validity_end = validity_end in + disable_auditor ~output ~master_key ~auditor_pub ~validity_end + +let wire_fee_cmd = + let doc = "Provides wire fee configuration." in + let wire_method = + Arg.(required & opt (some string) None & info [ "wire_method" ]) + in + let fee_start = + Arg.(required & opt (some timestamp) None & info [ "fee_start" ]) + in + let fee_end = + Arg.(required & opt (some timestamp) None & info [ "fee_end" ]) + in + let closing_fee = + Arg.(required & opt (some amount) None & info [ "closing_fee" ]) + in + let wire_fee = + Arg.(required & opt (some amount) None & info [ "wire_fee" ]) + in + Cmd.make (Cmd.info "wire-fee" ~doc) + @@ + let+ output = output + and+ master_key = master_key + and+ wire_method = wire_method + and+ fee_start = fee_start + and+ fee_end = fee_end + and+ closing_fee = closing_fee + and+ wire_fee = wire_fee in + Offline_impl.wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end + ~closing_fee ~wire_fee + +let global_fees_cmd = + let doc = "Provides global fee configuration." in + let start_date = + Arg.(required & opt (some timestamp) None & info [ "start_date" ]) + in + let end_date = + Arg.(required & opt (some timestamp) None & info [ "end_date" ]) + in + let history_fee = + Arg.(required & opt (some amount) None & info [ "history_fee" ]) + in + let account_fee = + Arg.(required & opt (some amount) None & info [ "account_fee" ]) + in + let purse_fee = + Arg.(required & opt (some amount) None & info [ "purse_fee" ]) + in + let history_expiration = + Arg.( + required & opt (some relative_time) None & info [ "history_expiration" ]) + in + let purse_account_limit = + Arg.(required & opt (some int) None & info [ "purse_account_limit" ]) + in + let purse_timeout = + Arg.(required & opt (some relative_time) None & info [ "purse_timeout" ]) + in + Cmd.make (Cmd.info "global-fees" ~doc) + @@ + let+ output = output + and+ master_key = master_key + and+ start_date = start_date + and+ end_date = end_date + and+ history_fee = history_fee + and+ account_fee = account_fee + and+ purse_fee = purse_fee + and+ history_expiration = history_expiration + and+ purse_account_limit = purse_account_limit + and+ purse_timeout = purse_timeout in + global_fees ~output ~master_key ~start_date ~end_date ~history_fee + ~account_fee ~purse_fee ~history_expiration ~purse_account_limit + ~purse_timeout + +let drain_cmd = + let doc = + "Drain profits from the exchange. The actual drain requires running the \ + `taler-exchange-drain` tool." + in + let debit_account_section = + Arg.(required & opt (some string) None & info [ "debit_account_section" ]) + in + let credit_payto_uri = + Arg.(required & opt (some string) None & info [ "credit_payto_uri" ]) + in + let wtid = Arg.(required & opt (some b32) None & info [ "wtid" ]) in + let date = Arg.(required & opt (some timestamp) None & info [ "date" ]) in + let amount = Arg.(required & opt (some amount) None & info [ "amount" ]) in + Cmd.make (Cmd.info "drain" ~doc) + @@ + let+ output = output + and+ master_key = master_key + and+ debit_account_section = debit_account_section + and+ credit_payto_uri = credit_payto_uri + and+ wtid = wtid + and+ date = date + and+ amount = amount in + drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid ~date + ~amount let cli = let info = let doc = "MTE Offline CLI tool" in Cmd.info "mte-offline" ~doc in - Cmd.group info [ setup_cmd; download_cmd; sign_cmd; upload_cmd ] + Cmd.group info + [ + setup_cmd; + download_cmd; + sign_cmd; + upload_cmd; + revoke_denom_cmd; + revoke_signkey_cmd; + enable_auditor_cmd; + disable_auditor_cmd; + wire_fee_cmd; + global_fees_cmd; + drain_cmd; + ] let main () = Cmd.eval_result cli let () = if !Sys.interactive then () else exit (main ()) diff --git a/tools/offline_bin.ml b/tools/offline_bin.ml deleted file mode 100644 index 1919706d..00000000 --- a/tools/offline_bin.ml +++ /dev/null @@ -1,84 +0,0 @@ -open Crypto -open Bin_type -open Api - -let denom_signature ~master_key - FutureDenom. - { - section_name= _; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - denom_pub; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund= _; - (* TODO check sigs *) - denom_secmod_sig= _; - } = - let octets = DenominationKey.to_octets denom_pub in - let h_denom_pub = HashCode.hash octets in - let master_sig = - let open Bin_signature.DenominationKeyValidityPS in - let master = EddsaPrivateKey.(pub_of_priv master_key) in - let denom_hash = DenominationHash.hash octets in - { - master; - start= stamp_start; - expire_withdraw= stamp_expire_withdraw; - expire_spend= stamp_expire_deposit; - expire_legal= stamp_expire_legal; - value; - fee_withdraw; - fee_deposit; - fee_refresh; - denom_hash; - } - |> Bin.to_string bin - |> EddsaSignature.sign ~key:master_key - in - DenomSignature.{ h_denom_pub; master_sig } - -let signkey_signature ~master_key - FutureSignKey. - { - key; - stamp_start; - stamp_expire; - stamp_end; - (* TODO check sigs *) - signkey_secmod_sig= _; - } = - let master_sig = - let open Bin_signature.ExchangeSigningKeyValidityPS in - { - start= stamp_start; - expire= stamp_expire; - end_= stamp_end; - signkey_pub= key; - } - |> Bin.to_string bin - |> EddsaSignature.sign ~key:master_key - in - SignKeySignature.{ key; master_sig } - -let make_master_signatures ~master_key - FutureKeysResponse. - { - future_denoms; - future_signkeys; - (* TODO check sigs *) - master_pub= _; - denom_secmod_public_key= _; - signkey_secmod_public_key= _; - } = - let denom_sigs = List.map (denom_signature ~master_key) future_denoms in - let signkey_sigs = List.map (signkey_signature ~master_key) future_signkeys in - MasterSignatures.{ denom_sigs; signkey_sigs } - -let verify_future_key_response _future_key_response = - (* TODO *) - Ok () diff --git a/tools/offline_impl.ml b/tools/offline_impl.ml index 2a0c09f4..0a505f8d 100644 --- a/tools/offline_impl.ml +++ b/tools/offline_impl.ml @@ -5,20 +5,22 @@ let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_err_msg let write_file fname content = Bos.OS.File.write (Fpath.v fname) content |> unwrap_err_msg -let base_url = Uri.of_string "http://localhost:3434/" +let read_master_key_file filename = + let* master_key = read_file filename in + Crypto.EddsaPrivateKey.of_octets master_key -let management_keys_url = - Uri.with_path base_url "/management/keys/" |> Uri.to_string +let base_url = Uri.of_string "http://localhost:3434/" +let full_url path = Uri.with_path base_url path |> Uri.to_string let download ~output = let open Bos in - let uri = management_keys_url in + let uri = full_url "/management/keys/" in OS.Cmd.run Cmd.(v "curl" % "-s" % "-o" % output % "-X" % "GET" % uri) |> unwrap_err_msg -let upload ~input = +let upload ~input ~url = let open Bos in - let uri = management_keys_url in + let uri = full_url url in OS.Cmd.run Cmd.( v "curl" @@ -42,14 +44,186 @@ let setup ~output = let sign ~master_key ~input ~output = let open Crypto in + let* master_key = read_master_key_file master_key in let* input = read_file input in - let* master_key = read_file master_key in - let master_key = EddsaPrivateKey.of_octets master_key in - let* future_key_response = Api.decode Api.FutureKeysResponse.jsont input in - let* () = Offline_bin.verify_future_key_response future_key_response in + let master_pub = EddsaPrivateKey.pub_of_priv master_key in + let* future_keys_response = Api.decode Api.FutureKeysResponse.jsont input in + let* () = + Offline_sig.verify_future_keys_response master_pub future_keys_response + in let master_signatures = - Offline_bin.make_master_signatures ~master_key future_key_response + Offline_sig.mk_future_keys ~master_key future_keys_response in let* s = Api.encode Api.MasterSignatures.jsont master_signatures in let* () = write_file output s in Ok () + +let revoke_denom ~output ~master_key ~h_denom = + let* key = read_master_key_file master_key in + let* h_denom_pub = Bin_type.DenominationHash.of_b32 h_denom in + let denom_revoke = + let master_sig = + let open Bin_sig.MasterDenominationKeyRevocation in + sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub } + in + Api.DenomRevocationSignature.{ master_sig } + in + let* s = Api.encode Api.DenomRevocationSignature.jsont denom_revoke in + let* () = write_file output s in + Ok () + +let revoke_signkey ~output ~master_key ~signkey = + let* key = read_master_key_file master_key in + let signkey_revoke = + let master_sig = + let open Bin_sig.MasterSigningKeyRevocation in + sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey } + in + Api.SignkeyRevocationSignature.{ master_sig } + in + let* s = Api.encode Api.SignkeyRevocationSignature.jsont signkey_revoke in + let* () = write_file output s in + Ok () + +let global_fees ~output ~master_key ~start_date ~end_date ~history_fee + ~account_fee ~purse_fee ~history_expiration ~purse_account_limit + ~purse_timeout = + let open Crypto in + let* key = read_master_key_file master_key in + let* purse_account_limit = + match + purse_account_limit >= 0 + && purse_account_limit <= Int32.to_int Int32.max_int + with + | false -> Error "invalid purse_account_limit value" + | true -> Ok (Int32.of_int purse_account_limit) + in + let master_sig = + let open Bin_sig.GlobalFees in + (* TODO KYC *) + let kyc_timeout = None in + let kyc_fee = Amount.dummy_value in + sign_f ~f:(EddsaSignature.sign ~key) + { + start_date; + end_date; + purse_timeout; + kyc_timeout; + history_expiration; + history_fee; + kyc_fee; + account_fee; + purse_fee; + purse_account_limit; + } + in + let global_fees = + Api.GlobalFees. + { + start_date; + end_date; + purse_timeout; + history_expiration; + history_fee; + account_fee; + purse_fee; + purse_account_limit; + master_sig; + } + in + let* s = Api.encode Api.GlobalFees.jsont global_fees in + let* () = write_file output s in + Ok () + +let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub + ~validity_start = + let open Crypto in + let* key = read_master_key_file master_key in + let master_sig = + let open Bin_sig.MasterAddAuditor in + sign_f ~f:(EddsaSignature.sign ~key) + { + start_date= validity_start; + auditor_pub; + h_auditor_url= Bin_type.Hash_64_cstr.hash auditor_url; + } + in + let v = + Api.AuditorSetupMessage. + { auditor_url; auditor_name; auditor_pub; master_sig; validity_start } + in + let* s = Api.encode Api.AuditorSetupMessage.jsont v in + let* () = write_file output s in + Ok () + +let disable_auditor ~output ~master_key ~auditor_pub ~validity_end = + let open Crypto in + let* key = read_master_key_file master_key in + let master_sig = + let open Bin_sig.MasterDelAuditor in + sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub } + in + let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in + let* s = Api.encode Api.AuditorTeardownMessage.jsont v in + let* () = write_file output s in + Ok () + +let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee + ~wire_fee = + let open Crypto in + let* key = read_master_key_file master_key in + let master_sig_wire = + let open Bin_sig.MasterWireFee in + sign_f ~f:(EddsaSignature.sign ~key) + { + h_wire_method= Bin_type.Hash_64_cstr.hash wire_method; + start_date= fee_start; + end_date= fee_end; + closing_fee; + wire_fee; + } + in + let v = + Api.WireFeeSetupMessage. + { + wire_method; + fee_start; + fee_end; + closing_fee; + wire_fee; + master_sig_wire; + } + in + let* s = Api.encode Api.WireFeeSetupMessage.jsont v in + let* () = write_file output s in + Ok () + +let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid + ~date ~amount = + let open Crypto in + let* key = read_master_key_file master_key in + let master_sig = + let open Bin_sig.MasterDrainProfit in + sign_f ~f:(EddsaSignature.sign ~key) + { + wtid; + date; + amount; + h_section= Bin_type.Hash_64_cstr.hash debit_account_section; + h_payto= Bin_type.FullPaytoHash.hash credit_payto_uri; + } + in + let v = + Api.DrainProfitsMessage. + { + debit_account_section; + credit_payto_uri; + wtid; + master_sig; + date; + amount; + } + in + let* s = Api.encode Api.DrainProfitsMessage.jsont v in + let* () = write_file output s in + Ok () diff --git a/tools/offline_sig.ml b/tools/offline_sig.ml new file mode 100644 index 00000000..0c07ce22 --- /dev/null +++ b/tools/offline_sig.ml @@ -0,0 +1,147 @@ +open Crypto +open Bin_type +open Api + +let verify_future_keys_response = + let verify_future_denom ~sm_denom_pub + FutureDenom. + { + section_name; + value= _; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit= _; + stamp_expire_legal= _; + denom_pub; + fee_withdraw= _; + fee_deposit= _; + fee_refresh= _; + fee_refund= _; + denom_secmod_sig; + } = + let h_denom_pub = + DenominationHash.hash (DenominationKey.to_octets denom_pub) + in + let h_section_name = Hash_64_cstr.hash section_name in + let anchor_time = stamp_start in + let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw in + let open Bin_sig.DenominationKeyAnnouncement in + verify_f + ~f:(EddsaSignature.verify ~key:sm_denom_pub) + denom_secmod_sig + { h_denom_pub; h_section_name; anchor_time; duration_withdraw } + in + let verify_future_signkey ~sm_signkey_pub + FutureSignKey. + { key; stamp_start; stamp_expire; stamp_end= _; signkey_secmod_sig } = + let exchange_pub = key in + let anchor_time = stamp_start in + let duration = Timestamp.diff stamp_start stamp_expire in + let open Bin_sig.SigningKeyAnnouncement in + verify_f + ~f:(EddsaSignature.verify ~key:sm_signkey_pub) + signkey_secmod_sig + { exchange_pub; anchor_time; duration } + in + + fun our_master_public_key + FutureKeysResponse. + { + future_denoms; + future_signkeys; + master_pub; + denom_secmod_public_key; + signkey_secmod_public_key; + } + -> + let open Syntax in + let* () = + match master_pub = our_master_public_key with + | false -> + Fmt.error + "master public key of the future key response does not match ours" + | true -> Ok () + in + let* () = + list_iter + (verify_future_denom ~sm_denom_pub:denom_secmod_public_key) + future_denoms + in + let* () = + list_iter + (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key) + future_signkeys + in + Ok () + +let mk_future_keys = + let denom_signature ~master_key + FutureDenom. + { + section_name= _; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + denom_pub; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund= _; + denom_secmod_sig= _; + } = + let octets = DenominationKey.to_octets denom_pub in + let h_denom_pub = DenominationHash.hash octets in + let master_sig = + let open Bin_sig.DenominationKeyValidity in + let master = EddsaPrivateKey.(pub_of_priv master_key) in + sign_f + ~f:(EddsaSignature.sign ~key:master_key) + { + master; + start= stamp_start; + expire_withdraw= stamp_expire_withdraw; + expire_spend= stamp_expire_deposit; + expire_legal= stamp_expire_legal; + value; + fee_withdraw; + fee_deposit; + fee_refresh; + denom_hash= h_denom_pub; + } + in + DenomSignature.{ h_denom_pub; master_sig } + in + let signkey_signature ~master_key + FutureSignKey. + { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } = + let master_sig = + let open Bin_sig.ExchangeSigningKeyValidity in + sign_f + ~f:(EddsaSignature.sign ~key:master_key) + { + start= stamp_start; + expire= stamp_expire; + end_= stamp_end; + signkey_pub= key; + } + in + SignKeySignature.{ key; master_sig } + in + + fun ~master_key + FutureKeysResponse. + { + future_denoms; + future_signkeys; + master_pub= _; + denom_secmod_public_key= _; + signkey_secmod_public_key= _; + } + -> + let denom_sigs = List.map (denom_signature ~master_key) future_denoms in + let signkey_sigs = + List.map (signkey_signature ~master_key) future_signkeys + in + MasterSignatures.{ denom_sigs; signkey_sigs }