From 05dcf779817ac5449b9688903e23f5dec0704b5c Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 29 Feb 2024 10:23:38 -0500
Subject: [PATCH] feat: add `Request.pp_with` which is a customizable printer

---
 src/core/request.ml  | 39 ++++++++++++++++++++++++++++++---------
 src/core/request.mli | 21 +++++++++++++++++++++
 2 files changed, 51 insertions(+), 9 deletions(-)

diff --git a/src/core/request.ml b/src/core/request.ml
index b8573052..1a3275df 100644
--- a/src/core/request.ml
+++ b/src/core/request.ml
@@ -52,19 +52,40 @@ let pp_query out q =
   Format.fprintf out "[%s]"
     (String.concat ";" @@ List.map (fun (a, b) -> Printf.sprintf "%S,%S" a b) q)
 
-let pp_ out self : unit =
+let pp_with ?(mask_header = fun _ -> false)
+    ?(headers_to_mask = [ "authorization"; "cookie" ]) ?(show_query = true)
+    ?(pp_body = fun out _ -> Format.pp_print_string out "?") () out self : unit
+    =
+  let pp_query out q =
+    if show_query then
+      pp_query out q
+    else
+      Format.fprintf out "<hidden>"
+  in
+
+  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
-    "{@[meth=%s;@ host=%s;@ headers=[@[%a@]];@ path=%S;@ body=?;@ \
+    "{@[meth=%s;@ host=%s;@ headers=[@[%a@]];@ path=%S;@ body=%a;@ \
      path_components=%a;@ query=%a@]}"
-    (Meth.to_string self.meth) self.host Headers.pp self.headers self.path
-    pp_comp_ self.path_components pp_query self.query
+    (Meth.to_string self.meth) self.host Headers.pp headers self.path pp_body
+    self.body pp_comp_ self.path_components pp_query self.query
+
+let pp_ out self : unit = pp_with () out self
 
 let pp out self : unit =
-  Format.fprintf out
-    "{@[meth=%s;@ host=%s;@ headers=[@[%a@]];@ path=%S;@ body=%S;@ \
-     path_components=%a;@ query=%a@]}"
-    (Meth.to_string self.meth) self.host Headers.pp self.headers self.path
-    self.body pp_comp_ self.path_components pp_query self.query
+  let pp_body out b = Format.fprintf out "%S" b in
+  pp_with ~pp_body () out self
 
 (* decode a "chunked" stream into a normal stream *)
 let read_stream_chunked_ ~bytes (bs : #IO.Input.t) : IO.Input.t =
diff --git a/src/core/request.mli b/src/core/request.mli
index 70ae741d..e4242bcf 100644
--- a/src/core/request.mli
+++ b/src/core/request.mli
@@ -49,6 +49,27 @@ val get_meta_exn : _ t -> 'a Hmap.key -> 'a
     @raise Invalid_argument if not present
  @since NEXT_RELEASE *)
 
+val pp_with :
+  ?mask_header:(string -> bool) ->
+  ?headers_to_mask:string list ->
+  ?show_query:bool ->
+  ?pp_body:(Format.formatter -> 'body -> unit) ->
+  unit ->
+  Format.formatter ->
+  'body t ->
+  unit
+(** Pretty print the request. 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 ["authorization"; "cookie"].
+    @show_query if [true] (default [true]), the query part of the
+      request is shown.
+    @param pp_body body printer (default prints "?" instead of the body,
+      which works even for stream bodies) *)
+
 val pp : Format.formatter -> string t -> unit
 (** Pretty print the request and its body. The exact format of this printing
       is not specified. *)