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

~

Browse source
This commit is contained in:
swrup 2026-02-23 07:24:40 +01:00 • committed by Swrup
parent 8708143f16
commit 481adaf53e
7 changed files with 72 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/respond.ml
View file

@ -1,6 +1,11 @@
(* TODO response
use ErrorDetail *)
let encode_error_detail err =
match Api.(encode ErrorDetail.jsont err) with
| Error e -> Fmt.failwith "json encoding error on `ErrorDetail`: %s." e
| Ok s -> s
let respond_json req content status =
let open Vif.Response in
let open Syntax in
@ -12,10 +17,10 @@ let mk_error_content ?hint _status =
let open Api in
let code = -1 in
let err = ErrorDetail.make ?hint code in
encode_exn ErrorDetail.jsont err
encode_error_detail err
let error ~hint req =
Logs.err (fun m -> m "internal server error: %s" hint);
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
@ -28,6 +33,13 @@ 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 open Vif.Response in
let open Syntax in
let* () = empty in
respond `No_content
let not_modified () =
Logs.debug (fun m -> m "not modified");
let open Vif.Response in
@ -37,3 +49,6 @@ let not_modified () =
let result res req =
match res with Error hint -> error ~hint req | Ok content -> ok content req
let result_no_content res req =
match res with Error hint -> error ~hint req | Ok () -> no_content ()