let accept_header_value = Fmt.str "%a" (Fmt.array ~sep:(Fmt.any ", ") Assets.Mimetype.pp) Assets.Mimetype.arr let avail_languages_header_value = Fmt.str "%a" (Fmt.array ~sep:(Fmt.any ", ") Fmt.string) Assets.Language.arr (* TODO Cohttp raises on invalid *) 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 m) |> function | None -> Assets.Mimetype.default | Some mime -> mime let select_language headers = let opt = Vif.Headers.get headers "accept-language" in Cohttp.Accept.languages opt |> Cohttp.Accept.qsort |> List.map snd |> List.find_map Assets.Language.of_cohttp |> function | None -> Assets.Language.default | Some lang -> lang let select_encoding headers = let opt = Vif.Headers.get headers "accept-encoding" in Cohttp.Accept.encodings opt |> Cohttp.Accept.qsort |> List.map snd |> List.find_map (function | Cohttp.Accept.Identity -> Some `Identity | Deflate -> Some `DEFLATE | Gzip -> Some `Gzip | AnyEncoding -> Some Assets.Assets_config.default_encoding | Encoding _ | Compress -> (* unsupported *) None) |> function | None -> None | Some `Identity -> None | Some `DEFLATE -> Some `DEFLATE | Some `Gzip -> Some `Gzip