From 7028fec2a067075801cd6c7a82b90e733a6d4011 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Sep 2024 15:25:33 -0400
Subject: [PATCH] feat response: add `pp_with`; have `pp` hide set-cookie
 headers

we don't want to accidentally log cookies, they might contain
credentials or secret tokens.
---
 src/core/response.ml  | 31 ++++++++++++++++++++++++-------
 src/core/response.mli | 19 +++++++++++++++++++
 2 files changed, 43 insertions(+), 7 deletions(-)

diff --git a/src/core/response.ml b/src/core/response.ml
index e1d2721a..b3f25af4 100644
--- a/src/core/response.ml
+++ b/src/core/response.ml
@@ -68,15 +68,32 @@ exception Bad_req = Bad_req
 let fail_raise ~code fmt =
   Printf.ksprintf (fun msg -> raise (Bad_req (code, msg))) fmt
 
-let pp out self : unit =
-  let pp_body out = function
-    | `String s -> Format.fprintf out "%S" s
-    | `Stream _ -> Format.pp_print_string out "<stream>"
-    | `Writer _ -> Format.pp_print_string out "<writer>"
-    | `Void -> ()
+let default_pp_body_ out = function
+  | `String s -> Format.fprintf out "%S" s
+  | `Stream _ -> Format.pp_print_string out "<stream>"
+  | `Writer _ -> Format.pp_print_string out "<writer>"
+  | `Void -> ()
+
+let pp_with ?(mask_header = fun _ -> false)
+    ?(headers_to_mask = [ "set-cookie" ]) ?(pp_body = default_pp_body_) () out
+    self : unit =
+  let headers_to_mask = List.rev_map String.lowercase_ascii headers_to_mask in
+  (* hide some headers *)
+  let headers =
+    List.map
+      (fun (k, v) ->
+        let hidden = List.mem k headers_to_mask || mask_header k in
+        if hidden then
+          k, "<hidden>"
+        else
+          k, v)
+      self.headers
   in
+
   Format.fprintf out "{@[code=%d;@ headers=[@[%a@]];@ body=%a@]}" self.code
-    Headers.pp self.headers pp_body self.body
+    Headers.pp headers pp_body self.body
+
+let[@inline] pp out self : unit = pp_with () out self
 
 let output_ ~bytes (oc : IO.Output.t) (self : t) : unit =
   (* double indirection:
diff --git a/src/core/response.mli b/src/core/response.mli
index 1586f301..27c3069f 100644
--- a/src/core/response.mli
+++ b/src/core/response.mli
@@ -109,6 +109,25 @@ val fail_raise : code:int -> ('a, unit, string, 'b) format4 -> 'a
     @raise Bad_req always
   *)
 
+val pp_with :
+  ?mask_header:(string -> bool) ->
+  ?headers_to_mask:string list ->
+  ?pp_body:(Format.formatter -> body -> unit) ->
+  unit ->
+  Format.formatter ->
+  t ->
+  unit
+(** Pretty print the response. The exact format of this printing
+    is not specified.
+    @param mask_header function which is given each header name. If it
+      returns [true], the header's value is masked. The presence of
+      the header is still printed. Default [fun _ -> false].
+    @param headers_to_mask a list of headers masked by default.
+      Default is ["set-cookie"].
+    @param pp_body body printer
+      (default fully prints String bodies, but omits stream bodies)
+    @since NEXT_RELEASE *)
+
 val pp : Format.formatter -> t -> unit
 (** Pretty print the response. The exact format is not specified. *)