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

~ Header_util

Browse source
This commit is contained in:
Swrup 2025-09-27 20:44:31 +02:00
parent 1cb610988f
commit 50b77108f1
1 changed files with 6 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/mte.ml
View file

@ -15,14 +15,14 @@
along with this program. If not, see <https://www.gnu.org/licenses/>. *) along with this program. If not, see <https://www.gnu.org/licenses/>. *)
module Header_util = struct module Header_util = struct
let parse_accept_header = let select_extension headers =
fun headers ->
let accept = Vif.Headers.get headers "accept" in let accept = Vif.Headers.get headers "accept" in
Cohttp.Accept.media_ranges accept Cohttp.Accept.media_ranges accept
|> Cohttp.Accept.qsort |> Cohttp.Accept.qsort
|> List.filter_map (fun (_q, (m, _p)) -> Util.media_to_extension m) |> List.filter_map (fun (_q, (m, _p)) -> Util.media_to_extension m)
|> List.find_opt Assets.is_supported_ext
let parse_accept_language_header headers = let select_language headers =
let accept_language = Vif.Headers.get headers "accept-language" in let accept_language = Vif.Headers.get headers "accept-language" in
Cohttp.Accept.languages accept_language Cohttp.Accept.languages accept_language
|> Cohttp.Accept.qsort |> Cohttp.Accept.qsort
@ -34,6 +34,7 @@ module Header_util = struct
match language_range with match language_range with
| [] -> assert false | [] -> assert false
| primary_tag :: _ -> primary_tag)) | primary_tag :: _ -> primary_tag))
|> List.find_opt Assets.is_supported_lang
let select_encoding headers = let select_encoding headers =
Vif.Headers.get headers "accept-encoding" Vif.Headers.get headers "accept-encoding"
@ -74,15 +75,11 @@ module Static = struct
let select_file headers kind = let select_file headers kind =
let open Syntax in let open Syntax in
let* ext = let* ext =
headers Header_util.select_extension headers
|> Header_util.parse_accept_header
|> List.find_opt Assets.is_supported_ext
|> Option.to_result ~none:"no acceptable mimetype" |> Option.to_result ~none:"no acceptable mimetype"
in in
let* lang = let* lang =
headers Header_util.select_language headers
|> Header_util.parse_accept_language_header
|> List.find_opt Assets.is_supported_lang
|> Option.to_result ~none:"no acceptable language" |> Option.to_result ~none:"no acceptable language"
in in
let content = Assets.get_content ~lang ~ext kind in let content = Assets.get_content ~lang ~ext kind in