mte/src/respond.ml

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 open Vifu.Response in
  let open Syntax in
  let* () = add ~field:"content-type" "application/json" in
  let* () = with_string req content in
  respond status

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 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 result res req =
  match res with Error e -> error e req | Ok content -> ok content req

let result_no_content res req =
  match res with Error e -> error e req | Ok () -> no_content ()