mte/src/mte.ml

(*  MTE - the MirageOS Taler Exchange
    Copyright (C) 2025 Olivier Pierre <swrup@protonmail.com>

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as published by
    the Free Software Foundation, version 3.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>. *)

let config req _server _env =
  Logs.info (fun m -> m "GET /config");
  let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in
  Respond_util.respond_with_ok_json s req

let hello req _server _env =
  let open Vif.Response in
  let open Syntax in
  let* () = with_string req "Hello~~\n" in
  let* () = add ~field:"content-type" "text/plain" in
  respond `OK

let routes =
  let open Vif.Uri in
  let open Vif.Route in
  let get_ path = get (path /?? any) in
  let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in
  let tos =
    let v s = rel / s in
    [
      get_ rel --> hello;
      get_ (v "terms") --> Static.terms;
      get_ (v "privacy") --> Static.privacy;
    ]
  in
  let status_info =
    [ get_ (rel / "config") --> config; get_ (rel / "keys") --> Http_keys.f ]
  in
  let management =
    let open Http_management in
    let v s = rel / "management" / s in
    [
      get_ (v "keys") --> Keys_get.f;
      post (v "keys") Keys_post.jsont --> Keys_post.f;
      post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
      --> Denom_revoke.f;
      post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont
      --> Signkey_revoke.f;
      post (v "auditors") Auditors.jsont --> Auditors.f;
      post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont
      --> Auditors_disable.f;
      post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f;
      post (v "global-fees") Global_fees.jsont --> Global_fees.f;
      post (v "wire") Wire.jsont --> Wire.f;
      post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f;
      post (v "drain") Drain.jsont --> Drain.f;
      post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f;
      post (v "partners") Partners.jsont --> Partners.f;
    ]
  in
  tos @ status_info @ management

let () =
  Util.Log_reporter.setup ();
  let cfg =
    let port = Config.Exchange.port in
    let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
    Vif.config ~reporter:Util.Log_reporter.reporter sockaddr
  in
  Miou_unix.run @@ fun () ->
  Caqti_miou.Switch.run @@ fun caqti_switch ->
  let env : Devices.env =
    { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
  in
  let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in
  let middlewares = Vif.Middlewares.[] in
  Logs.info (fun m ->
      m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
  Vif.run ~cfg ~devices ~middlewares routes env