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