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

better response status

Browse source
This commit is contained in:
swrup 2026-03-29 16:54:08 +02:00 • committed by Swrup
parent 42b0ec1445
commit 5532798ea5
5 changed files with 170 additions and 178 deletions
Download patch file Download diff file Expand all files Collapse all files

88
src/respond.ml
View file

@ -1,53 +1,63 @@
let encode_error_detail err =
match Api.encode Api.ErrorDetail.jsont err with
| Error e ->
Fmt.failwith "json encoding error on `ErrorDetail`: %a." Result.pp_err e
| Ok s -> s
let respond_json req content status =
let bad_request _req =
let open Vifu.Response in
let open Syntax in
let* () = add ~field:"content-type" "application/json" in
let* () = with_string req content in
respond status
Logs.debug (fun m -> m "Bad request");
respond `Bad_request
let mk_error_content ?hint _status =
let open Api in
let code = -1 in
let err = ErrorDetail.make ?hint code in
encode_error_detail err
let error err req =
let hint = Fmt.str "%a" Result.pp_err err in
Logs.err (fun m -> m "error: %s" hint);
let body = mk_error_content ~hint `Internal_server_error in
respond_json req body `Internal_server_error
let bad_request ?hint req =
Logs.err (fun m -> m "bad request");
let body = mk_error_content ?hint `Bad_request in
respond_json req body `Bad_request
let ok content req =
Logs.debug (fun m -> m "ok");
respond_json req content `OK
let no_content () =
Logs.debug (fun m -> m "no content");
let no_content _req =
Logs.debug (fun m -> m "No content");
let open Vifu.Response in
let open Syntax in
let* () = empty in
respond `No_content
let not_modified () =
Logs.debug (fun m -> m "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 result res req =
match res with Error e -> error e req | Ok content -> ok content req
let respond_json req jsont status body =
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 result_no_content res req =
match res with Error e -> error e req | Ok () -> no_content ()
let ok req jsont body =
Logs.debug (fun m -> m "OK");
respond_json req jsont `OK body
let map_err_status err =
match err with
| `Json_decode _ | `Bin_decode _ -> `Bad_request
| `Invalid_signature_eddsa | `Invalid_signature_rsa -> `Forbidden
| `Not_found _ -> `Not_found
| `Conflict _ -> `Conflict
| `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);
respond_json req Api.ErrorDetail.jsont status 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