wip clean up ToS

src/assets.ml

@@ -1,55 +1,15 @@
-(* TODO clean up *)
-
-(* docs: https://docs.taler.net/manpages/taler-exchange.conf.5.html
-   https://docs.taler.net/design-documents/003-tos-rendering.html *)
+(* doc: https://docs.taler.net/design-documents/003-tos-rendering.html
+   - must support `text/plain` and `text/markdown` *)
 
 (* hardcoded config just for static assets *)
 let default_lang = "en"
-let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
-
-(* todo: Taler documentation markdown mimetype should be the prefered one, and be
-   supported, according to DD we take text/plain as default instead for now *)
 let default_mimetype = ("text", "plain")
 let default_extension = ".txt"
-let terms_legal_version = "1"
-let privacy_legal_version = "1"
+let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
 
-module Mimetype = struct
-  let mimetype_extension_assoc =
-    [
-      (("text", "plain"), ".txt");
-      (("text", "markdown"), ".md");
-      (("text", "html"), ".html");
-      (("text", "html"), ".htm");
-      (("application", "pdf"), ".pdf");
-      (("image", "jpeg"), ".jpg");
-      (("image", "jpeg"), ".jpeg");
-      (("image", "png"), ".png");
-      (("image", "gif"), ".gif");
-    ]
-
-  let mimetype_l, _ = List.split mimetype_extension_assoc
-
-  let of_cohttp_media = function
-    | Cohttp.Accept.MediaType (m, m_sub) ->
-        List.find_opt (( = ) (m, m_sub)) mimetype_l
-    | AnyMediaSubtype m ->
-        List.find_opt (fun (m', _) -> String.equal m m') mimetype_l
-    | AnyMedia -> Some default_mimetype
-
-  let to_extension (m, m_sub) =
-    assert (m <> "*");
-    assert (m_sub <> "*");
-    List.assoc_opt (m, m_sub) mimetype_extension_assoc
-
-  let of_extension ext =
-    List.find_map
-      (fun (mime, ext') ->
-        match String.equal ext ext' with false -> None | true -> Some mime)
-      mimetype_extension_assoc
-
-  let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
-end
+(* TODO how to update ToS version? *)
+let terms_legal_version = "0"
+let privacy_legal_version = "0"
 
 (* TODO config *)
 type t =
@@ -65,11 +25,9 @@ let legal_version = function
   | Terms -> terms_legal_version
   | Privacy -> privacy_legal_version
 
-let base_dir = function
-  | Terms -> Fpath.v "terms"
-  | Privacy -> Fpath.v "privacy"
+let base_dir = function Terms -> "terms" | Privacy -> "privacy"
 
-(* does some checks on assets/ folder content and infer the set of supported languages and mimetype *)
+(* TODO clean up this horror *)
 let supported_lang_arr, supported_ext_arr =
   let open Syntax in
   let path_l =
@@ -78,7 +36,7 @@ let supported_lang_arr, supported_ext_arr =
     | Ok x -> x
   in
   let aux t =
-    let prefix = base_dir t in
+    let prefix = Fpath.v (base_dir t) in
     let path_l = path_l |> List.filter_map (Fpath.rem_prefix prefix) in
     let ext_l =
       path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
@@ -129,22 +87,63 @@ let supported_lang_arr, supported_ext_arr =
   in
   (Array.of_list lang_l, Array.of_list ext_l)
 
-let supported_mimetype_arr =
-  Array.map Mimetype.of_extension supported_ext_arr |> Array.map Option.get
+module Mimetype = struct
+  type t = string * string
 
-let is_supported_lang lang = Array.mem lang supported_lang_arr
-let is_supported_ext ext = Array.mem ext supported_ext_arr
-let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr
+  let pp fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
+
+  let assoc =
+    List.filter
+      (fun (_mime, ext) -> Array.mem ext supported_ext_arr)
+      [
+        (("text", "plain"), ".txt");
+        (("text", "markdown"), ".md");
+        (("text", "html"), ".html");
+        (("text", "html"), ".htm");
+        (("application", "pdf"), ".pdf");
+        (("image", "jpeg"), ".jpg");
+        (("image", "jpeg"), ".jpeg");
+        (("image", "png"), ".png");
+        (("image", "gif"), ".gif");
+      ]
+
+  let all_supported, _ = List.split assoc
+
+  let of_cohttp_media = function
+    | Cohttp.Accept.MediaType (m, m_sub) ->
+        List.find_opt (( = ) (m, m_sub)) all_supported
+    | AnyMediaSubtype m ->
+        List.find_opt (fun (m', _) -> String.equal m m') all_supported
+    | AnyMedia -> Some default_mimetype
+
+  let to_extension t =
+    match List.assoc_opt t assoc with
+    | None ->
+        Fmt.failwith "Mimetype.to_extension failure: `%s/%s` unknown" (fst t)
+          (snd t)
+    | Some ext -> ext
+
+  let is_supported mime = List.mem mime all_supported
+end
+
+module Language = struct
+  type t = string
+
+  let of_cohttp_language = function
+    | Cohttp.Accept.AnyLanguage -> Some default_lang
+    | Language language_range -> (
+        (* ignore language subtags (e.g. "en-US" -> "en") *)
+        match language_range with
+        | [] -> assert false
+        | lang :: _ when Array.mem lang supported_lang_arr -> Some lang
+        | _ -> None)
+end
 
 (* ! lang and mime must be supported *)
 let get_content ~lang ~mime t =
   let etag = Headers_lib.Etag.to_raw_string (etag t) in
-  let ext =
-    match Mimetype.to_extension mime with
-    | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime)
-    | Some ext -> ext
-  in
-  let path = Fpath.to_string Fpath.((base_dir t / lang / etag) + ext) in
+  let ext = Mimetype.to_extension mime in
+  let path = Fpath.to_string Fpath.((v (base_dir t) / lang / etag) + ext) in
   match Assets_crunch.read path with
   | None -> Fmt.failwith "static file not found: `%s`" path
   | Some data -> data