only print debug content for json or text

OCamlPro · Feb 20, 2025 · 11e7ec1 · 11e7ec1
1 parent ceb949d
commit 11e7ec1
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 6 deletions.
diff --git a/src/server/cohttp/ezAPIServerCohttp.ml b/src/server/cohttp/ezAPIServerCohttp.ml
@@ -72,7 +72,9 @@ let dispatch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials
   let meth = meth_from_cohttp req in
   Cohttp_lwt.Body.to_string body >>= fun body ->
   let ws = WsCohttp.ws req in
-  if body <> "" then debug ~v:2 "Request content:\n%s" body;
+  debugf ~v:2 (fun () ->
+      if body <> "" && (content_type = Some "application/json" || content_type = Some "text/plain") then
+        EzDebug.printf "Request content:\n%s" body);
   Lwt.catch (fun () -> handle ~ws ?meth ?content_type s.server_kind r path body)
     (fun exn ->
        EzDebug.printf "In %s: exception %s" path_str @@ Printexc.to_string exn;
@@ -96,7 +98,10 @@ let dispatch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials
         ?allow_methods ?allow_credentials ?origin resp_headers in
     let status = Code.status_of_code code in
     debug ~v:(if code >= 200 && code < 300 then 1 else 0) "Reply computed to %S: %d" path_str code;
-    if body <> "" then debug ~v:3 "Reply content:\n%s" body;
+    debugf ~v:3 (fun () ->
+        let content_type = List.assoc_opt "content-type" resp_headers in
+        if body <> "" && (content_type = Some "application/json" || content_type = Some "text/plain") then
+          EzDebug.printf "Reply content:\n%s" body);
     let headers = Header.of_list headers in
     Server.respond_string ~headers ~status ~body () >|= fun (r, b) ->
     `Response (r, b)

diff --git a/src/server/httpaf/ezAPIServerHttpAf.ml b/src/server/httpaf/ezAPIServerHttpAf.ml
@@ -52,7 +52,9 @@ let connection_handler ?catch ?allow_origin ?allow_headers ?allow_methods
     Lwt.async @@ fun () ->
     read_body (Reqd.request_body reqd) >>= fun body ->
     let ws = WsHttpaf.ws reqd fd in
-    if body <> "" then debug ~v:2 "Request content:\n%s" body;
+    debugf ~v:2 (fun () ->
+        if body <> "" && (content_type = Some "application/json" || content_type = Some "text/plain") then
+          EzDebug.printf "Request content:\n%s" body);
     Lwt.catch
       (fun () -> handle ~ws ?meth ?content_type s.server_kind r path body)
       (fun exn ->
@@ -74,7 +76,10 @@ let connection_handler ?catch ?allow_origin ?allow_headers ?allow_methods
     | `http {Answer.code; body; headers=resp_headers} ->
       let status = Status.unsafe_of_code code in
       debug ~v:(if code = 200 then 1 else 0) "Reply computed to %S: %d" path_str code;
-      if body <> "" then debug ~v:3 "Reply content:\n%s" body;
+      debugf ~v:3 (fun () ->
+          let content_type = List.assoc_opt "content-type" resp_headers in
+          if body <> "" && (content_type = Some "application/json" || content_type = Some "text/plain") then
+            EzDebug.printf "Reply content:\n%s" body);
       let origin = match allow_origin with
         | Some `origin -> StringMap.find_opt "origin" headers
         | _ -> None in

diff --git a/src/server/httpun/ezAPIServerHttpun.ml b/src/server/httpun/ezAPIServerHttpun.ml
@@ -55,7 +55,9 @@ let connection_handler ?catch ?allow_origin ?allow_headers ?allow_methods
     Lwt.async @@ fun () ->
     let> body = read_body (Reqd.request_body reqd) in
     let ws = WsHttpun.ws reqd fd in
-    if body <> "" then debug ~v:2 "Request content:\n%s" body;
+    debugf ~v:2 (fun () ->
+        if body <> "" && (content_type = Some "application/json" || content_type = Some "text/plain") then
+          EzDebug.printf "Request content:\n%s" body);
     let> res = Lwt.catch
         (fun () -> handle ~ws ?meth ?content_type s.server_kind r path body)
         (fun exn ->
@@ -77,7 +79,10 @@ let connection_handler ?catch ?allow_origin ?allow_headers ?allow_methods
     | `http {Answer.code; body; headers=resp_headers} ->
       let status = Status.unsafe_of_code code in
       debug ~v:(if code = 200 then 1 else 0) "Reply computed to %S: %d" path_str code;
-      if body <> "" then debug ~v:3 "Reply content:\n%s" body;
+      debugf ~v:3 (fun () ->
+          let content_type = List.assoc_opt "content-type" resp_headers in
+          if body <> "" && (content_type = Some "application/json" || content_type = Some "text/plain") then
+            EzDebug.printf "Reply content:\n%s" body);
       let origin = match allow_origin with
         | Some `origin -> StringMap.find_opt "origin" headers
         | _ -> None in