mte/src/http_info.ml

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.geq v.Denomination.stamp_start timestamp)
          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