99 lines
3.5 KiB
OCaml
99 lines
3.5 KiB
OCaml
(* 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 hello req _server _env =
|
|
let open Vifu.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 Vifu.Uri in
|
|
let open Vifu.Route in
|
|
let get path = get (path /?? any) in
|
|
let post path jsont = post (Vifu.Type.json_encoding jsont) (path /?? any) in
|
|
let v s = rel / s in
|
|
let tos =
|
|
[
|
|
get rel --> hello;
|
|
get (v "terms") --> Mte_terms.terms;
|
|
get (v "privacy") --> Mte_terms.privacy;
|
|
]
|
|
in
|
|
let status_info =
|
|
[
|
|
get (v "seed") --> Mte_info.seed;
|
|
get (v "config") --> Mte_info.config;
|
|
get (v "keys") --> Mte_info.keys;
|
|
]
|
|
in
|
|
let management =
|
|
let open Mte_management in
|
|
let v s = v "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
|
|
|
|
module RNG = Mirage_crypto_rng.Fortuna
|
|
|
|
let () =
|
|
let ( let@ ) finally fn = Fun.protect ~finally fn in
|
|
Util.Log_reporter.setup ();
|
|
let rng =
|
|
let rng () = Mirage_crypto_rng_mkernel.initialize (module RNG) in
|
|
Mkernel.map rng Mkernel.[]
|
|
in
|
|
let storage = Mkernel.block "storage" in
|
|
let service =
|
|
let ipv4 = Ipaddr.V4.Prefix.of_string_exn "10.0.0.2/24" in
|
|
Mnet.stack ~name:"service"
|
|
ipv4
|
|
in
|
|
Mkernel.(run [ rng; storage; service ])
|
|
@@ fun rng storage (stack, tcp, udp) () ->
|
|
let@ () = fun () -> Mirage_crypto_rng_mkernel.kill rng in
|
|
let@ () = fun () -> Mnet.kill stack in
|
|
let hed, he = Mnet_happy_eyeballs.create tcp in
|
|
let@ () = fun () -> Mnet_happy_eyeballs.kill hed in
|
|
let dns = Mnet_dns.create (udp, he) in
|
|
let t = Mnet_dns.transport dns in
|
|
let@ () = fun () -> Mnet_dns.Transport.kill t in
|
|
Caqti_miou.Switch.run @@ fun sw ->
|
|
(* -- *)
|
|
let fs = Fat.create storage in
|
|
let env = Env.{ sw; stack; tcp; dns; fs } in
|
|
let devices = Vifu.Devices.[ Global.db_conn; Global.keys ] in
|
|
let cfg = Vifu.Config.v Config.Exchange.port in
|
|
Logs.info (fun m ->
|
|
m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
|
|
Vifu.run ~cfg ~devices tcp routes env
|