mte/src/http_keys.ml
2026-02-03 17:43:54 +01:00

264 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 = "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.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 =
Some 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 [] -> None | v :: _ -> v.Denom_data.stamp_start
in
let denominations =
let open Denom_data in
(* TODO time
truncated timestamps to int for comparison *)
let timestamp_to_int = function
| None -> 0
| Some ptime -> ptime |> Ptime.to_float_s |> Int.of_float
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 -> timestamp_to_int v.stamp_start = last_issue_date)
denom_data_l
with
| None -> denom_data_l
| Some _ ->
List.filter
(fun v -> timestamp_to_int v.stamp_start >= last_issue_date)
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+ signkey_data_l = Pg.get_active_signkeys db_conn |> 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 Bin_sig.DenominationKeyValidity.to_octets
|> String.concat ""
|> Bin_type.Hash_64.hash
in
let open Bin_sig.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.epoch |> unwrap_err_caqti
in
let auditors =
(* TODO /management/auditors + /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) []
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 last_issue_date =
match Vif.Queries.get req "last_issue_date" with
| [] -> None
| v :: _ -> (
(* TODO time *)
match float_of_string_opt v with
| None ->
Fmt.failwith
"invalid `?last_issue_date` query param, float_of_string failure"
| Some v -> Some (Int.of_float v))
in
let res =
(*let last_issue_date = Ptime_clock.now () |> Option.some 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