+ wip tos

src/assets.ml

@@ -16,10 +16,10 @@ type t =
   | Terms
   | Privacy
 
+(* TODO etag = filename *)
 let etag k =
-  Result.get_ok
-  @@ Headers_lib.Etag.of_crockford32
-  @@ match k with Terms -> "0" | Privacy -> "0"
+  let etag = match k with Terms -> "0" | Privacy -> "0" in
+  etag |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
 
 let legal_version = function
   | Terms -> terms_legal_version
@@ -107,30 +107,40 @@ module Mimetype = struct
         (("image", "gif"), ".gif");
       ]
 
-  let all_supported, _ = List.split assoc
+  let all_supported =
+    let all_supported, all_supported_ext = List.split assoc in
+    match
+      Array.find_opt
+        (fun ext -> not @@ List.exists (( = ) ext) all_supported_ext)
+        supported_ext_arr
+    with
+    | Some ext -> Fmt.failwith "extension `%s` unsupported" ext
+    | None -> all_supported
 
-  let of_cohttp_media = function
+  let default = default_mimetype
+
+  let of_cohttp = 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
+    | AnyMedia -> Some default
 
-  let to_extension t =
+  let to_extension_exn 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
+  let default = default_lang
+
+  let of_cohttp = function
+    | Cohttp.Accept.AnyLanguage -> Some default
     | Language language_range -> (
         (* ignore language subtags (e.g. "en-US" -> "en") *)
         match language_range with
@@ -142,7 +152,7 @@ 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 = Mimetype.to_extension mime in
+  let ext = Mimetype.to_extension_exn 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

src/headers.ml

@@ -14,7 +14,7 @@ let select_mimetype headers =
   let opt = Vif.Headers.get headers "accept" in
   Cohttp.Accept.media_ranges opt
   |> Cohttp.Accept.qsort
-  |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
+  |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp m)
   |> function
   | None -> Assets.default_mimetype
   | Some mime -> mime
@@ -24,9 +24,9 @@ let select_language headers =
   Cohttp.Accept.languages opt
   |> Cohttp.Accept.qsort
   |> List.map snd
-  |> List.find_map Assets.Language.of_cohttp_language
+  |> List.find_map Assets.Language.of_cohttp
   |> function
-  | None -> Assets.default_lang
+  | None -> Assets.Language.default
   | Some lang -> lang
 
 let select_encoding headers =