Skip to content

web: expose http_request_ ~result #58

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.

Sign up for GitHub

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

Open
rr0gi wants to merge 1 commit into
base: master
Choose a base branch
from
Open

web: expose http_request_ ~result #58

Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
100 changes: 47 additions & 53 deletions web.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -120,9 +120,9 @@ module type CURL = sig
end

type ('body,'ret) http_request_ =
?verbose:bool ->
?ua:string ->
?timeout:int ->
?verbose:bool ->
?setup:(Curl.t -> unit) ->
?timer:Action.timer ->
?max_size:int ->
Expand All @@ -141,30 +141,32 @@ module type HTTP = sig
type ('body,'ret) request_ = ('body,'ret IO.t) http_request_
type 'ret request = 'ret IO.t http_request

val http_request' : [> `Error of Curl.curlCode | `Ok of int * string ] request
val http_request : [> `Error of string | `Ok of string ] request
val http_request_ : result:(Curl.t * [ `Error of Curl.curlCode | `Ok of int * string ] -> 'r) -> 'r request
val http_request' : [ `Error of Curl.curlCode | `Ok of int * string ] request
val http_request : [ `Error of string | `Ok of string ] request
val http_request_exn : string request
val http_query : (string * string, [> `Error of string | `Ok of string ]) request_
val http_query : (string * string, [ `Error of string | `Ok of string ]) request_
val http_submit :
?verbose:bool ->
?ua:string ->
?timeout:int ->
?verbose:bool ->
?setup:(Curl.t -> unit) ->
?timer:Action.timer ->
?http_1_0:bool ->
?headers:string list ->
?action:http_action ->
string ->
(string * string) list -> [> `Error of string | `Ok of string ] IO.t
(string * string) list -> [ `Error of string | `Ok of string ] IO.t
end

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

@raphael-proust raphael-proust Apr 21, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

would be useful to have a show_simple_result counterpart

Copy link
Copy Markdown
Contributor Author

@rr0gi rr0gi Apr 22, 2026 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

now simple_result is just Ok string | Error string
would be nice to switch it to Result.t though


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

let nr_http = ref 0

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

(* deprecated *)
let http_gets ?(setup=ignore) ?timer ?max_size ?(check=(fun _ -> true)) ?(result=(fun _ _ -> return_unit)) url =
let http_gets ~setup ?timer ?max_size ~result url =
with_curl_cache begin fun h ->
Curl.set_url h url;
curl_default_setup h;
let () = setup h in
setup h;
let b = Buffer.create 10 in
let read_size = ref 0 in
Curl.set_writefunction h begin fun s ->
match check h with
| false -> 0
| true ->
Buffer.add_string b s;
let l = String.length s in
read_size += l;
match max_size with
| Some max_size when !read_size > max_size -> Exn.fail "received too much data (%db) when max is %db" !read_size max_size
| _ -> l
Buffer.add_string b s;
let l = String.length s in
read_size += l;
match max_size with
| Some max_size when !read_size > max_size -> Exn.fail "received too much data (%db) when max is %db" !read_size max_size
| _ -> l
end;
timer |> Option.may (fun t -> t#mark "Web.http");
catch (fun () -> Curl_IO.perform h) (fun exn -> update_timer h timer; IO.raise exn) >>= fun code ->
(update_timer h timer; result h code) >>= fun () ->
return @@ match code with
| Curl.CURLE_OK -> `Ok (Curl.get_httpcode h, Buffer.contents b)
| code -> `Error code
(update_timer h timer; return @@ result (h,match code with CURLE_OK -> `Ok (Curl.get_httpcode h, Buffer.contents b) | err -> `Error err))
end

let verbose_curl_result nr_http action t h code =
let verbose_curl_result nr_http action t (h,r) =
let open Curl in
let b = Buffer.create 10 in
bprintf b "%s #%d %s ⇓%s ⇑%s %s "
Expand All @@ -245,9 +241,9 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
(Action.bytes_string_f @@ get_sizeupload h)
(get_primaryip h)
;
begin match code with
| CURLE_OK ->
bprintf b "HTTP %d %s" (get_httpcode h) (get_effectiveurl h);
begin match r with
| `Ok (code,_) ->
bprintf b "HTTP %d %s" code (get_effectiveurl h);
begin match get_redirecturl h with
| "" -> ()
| s -> bprintf b " -> %s" s
Expand All @@ -256,7 +252,7 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with
| 0 -> ()
| n -> bprintf b " after %d redirects" n
end
| _ ->
| `Error code ->
bprintf b "error (%d) %s (errno %d)" (errno code) (strerror code) (Curl.get_oserrno h)
end;
log #info_s (Buffer.contents b)
Expand All @@ -270,7 +266,7 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with

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

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

let t = new Action.timer in
let result = Some (fun h code ->
if verbose then verbose_curl_result nr_http action t h code;
if Trace_core.enabled () then (
let result (h,_ as res) =
if verbose then verbose_curl_result nr_http action t res;
if Trace_core.enabled () then
begin
let data = get_curl_data h in
let data = match !ch_query_id with None -> data
| Some v -> ("http.response.header.x-clickhouse-query-id", `String v) :: data in
let data = match !ch_summary with None -> data
| Some v -> ("http.response.header.x-clickhouse-summary", `String v) :: data in
let data = match !resp_content_encoding with None -> data
| Some v -> ("http.response.header.content-encoding", `String v) :: data in
let data = match !ch_query_id with None -> data | Some v -> ("http.response.header.x-clickhouse-query-id", `String v) :: data in
let data = match !ch_summary with None -> data | Some v -> ("http.response.header.x-clickhouse-summary", `String v) :: data in
let data = match !resp_content_encoding with None -> data | Some v -> ("http.response.header.content-encoding", `String v) :: data in
Trace_core.add_data_to_span explicit_span data
);
end;
Trace_core.exit_span explicit_span;
return ()
) in
result res
in

http_gets ~setup:(setup ~headers set_body_and_headers) ?timer ?max_size ~result url

http_gets ~setup:(setup ~headers set_body_and_headers) ?timer ?result ?max_size url
let http_request' = http_request_ ~result:snd

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

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

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

let http_submit ?ua ?timeout ?verbose ?setup ?timer ?http_1_0 ?headers ?(action=`POST) url args =
http_request ?ua ?timeout ?verbose ?setup ?timer ?http_1_0 ?headers ~body:(`Form args) action url
let http_submit ?verbose ?ua ?timeout ?setup ?timer ?http_1_0 ?headers ?(action=`POST) url args =
http_request ?verbose ?ua ?timeout ?setup ?timer ?http_1_0 ?headers ~body:(`Form args) action url

end

Expand Down
Loading