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

add unsupported media type response

Browse source
This commit is contained in:
swrup 2026-04-12 20:15:08 +02:00 • committed by Swrup
parent 305818ae4a
commit 86b03e6985
2 changed files with 26 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

46
src/mte_tos.ml
View file

@ -83,32 +83,36 @@ let get_content t accept accept_language =
| AnyMediaSubtype m ->
Array.find_index (fun (m', _) -> m = m') supported_mimetypes
in
let i = List.find_map find_lang_index accept_language in
let j = List.find_map find_mime_index accept in
(* TODO *)
let i = Option.get i in
let j = Option.get j in
(supported_languages.(i), supported_mimetypes.(j), content_matrix.(i).(j))
let i_opt = List.find_map find_lang_index accept_language in
let j_opt = List.find_map find_mime_index accept in
match (i_opt, j_opt) with
| None, _ | _, None -> None
| Some i, Some j ->
Some
( supported_languages.(i),
supported_mimetypes.(j),
content_matrix.(i).(j) )
let aux t req _server _env =
let headers = Vifu.Request.headers req in
if has_matching_etag (asset_etag t) headers then Respond.not_modified ()
else
let compression = select_encoding headers in
let language, mimetype, content =
get_content t (get_accept headers) (get_accept_language headers)
in
(* -- *)
let open Vifu.Response in
let open Syntax in
let* () = with_string ?compression req content in
let* () = add ~field:"etag" (asset_etag t) in
let* () = add ~field:"taler-terms-version" Cfg.terms_legal_version in
let* () = add ~field:"accept" (accept t) in
let* () = add ~field:"avail-languages" (avail_languages t) in
let* () = add ~field:"content-type" (Fmt.str "%a" pp_mimetype mimetype) in
let* () = add ~field:"content-language" language in
respond `OK
match get_content t (get_accept headers) (get_accept_language headers) with
| None -> Respond.unsupported_media_type ()
| Some (language, mimetype, content) ->
let open Vifu.Response in
let open Syntax in
let compression = select_encoding headers in
let* () = with_string ?compression req content in
let* () = add ~field:"etag" (asset_etag t) in
let* () = add ~field:"taler-terms-version" Cfg.terms_legal_version in
let* () = add ~field:"accept" (accept t) in
let* () = add ~field:"avail-languages" (avail_languages t) in
let* () =
add ~field:"content-type" (Fmt.str "%a" pp_mimetype mimetype)
in
let* () = add ~field:"content-language" language in
respond `OK
let terms req _server _env =
Logs.info (fun m -> m "GET /terms");

1
src/respond.ml
View file

@ -16,6 +16,7 @@ let bad_request () = empty `Bad_request
let no_content () = empty `No_content
let not_modified () = empty `Not_modified
let not_implemented () = empty `Not_implemented
let unsupported_media_type () = empty `Unsupported_media_type
let respond_json req jsont status body =
Logs.info (fun m -> m "%a" pp_status status);