mte/src/mte.ml
2025-09-28 19:44:36 +02:00

97 lines
3.4 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/>. *)
module Static = struct
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
(* /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
- If it did not change, a "304 Not Modified" response will be returned
TODO:
- 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 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 =
get_ok
@@
match Vif.Headers.get headers "if-none-match" with
| None -> Ok false
| Some s ->
Headers.Etag.parse s |> Result.map (Headers.Etag.evaluate etag)
in
let open Vif.Response.Syntax in
match has_matching_etag with
| true ->
let* () = Vif.Response.empty in
Vif.Response.respond `Not_modified
| false ->
let data = select_file headers kind |> get_ok in
let compression = Headers.select_encoding headers in
let* () = Vif.Response.with_string ?compression req data in
let etag_field_value = Headers.Etag.to_field_value etag in
let* () = Vif.Response.add ~field:"etag" etag_field_value 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