let pp_status ppf status = match status with | #H2.Status.standard as status -> Fmt.pf ppf "HTTP status: %d %s" (H2.Status.to_code status) (H2.Status.default_reason_phrase status) | _ -> Fmt.pf ppf "HTTP %d" (H2.Status.to_code status) let empty status = Logs.info (fun m -> m "%a" pp_status status); let open Vifu.Response in let open Syntax in let* () = empty in respond status let bad_request () = empty `Bad_request let no_content () = empty `No_content let not_modified () = empty `Not_modified let not_implemented () = empty `Not_implemented let unsupported_media_type () = empty `Unsupported_media_type let respond_json req jsont status body = Logs.info (fun m -> m "%a" pp_status status); 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 = 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 | `Replay_attack _ -> `Conflict | `Not_found _ -> `Not_found | `Conflict _ -> `Conflict | `Caqti _s | `Mfat _s | `Json_encode _s | `Bin_encode _s | `Msg _s -> `Internal_server_error let error req err = let status = map_err_status err in let hint = Result.err_to_string err in let log = if H2.Status.is_server_error status then Logs.err else Logs.warn in log (fun m -> m "%a %s" pp_status status hint); let body = Api.ErrorDetail.make ~hint (-1) in 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 ()