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

add taler_config.ml with module sig; put config in assets.ml

Browse source
This commit is contained in:
swrup 2025-10-13 00:29:33 +02:00
parent be2e590e93
commit a3d6b30170
6 changed files with 245 additions and 177 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/headers.ml
View file

@ -1,16 +1,22 @@
let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item
let accept_header_value =
let s = Fmt.str "%a" Util.(pp_array pp_mime) Assets.supported_mimetype_arr in
let s =
Fmt.str "%a"
(pp_array Assets.Mimetype.pp_mime)
Assets.supported_mimetype_arr
in
s
let avail_languages_header_value =
let s = Fmt.str "%a" (Util.pp_array Fmt.string) Assets.supported_lang_arr in
let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
s
let select_mimetype headers =
let accept = Vif.Headers.get headers "accept" in
Cohttp.Accept.media_ranges accept
|> Cohttp.Accept.qsort
|> List.filter_map (fun (_q, (m, _p)) -> Util.Mimetype.of_cohttp_media m)
|> List.filter_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
|> List.find_opt Assets.is_supported_mimetype
let select_language headers =
@ -19,14 +25,14 @@ let select_language headers =
|> Cohttp.Accept.qsort
|> List.map (fun (_q, lang) -> lang)
|> List.map (function
| Cohttp.Accept.AnyLanguage -> Config.default_lang
| Cohttp.Accept.AnyLanguage -> Assets.Config.default_lang
| Language language_range -> (
(* ignore language subtags (e.g. "en-US" -> "en") *)
match language_range with
| [] -> assert false
| primary_tag :: _ -> primary_tag))
|> List.find_opt Assets.is_supported_lang
|> Option.value ~default:Config.default_lang
|> Option.value ~default:Assets.Config.default_lang
let select_encoding headers =
Vif.Headers.get headers "accept-encoding"
@ -37,7 +43,7 @@ let select_encoding headers =
| Cohttp.Accept.Identity -> Some `Identity
| Deflate -> Some `DEFLATE
| Gzip -> Some `Gzip
| AnyEncoding -> Some Config.default_encoding
| AnyEncoding -> Some Assets.Config.default_encoding
| Encoding _ | Compress -> (* unsupported *) None)
|> function
| [] -> assert false