68 lines
1.9 KiB
OCaml
68 lines
1.9 KiB
OCaml
let bad_request _req =
|
|
let open Vifu.Response in
|
|
Logs.debug (fun m -> m "Bad request");
|
|
respond `Bad_request
|
|
|
|
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");
|
|
let open Vifu.Response in
|
|
let open Syntax in
|
|
let* () = empty in
|
|
respond `Not_modified
|
|
|
|
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 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 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
|