mte/src/headers.ml

(* 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