+ clean up tos

This commit is contained in:
swrup 2026-02-12 07:09:37 +01:00
parent 98ba917cfb
commit 28eb9fae55
3 changed files with 114 additions and 113 deletions

View file

@ -26,14 +26,14 @@ module Respond_with = struct
respond `Not_modified
end
let _aux kind req _server _env =
let etag = Assets.etag kind in
let aux asset req _server _env =
let etag = Assets.etag asset in
let headers = Vif.Request.headers req in
let has_matching_etag =
match Vif.Headers.get headers "if-none-match" with
| None -> Ok false
| Some s ->
Headers_lib.Etag.parse s |> Result.map (Headers_lib.Etag.evaluate etag)
Result.map (Headers_lib.Etag.evaluate etag) (Headers_lib.Etag.parse s)
in
match has_matching_etag with
| Error e ->
@ -46,7 +46,7 @@ let _aux kind req _server _env =
let mime = Headers.select_mimetype headers in
let lang = Headers.select_language headers in
let compression = Headers.select_encoding headers in
let data = Assets.get_content ~mime ~lang kind in
let data = Assets.get_content ~mime ~lang asset in
(* -- *)
let open Vif.Response in
let open Syntax in
@ -57,9 +57,8 @@ let _aux kind req _server _env =
in
let* () =
(* todo: is it "taler-privacy-version" for /policy ? *)
add ~field:"taler-terms-version" Assets.terms_legal_version
add ~field:"taler-terms-version" (Assets.legal_version asset)
in
(* TODO add compression and mimetype headers too *)
let* () =
add ~field:"avail-languages" Headers.avail_languages_header_value
in
@ -69,23 +68,6 @@ let _aux kind req _server _env =
in
respond `OK
(* WIP DEBUG *)
let aux _kind req _server _env =
let open Vif.Response in
let open Syntax in
let data = "uhuh" in
let etag = "0" in
let content_type = "text/plain" in
let* () = with_string req data in
let* () = add ~field:"etag" etag in
let* () =
(* todo: is it "taler-privacy-version" for /policy ? *)
add ~field:"taler-terms-version" Assets.terms_legal_version
in
let* () = add ~field:"avail-languages" Headers.avail_languages_header_value in
let* () = add ~field:"content-type" content_type in
respond `OK
let terms req _server _env =
Logs.info (fun m -> m "GET /terms");
aux Assets.Terms req _server _env