let accept_header_value = let s = Fmt.str "%a" Util.(pp_array pp_mime) Assets.supported_mimetype_arr in s let avail_languages_header_value = let s = Fmt.str "%a" (Util.pp_array Fmt.string) Assets.supported_lang_arr in s 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.find_opt Assets.is_supported_mimetype let select_language headers = let accept_language = Vif.Headers.get headers "accept-language" in Cohttp.Accept.languages accept_language |> Cohttp.Accept.qsort |> List.map (fun (_q, lang) -> lang) |> List.map (function | Cohttp.Accept.AnyLanguage -> Config.default_lang | Language language_range -> ( (* ignore language subtags (e.g. "en-US" -> "en") *) match language_range with | [] -> assert false | primary_tag :: _ -> primary_tag)) |> List.find_opt Assets.is_supported_lang |> Option.value ~default:Config.default_lang let select_encoding headers = Vif.Headers.get headers "accept-encoding" |> Cohttp.Accept.encodings |> Cohttp.Accept.qsort |> List.map snd |> List.filter_map (function | Cohttp.Accept.Identity -> Some `Identity | Deflate -> Some `DEFLATE | Gzip -> Some `Gzip | AnyEncoding -> Some Config.default_encoding | Encoding _ | Compress -> (* unsupported *) None) |> function | [] -> assert false | `Identity :: _ -> None | `DEFLATE :: _ -> Some `DEFLATE | `Gzip :: _ -> Some `Gzip