+ wip content negotation

src/mte.ml

@@ -4,35 +4,64 @@ module Assets = struct
     match Assets.read path with
     | None -> Fmt.failwith "asset loading failure `%s`" path
     | Some data -> data
-
-  let terms =
-    get Fpath.((Config.terms_dir / "en" / Config.terms_etag) + ".html")
-
-  let privacy =
-    get Fpath.((Config.privacy_dir / "en" / Config.privacy_etag) + ".html")
 end
 
-let static kind req _server _env =
+let static _kind req _server _env =
   let open Vif.Response.Syntax in
-  let extension = .. in
-  if not @@ extension is supported then
-    error mimetype not supported
-  else
-
-  let base_dir, etag =
-    let open Config in
-    match kind with
-  | `Terms ->   terms_dir, terms_etag
-  | `Privacy -> privacy_dir, privacy_etag
+  let headers = Vif.Request.headers req in
+  let media_l =
+    let accept = Vif.Headers.get headers "accept" in
+    Cohttp.Accept.media_ranges accept
+    |> Cohttp.Accept.qsort
+    |> List.map (fun (_q, (m, _p)) -> m)
+  in
+  let accept_language_l =
+    let accept_language = Vif.Headers.get headers "accept-language" in
+    Cohttp.Accept.languages accept_language
+    |> Cohttp.Accept.qsort
+    |> List.map (fun (_q, lang) -> lang)
+    |>
+    (* ignore language subtags *)
+    List.map (function
+      | Cohttp.Accept.AnyLanguage -> "*"
+      | Language l -> (
+          match l with
+          | [] -> Fmt.failwith "language subtags error"
+          | primary_tag :: _ -> primary_tag))
+  in
+  (* todo: not sure what to do if no accept-lenguage header *)
+  assert (List.length accept_language_l > 0);
+  (* find an approriate extension + supported lang_l *)
+  let opt =
+    media_l
+    |> List.find_map (fun media ->
+           match media with
+           | Cohttp.Accept.MediaType (m, m_sub) ->
+               List.assoc_opt (m, m_sub) Config.terms_assoc
+           | AnyMediaSubtype m ->
+               List.find_opt
+                 (fun ((mm, _), _) -> String.equal m mm)
+                 Config.terms_assoc
+               |> Option.map snd
+           | AnyMedia -> List.nth_opt Config.terms_assoc 0 |> Option.map snd)
+  in
+  let lang, ext =
+    match opt with
+    | None ->
+        (* todo respond with smthing approriate *)
+        Fmt.failwith "usuported mimetype"
+    | Some (ext, lang_l) -> (
+        (* pick best language to use *)
+        match Config.preferred_lang ~supported:lang_l accept_language_l with
+        | None ->
+            (* todo respond with smthing approriate *)
+            Fmt.failwith "usuported accepted language"
+        | Some lang -> (lang, ext))
+  in
+  (* todo add headers ... *)
+  let data =
+    Assets.get @@ Fpath.((Config.terms_dir / lang / Config.terms_etag) + ext)
   in
-
-  let accepted_lang_l = .. in
-
-
-  (* add headers ... *)
-
-
-
   let* () = Vif.Response.with_string ~compression:`Gzip req data in
   let field = "content-type" in
   let* () = Vif.Response.add ~field "html; charset=utf-8" in
@@ -43,8 +72,8 @@ let routes =
   let open Vif.Route in
   (*let open Vif.Type in*)
   [
-    get (rel / "terms" /?? nil) --> static Assets.terms
-  ; get (rel / "privacy" /?? nil) --> static Assets.privacy
+    get (rel / "terms" /?? nil) --> static `Terms
+  ; get (rel / "privacy" /?? nil) --> static `Privacy
   ]
 
 let () =