From c7901eb9e183580877d051ea412071bda52d1d2a Mon Sep 17 00:00:00 2001 From: swrup Date: Wed, 25 Feb 2026 21:46:20 +0100 Subject: [PATCH] JJ: Description from the destination commit: + wire JJ: Description from source commit: + drain --- src/api.ml | 95 +++++++++++++++++------------- src/http_management.ml | 115 +++++++++++++++++++++++++------------ src/pg.ml | 49 +++++++--------- src/pg_type.ml | 3 +- test/offline_management.sh | 33 +++++++++-- tools/offline.ml | 46 +++++++++++---- tools/offline_impl.ml | 75 ++++++++++++++++++++++++ 7 files changed, 296 insertions(+), 120 deletions(-) diff --git a/src/api.ml b/src/api.ml index 6fbade8b..f6b87cc3 100644 --- a/src/api.ml +++ b/src/api.ml @@ -624,44 +624,6 @@ module GlobalFees = struct |> finish end -module WireSetupMessage = struct - type t = { - payto_uri: string; - master_sig_wire: MasterWireDetails.t; - master_sig_add: MasterAddWire.t; - 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; @@ -685,7 +647,7 @@ end module DrainProfitsMessage = struct type t = { - wtid: B32.t; + wtid: Bytes32.t; debit_account_section: string; credit_payto_uri: string; date: Timestamp.t; @@ -1137,6 +1099,61 @@ module AccountRestriction = struct |> finish end +module WireSetupMessage = struct + type t = { + payto_uri: string; + master_sig_wire: MasterWireDetails.t; + master_sig_add: MasterAddWire.t; + conversion_url: string option; + credit_restrictions: AccountRestriction.t list; + debit_restrictions: AccountRestriction.t list; + validity_start: Timestamp.t; + bank_label: string option; + priority: int option; + } + + let jsont = + let make payto_uri master_sig_wire master_sig_add conversion_url + credit_restrictions debit_restrictions validity_start bank_label + priority = + { + payto_uri; + master_sig_wire; + master_sig_add; + conversion_url; + credit_restrictions; + debit_restrictions; + 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 conversion_url v = v.conversion_url in + let credit_restrictions v = v.credit_restrictions in + let debit_restrictions v = v.debit_restrictions 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 "conversion_url" (Jsont.option 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 "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 ExchangeWireAccount = struct type t = { payto_uri: string; diff --git a/src/http_management.ml b/src/http_management.ml index afacfe6e..47b4a139 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -375,22 +375,37 @@ module Wire = struct payto_uri; master_sig_wire; master_sig_add; + conversion_url; + credit_restrictions; + debit_restrictions; validity_start; bank_label= _; priority= _; } = - (* TODO are those read from payto_uri? *) - let conversion_url = "" in - let credit_restrictions = "" in - let debit_restrictions = "" in + (* TODO wire + hash over json, hash over string option? *) + let* () = + match (credit_restrictions, debit_restrictions) with + | [], [] -> Ok () + | _ -> + Fmt.error + "wire setup: credit_restrictions and debit_restrictions are not \ + supported" + in + let h_wire_details = Hash.FullPaytoHash.hash payto_uri in + let h_conversion_url = + Hash.Cstring.H64.hash ((* ?? *) Option.value ~default:"" conversion_url) + in + let h_credit_restrictions = Hash.Cstring.H64.hash "" in + let h_debit_restrictions = Hash.Cstring.H64.hash "" in let* () = let open Signatures.MasterWireDetails in verify Config.master_public_key master_sig_wire { - h_wire_details= FullPaytoHash.hash payto_uri; - h_conversion_url= Hash.Cstring.H64.hash conversion_url; - h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions; - h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions; + h_wire_details; + h_conversion_url; + h_credit_restrictions; + h_debit_restrictions; } in let* () = @@ -398,38 +413,56 @@ module Wire = struct verify Config.master_public_key master_sig_add { start_date= validity_start; - h_wire= FullPaytoHash.hash payto_uri; - h_conversion_url= Hash.Cstring.H64.hash conversion_url; - h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions; - h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions; + h_wire= h_wire_details; + h_conversion_url; + h_credit_restrictions; + h_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" + let do_ ~db_conn + WireSetupMessage. + { + payto_uri; + master_sig_wire; + master_sig_add= _; + conversion_url; + credit_restrictions; + debit_restrictions; + validity_start; + bank_label; + priority; + } = + let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in + match opt with + | Some wire -> + let+ () = + Pg.update_wire db_conn ~is_active:true ~last_change:validity_start + wire + |> unwrap_err_caqti + in + Logs.info (fun m -> m "updated wire method"); + () | None -> - let r = + let wire = 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; + payto_uri; + conversion_url; + credit_restrictions; + debit_restrictions; + master_sig= master_sig_wire; + bank_label; + priority; } in let+ () = - Pg.insert_wire db_conn ~last_change:v.validity_start r + Pg.update_wire db_conn ~is_active:true ~last_change:validity_start + wire |> unwrap_err_caqti in + Logs.info (fun m -> m "added wire method"); () let jsont = WireSetupMessage.jsont @@ -456,15 +489,15 @@ module Wire_disable = struct 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 + let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in + match opt with | None -> Error "wire not found" - | Some _ -> + | Some wire -> let+ () = - Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti + Pg.update_wire db_conn ~is_active:false ~last_change:validity_end wire + |> unwrap_err_caqti in + Logs.info (fun m -> m "disabled wire method"); () let jsont = WireTeardownMessage.jsont @@ -504,8 +537,18 @@ module Drain = struct } let do_ ~db_conn v = - let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in - () + let* opt = + Pg.find_drain_profit db_conn v.DrainProfitsMessage.wtid + |> unwrap_err_caqti + in + match opt with + | Some _ -> + Logs.info (fun m -> m "drain profit message already added to database"); + Ok () + | None -> + let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in + Logs.info (fun m -> m "added drain profit message to database"); + () let jsont = DrainProfitsMessage.jsont diff --git a/src/pg.ml b/src/pg.ml index 892fb98b..749d9d46 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -255,46 +255,30 @@ let insert_global_fees = in fun (module Conn : CONN) v -> Conn.exec req v -let get_wire_timestamp = +let find_wire = let req = - Caqti_type.(payto_uri ->? time) - "SELECT last_change FROM wire_accounts WHERE payto_uri=$1" + Caqti_type.(payto_uri ->? exchange_wire_account) + "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \ + credit_restrictions::TEXT, master_sig, bank_label, priority FROM \ + wire_accounts WHERE payto_uri=$1" in fun (module Conn : CONN) ~payto_uri -> Conn.find_opt req payto_uri -let insert_wire = +let update_wire = let req = 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 req (v, is_active, last_change) - -let update_wire = - let req = - 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" + ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,$8,$9) ON CONFLICT \ + (payto_uri) DO UPDATE SET conversion_url=$2, \ + credit_restrictions=$3::TEXT::JSONB, \ + debit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \ + priority=$7, is_active=$8, last_change=$9" in fun (module Conn : CONN) ~is_active ~last_change v -> Conn.exec req (v, is_active, last_change) -let disable_wire = - let req = - 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 req (payto_uri, validity_end) - let get_wire_accounts = let req = Caqti_type.(unit ->* exchange_wire_account) @@ -304,11 +288,20 @@ let get_wire_accounts = in fun (module Conn : CONN) () -> Conn.collect_list req () +let find_drain_profit = + let req = + Caqti_type.(octets ->? drain_profit_message) + "SELECT wtid, account_section, payto_uri, trigger_date, (amount).*, \ + master_sig FROM profit_drains WHERE wtid=$1" + in + fun (module Conn : CONN) wtid -> Conn.find_opt req wtid + let insert_drain_profit = let req = 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)" + trigger_date, amount, master_sig) VALUES ($1::BYTEA, $2, $3, $4, \ + ($5,$6), $7)" in fun (module Conn : CONN) v -> Conn.exec req v diff --git a/src/pg_type.ml b/src/pg_type.ml index a78f274a..57865968 100644 --- a/src/pg_type.ml +++ b/src/pg_type.ml @@ -24,7 +24,6 @@ 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 *) @@ -266,7 +265,7 @@ let drain_profit_message = amount; master_sig; }) - Caqti_type.(t6 b32 string string time amount master_sig) + Caqti_type.(t6 octets string string time amount master_sig) let aml_officer_setup = let master_sig = Signatures.MasterAmlOfficerStatus.caqti in diff --git a/test/offline_management.sh b/test/offline_management.sh index b80bbc73..63877239 100755 --- a/test/offline_management.sh +++ b/test/offline_management.sh @@ -82,8 +82,31 @@ offline_tool global-fees \ offline_tool upload --input $b --url $url"/management/global-fees" echo "[OK] /management/global-fees" -# todo test enable wire -# todo test disable wire -# todo test drain -# todo test aml-officer -# todo test partners +offline_tool enable-wire \ +--master_key $master_key \ +--output $b \ +--payto_uri "" \ +--bank_label "" \ +--priority 4 +offline_tool upload --input $b --url $url"/management/wire" +echo "[OK] /management/wire" + +offline_tool disable-wire \ +--master_key $master_key \ +--output $b \ +--payto_uri "" +offline_tool upload --input $b --url $url"/management/wire/disable" +echo "[OK] /management/wire/disable" + +# wtid (after base32 decode) must be 32bytes +wtid="000G40R40M30E209185GR38E1W8124GK2GAHC5RR34D1P70X3RFG" +offline_tool drain \ +--master_key $master_key \ +--output $b \ +--debit_account_section "" \ +--credit_payto_uri "" \ +--wtid $wtid \ +--date 0 \ +--amount $zero_euro +offline_tool upload --input $b --url $url"/management/drain" +echo "[OK] /management/drain" diff --git a/tools/offline.ml b/tools/offline.ml index 86217734..595bcc9c 100644 --- a/tools/offline.ml +++ b/tools/offline.ml @@ -1,13 +1,6 @@ -(* TODO - all management operations: - /management/wire - /management/wire/disable - - /management/aml-officers - -> /aml - /management/partners - -> /wads *) - +(* not done: + /management/aml-officers (for /aml) + /management/partners (for /wads) *) open Cmdliner open Cmdliner.Term.Syntax open Offline_impl @@ -292,6 +285,36 @@ let global_fees_cmd = ~account_fee ~purse_fee ~history_expiration ~purse_account_limit ~purse_timeout +let enable_wire_cmd = + let doc = "Enable wire method." in + let payto_uri = + Arg.(required & opt (some string) None & info [ "payto_uri" ]) + in + let bank_label = + Arg.(value & opt (some string) None & info [ "bank_label" ]) + in + let priority = Arg.(value & opt (some int) None & info [ "priority" ]) in + Cmd.make (Cmd.info "enable-wire" ~doc) + @@ + let+ output = output + and+ master_key = master_key + and+ payto_uri = payto_uri + and+ bank_label = bank_label + and+ priority = priority in + enable_wire ~output ~master_key ~payto_uri ~bank_label ~priority + +let disable_wire_cmd = + let doc = "Disable wire method." in + let payto_uri = + Arg.(required & opt (some string) None & info [ "payto_uri" ]) + in + Cmd.make (Cmd.info "disable-wire" ~doc) + @@ + let+ output = output + and+ master_key = master_key + and+ payto_uri = payto_uri in + disable_wire ~output ~master_key ~payto_uri + let drain_cmd = let doc = "Drain profits from the exchange. The actual drain requires running the \ @@ -335,7 +358,10 @@ let cli = disable_auditor_cmd; wire_fee_cmd; global_fees_cmd; + enable_wire_cmd; + disable_wire_cmd; drain_cmd; + (* - *) test_hash64_cmd; ] diff --git a/tools/offline_impl.ml b/tools/offline_impl.ml index 39ae19c2..cc681153 100644 --- a/tools/offline_impl.ml +++ b/tools/offline_impl.ml @@ -338,9 +338,84 @@ let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee let* () = write_file output s in Ok () +(* TODO wire + hash over json, hash over string option? + + ~conversion_url ~credit_restrictions ~debit_restrictions *) +let enable_wire ~output ~master_key ~payto_uri ~bank_label ~priority = + let* key = read_master_key_file master_key in + let ns = Mtime_clock.now_ns () in + let validity_start = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in + let h_wire_details = Hash.FullPaytoHash.hash payto_uri in + let conversion_url = None in + let credit_restrictions = [] in + let debit_restrictions = [] in + let h_conversion_url = + Hash.Cstring.H64.hash ((* ?? *) Option.value ~default:"" conversion_url) + in + let h_credit_restrictions = Hash.Cstring.H64.hash "" in + let h_debit_restrictions = Hash.Cstring.H64.hash "" in + let master_sig_wire = + let open Signatures.MasterWireDetails in + signf (EddsaSignature.sign ~key) + { + h_wire_details; + h_conversion_url; + h_credit_restrictions; + h_debit_restrictions; + } + in + let master_sig_add = + let open Signatures.MasterAddWire in + signf (EddsaSignature.sign ~key) + { + start_date= validity_start; + h_wire= h_wire_details; + h_conversion_url; + h_credit_restrictions; + h_debit_restrictions; + } + in + let v = + Api.WireSetupMessage. + { + master_sig_wire; + master_sig_add; + payto_uri; + conversion_url; + credit_restrictions; + debit_restrictions; + validity_start; + bank_label; + priority; + } + in + let* s = Api.encode Api.WireSetupMessage.jsont v in + let* () = write_file output s in + Ok () + +let disable_wire ~output ~master_key ~payto_uri = + let* key = read_master_key_file master_key in + let ns = Mtime_clock.now_ns () in + let validity_end = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in + let h_wire = Hash.FullPaytoHash.hash payto_uri in + let master_sig_del = + let open Signatures.MasterDelWire in + signf (EddsaSignature.sign ~key) { end_date= validity_end; h_wire } + in + let v = Api.WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } in + let* s = Api.encode Api.WireTeardownMessage.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* key = read_master_key_file master_key in + let* () = + match String.length wtid = 32 with + | false -> Error "invalid wtid: must be 32 bytes" + | true -> Ok () + in let master_sig = let open Signatures.MasterDrainProfit in signf (EddsaSignature.sign ~key)