rename

src/http_information.ml

@@ -18,7 +18,7 @@ let seed req _server _env =
 let config req _server _env =
   Logs.info (fun m -> m "GET /config");
   let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in
-  Respond_util.respond_with_ok_json s req
+  Respond.ok s req
 
 (* TODO
    for now we only have one item in each "denom group"
@@ -276,4 +276,4 @@ let keys req server _env =
     let s = Api.encode_exn jsont v in
     Ok s
   in
-  Respond_util.respond_with_res res req
+  Respond.result res req

src/http_management.ml

@@ -109,7 +109,7 @@ module Keys_get = struct
       let s = Api.encode_exn jsont v in
       Ok s
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Keys_post = struct
@@ -215,7 +215,7 @@ module Keys_post = struct
       let* () = do_ ~db_conn sm v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Denom_revoke = struct
@@ -246,7 +246,7 @@ module Denom_revoke = struct
       let* () = do_ ~db_conn sm h_denom_pub v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Signkey_revoke = struct
@@ -277,7 +277,7 @@ module Signkey_revoke = struct
       let* () = do_ ~db_conn sm exchange_pub v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Auditors = struct
@@ -333,7 +333,7 @@ module Auditors = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Auditors_disable = struct
@@ -374,7 +374,7 @@ module Auditors_disable = struct
       let* () = do_ ~db_conn auditor_pub v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Wire_fee = struct
@@ -433,7 +433,7 @@ module Wire_fee = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Global_fees = struct
@@ -504,7 +504,7 @@ module Global_fees = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Wire = struct
@@ -582,7 +582,7 @@ module Wire = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Wire_disable = struct
@@ -617,7 +617,7 @@ module Wire_disable = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Drain = struct
@@ -657,7 +657,7 @@ module Drain = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module AmlOfficer = struct
@@ -697,7 +697,7 @@ module AmlOfficer = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end
 
 module Partners = struct
@@ -739,5 +739,5 @@ module Partners = struct
       let* () = do_ ~db_conn v in
       Ok ""
     in
-    Respond_util.respond_with_res res req
+    Respond.result res req
 end

src/http_terms.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 ->
+  | Error e -> Respond.bad_request ~hint:e req
-      Logs.err (fun m -> m "bad request");
+  | Ok true -> Respond.not_modified ()
-      Respond_with.bad_request ~hint:e req
-  | Ok true ->
-      Logs.err (fun m -> m "not modified");
-      Respond_with.not_modified ()
   | Ok false ->
       let mime = Headers.select_mimetype headers in
       let lang = Headers.select_language headers in

src/mte.ml

@@ -23,28 +23,28 @@ let hello req _server _env =
 let routes =
   let open Vif.Uri in
   let open Vif.Route in
-  let get_ path = get (path /?? any) in
+  let get path = get (path /?? any) in
   let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in
+  let v s = rel / s in
   let tos =
-    let v s = rel / s in
     [
-      get_ rel --> hello;
+      get rel --> hello;
-      get_ (v "terms") --> Static.terms;
+      get (v "terms") --> Http_terms.terms;
-      get_ (v "privacy") --> Static.privacy;
+      get (v "privacy") --> Http_terms.privacy;
     ]
   in
   let status_info =
     [
-      get_ (rel / "seed") --> Http_information.seed;
+      get (v "seed") --> Http_information.seed;
-      get_ (rel / "config") --> Http_information.config;
+      get (v "config") --> Http_information.config;
-      get_ (rel / "keys") --> Http_information.keys;
+      get (v "keys") --> Http_information.keys;
     ]
   in
   let management =
     let open Http_management in
-    let v s = rel / "management" / s in
+    let v s = v "management" / s in
     [
-      get_ (v "keys") --> Keys_get.f;
+      get (v "keys") --> Keys_get.f;
       post (v "keys") Keys_post.jsont --> Keys_post.f;
       post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
       --> Denom_revoke.f;

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