Skip to content

Commit 0de001b

Browse files
rr0girr0gi
committed
web: expose http_request_ ~result
1 parent f1b26ec commit 0de001b

1 file changed

Lines changed: 47 additions & 53 deletions

File tree

‎web.ml‎

Lines changed: 47 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -120,9 +120,9 @@ module type CURL = sig
120120
end
121121

122122
type ('body,'ret) http_request_ =
123+
?verbose:bool ->
123124
?ua:string ->
124125
?timeout:int ->
125-
?verbose:bool ->
126126
?setup:(Curl.t -> unit) ->
127127
?timer:Action.timer ->
128128
?max_size:int ->
@@ -141,30 +141,32 @@ module type HTTP = sig
141141
type ('body,'ret) request_ = ('body,'ret IO.t) http_request_
142142
type 'ret request = 'ret IO.t http_request
143143

144-
val http_request' : [> `Error of Curl.curlCode | `Ok of int * string ] request
145-
val http_request : [> `Error of string | `Ok of string ] request
144+
val http_request_ : result:(Curl.t * [ `Error of Curl.curlCode | `Ok of int * string ] -> 'r) -> 'r request
145+
val http_request' : [ `Error of Curl.curlCode | `Ok of int * string ] request
146+
val http_request : [ `Error of string | `Ok of string ] request
146147
val http_request_exn : string request
147-
val http_query : (string * string, [> `Error of string | `Ok of string ]) request_
148+
val http_query : (string * string, [ `Error of string | `Ok of string ]) request_
148149
val http_submit :
150+
?verbose:bool ->
149151
?ua:string ->
150152
?timeout:int ->
151-
?verbose:bool ->
152153
?setup:(Curl.t -> unit) ->
153154
?timer:Action.timer ->
154155
?http_1_0:bool ->
155156
?headers:string list ->
156157
?action:http_action ->
157158
string ->
158-
(string * string) list -> [> `Error of string | `Ok of string ] IO.t
159+
(string * string) list -> [ `Error of string | `Ok of string ] IO.t
159160
end
160161

161162
let show_result ?(verbose=false) = function
162163
| `Error code -> sprintf "(%d) %s" (Curl.errno code) (Curl.strerror code)
163164
| `Ok (n, content) -> sprintf "http %d%s" n (if verbose then ": " ^ content else "")
164165

165-
let simple_result ?(is_ok=(fun code -> code / 100 = 2)) ?verbose = function
166-
| `Ok (code, s) when is_ok code -> `Ok s
167-
| r -> `Error (show_result ?verbose r)
166+
let simple_result ?verbose (_,r) =
167+
match r with
168+
| `Ok (n,s) when n / 100 = 2 -> `Ok s
169+
| r -> `Error (show_result ?verbose r)
168170

169171
let nr_http = ref 0
170172

@@ -210,33 +212,27 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
210212
()
211213

212214
(* deprecated *)
213-
let http_gets ?(setup=ignore) ?timer ?max_size ?(check=(fun _ -> true)) ?(result=(fun _ _ -> return_unit)) url =
215+
let http_gets ~setup ?timer ?max_size ~result url =
214216
with_curl_cache begin fun h ->
215217
Curl.set_url h url;
216218
curl_default_setup h;
217-
let () = setup h in
219+
setup h;
218220
let b = Buffer.create 10 in
219221
let read_size = ref 0 in
220222
Curl.set_writefunction h begin fun s ->
221-
match check h with
222-
| false -> 0
223-
| true ->
224-
Buffer.add_string b s;
225-
let l = String.length s in
226-
read_size += l;
227-
match max_size with
228-
| Some max_size when !read_size > max_size -> Exn.fail "received too much data (%db) when max is %db" !read_size max_size
229-
| _ -> l
223+
Buffer.add_string b s;
224+
let l = String.length s in
225+
read_size += l;
226+
match max_size with
227+
| Some max_size when !read_size > max_size -> Exn.fail "received too much data (%db) when max is %db" !read_size max_size
228+
| _ -> l
230229
end;
231230
timer |> Option.may (fun t -> t#mark "Web.http");
232231
catch (fun () -> Curl_IO.perform h) (fun exn -> update_timer h timer; IO.raise exn) >>= fun code ->
233-
(update_timer h timer; result h code) >>= fun () ->
234-
return @@ match code with
235-
| Curl.CURLE_OK -> `Ok (Curl.get_httpcode h, Buffer.contents b)
236-
| code -> `Error code
232+
(update_timer h timer; return @@ result (h,match code with CURLE_OK -> `Ok (Curl.get_httpcode h, Buffer.contents b) | err -> `Error err))
237233
end
238234

239-
let verbose_curl_result nr_http action t h code =
235+
let verbose_curl_result nr_http action t (h,r) =
240236
let open Curl in
241237
let b = Buffer.create 10 in
242238
bprintf b "%s #%d %s ⇓%s ⇑%s %s "
@@ -245,9 +241,9 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
245241
(Action.bytes_string_f @@ get_sizeupload h)
246242
(get_primaryip h)
247243
;
248-
begin match code with
249-
| CURLE_OK ->
250-
bprintf b "HTTP %d %s" (get_httpcode h) (get_effectiveurl h);
244+
begin match r with
245+
| `Ok (code,_) ->
246+
bprintf b "HTTP %d %s" code (get_effectiveurl h);
251247
begin match get_redirecturl h with
252248
| "" -> ()
253249
| s -> bprintf b " -> %s" s
@@ -256,7 +252,7 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
256252
| 0 -> ()
257253
| n -> bprintf b " after %d redirects" n
258254
end
259-
| _ ->
255+
| `Error code ->
260256
bprintf b "error (%d) %s (errno %d)" (errno code) (strerror code) (Curl.get_oserrno h)
261257
end;
262258
log #info_s (Buffer.contents b)
@@ -270,7 +266,7 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
270266

271267
(* NOTE don't forget to set http_1_0=true when sending requests to a Httpev-based server *)
272268
(* Don't use curl_setheaders when using ?headers option *)
273-
let http_request' ?ua ?timeout ?(verbose=false) ?(setup=ignore) ?timer ?max_size ?(http_1_0=false) ?headers ?body (action:http_action) url =
269+
let http_request_ ~result ?(verbose=false) ?ua ?timeout ?(setup=ignore) ?timer ?max_size ?(http_1_0=false) ?headers ?body (action:http_action) url =
274270
let open Curl in
275271
let action_name = string_of_http_action action in
276272
let ch_query_id = ref None in
@@ -338,7 +334,7 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
338334
let span_name = Printf.sprintf "devkit.web.%s" action_name in
339335
(* We set the value of `__FUNCTION__` to preserve the build with OCaml < 4.12. *)
340336
Possibly_otel.enter_manual_span
341-
~__FUNCTION__:"Devkit.Web.Http.http_request'" ~__FILE__ ~__LINE__ ~data:describe span_name in
337+
~__FUNCTION__:"Devkit.Web.Http.http_request_" ~__FILE__ ~__LINE__ ~data:describe span_name in
342338

343339
let headers = match Possibly_otel.Traceparent.get_ambient ~explicit_span () with
344340
| None -> headers
@@ -352,38 +348,36 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
352348
in
353349

354350
let t = new Action.timer in
355-
let result = Some (fun h code ->
356-
if verbose then verbose_curl_result nr_http action t h code;
357-
if Trace_core.enabled () then (
351+
let result (h,_ as res) =
352+
if verbose then verbose_curl_result nr_http action t res;
353+
if Trace_core.enabled () then
354+
begin
358355
let data = get_curl_data h in
359-
let data = match !ch_query_id with None -> data
360-
| Some v -> ("http.response.header.x-clickhouse-query-id", `String v) :: data in
361-
let data = match !ch_summary with None -> data
362-
| Some v -> ("http.response.header.x-clickhouse-summary", `String v) :: data in
363-
let data = match !resp_content_encoding with None -> data
364-
| Some v -> ("http.response.header.content-encoding", `String v) :: data in
356+
let data = match !ch_query_id with None -> data | Some v -> ("http.response.header.x-clickhouse-query-id", `String v) :: data in
357+
let data = match !ch_summary with None -> data | Some v -> ("http.response.header.x-clickhouse-summary", `String v) :: data in
358+
let data = match !resp_content_encoding with None -> data | Some v -> ("http.response.header.content-encoding", `String v) :: data in
365359
Trace_core.add_data_to_span explicit_span data
366-
);
360+
end;
367361
Trace_core.exit_span explicit_span;
368-
return ()
369-
) in
362+
result res
363+
in
364+
365+
http_gets ~setup:(setup ~headers set_body_and_headers) ?timer ?max_size ~result url
370366

371-
http_gets ~setup:(setup ~headers set_body_and_headers) ?timer ?result ?max_size url
367+
let http_request' = http_request_ ~result:snd
372368

373-
let http_request ?ua ?timeout ?verbose ?setup ?timer ?max_size ?http_1_0 ?headers ?body (action:http_action) url =
374-
http_request' ?ua ?timeout ?verbose ?setup ?timer ?max_size ?http_1_0 ?headers ?body action url >>= fun res ->
375-
return @@ simple_result ?verbose res
369+
let http_request ?verbose = http_request_ ?verbose ~result:(simple_result ?verbose)
376370

377-
let http_request_exn ?ua ?timeout ?verbose ?setup ?timer ?max_size ?http_1_0 ?headers ?body (action:http_action) url =
378-
http_request ?ua ?timeout ?verbose ?setup ?timer ?max_size ?http_1_0 ?headers ?body action url
371+
let http_request_exn ?verbose ?ua ?timeout ?setup ?timer ?max_size ?http_1_0 ?headers ?body (action:http_action) url =
372+
http_request ?verbose ?ua ?timeout ?setup ?timer ?max_size ?http_1_0 ?headers ?body action url
379373
>>= function `Ok s -> return s | `Error error -> fail "%s" error
380374

381-
let http_query ?ua ?timeout ?verbose ?setup ?timer ?max_size ?http_1_0 ?headers ?body (action:http_action) url =
375+
let http_query ?verbose ?ua ?timeout ?setup ?timer ?max_size ?http_1_0 ?headers ?body (action:http_action) url =
382376
let body = match body with Some (ct,s) -> Some (`Raw (ct,s)) | None -> None in
383-
http_request ?ua ?timeout ?verbose ?setup ?timer ?max_size ?http_1_0 ?headers ?body action url
377+
http_request ?verbose ?ua ?timeout ?setup ?timer ?max_size ?http_1_0 ?headers ?body action url
384378

385-
let http_submit ?ua ?timeout ?verbose ?setup ?timer ?http_1_0 ?headers ?(action=`POST) url args =
386-
http_request ?ua ?timeout ?verbose ?setup ?timer ?http_1_0 ?headers ~body:(`Form args) action url
379+
let http_submit ?verbose ?ua ?timeout ?setup ?timer ?http_1_0 ?headers ?(action=`POST) url args =
380+
http_request ?verbose ?ua ?timeout ?setup ?timer ?http_1_0 ?headers ~body:(`Form args) action url
387381

388382
end
389383

0 commit comments

Comments
 (0)