swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

wip debug

Browse source
This commit is contained in:
swrup 2026-02-07 00:11:25 +01:00
parent 08699487f1
commit 769d4f9f6e
6 changed files with 66 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

21
src/headers.ml
View file

@ -13,15 +13,21 @@ let avail_languages_header_value =
s
let select_mimetype headers =
let accept = Vif.Headers.get headers "accept" in
Cohttp.Accept.media_ranges accept
let opt = Vif.Headers.get headers "accept" in
Logs.err (fun m ->
let s = Option.value ~default:"none" opt in
m "Header accept: %s" s);
Cohttp.Accept.media_ranges opt
|> 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
let opt = Vif.Headers.get headers "accept-language" in
Logs.err (fun m ->
let s = Option.value ~default:"none" opt in
m "Header accept-language: %s" s);
Cohttp.Accept.languages opt
|> Cohttp.Accept.qsort
|> List.map (fun (_q, lang) -> lang)
|> List.map (function
@ -35,8 +41,11 @@ let select_language headers =
|> Option.value ~default:Assets.default_lang
let select_encoding headers =
Vif.Headers.get headers "accept-encoding"
|> Cohttp.Accept.encodings
let opt = Vif.Headers.get headers "accept-encoding" in
Logs.err (fun m ->
let s = Option.value ~default:"none" opt in
m "Header accept-encoding: %s" s);
Cohttp.Accept.encodings opt
|> Cohttp.Accept.qsort
|> List.map snd
|> List.filter_map (function