src/respond.ml

@@ -0,0 +1,39 @@
+(* TODO response
+   use ErrorDetail *)
+
+let respond_json req content status =
+  let open Vif.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_exn ErrorDetail.jsont err
+
+let error ~hint req =
+  Logs.err (fun m -> m "internal server 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 not_modified () =
+  Logs.debug (fun m -> m "not modified");
+  let open Vif.Response in
+  let open Syntax in
+  let* () = empty in
+  respond `Not_modified
+
+let result res req =
+  match res with Error hint -> error ~hint req | Ok content -> ok content req

src/respond_util.ml

@@ -1,25 +0,0 @@
-(* TODO response
-   use ErrorDetail *)
-
-let respond_with_plain_text_error ?status e req =
-  let open Vif.Response in
-  let open Syntax in
-  let status = Option.value ~default:`Bad_request status in
-  let* () = add ~field:"content-type" "text/plain; charset=utf-8" in
-  let* () = with_string req e in
-  respond status
-
-let respond_with_ok_json content req =
-  let open Vif.Response in
-  let open Syntax in
-  let* () = add ~field:"content-type" "application/json" in
-  let* () = with_string req content in
-  respond `OK
-
-let respond_with_res res req =
-  match res with
-  | Error err ->
-      Logs.err (fun m -> m "%s." err);
-      let err = Fmt.str "%s@." err in
-      respond_with_plain_text_error err req
-  | Ok content -> respond_with_ok_json content req

src/static.ml

@@ -1,31 +1,5 @@
 (* /terms + /privacy *)
 
-(* TODO response *)
-module Respond_with = struct
-  open Vif.Response
-  open Syntax
-
-  open struct
-    let error_detail ?hint _status =
-      let open Api in
-      let code = -1 in
-      let err = ErrorDetail.make ?hint code in
-      let s = encode_exn ErrorDetail.jsont err in
-      Logs.err (fun m -> m "ErrorDetail: `%s`" s);
-      s
-  end
-
-  let bad_request ?hint req =
-    let body = error_detail ?hint `Bad_request in
-    let* () = add ~field:"content-type" "application/json" in
-    let* () = with_string ?compression:None req body in
-    respond `Bad_request
-
-  let not_modified () =
-    let* () = empty in
-    respond `Not_modified
-end
-
 let aux asset req _server _env =
   let etag = Assets.etag asset in
   let headers = Vif.Request.headers req in
@@ -37,12 +11,8 @@ let aux asset req _server _env =
         |> Result.map (Headers_lib.If_none_match.evaluate etag)
   in
   match has_matching_etag with
-  | Error e ->
-      Logs.err (fun m -> m "bad request");
-      Respond_with.bad_request ~hint:e req
-  | Ok true ->
-      Logs.err (fun m -> m "not modified");
-      Respond_with.not_modified ()
+  | Error e -> Respond_util.bad_request ~hint:e req
+  | Ok true -> Respond_util.not_modified ()
   | Ok false ->
       let mime = Headers.select_mimetype headers in
       let lang = Headers.select_language headers in