diff --git a/src/assets.ml b/src/assets.ml index 9de7212e..4fa5b57b 100644 --- a/src/assets.ml +++ b/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 diff --git a/src/headers.ml b/src/headers.ml index b91e2f7b..f3a24ac9 100644 --- a/src/headers.ml +++ b/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 =