mte/src/mte.ml

81 lines
2.9 KiB
OCaml
Raw Normal View History

2025-09-21 17:44:14 +02:00
(* 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
2025-09-28 16:58:47 +02:00
the Free Software Foundation, version 3.
2025-09-21 17:44:14 +02:00
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/>. *)
2025-09-28 20:04:52 +02:00
let hello req _server _env =
2025-09-28 22:12:16 +02:00
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
2025-09-28 20:04:52 +02:00
2025-09-13 15:56:19 +02:00
let routes =
let open Vif.Uri in
let open Vif.Route in
2025-12-06 20:50:29 +01:00
let open Vif.Type in
2025-12-06 22:29:56 +01:00
let get_ path = get (path /?? nil) in
let post path jsont = post (json_encoding jsont) (path /?? nil) in
2025-12-11 09:54:40 +01:00
let static =
let v s = rel / s in
[
get_ rel --> hello;
get_ (v "terms") --> Static.terms;
get_ (v "privacy") --> Static.privacy;
]
in
let management =
let open 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
static @ management
2025-09-13 15:56:19 +02:00
2025-09-13 17:57:29 +02:00
let () =
2025-11-29 19:36:35 +01:00
Util.Log_reporter.setup ();
2025-09-28 20:52:25 +02:00
let cfg =
2025-10-13 11:48:29 +02:00
let port = Config.Exchange.port in
2025-09-28 20:52:25 +02:00
let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
2025-11-29 19:36:35 +01:00
Vif.config ~reporter:Util.Log_reporter.reporter sockaddr
2025-09-28 20:52:25 +02:00
in
2025-09-13 17:57:29 +02:00
Miou_unix.run @@ fun () ->
2025-11-11 03:12:12 +01:00
Caqti_miou.Switch.run @@ fun caqti_switch ->
let env : Devices.env =
{ caqti_switch; db_uri= Config.Exchangedb_postgres.config }
in
let devices =
2025-11-22 21:40:24 +01:00
Vif.Devices.
2025-11-28 07:47:51 +01:00
[ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ]
2025-11-11 03:12:12 +01:00
in
2025-09-13 17:57:29 +02:00
let middlewares = Vif.Middlewares.[] in
2025-11-29 19:36:35 +01:00
Logs.info (fun m ->
m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
2025-10-18 18:19:09 +02:00
Vif.run ~cfg ~devices ~middlewares routes env