Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Refactor, modularize, add hmap to requests #81

Merged
merged 20 commits into from
Mar 7, 2024
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
feat: add Request.pp_with which is a customizable printer
c-cube committed Feb 29, 2024
commit 05dcf779817ac5449b9688903e23f5dec0704b5c
39 changes: 30 additions & 9 deletions src/core/request.ml
Original file line number Diff line number Diff line change
@@ -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 =
21 changes: 21 additions & 0 deletions src/core/request.mli
Original file line number Diff line number Diff line change
@@ -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. *)