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

(* /terms + /privacy
   - try to find a response with an acceptable mime-type
   - pick the version in the most preferred language of the user
   - apply compression if that is allowed by the client
   - set ETAG header
   - If it did not change, a "304 Not Modified" response will be returned
   - 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"),
     include a "Avail-Languages" header: a comma-separated list of the languages available *)
module Static = struct
  let static kind req _server _env =
    let get_ok = function
      | Error e -> Fmt.failwith "TODO handle me, %s" e
      | Ok v -> v
    in
    let etag =
      (* TODO keep our static asset etag as Etag.t in Config? *)
      Assets.etag kind |> Headers.Etag.of_crockford32 |> Result.get_ok
    in
    let headers = Vif.Request.headers req in
    let has_matching_etag =
      match Vif.Headers.get headers "if-none-match" with
      | None -> false
      | Some s ->
          s |> Headers.Etag.parse |> get_ok |> Headers.Etag.evaluate etag
    in
    match has_matching_etag with
    | true ->
        let open Vif.Response.Syntax in
        let* () = Vif.Response.empty in
        Vif.Response.respond `Not_modified
    | false ->
        let mime = Headers.select_mimetype headers |> get_ok in
        let lang = Headers.select_language headers |> get_ok in
        let compression = Headers.select_encoding headers in
        let data = Assets.get_content ~mime ~lang kind in
        (* -- *)
        let open Vif.Response.Syntax in
        let* () = Vif.Response.with_string ?compression req data in
        let* () =
          let etag_field_value = Headers.Etag.to_field_value etag in
          Vif.Response.add ~field:"etag" etag_field_value
        in
        let* () =
          (* todo: is it "taler-privacy-version" for /policy ? *)
          Vif.Response.add ~field:"taler-terms-version"
            Config.terms_legal_version
        in
        let* () =
          Vif.Response.add ~field:"avail-languages"
            Headers.avail_languages_header_value
        in
        let* () =
          let content_type = Fmt.str "%s/%s" (fst mime) (snd mime) in
          Vif.Response.add ~field:"content-type" content_type
        in
        Vif.Response.respond `OK

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

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

let routes =
  let open Vif.Uri in
  let open Vif.Route in
  (*let open Vif.Type in*)
  [
    get (rel /?? nil) --> hello; 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