(* MTE - the MirageOS Taler Exchange Copyright (C) 2025 Olivier Pierre 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 . *) 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 (* TODO nice routes typing to enforce json verification to specify handlers responses data and status codes use Vif.Uri.conv *) 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 log_level = Some Logs.Info let () = let ( let@ ) finally fn = Fun.protect ~finally fn in Log_reporter.setup log_level; 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 cfg = Vifu.Config.v Config.Exchange.port in let devices = Vifu.Devices.[ Global.db_conn; Global.keys ] in let handlers = [ Mte_handler.not_implemented_route ] in let env = Global.{ sw; stack; tcp; dns; fs } in Logs.info (fun m -> m "Starting MTE server"); Vifu.run ~cfg ~devices ~handlers tcp routes env