open Syntax open Api module String_map = Stdlib.Map.Make (Stdlib.String) (* TODO mirage-crypto is this ok? maybe don't use the same RNG-initialization as the one used to generate keys *) let seed req _server _env = Logs.info (fun m -> m "GET /seed"); (* RNG is initialized by Vif.run *) let s = Mirage_crypto_rng.generate 64 in let open Vif.Response in let open Syntax in let* () = add ~field:"content-type" "application/octet-stream" in let* () = with_string req s in respond `OK let config req _server _env = Logs.info (fun m -> m "GET /config"); let res = Api.encode Api.ExchangeVersionResponse.jsont config in Respond.result res req (* not implemented: - kyc - wads - account limits - zero limited operations - recoup - extensions *) let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date = let version = Libtool_version.mte_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 = Api.currency_specification 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 (* type of the asset. "fiat", "crypto", "regional" or "stock". *) let asset_type = "fiat" in let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_err_caqti in let* wire_fees = (* wire_methods? *) let wire_method = "x-taler-bank" 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 = [] in let kyc_enabled = false in let disable_direct_deposit = false in let master_public_key = Config.master_public_key in let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in let wallet_balance_limit_without_kyc = None in let hard_limits = [] in let zero_limits = [] in let* denom_l = Keys.denominations () in let list_issue_date = List.fold_left (fun acc dn -> Timestamp.max acc dn.Denomination.stamp_start) Timestamp.zero denom_l in let denom_l = (* if `?last_issue_date` query param does not exactly match the `stamp_start` of one of the denomination keys, all keys are returned *) let stamp_start_opt = match last_issue_date with | None -> None | Some timestamp -> List.find_map (fun v -> if Timestamp.equal v.Denomination.stamp_start timestamp then Some v.stamp_start else None) denom_l in match stamp_start_opt with | None -> denom_l | Some timestamp -> List.filter (fun v -> Timestamp.compare timestamp v.Denomination.stamp_start <= 0) denom_l in let* denominations = Denomination.make_denom_group_sorted denom_l in let* signkeys = Keys.signkeys () in (* the eddsa pub key used to sign exchange_sig *) let* exchange_pub = let now = Timestamp.of_ptime (Ptime_clock.now ()) in let opt = List.find_opt (fun sk -> Signkey.is_valid_at ~timestamp:now sk) signkeys in match opt with | None -> Fmt.error "exchange has no active signkey" | Some sk -> Ok sk.pub in let signkeys = List.map Api.SignKey.of_signkey signkeys in (* ! depends on denominations order *) let exchange_sig = let open Signatures.ExchangeKeySet in signf (Keys.sign exchange_pub) R. { list_issue_date; hc= Denomination.hash_over_master_sigs denominations; } in let recoup = (* /recoup *) [] in let* global_fees = Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti in let* auditors = (* /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) 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; 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 let keys req server _env = Logs.info (fun m -> m "GET /keys"); let db_conn = Vif.Server.device Devices.db_connection server in let keys = Vif.Server.device Devices.keys server in let res = let* last_issue_date = match Vif.Queries.get req "last_issue_date" with | [] -> Ok None | s :: _ -> ( match Int64.of_string_opt s with | None -> Error "invalid `?last_issue_date` query param, not an int" | Some n -> Ok (Some (Timestamp.of_s n))) in let* v = mk_keys ~db_conn keys ~last_issue_date in Api.encode jsont v in Respond.result res req