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

log response status code

Browse source
This commit is contained in:
swrup 2026-03-30 14:57:36 +02:00 • committed by Swrup
parent 18c4f0b3d5
commit e966b62712
2 changed files with 22 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/mte_handler.ml
View file

@ -25,4 +25,4 @@ let not_implemented_route : (string, Global.env) Vifu.Handler.t =
Logs.debug (fun m -> m "not_implemented_route_handler `%s`" target);
uri_prefix_list
|> List.find_opt (fun uri -> Vifu.Uri.execp uri target)
|> Option.map (fun _uri -> Respond.not_implemented req)
|> Option.map (fun _uri -> Respond.not_implemented ())

57
src/respond.ml
View file

@ -1,32 +1,31 @@
let bad_request _req =
let open Vifu.Response in
Logs.debug (fun m -> m "Bad request");
respond `Bad_request
let pp_status ppf status =
match status with
| #H2.Status.standard as status ->
Fmt.pf ppf "HTTP [%d %s]" (H2.Status.to_code status)
(H2.Status.default_reason_phrase status)
| _ -> Fmt.pf ppf "HTTP [%d]" (H2.Status.to_code status)
let no_content _req =
Logs.debug (fun m -> m "No content");
let empty status =
Logs.info (fun m -> m "%a" pp_status status);
let open Vifu.Response in
let open Syntax in
let* () = empty in
respond `No_content
respond status
let not_modified () =
Logs.debug (fun m -> m "Not modified");
let open Vifu.Response in
let open Syntax in
let* () = empty in
respond `Not_modified
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 respond_json req jsont status body =
Logs.info (fun m -> m "%a" pp_status status);
let open Vifu.Response in
let open Syntax in
let* () = add ~field:"content-type" "application/json" in
let* () = with_json req jsont body in
respond status
let ok req jsont body =
Logs.debug (fun m -> m "OK");
respond_json req jsont `OK body
let ok req jsont body = respond_json req jsont `OK body
let map_err_status err =
match err with
@ -37,32 +36,18 @@ let map_err_status err =
| `Caqti _s | `Mfat _s | `Json_encode _s | `Bin_encode _s | `Msg _s ->
`Internal_server_error
let status_to_string = function
| `Bad_request -> "Bad request"
| `Forbidden -> "Forbidden"
| `Not_found -> "Not found"
| `Conflict -> "Conflict"
| `Internal_server_error -> "Internal server error"
let error_detail hint =
let open Api in
let code = -1 in
ErrorDetail.make ~hint code
let error req err =
let status = map_err_status err in
let hint = Result.err_to_string err in
let body = error_detail hint in
Logs.err (fun m -> m "%s: %s" (status_to_string status) hint);
let log_lvl =
if H2.Status.is_server_error status then Logs.Error else Logs.Warning
in
Logs.msg log_lvl (fun m -> m "%a %s" pp_status status hint);
let body = Api.ErrorDetail.make ~hint (-1) in
respond_json req Api.ErrorDetail.jsont status body
let not_implemented req =
Logs.debug (fun m -> m "Not implemented");
let body = error_detail "Not Implemented" in
respond_json req Api.ErrorDetail.jsont `Not_implemented body
let result req jsont res =
match res with Error e -> error req e | Ok body -> ok req jsont body
let result_no_content req res =
match res with Error e -> error req e | Ok () -> no_content req
match res with Error e -> error req e | Ok () -> no_content ()