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/>. *)

module Static = struct
  (* /terms + /privacy

     - try to find a response with an acceptable mime-type,
     - then pick the version in the most preferred language of the user,
     - and finally apply compression if that is allowed by the client
     - set ETAG header

     TODO:
       - subsequent requests of the client should provide the tag in an "If-None-Match" header
         to detect if the terms of service have changed
       - If it did not change, a "304 Not Modified" response will be returned
       - The ETAG is encoded in Crockford base-32
       - A "Taler-Terms-Version" header is generated to indicate the legal version of the terms
       - When returning a full response (not a "304 Not Modified"), the server
         should also include a "Avail-Languages" header which includes a
         comma-separated list of the languages in which the terms of service are available in
  *)

  let select_file headers kind =
    let open Syntax in
    let* ext =
      Option.to_result ~none:"no acceptable mimetype"
        (Headers.select_extension headers)
    in
    let* lang =
      Option.to_result ~none:"no acceptable language"
        (Headers.select_language headers)
    in
    let content = Assets.get_content ~lang ~ext kind in
    content

  (* TODO add headers, handle errors etc
     think on how to (not) mix error and vif monade well *)
  let static kind req _server _env =
    let open Vif.Response.Syntax in
    let headers = Vif.Request.headers req in
    (* TODO(etag) *)
    let _if_none_match = Vif.Headers.get headers "if-none-match" in
    let data =
      match select_file headers kind with
      | Error e -> Fmt.failwith "%s" e
      | Ok content -> content
    in
    let compression = Headers.select_encoding headers in
    let* () = Vif.Response.with_string ?compression req data in
    (* TODO(etag) *)
    let* () = Vif.Response.add ~field:"etag" (Assets.etag kind) in
    (* TODO content-type *)
    let* () = Vif.Response.add ~field:"content-type" "html; charset=utf-8" in
    Vif.Response.respond `OK

  let terms = static Assets.Terms
  let privacy = static Assets.Privacy
end

let routes =
  let open Vif.Uri in
  let open Vif.Route in
  (*let open Vif.Type in*)
  [
    get (rel / "terms" /?? nil) --> Static.terms
  ; get (rel / "privacy" /?? nil) --> Static.privacy
  ]

let () =
  Miou_unix.run @@ fun () ->
  let env = () in
  let middlewares = Vif.Middlewares.[] in
  Vif.run ~middlewares routes env