From 5342a1281f4fc5c1d40c67d82284cf7c6016f419 Mon Sep 17 00:00:00 2001
From: Swrup <swrup@protonmail.com>
Date: Sat, 27 Sep 2025 18:38:54 +0200
Subject: [PATCH] + accept-encoding

---
 src/config.ml |  1 +
 src/mte.ml    | 65 ++++++++++++++++++++++++++++++++++-----------------
 2 files changed, 45 insertions(+), 21 deletions(-)

diff --git a/src/config.ml b/src/config.ml
index 5540de6b..611537d7 100644
--- a/src/config.ml
+++ b/src/config.ml
@@ -1,4 +1,5 @@
 let default_lang = "en"
+let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
 
 (* TODO
    generate `config.ml` from config file (virtual module)?
diff --git a/src/mte.ml b/src/mte.ml
index 15b479e9..197b70f7 100644
--- a/src/mte.ml
+++ b/src/mte.ml
@@ -19,9 +19,7 @@ module Header_util = struct
    fun headers ->
     let accept = Vif.Headers.get headers "accept" in
     Cohttp.Accept.media_ranges accept
-    |>
-    (* TODO check that its not in reverse order *)
-    Cohttp.Accept.qsort
+    |> Cohttp.Accept.qsort
     |> List.filter_map (fun (_q, (m, _p)) -> Util.media_to_extension m)
 
   let parse_accept_language_header headers =
@@ -36,24 +34,50 @@ module Header_util = struct
              match language_range with
              | [] -> assert false
              | primary_tag :: _ -> primary_tag))
+
+  let select_encoding headers =
+    Vif.Headers.get headers "accept-encoding"
+    |> Cohttp.Accept.encodings
+    |> Cohttp.Accept.qsort
+    |> List.map snd
+    |> List.filter_map (function
+         | Cohttp.Accept.Identity -> Some `Identity
+         | Deflate -> Some `DEFLATE
+         | Gzip -> Some `Gzip
+         | AnyEncoding -> Some Config.default_encoding
+         | Encoding _ | Compress -> (* unsupported *) None)
+    |> function
+    | [] -> assert false
+    | `Identity :: _ -> None
+    | `DEFLATE :: _ -> Some `DEFLATE
+    | `Gzip :: _ -> Some `Gzip
 end
 
 module Static = struct
-  (* TODO handle errors:
-   - bad headers
-   - see what to do if usupported lang or ext *)
-  (* assumes accept_ext_l and accept_lang_l to be sorted by preference *)
-  let select_file ~accept_lang_l ~accept_ext_l kind =
+  (* - 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
+
+     TODO:
+       - set an ETAG,
+       - 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 not, a "304 Not Modified" response will be returned.
+         Note that the “304 Not Modified” will also be returned if the client changed
+         the "Accept-Language" or "Accept-Encoding" header.
+       - 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
+
+  *)
+
+  (* accept_ext_l and accept_lang_l are assumed to be sorted by preference *)
+  let select_file headers kind =
     let open Syntax in
-    let* () =
-      if List.is_empty accept_ext_l then Fmt.error "empty accept header"
-      else Ok ()
-    in
-    let* () =
-      if List.is_empty accept_lang_l then
-        Fmt.error "empty accept language header"
-      else Ok ()
-    in
+    let accept_ext_l = Header_util.parse_accept_header headers in
+    let accept_lang_l = Header_util.parse_accept_language_header headers in
     let* ext =
       accept_ext_l
       |> List.find_opt Assets.is_supported_ext
@@ -72,14 +96,13 @@ module Static = struct
   let static kind req _server _env =
     let open Vif.Response.Syntax in
     let headers = Vif.Request.headers req in
-    let accept_ext_l = Header_util.parse_accept_header headers in
-    let accept_lang_l = Header_util.parse_accept_language_header headers in
     let data =
-      match select_file ~accept_lang_l ~accept_ext_l kind with
+      match select_file headers kind with
       | Error e -> Fmt.failwith "%s" e
       | Ok content -> content
     in
-    let* () = Vif.Response.with_string ~compression:`Gzip req data in
+    let compression = Header_util.select_encoding headers in
+    let* () = Vif.Response.with_string ?compression req data in
     let field = "content-type" in
     let* () = Vif.Response.add ~field "html; charset=utf-8" in
     Vif.Response.respond `OK