~ util; add Protocol_version

src/assets.ml

@@ -75,12 +75,6 @@ let supported_lang_arr, supported_ext_arr =
   let lang_l, ext_l = aux Terms in
   let lang_l', ext_l' = aux Privacy in
   let () =
-    List.iter
-      (fun path ->
-        if not @@ Util.is_valid_filename path then
-          Fmt.failwith "file `%s` has an unsupported extension"
-            (Fpath.to_string path))
-      path_l;
     if
       not
       @@ (List.equal String.equal lang_l lang_l'
@@ -94,7 +88,7 @@ let supported_lang_arr, supported_ext_arr =
   (Array.of_list lang_l, Array.of_list ext_l)
 
 let supported_mimetype_arr =
-  Array.map Util.extension_to_mimetype supported_ext_arr |> Array.map Option.get
+  Array.map Util.Mimetype.of_extension supported_ext_arr |> Array.map Option.get
 
 let is_supported_lang lang = Array.mem lang supported_lang_arr
 let is_supported_ext ext = Array.mem ext supported_ext_arr
@@ -107,7 +101,7 @@ let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr
 let get_content ~lang ~mime t =
   let etag = Headers_lib.Etag.to_raw_string (etag t) in
   let ext =
-    match Util.mimetype_to_extension mime with
+    match Util.Mimetype.to_extension mime with
     | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime)
     | Some ext -> ext
   in

src/headers.ml

@@ -10,7 +10,7 @@ let select_mimetype headers =
   let accept = Vif.Headers.get headers "accept" in
   Cohttp.Accept.media_ranges accept
   |> Cohttp.Accept.qsort
-  |> List.filter_map (fun (_q, (m, _p)) -> Util.media_to_known_mimetype m)
+  |> List.filter_map (fun (_q, (m, _p)) -> Util.Mimetype.of_cohttp_media m)
   |> List.find_opt Assets.is_supported_mimetype
 
 let select_language headers =

src/util.ml

@@ -1,33 +1,42 @@
-let mimetype_ext_assoc =
+module Protocol_version = struct
-  [
+  (* libtool version format *)
-    (("text", "plain"), ".txt"); (("text", "markdown"), ".md")
+  (* todo *)
-  ; (("text", "html"), ".html"); (("text", "html"), ".htm")
+  let current = 0
-  ; (("application", "pdf"), ".pdf"); (("image", "jpeg"), ".jpg")
+  let revision = 0
-  ; (("image", "jpeg"), ".jpeg"); (("image", "png"), ".png")
+  let age = 0
-  ; (("image", "gif"), ".gif")
+  let v = Fmt.str "%d:%d:%d"
-  ]
+end
 
-(* <> than the actual set of "supported" extension (which depends on config files) *)
+module Mimetype = struct
-let all_known_mimetypes, all_known_extensions = List.split mimetype_ext_assoc
+  let mimetype_extension_assoc =
-let is_valid_filename path = Fpath.mem_ext all_known_extensions path
+    [
+      (("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 media_to_known_mimetype = function
+  let mimetype_l, _ = List.split mimetype_extension_assoc
-  | Cohttp.Accept.MediaType (m, m_sub) ->
-      List.find_opt (( = ) (m, m_sub)) all_known_mimetypes
-  | AnyMediaSubtype m ->
-      List.find_opt (fun (m', _) -> String.equal m m') all_known_mimetypes
-  | AnyMedia -> Some Config.default_mimetype
 
-let mimetype_to_extension (m, m_sub) =
+  let of_cohttp_media = function
-  assert (m <> "*");
+    | Cohttp.Accept.MediaType (m, m_sub) ->
-  assert (m_sub <> "*");
+        List.find_opt (( = ) (m, m_sub)) mimetype_l
-  List.assoc_opt (m, m_sub) mimetype_ext_assoc
+    | AnyMediaSubtype m ->
+        List.find_opt (fun (m', _) -> String.equal m m') mimetype_l
+    | AnyMedia -> Some Config.default_mimetype
 
-let extension_to_mimetype ext =
+  let to_extension (m, m_sub) =
-  List.find_map
+    assert (m <> "*");
-    (fun (mime, ext') ->
+    assert (m_sub <> "*");
-      match String.equal ext ext' with false -> None | true -> Some mime)
+    List.assoc_opt (m, m_sub) mimetype_extension_assoc
-    mimetype_ext_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
+end
 
 (* -- pretty printers -- *)
 let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)