mte/src/respond.ml

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 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