swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

+ wire

Browse source
This commit is contained in:
swrup 2026-02-25 21:46:20 +01:00
parent f3c6424ec9
commit e716990b11
6 changed files with 252 additions and 101 deletions
Download patch file Download diff file Expand all files Collapse all files

93
src/api.ml
View file

@ -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;
@ -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;

99
src/http_management.ml
View file

@ -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
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
match last_change_opt with
| Some _ -> Error "wire already setup"
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

38
src/pg.ml
View file

@ -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)

18
test/offline_management.sh
View file

@ -82,8 +82,22 @@ 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
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"
# todo test drain
# todo test aml-officer
# todo test partners

33
tools/offline.ml
View file

@ -292,6 +292,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 \
@ -336,6 +366,9 @@ let cli =
wire_fee_cmd;
global_fees_cmd;
drain_cmd;
enable_wire_cmd;
disable_wire_cmd;
(* - *)
test_hash64_cmd;
]

70
tools/offline_impl.ml
View file

@ -338,6 +338,76 @@ 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