let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item let accept_header_value = let s = Fmt.str "%a" (pp_array Assets.Mimetype.pp_mime) Assets.supported_mimetype_arr in s let avail_languages_header_value = let s = Fmt.str "%a" (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)) -> Assets.Mimetype.of_cohttp_media 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 -> Assets.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:Assets.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 Assets.Config.default_encoding | Encoding _ | Compress -> (* unsupported *) None) |> function | [] -> assert false | `Identity :: _ -> None | `DEFLATE :: _ -> Some `DEFLATE | `Gzip :: _ -> Some `Gzip