This commit is contained in:
swrup 2025-12-14 23:34:25 +01:00
parent 638cccc185
commit 26f5e392ee
6 changed files with 195 additions and 49 deletions

View file

@ -27,6 +27,7 @@ max_keys_caching = "4 weeks"
enable_kyc = NO enable_kyc = NO
terms_etag = "0" terms_etag = "0"
privacy_etag = "0" privacy_etag = "0"
base_url = localhost
[exchangedb] [exchangedb]
idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds" idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds"

View file

@ -40,17 +40,16 @@ module Exchange = struct
let enable_kyc = get "enable_kyc" |> yes_no let enable_kyc = get "enable_kyc" |> yes_no
let terms_etag = get "terms_etag" let terms_etag = get "terms_etag"
let privacy_etag = get "privacy_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: (* not implemented or not relevant to MTE:
let max_requests = get "max_requests" |> int let max_requests = get "max_requests" |> int
base_url
aggregator_shard_size aggregator_shard_size
serve serve
unixpath unixpath
@ -105,7 +104,7 @@ module Currency = struct
fractional_normal_digits= get "fractional_normal_digits" |> int; fractional_normal_digits= get "fractional_normal_digits" |> int;
fractional_trailing_zero_digits= fractional_trailing_zero_digits=
get "fractional_trailing_zero_digits" |> int; 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 let all_currencies = List.map parse_currency currency_sections

View file

@ -1,16 +1,111 @@
[@@@ocaml.warning "-27"] [@@@ocaml.warning "-26-27"]
open Syntax
open Api 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 let jsont = ExchangeKeysResponse.jsont
(* TODO query param ?last_issue_date *)
let f req server _env = let f req server _env =
Logs.info (fun m -> m "GET /keys/"); 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_signkey = Vif.Server.device Devices.secmod_signkey server in
let sm_denom = Vif.Server.device Devices.secmod_denom server in let sm_denom = Vif.Server.device Devices.secmod_denom server in
let res = 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 let s = Api.encode_exn jsont v in
Ok s Ok s
in in

View file

@ -561,7 +561,21 @@ module Wire = struct
match last_change_opt with match last_change_opt with
| Some _ -> Error "wire already setup" | Some _ -> Error "wire already setup"
| None -> | 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 let jsont = WireSetupMessage.jsont

View file

@ -228,7 +228,8 @@ let ed25519 s =
|> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e) |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
|> unwrap_res |> unwrap_res
module Parse_alt_unit_names = struct (* TODO alt_unit_names jsont *)
module Alt_unit_names = struct
let rm_brackets s = let rm_brackets s =
let s = String.trim s in let s = String.trim s in
match match
@ -267,4 +268,9 @@ module Parse_alt_unit_names = struct
| Some k -> k | Some k -> k
in in
(k, v)) (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 end

101
src/pg.ml
View file

@ -38,13 +38,16 @@ module Caqti_type = struct
let eddsa_pub = EddsaPublicKey.caqti let eddsa_pub = EddsaPublicKey.caqti
let eddsa_sig = EddsaSignature.caqti let eddsa_sig = EddsaSignature.caqti
(* TODO json strings? *)
let json_str = Caqti_type.string
(* todo: enum type for wire_method? *) (* todo: enum type for wire_method? *)
let wire_method = Caqti_type.string let wire_method = Caqti_type.string
let payto_uri = 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 include struct
(* alias for hash *) (* alias for hash *)
@ -324,8 +327,8 @@ let insert_wire =
let insert_wire = let insert_wire =
let master_sig = Bin_sig.MasterWireDetails.caqti in let master_sig = Bin_sig.MasterWireDetails.caqti in
Caqti_type.( Caqti_type.(
t8 payto_uri string json_str json_str master_sig time (option string) t8 payto_uri (option string) account_restrictions account_restrictions
(option int) master_sig time (option string) (option int)
->. unit) ->. unit)
"INSERT INTO wire_accounts (payto_uri, conversion_url, \ "INSERT INTO wire_accounts (payto_uri, conversion_url, \
debit_restrictions, credit_restrictions, master_sig, is_active, \ 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)" ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,true,$6,$7,$8)"
in in
fun (module Conn : CONN) fun (module Conn : CONN)
WireSetupMessage. ~last_change
ExchangeWireAccount.
{ {
payto_uri; payto_uri;
master_sig_wire; conversion_url;
master_sig_add= _; debit_restrictions;
validity_start; credit_restrictions;
master_sig;
bank_label; bank_label;
priority; 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 Conn.exec insert_wire
( payto_uri, ( payto_uri,
conversion_url, conversion_url,
debit_restrictions, debit_restrictions,
credit_restrictions, credit_restrictions,
master_sig_wire, master_sig,
validity_start, last_change,
bank_label, bank_label,
priority ) priority )
@ -363,8 +362,8 @@ let update_wire =
let update_wire = let update_wire =
let master_sig = Bin_sig.MasterWireDetails.caqti in let master_sig = Bin_sig.MasterWireDetails.caqti in
Caqti_type.( Caqti_type.(
t9 payto_uri bool string json_str json_str time master_sig (option string) t9 payto_uri bool (option string) account_restrictions
(option int) account_restrictions time master_sig (option string) (option int)
->. unit) ->. unit)
"UPDATE wire_accounts SET is_active=$2, conversion_url=$3, \ "UPDATE wire_accounts SET is_active=$2, conversion_url=$3, \
debit_restrictions=$4::TEXT::JSONB, \ debit_restrictions=$4::TEXT::JSONB, \
@ -372,20 +371,18 @@ let update_wire =
bank_label=$8, priority=$9 WHERE payto_uri=$1" bank_label=$8, priority=$9 WHERE payto_uri=$1"
in in
fun (module Conn : CONN) fun (module Conn : CONN)
WireSetupMessage. ~last_change
ExchangeWireAccount.
{ {
payto_uri; payto_uri;
master_sig_wire; conversion_url;
master_sig_add= _; debit_restrictions;
validity_start; credit_restrictions;
master_sig;
bank_label; bank_label;
priority; priority;
} }
-> ->
(* TODO wire *)
let conversion_url = "" in
let credit_restrictions = "" in
let debit_restrictions = "" in
let enabled = true in let enabled = true in
Conn.exec update_wire Conn.exec update_wire
( payto_uri, ( payto_uri,
@ -393,8 +390,8 @@ let update_wire =
conversion_url, conversion_url,
debit_restrictions, debit_restrictions,
credit_restrictions, credit_restrictions,
validity_start, last_change,
master_sig_wire, master_sig,
bank_label, bank_label,
priority ) priority )
@ -485,21 +482,55 @@ let insert_partner =
master_sig, master_sig,
partner_base_url ) partner_base_url )
(* TODO wire
option for nullable fields?
collect in a record type *)
let get_wire_accouts = let get_wire_accouts =
let get_wire_accounts = let get_wire_accounts =
let master_sig = Bin_sig.MasterWireDetails.caqti in let master_sig = Bin_sig.MasterWireDetails.caqti in
Caqti_type.( Caqti_type.(
unit unit
->* t7 string (option string) (option string) int (option json_str) ->* t7 string (option string) account_restrictions account_restrictions
(option json_str) master_sig) master_sig (option string) (option int))
"SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \ "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
credit_restrictions::TEXT, master_sig, bank_label, priority FROM \ credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
wire_accounts WHERE is_active" wire_accounts WHERE is_active"
in 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 =
let get_global_fees = let get_global_fees =