(* TODO header Cohttp -> Http *) let accept_header_value = let pp_list pp_item item = Fmt.list ~sep:(Fmt.any ", ") pp_item item in Fmt.str "%a" (pp_list Assets.Mimetype.pp) Assets.Mimetype.all_supported let avail_languages_header_value = let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item in let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in s 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.default_mimetype | 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.default_encoding | Encoding _ | Compress -> (* unsupported *) None) |> function | None -> None | Some `Identity -> None | Some `DEFLATE -> Some `DEFLATE | Some `Gzip -> Some `Gzip