mte/src/http_keys.ml
2026-02-07 01:01:05 +01:00

262 lines
7.5 KiB
OCaml

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 = Api.protocol_version 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 = 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
| [] -> Time.Timestamp.never
| v :: _ -> v.Denom_data.stamp_start
in
let denominations =
let open Denom_data 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 ->
Time.Timestamp.compare v.stamp_start last_issue_date = 0)
denom_data_l
with
| None -> denom_data_l
| Some _ ->
List.filter
(fun v ->
Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
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 now = Ptime_clock.now () |> Option.some in
let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> 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 Signatures.DenominationKeyValidity.to_octets
|> String.concat ""
|> Hash.H64.hash
in
let open Signatures.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.zero |> 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 res =
let* last_issue_date =
match Vif.Queries.get req "last_issue_date" with
| [] -> Ok None
| v :: _ -> (
match int_of_string_opt v with
| None ->
Error
"invalid `?last_issue_date` query param, int_of_string failure"
| Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n))))
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