mte/src/mte_terms.ml

50 lines
1.6 KiB
OCaml
Raw Normal View History

2026-02-10 21:49:42 +01:00
(* /terms + /privacy *)
2025-11-29 19:36:35 +01:00
2026-02-12 07:09:37 +01:00
let aux asset req _server _env =
let etag = Assets.etag asset in
2026-03-12 12:23:57 +01:00
let headers = Vifu.Request.headers req in
2025-11-29 19:36:35 +01:00
let has_matching_etag =
2026-03-12 12:23:57 +01:00
match Vifu.Headers.get headers "if-none-match" with
2025-11-29 19:36:35 +01:00
| None -> Ok false
| Some s ->
2026-02-12 11:25:57 +01:00
Headers_lib.If_none_match.parse s
|> Result.map (Headers_lib.If_none_match.evaluate etag)
2025-11-29 19:36:35 +01:00
in
match has_matching_etag with
2026-02-12 12:13:30 +01:00
| Error e -> Respond.bad_request ~hint:e req
| Ok true -> Respond.not_modified ()
2026-02-10 21:49:42 +01:00
| Ok false ->
let mime = Headers.select_mimetype headers in
let lang = Headers.select_language headers in
let compression = Headers.select_encoding headers in
2026-02-12 07:09:37 +01:00
let data = Assets.get_content ~mime ~lang asset in
2026-02-10 21:49:42 +01:00
(* -- *)
2026-03-12 12:23:57 +01:00
let open Vifu.Response in
2026-02-10 21:49:42 +01:00
let open Syntax in
let* () = with_string ?compression req data in
let* () =
2026-02-12 11:25:57 +01:00
let etag_field_value = Headers_lib.Etag.to_field_string etag in
2026-02-10 21:49:42 +01:00
add ~field:"etag" etag_field_value
in
let* () =
2026-02-12 07:09:37 +01:00
add ~field:"taler-terms-version"
Assets.Assets_config.terms_legal_version
2026-02-10 21:49:42 +01:00
in
let* () =
add ~field:"avail-languages" Headers.avail_languages_header_value
in
let* () =
let content_type = Fmt.str "%a" Assets.Mimetype.pp mime in
add ~field:"content-type" content_type
in
2026-02-12 07:09:37 +01:00
let* () = add ~field:"content-language" lang in
2026-02-10 21:49:42 +01:00
respond `OK
2025-11-29 19:36:35 +01:00
2026-02-07 00:11:25 +01:00
let terms req _server _env =
Logs.info (fun m -> m "GET /terms");
aux Assets.Terms req _server _env
let privacy req _server _env =
Logs.info (fun m -> m "GET /privacy");
aux Assets.Privacy req _server _env