mte/src/headers.ml
2026-02-10 22:11:52 +01:00

47 lines
1.5 KiB
OCaml

(* 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_media 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_language
|> function
| None -> Assets.default_lang
| 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