From 26f5e392ee4ae0910edacac9b16cff9ff603f280 Mon Sep 17 00:00:00 2001 From: swrup Date: Sun, 14 Dec 2025 23:34:25 +0100 Subject: [PATCH] + --- data/assets/default.config | 1 + src/config.ml | 17 +++---- src/keys.ml | 101 +++++++++++++++++++++++++++++++++++-- src/management.ml | 16 +++++- src/parse_config.ml | 8 ++- src/pg.ml | 101 ++++++++++++++++++++++++------------- 6 files changed, 195 insertions(+), 49 deletions(-) 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/src/config.ml b/src/config.ml index e3c112ee..2228421c 100644 --- a/src/config.ml +++ b/src/config.ml @@ -40,17 +40,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 +104,7 @@ 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.parse; } let all_currencies = List.map parse_currency currency_sections diff --git a/src/keys.ml b/src/keys.ml index 3b216d58..3d9f66aa 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -1,16 +1,111 @@ -[@@@ocaml.warning "-27"] +[@@@ocaml.warning "-26-27"] +open Syntax open Api +module String_map = Stdlib.Map.Make (Stdlib.String) + +let mk_keys ~db_conn ~sm_signkey ~sm_denom ~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.to_json_string 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_accouts 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 = Config.Exchangedb.idle_reserve_expiration_time in + (* todo *) + let wallet_balance_limit_without_kyc = None in + let hard_limits = [] in + let zero_limits = [] in + (* + { + 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; + } + *) + assert false -let mk_keys ~sm_signkey ~sm_denom = assert false 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_signkey = Vif.Server.device Devices.secmod_signkey server in let sm_denom = Vif.Server.device Devices.secmod_denom server in let res = - let v = mk_keys ~sm_signkey ~sm_denom in + let last_issue_date = Ptime_clock.now () |> Option.some in + let* v = mk_keys ~db_conn ~sm_signkey ~sm_denom ~last_issue_date in let s = Api.encode_exn jsont v in Ok s in diff --git a/src/management.ml b/src/management.ml index 8d4655f2..09c64427 100644 --- a/src/management.ml +++ b/src/management.ml @@ -561,7 +561,21 @@ module Wire = struct match last_change_opt with | Some _ -> Error "wire already setup" | None -> - let+ () = Pg.insert_wire db_conn v |> unwrap_err_caqti in + (* 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 diff --git a/src/parse_config.ml b/src/parse_config.ml index 0fd672a3..0f53e4d3 100644 --- a/src/parse_config.ml +++ b/src/parse_config.ml @@ -228,7 +228,8 @@ 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 +(* TODO alt_unit_names jsont *) +module Alt_unit_names = struct let rm_brackets s = let s = String.trim s in match @@ -267,4 +268,9 @@ module Parse_alt_unit_names = struct | Some k -> k in (k, v)) + + let to_json_string l = + let l = List.map (fun (i, s) -> Fmt.str {|"%d": "%s"|} i s) l in + let s = String.concat "," l in + "{" ^ s ^ "}" end diff --git a/src/pg.ml b/src/pg.ml index 9a1a084f..0232e954 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -38,13 +38,16 @@ module Caqti_type = struct let eddsa_pub = EddsaPublicKey.caqti let eddsa_sig = EddsaSignature.caqti - (* TODO json strings? *) - let json_str = Caqti_type.string - (* todo: enum type for wire_method? *) let wire_method = Caqti_type.string let payto_uri = Caqti_type.string + 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 + include struct (* alias for hash *) @@ -324,8 +327,8 @@ let insert_wire = let insert_wire = let master_sig = Bin_sig.MasterWireDetails.caqti in Caqti_type.( - t8 payto_uri string json_str json_str master_sig time (option string) - (option int) + t8 payto_uri (option string) account_restrictions account_restrictions + master_sig time (option string) (option int) ->. unit) "INSERT INTO wire_accounts (payto_uri, conversion_url, \ debit_restrictions, credit_restrictions, master_sig, is_active, \ @@ -333,29 +336,25 @@ let insert_wire = ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,true,$6,$7,$8)" in fun (module Conn : CONN) - WireSetupMessage. + ~last_change + ExchangeWireAccount. { payto_uri; - master_sig_wire; - master_sig_add= _; - validity_start; + conversion_url; + debit_restrictions; + credit_restrictions; + master_sig; bank_label; priority; } -> - (* TODO wire - some field are allowed to be NULL - -> use option? *) - let conversion_url = "" in - let credit_restrictions = "" in - let debit_restrictions = "" in Conn.exec insert_wire ( payto_uri, conversion_url, debit_restrictions, credit_restrictions, - master_sig_wire, - validity_start, + master_sig, + last_change, bank_label, priority ) @@ -363,8 +362,8 @@ let update_wire = let update_wire = let master_sig = Bin_sig.MasterWireDetails.caqti in Caqti_type.( - t9 payto_uri bool string json_str json_str time master_sig (option string) - (option int) + t9 payto_uri bool (option string) account_restrictions + account_restrictions time master_sig (option string) (option int) ->. unit) "UPDATE wire_accounts SET is_active=$2, conversion_url=$3, \ debit_restrictions=$4::TEXT::JSONB, \ @@ -372,20 +371,18 @@ let update_wire = bank_label=$8, priority=$9 WHERE payto_uri=$1" in fun (module Conn : CONN) - WireSetupMessage. + ~last_change + ExchangeWireAccount. { payto_uri; - master_sig_wire; - master_sig_add= _; - validity_start; + conversion_url; + debit_restrictions; + credit_restrictions; + master_sig; bank_label; priority; } -> - (* TODO wire *) - let conversion_url = "" in - let credit_restrictions = "" in - let debit_restrictions = "" in let enabled = true in Conn.exec update_wire ( payto_uri, @@ -393,8 +390,8 @@ let update_wire = conversion_url, debit_restrictions, credit_restrictions, - validity_start, - master_sig_wire, + last_change, + master_sig, bank_label, priority ) @@ -485,21 +482,55 @@ let insert_partner = master_sig, partner_base_url ) -(* TODO wire - option for nullable fields? - collect in a record type *) let get_wire_accouts = let get_wire_accounts = let master_sig = Bin_sig.MasterWireDetails.caqti in Caqti_type.( unit - ->* t7 string (option string) (option string) int (option json_str) - (option json_str) master_sig) + ->* t7 string (option string) account_restrictions account_restrictions + master_sig (option string) (option int)) "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 () + fun (module Conn : CONN) -> + let open Syntax in + let+ l = Conn.collect_list get_wire_accounts () in + List.map + (fun ( payto_uri, + conversion_url, + debit_restrictions, + credit_restrictions, + master_sig, + bank_label, + priority ) -> + ExchangeWireAccount. + { + payto_uri; + conversion_url; + debit_restrictions; + credit_restrictions; + master_sig; + bank_label; + priority; + }) + l + +let get_wire_fees = + let get_wire_fees = + let master_sig = Bin_sig.MasterWireFee.caqti in + Caqti_type.(string ->* t5 amount amount time time master_sig) + "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 -> + let open Syntax in + let+ l = Conn.collect_list get_wire_fees wire_method in + List.map + (fun (wire_fee, closing_fee, start_date, end_date, sig_) -> + AggregateTransferFee. + { wire_fee; closing_fee; start_date; end_date; sig_ }) + l let get_global_fees = let get_global_fees =