this repo has no description
more
+1020
-1649
+2
-2
stack/requests/bin/dune
+2
-2
stack/requests/bin/dune
+152
-87
stack/requests/bin/ocurl.ml
+152
-87
stack/requests/bin/ocurl.ml
···
115
115
116
116
Fmt.pf ppf "@."
117
117
118
-
(* Main function using Session *)
118
+
(* Process a single URL and return result *)
119
+
let process_url env req method_ headers body include_headers quiet output url_str =
120
+
let uri = Uri.of_string url_str in
121
+
122
+
if not quiet then begin
123
+
let method_str = Requests.Method.to_string (method_ :> Requests.Method.t) in
124
+
Fmt.pr "@[<v>%a %a@]@."
125
+
Fmt.(styled `Bold string) method_str
126
+
Fmt.(styled `Underline Uri.pp) uri;
127
+
end;
128
+
try
129
+
(* Make request *)
130
+
let response =
131
+
match method_ with
132
+
| `GET -> Requests.get req ~headers url_str
133
+
| `POST -> Requests.post req ~headers ?body url_str
134
+
| `PUT -> Requests.put req ~headers ?body url_str
135
+
| `DELETE -> Requests.delete req ~headers url_str
136
+
| `HEAD -> Requests.head req ~headers url_str
137
+
| `OPTIONS -> Requests.options req ~headers url_str
138
+
| `PATCH -> Requests.patch req ~headers ?body url_str
139
+
in
140
+
141
+
(* Print response headers if requested *)
142
+
if include_headers && not quiet then
143
+
pp_response Fmt.stdout response;
144
+
145
+
(* Handle output *)
146
+
let body_flow = Requests.Response.body response in
147
+
148
+
begin match output with
149
+
| Some file -> begin
150
+
let filename =
151
+
if List.length [url_str] > 1 then begin
152
+
let base = Filename.remove_extension file in
153
+
let ext = Filename.extension file in
154
+
let url_hash =
155
+
let full_hash = Digest.string url_str |> Digest.to_hex in
156
+
String.sub full_hash (String.length full_hash - 8) 8 in
157
+
Printf.sprintf "%s-%s%s" base url_hash ext
158
+
end else file
159
+
in
160
+
let () =
161
+
Eio.Path.with_open_out ~create:(`Or_truncate 0o644)
162
+
Eio.Path.(env#fs / filename) @@ fun sink ->
163
+
Eio.Flow.copy body_flow sink in
164
+
let () = if not quiet then
165
+
Fmt.pr "[%s] Saved to %s@." url_str filename else () in
166
+
Ok (url_str, response)
167
+
end
168
+
| None ->
169
+
(* Write to stdout *)
170
+
let buf = Buffer.create 1024 in
171
+
Eio.Flow.copy body_flow (Eio.Flow.buffer_sink buf);
172
+
let body_str = Buffer.contents buf in
173
+
174
+
(* Pretty-print JSON if applicable *)
175
+
if String.length body_str > 0 &&
176
+
(body_str.[0] = '{' || body_str.[0] = '[') then
177
+
try
178
+
let json = Yojson.Safe.from_string body_str in
179
+
if not quiet then Fmt.pr "[%s]:@." url_str;
180
+
Fmt.pr "%a@." (Yojson.Safe.pretty_print ~std:true) json
181
+
with _ ->
182
+
if not quiet then Fmt.pr "[%s]:@." url_str;
183
+
print_string body_str
184
+
else begin
185
+
if not quiet then Fmt.pr "[%s]:@." url_str;
186
+
print_string body_str
187
+
end;
188
+
189
+
if not quiet && Requests.Response.ok response then
190
+
Logs.app (fun m -> m "✓ Success for %s" url_str);
191
+
192
+
Ok (url_str, response)
193
+
end
194
+
with
195
+
| exn ->
196
+
if not quiet then
197
+
Logs.err (fun m -> m "Request failed for %s: %s" url_str (Printexc.to_string exn));
198
+
Error (url_str, exn)
199
+
200
+
(* Main function using Requests with concurrent fetching *)
119
201
let run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects
120
202
method_ urls headers data json_data output include_headers
121
203
auth verbose quiet _show_progress () =
···
131
213
(* Create XDG paths *)
132
214
let xdg = Xdge.create env#fs "ocurl" in
133
215
134
-
(* Create session with configuration *)
216
+
(* Create requests instance with configuration *)
135
217
let timeout_obj = Option.map (fun t -> Requests.Timeout.create ~total:t ()) timeout in
136
-
let session = Requests.Session.create ~sw ~xdg ~persist_cookies ~verify_tls
218
+
let req = Requests.create ~sw ~xdg ~persist_cookies ~verify_tls
137
219
~follow_redirects ~max_redirects ?timeout:timeout_obj env in
138
220
139
221
(* Set authentication if provided *)
···
141
223
| Some auth_str ->
142
224
(match parse_auth auth_str with
143
225
| Some (user, pass) ->
144
-
Requests.Session.set_auth session
226
+
Requests.set_auth req
145
227
(Requests.Auth.basic ~username:user ~password:pass)
146
228
| None ->
147
229
Logs.warn (fun m -> m "Invalid auth format, ignoring"))
148
230
| None -> ());
149
231
150
-
(* Process each URL *)
151
-
List.iter (fun url_str ->
152
-
let uri = Uri.of_string url_str in
232
+
(* Build headers from command line *)
233
+
let cmd_headers = List.fold_left (fun hdrs header_str ->
234
+
match parse_header header_str with
235
+
| Some (k, v) -> Requests.Headers.add k v hdrs
236
+
| None -> hdrs
237
+
) Requests.Headers.empty headers in
153
238
154
-
if not quiet then
155
-
let method_str = Requests.Method.to_string (method_ :> Requests.Method.t) in
156
-
Fmt.pr "@[<v>%a %a@]@."
157
-
Fmt.(styled `Bold string) method_str
158
-
Fmt.(styled `Underline Uri.pp) uri;
239
+
(* Prepare body based on data/json options *)
240
+
let body = match json_data, data with
241
+
| Some json, _ -> Some (Requests.Body.json json)
242
+
| None, Some d -> Some (Requests.Body.text d)
243
+
| None, None -> None
244
+
in
159
245
160
-
(* Build headers from command line *)
161
-
let cmd_headers = List.fold_left (fun hdrs header_str ->
162
-
match parse_header header_str with
163
-
| Some (k, v) -> Requests.Headers.add k v hdrs
164
-
| None -> hdrs
165
-
) Requests.Headers.empty headers in
246
+
(* Process URLs concurrently or sequentially based on count *)
247
+
match urls with
248
+
| [] -> ()
249
+
| [single_url] ->
250
+
(* Single URL - process directly *)
251
+
let _ = process_url env req method_ cmd_headers body include_headers quiet output single_url in
252
+
()
253
+
| multiple_urls ->
254
+
(* Multiple URLs - process concurrently *)
255
+
if not quiet then
256
+
Fmt.pr "@[<v>Processing %d URLs concurrently...@]@." (List.length multiple_urls);
166
257
167
-
(* Prepare body based on data/json options *)
168
-
let body = match json_data, data with
169
-
| Some json, _ -> Some (Requests.Body.json json)
170
-
| None, Some d -> Some (Requests.Body.text d)
171
-
| None, None -> None
172
-
in
173
-
174
-
try
175
-
(* Make request using session *)
176
-
let response =
177
-
match method_ with
178
-
| `GET -> Requests.Session.get session ~headers:cmd_headers url_str
179
-
| `POST -> Requests.Session.post session ~headers:cmd_headers ?body url_str
180
-
| `PUT -> Requests.Session.put session ~headers:cmd_headers ?body url_str
181
-
| `DELETE -> Requests.Session.delete session ~headers:cmd_headers url_str
182
-
| `HEAD -> Requests.Session.head session ~headers:cmd_headers url_str
183
-
| `OPTIONS -> Requests.Session.options session ~headers:cmd_headers url_str
184
-
| `PATCH -> Requests.Session.patch session ~headers:cmd_headers ?body url_str
258
+
(* Create promises for each URL *)
259
+
let results =
260
+
List.map (fun url_str ->
261
+
let promise, resolver = Eio.Promise.create () in
262
+
(* Fork a fiber for each URL *)
263
+
Fiber.fork ~sw (fun () ->
264
+
let result = process_url env req method_ cmd_headers body include_headers quiet output url_str in
265
+
Eio.Promise.resolve resolver result
266
+
);
267
+
promise
268
+
) multiple_urls
185
269
in
186
270
187
-
(* Print response headers if requested *)
188
-
if include_headers && not quiet then
189
-
pp_response Fmt.stdout response;
271
+
(* Wait for all promises to complete *)
272
+
let completed_results = List.map Eio.Promise.await results in
190
273
191
-
(* Handle output *)
192
-
let body_flow = Requests.Response.body response in
274
+
(* Report summary *)
275
+
if not quiet then begin
276
+
let successes = List.filter Result.is_ok completed_results |> List.length in
277
+
let failures = List.filter Result.is_error completed_results |> List.length in
278
+
Fmt.pr "@[<v>@.Summary: %d successful, %d failed out of %d total@]@."
279
+
successes failures (List.length completed_results);
193
280
194
-
match output with
195
-
| Some file ->
196
-
(* Write to file *)
197
-
Eio.Path.with_open_out ~create:(`Or_truncate 0o644)
198
-
Eio.Path.(env#fs / file) @@ fun sink ->
199
-
Eio.Flow.copy body_flow sink;
200
-
if not quiet then
201
-
Fmt.pr "Saved to %s@." file
202
-
| None ->
203
-
(* Write to stdout *)
204
-
let buf = Buffer.create 1024 in
205
-
Eio.Flow.copy body_flow (Eio.Flow.buffer_sink buf);
206
-
let body_str = Buffer.contents buf in
207
-
208
-
(* Try to pretty-print JSON if it looks like JSON *)
209
-
if String.length body_str > 0 &&
210
-
(body_str.[0] = '{' || body_str.[0] = '[') then
211
-
try
212
-
let json = Yojson.Safe.from_string body_str in
213
-
Fmt.pr "%a@." (Yojson.Safe.pretty_print ~std:true) json
214
-
with _ ->
215
-
print_string body_str
216
-
else
217
-
print_string body_str;
218
-
219
-
(* Response auto-closes with switch *)
220
-
221
-
if not quiet && Requests.Response.ok response then
222
-
Logs.app (fun m -> m "✓ Success")
223
-
224
-
with
225
-
| exn ->
226
-
if not quiet then
227
-
Logs.err (fun m -> m "Request failed: %s" (Printexc.to_string exn));
228
-
exit 1
229
-
) urls
281
+
(* Print failed URLs *)
282
+
if failures > 0 then begin
283
+
Fmt.pr "@[<v>Failed URLs:@]@.";
284
+
List.iter (function
285
+
| Error (url, _) -> Fmt.pr " - %s@." url
286
+
| Ok _ -> ()
287
+
) completed_results
288
+
end
289
+
end
230
290
231
291
(* Main entry point *)
232
292
let main method_ urls headers data json_data output include_headers
···
243
303
244
304
(* Command-line interface *)
245
305
let cmd =
246
-
let doc = "OCaml HTTP client using the Requests library" in
306
+
let doc = "OCaml HTTP client with concurrent fetching using the Requests library" in
247
307
let man = [
248
308
`S Manpage.s_description;
249
309
`P "$(tname) is a command-line HTTP client written in OCaml that uses the \
250
-
Requests library with session management. It supports various HTTP methods, \
251
-
custom headers, authentication, cookies, and JSON data.";
310
+
Requests library with stateful request management. It supports various HTTP methods, \
311
+
custom headers, authentication, cookies, and JSON data. When multiple URLs are provided, \
312
+
they are fetched concurrently using Eio fibers for maximum performance.";
252
313
`S Manpage.s_examples;
253
314
`P "Fetch a URL:";
254
315
`Pre " $(tname) https://api.github.com";
316
+
`P "Fetch multiple URLs concurrently:";
317
+
`Pre " $(tname) https://api.github.com https://httpbin.org/get https://example.com";
255
318
`P "POST JSON data:";
256
319
`Pre " $(tname) -X POST --json '{\"key\":\"value\"}' https://httpbin.org/post";
257
320
`P "Download file:";
258
321
`Pre " $(tname) -o file.zip https://example.com/file.zip";
322
+
`P "Download multiple files concurrently:";
323
+
`Pre " $(tname) -o output.json https://api1.example.com https://api2.example.com https://api3.example.com";
259
324
`P "Basic authentication:";
260
325
`Pre " $(tname) -u user:pass https://httpbin.org/basic-auth/user/pass";
261
326
`P "Custom headers:";
···
266
331
`Pre " $(tname) --no-verify-tls https://self-signed.example.com";
267
332
] in
268
333
269
-
(* Build the term with Session configuration options *)
334
+
(* Build the term with Requests configuration options *)
270
335
let app_name = "ocurl" in
271
336
let combined_term =
272
337
Term.(const main $ http_method $ urls $ headers $ data $ json_data $
273
338
output_file $ include_headers $ auth $ verbose $ quiet $
274
339
show_progress $
275
-
Requests.Session.Cmd.persist_cookies_term app_name $
276
-
Requests.Session.Cmd.verify_tls_term app_name $
277
-
Requests.Session.Cmd.timeout_term app_name $
278
-
Requests.Session.Cmd.follow_redirects_term app_name $
279
-
Requests.Session.Cmd.max_redirects_term app_name $
340
+
Requests.Cmd.persist_cookies_term app_name $
341
+
Requests.Cmd.verify_tls_term app_name $
342
+
Requests.Cmd.timeout_term app_name $
343
+
Requests.Cmd.follow_redirects_term app_name $
344
+
Requests.Cmd.max_redirects_term app_name $
280
345
setup_log)
281
346
in
282
347
283
348
let info = Cmd.info "ocurl" ~version:"2.0.0" ~doc ~man in
284
349
Cmd.v info combined_term
285
350
286
-
let () = exit (Cmd.eval cmd)
351
+
let () = exit (Cmd.eval cmd)
+8
-1
stack/requests/lib/auth.ml
+8
-1
stack/requests/lib/auth.ml
···
1
+
let src = Logs.Src.create "requests.auth" ~doc:"HTTP Authentication"
2
+
module Log = (val Logs.src_log src : Logs.LOG)
3
+
1
4
type t =
2
5
| None
3
6
| Basic of { username : string; password : string }
···
19
22
match auth with
20
23
| None -> headers
21
24
| Basic { username; password } ->
25
+
Log.debug (fun m -> m "Applying basic authentication for user: %s" username);
22
26
Headers.basic ~username ~password headers
23
27
| Bearer { token } ->
28
+
Log.debug (fun m -> m "Applying bearer token authentication");
24
29
Headers.bearer token headers
25
-
| Digest { username = _; password = _ } ->
30
+
| Digest { username; password = _ } ->
31
+
Log.debug (fun m -> m "Digest auth configured for user: %s (requires server challenge)" username);
26
32
(* Digest auth requires server challenge first, handled elsewhere *)
27
33
headers
28
34
| Custom f ->
35
+
Log.debug (fun m -> m "Applying custom authentication handler");
29
36
f headers
+3
stack/requests/lib/auth.mli
+3
stack/requests/lib/auth.mli
+14
-5
stack/requests/lib/body.ml
+14
-5
stack/requests/lib/body.ml
···
1
+
let src = Logs.Src.create "requests.body" ~doc:"HTTP Request/Response Body"
2
+
module Log = (val Logs.src_log src : Logs.LOG)
3
+
1
4
type 'a part = {
2
5
name : string;
3
6
filename : string option;
···
26
29
| None ->
27
30
(* Guess MIME type from filename if available *)
28
31
let path = Eio.Path.native_exn file in
29
-
if String.ends_with ~suffix:".json" path then Mime.json
30
-
else if String.ends_with ~suffix:".html" path then Mime.html
31
-
else if String.ends_with ~suffix:".xml" path then Mime.xml
32
-
else if String.ends_with ~suffix:".txt" path then Mime.text
33
-
else Mime.octet_stream
32
+
let guessed =
33
+
if String.ends_with ~suffix:".json" path then Mime.json
34
+
else if String.ends_with ~suffix:".html" path then Mime.html
35
+
else if String.ends_with ~suffix:".xml" path then Mime.xml
36
+
else if String.ends_with ~suffix:".txt" path then Mime.text
37
+
else Mime.octet_stream
38
+
in
39
+
Log.debug (fun m -> m "Guessed MIME type %s for file %s" (Mime.to_string guessed) path);
40
+
guessed
34
41
in
42
+
Log.debug (fun m -> m "Creating file body from %s with MIME type %s"
43
+
(Eio.Path.native_exn file) (Mime.to_string mime));
35
44
File { file; mime }
36
45
37
46
let json json_string =
+3
stack/requests/lib/body.mli
+3
stack/requests/lib/body.mli
-302
stack/requests/lib/client.ml
-302
stack/requests/lib/client.ml
···
1
-
type ('a,'b) t = {
2
-
clock : 'a;
3
-
net : 'b;
4
-
default_headers : Headers.t;
5
-
timeout : Timeout.t;
6
-
max_retries : int;
7
-
retry_backoff : float;
8
-
verify_tls : bool;
9
-
tls_config : Tls.Config.client option;
10
-
}
11
-
12
-
let create
13
-
?(default_headers = Headers.empty)
14
-
?(timeout = Timeout.default)
15
-
?(max_retries = 3)
16
-
?(retry_backoff = 2.0)
17
-
?(verify_tls = true)
18
-
?tls_config
19
-
~clock
20
-
~net
21
-
() =
22
-
(* Create default TLS config if verify_tls is true and no custom config provided *)
23
-
let tls_config =
24
-
match tls_config, verify_tls with
25
-
| Some config, _ -> Some config
26
-
| None, true ->
27
-
(* Use CA certificates for verification *)
28
-
(match Ca_certs.authenticator () with
29
-
| Ok authenticator ->
30
-
(match Tls.Config.client ~authenticator () with
31
-
| Ok cfg -> Some cfg
32
-
| Error (`Msg msg) ->
33
-
Logs.warn (fun m -> m "Failed to create TLS config: %s" msg);
34
-
None)
35
-
| Error (`Msg msg) ->
36
-
Logs.warn (fun m -> m "Failed to load CA certificates: %s" msg);
37
-
None)
38
-
| None, false -> None
39
-
in
40
-
{
41
-
clock;
42
-
net;
43
-
default_headers;
44
-
timeout;
45
-
max_retries;
46
-
retry_backoff;
47
-
verify_tls;
48
-
tls_config;
49
-
}
50
-
51
-
let default ~clock ~net =
52
-
create ~clock ~net ()
53
-
54
-
(* Accessors *)
55
-
let clock t = t.clock
56
-
let net t = t.net
57
-
let default_headers t = t.default_headers
58
-
let timeout t = t.timeout
59
-
let max_retries t = t.max_retries
60
-
let retry_backoff t = t.retry_backoff
61
-
let verify_tls t = t.verify_tls
62
-
let tls_config t = t.tls_config
63
-
64
-
(* HTTP Request Methods *)
65
-
66
-
let src = Logs.Src.create "requests.client" ~doc:"HTTP Request Client"
67
-
module Log = (val Logs.src_log src : Logs.LOG)
68
-
69
-
(* Helper to get client or use default *)
70
-
let get_client client =
71
-
match client with
72
-
| Some c -> c
73
-
| None -> failwith "No client provided"
74
-
75
-
(* Convert our Headers.t to Cohttp.Header.t *)
76
-
let headers_to_cohttp headers =
77
-
Headers.to_list headers
78
-
|> Cohttp.Header.of_list
79
-
80
-
(* Convert Cohttp.Header.t to our Headers.t *)
81
-
let headers_from_cohttp cohttp_headers =
82
-
Cohttp.Header.to_list cohttp_headers
83
-
|> Headers.of_list
84
-
85
-
(* Main request implementation *)
86
-
let request ~sw ?client ?headers ?body ?auth ?timeout ?follow_redirects
87
-
?max_redirects ~method_ url =
88
-
let client = get_client client in
89
-
let start_time = Unix.gettimeofday () in
90
-
91
-
Log.info (fun m -> m "Making %s request to %s" (Method.to_string method_) url);
92
-
93
-
(* Prepare headers *)
94
-
let headers = match headers with
95
-
| Some h -> h
96
-
| None -> default_headers client
97
-
in
98
-
99
-
(* Apply auth *)
100
-
let headers = match auth with
101
-
| Some a ->
102
-
Log.debug (fun m -> m "Applying authentication");
103
-
Auth.apply a headers
104
-
| None -> headers
105
-
in
106
-
107
-
(* Add content type from body *)
108
-
let headers = match body with
109
-
| Some b -> (match Body.content_type b with
110
-
| Some mime -> Headers.content_type mime headers
111
-
| None -> headers)
112
-
| None -> headers
113
-
in
114
-
115
-
(* Convert to Cohttp types *)
116
-
let cohttp_method =
117
-
match Method.to_string method_ with
118
-
| "GET" -> `GET
119
-
| "POST" -> `POST
120
-
| "PUT" -> `PUT
121
-
| "DELETE" -> `DELETE
122
-
| "HEAD" -> `HEAD
123
-
| "OPTIONS" -> `OPTIONS
124
-
| "PATCH" -> `PATCH
125
-
| "CONNECT" -> `CONNECT
126
-
| "TRACE" -> `TRACE
127
-
| _ -> `GET
128
-
in
129
-
130
-
let cohttp_headers = headers_to_cohttp headers in
131
-
let cohttp_body = match body with
132
-
| Some b -> Body.Private.to_cohttp_body ~sw b
133
-
| None -> None
134
-
in
135
-
136
-
(* Make request using cohttp-eio *)
137
-
let uri = Uri.of_string url in
138
-
139
-
(* Create HTTPS handler if TLS is configured *)
140
-
let https = match tls_config client with
141
-
| None ->
142
-
Log.debug (fun m -> m "No TLS configuration");
143
-
None
144
-
| Some tls_config ->
145
-
Log.debug (fun m -> m "Using TLS configuration");
146
-
let https_fn uri socket =
147
-
let host =
148
-
Uri.host uri
149
-
|> Option.map (fun x -> Domain_name.(host_exn (of_string_exn x)))
150
-
in
151
-
Tls_eio.client_of_flow ?host tls_config socket
152
-
in
153
-
Some https_fn
154
-
in
155
-
156
-
(* Create the client *)
157
-
let eio_client = Cohttp_eio.Client.make ~https (net client) in
158
-
159
-
(* Apply timeout if specified *)
160
-
let make_request () =
161
-
Cohttp_eio.Client.call ~sw eio_client cohttp_method uri ~headers:cohttp_headers ?body:cohttp_body
162
-
in
163
-
164
-
(* Make the actual request with optional timeout *)
165
-
let resp, resp_body =
166
-
match timeout with
167
-
| Some t ->
168
-
let timeout_seconds = Timeout.total t in
169
-
(match timeout_seconds with
170
-
| Some seconds ->
171
-
Log.debug (fun m -> m "Setting timeout: %.2f seconds" seconds);
172
-
Eio.Time.with_timeout_exn (clock client) seconds make_request
173
-
| None -> make_request ())
174
-
| None -> make_request ()
175
-
in
176
-
177
-
let status = Cohttp.Response.status resp |> Cohttp.Code.code_of_status in
178
-
let cohttp_resp_headers = Cohttp.Response.headers resp in
179
-
let resp_headers = headers_from_cohttp cohttp_resp_headers in
180
-
181
-
Log.info (fun m -> m "Received response: status=%d" status);
182
-
183
-
(* Handle redirects if enabled *)
184
-
let follow_redirects = Option.value follow_redirects ~default:true in
185
-
let max_redirects = Option.value max_redirects ~default:10 in
186
-
187
-
let final_resp, final_body, final_url =
188
-
if follow_redirects && (status >= 300 && status < 400) then
189
-
let rec follow_redirect url redirects_left =
190
-
if redirects_left <= 0 then begin
191
-
Log.err (fun m -> m "Too many redirects (%d) for %s" max_redirects url);
192
-
raise (Error.TooManyRedirects { url; count = max_redirects; max = max_redirects })
193
-
end else
194
-
(* Get location header from Cohttp headers *)
195
-
match Cohttp.Header.get cohttp_resp_headers "location" with
196
-
| None ->
197
-
Log.debug (fun m -> m "Redirect response missing Location header");
198
-
(resp, resp_body, url)
199
-
| Some location ->
200
-
Log.info (fun m -> m "Following redirect to %s (%d remaining)"
201
-
location redirects_left);
202
-
(* Make new request to redirect location *)
203
-
let new_uri = Uri.of_string location in
204
-
let new_resp, new_body =
205
-
Cohttp_eio.Client.call ~sw eio_client cohttp_method new_uri ~headers:cohttp_headers
206
-
in
207
-
let new_status = Cohttp.Response.status new_resp |> Cohttp.Code.code_of_status in
208
-
if new_status >= 300 && new_status < 400 then
209
-
follow_redirect location (redirects_left - 1)
210
-
else
211
-
(new_resp, new_body, location)
212
-
in
213
-
follow_redirect url max_redirects
214
-
else
215
-
(resp, resp_body, url)
216
-
in
217
-
218
-
(* Get final headers *)
219
-
let final_headers =
220
-
if final_resp == resp then
221
-
resp_headers
222
-
else
223
-
Cohttp.Response.headers final_resp |> headers_from_cohttp
224
-
in
225
-
226
-
let elapsed = Unix.gettimeofday () -. start_time in
227
-
Log.info (fun m -> m "Request completed in %.3f seconds" elapsed);
228
-
229
-
Response.Private.make
230
-
~sw
231
-
~status
232
-
~headers:final_headers
233
-
~body:final_body
234
-
~url:final_url
235
-
~elapsed
236
-
237
-
(* Convenience methods *)
238
-
let get ~sw ?client ?headers ?auth ?timeout ?follow_redirects ?max_redirects url =
239
-
request ~sw ?client ?headers ?auth ?timeout ?follow_redirects ?max_redirects
240
-
~method_:`GET url
241
-
242
-
let post ~sw ?client ?headers ?body ?auth ?timeout url =
243
-
request ~sw ?client ?headers ?body ?auth ?timeout ~method_:`POST url
244
-
245
-
let put ~sw ?client ?headers ?body ?auth ?timeout url =
246
-
request ~sw ?client ?headers ?body ?auth ?timeout ~method_:`PUT url
247
-
248
-
let delete ~sw ?client ?headers ?auth ?timeout url =
249
-
request ~sw ?client ?headers ?auth ?timeout ~method_:`DELETE url
250
-
251
-
let head ~sw ?client ?headers ?auth ?timeout url =
252
-
request ~sw ?client ?headers ?auth ?timeout ~method_:`HEAD url
253
-
254
-
let patch ~sw ?client ?headers ?body ?auth ?timeout url =
255
-
request ~sw ?client ?headers ?body ?auth ?timeout ~method_:`PATCH url
256
-
257
-
let upload ~sw ?client ?headers ?auth ?timeout ?method_ ?mime ?length
258
-
?on_progress ~source url =
259
-
let method_ = Option.value method_ ~default:`POST in
260
-
let mime = Option.value mime ~default:Mime.octet_stream in
261
-
262
-
(* Wrap source with progress tracking if callback provided *)
263
-
let tracked_source = match on_progress with
264
-
| None -> source
265
-
| Some callback ->
266
-
(* For now, progress tracking is not implemented for uploads
267
-
due to complexity of wrapping Eio.Flow.source.
268
-
This would require creating a custom flow wrapper. *)
269
-
let _ = callback in
270
-
source
271
-
in
272
-
273
-
let body = Body.of_stream ?length mime tracked_source in
274
-
request ~sw ?client ?headers ~body ?auth ?timeout ~method_ url
275
-
276
-
let download ~sw ?client ?headers ?auth ?timeout ?on_progress url ~sink =
277
-
let response = get ~sw ?client ?headers ?auth ?timeout url in
278
-
279
-
try
280
-
(* Get content length for progress tracking *)
281
-
let total = Response.content_length response in
282
-
283
-
let body = Response.body response in
284
-
285
-
(* Stream data to sink with optional progress *)
286
-
match on_progress with
287
-
| None ->
288
-
(* No progress tracking, just copy directly *)
289
-
Eio.Flow.copy body sink
290
-
| Some progress_fn ->
291
-
(* Copy with progress tracking *)
292
-
(* We need to intercept the flow to track bytes *)
293
-
(* For now, just do a simple copy - proper progress tracking needs flow wrapper *)
294
-
progress_fn ~received:0L ~total;
295
-
Eio.Flow.copy body sink;
296
-
progress_fn ~received:(Option.value total ~default:0L) ~total;
297
-
298
-
(* Response auto-closes with switch *)
299
-
()
300
-
with e ->
301
-
(* Response auto-closes with switch *)
302
-
raise e
-202
stack/requests/lib/client.mli
-202
stack/requests/lib/client.mli
···
1
-
(** Low-level HTTP client with streaming support
2
-
3
-
The Client module provides a stateless HTTP client with connection pooling,
4
-
TLS support, and streaming capabilities. For stateful requests with automatic
5
-
cookie handling and persistent configuration, use the {!Session} module instead.
6
-
7
-
{2 Examples}
8
-
9
-
{[
10
-
open Eio_main
11
-
12
-
let () = run @@ fun env ->
13
-
Switch.run @@ fun sw ->
14
-
15
-
(* Create a client *)
16
-
let client = Client.create ~clock:env#clock ~net:env#net () in
17
-
18
-
(* Simple GET request *)
19
-
let response = Client.get ~sw ~client "https://example.com" in
20
-
Printf.printf "Status: %d\n" (Response.status_code response);
21
-
Response.close response;
22
-
23
-
(* POST with JSON body *)
24
-
let response = Client.post ~sw ~client
25
-
~body:(Body.json {|{"key": "value"}|})
26
-
~headers:(Headers.empty |> Headers.content_type Mime.json)
27
-
"https://api.example.com/data" in
28
-
Response.close response;
29
-
30
-
(* Download file with streaming *)
31
-
Client.download ~sw ~client
32
-
"https://example.com/large-file.zip"
33
-
~sink:(Eio.Path.(fs / "download.zip" |> sink))
34
-
]}
35
-
*)
36
-
37
-
type ('a,'b) t
38
-
(** Client configuration with clock and network types.
39
-
The type parameters track the Eio environment capabilities. *)
40
-
41
-
(** {1 Client Creation} *)
42
-
43
-
val create :
44
-
?default_headers:Headers.t ->
45
-
?timeout:Timeout.t ->
46
-
?max_retries:int ->
47
-
?retry_backoff:float ->
48
-
?verify_tls:bool ->
49
-
?tls_config:Tls.Config.client ->
50
-
clock:'a Eio.Time.clock ->
51
-
net:'b Eio.Net.t ->
52
-
unit -> ('a Eio.Time.clock, 'b Eio.Net.t) t
53
-
(** [create ?default_headers ?timeout ?max_retries ?retry_backoff ?verify_tls ?tls_config ~clock ~net ()]
54
-
creates a new HTTP client with the specified configuration.
55
-
56
-
@param default_headers Headers to include in every request (default: empty)
57
-
@param timeout Default timeout configuration (default: 30s connect, 60s read)
58
-
@param max_retries Maximum number of retries for failed requests (default: 3)
59
-
@param retry_backoff Exponential backoff factor for retries (default: 2.0)
60
-
@param verify_tls Whether to verify TLS certificates (default: true)
61
-
@param tls_config Custom TLS configuration (default: uses system CA certificates)
62
-
@param clock Eio clock for timeouts and scheduling
63
-
@param net Eio network capability for making connections
64
-
*)
65
-
66
-
val default : clock:'a Eio.Time.clock -> net:'b Eio.Net.t -> ('a Eio.Time.clock, 'b Eio.Net.t) t
67
-
(** [default ~clock ~net] creates a client with default configuration.
68
-
Equivalent to [create ~clock ~net ()]. *)
69
-
70
-
(** {1 Configuration Access} *)
71
-
72
-
val clock : ('a,'b) t -> 'a
73
-
(** [clock client] returns the clock capability. *)
74
-
75
-
val net : ('a,'b) t -> 'b
76
-
(** [net client] returns the network capability. *)
77
-
78
-
val default_headers : ('a,'b) t -> Headers.t
79
-
(** [default_headers client] returns the default headers. *)
80
-
81
-
val timeout : ('a,'b) t -> Timeout.t
82
-
(** [timeout client] returns the timeout configuration. *)
83
-
84
-
val max_retries : ('a,'b) t -> int
85
-
(** [max_retries client] returns the maximum retry count. *)
86
-
87
-
val retry_backoff : ('a,'b) t -> float
88
-
(** [retry_backoff client] returns the retry backoff factor. *)
89
-
90
-
val verify_tls : ('a,'b) t -> bool
91
-
(** [verify_tls client] returns whether TLS verification is enabled. *)
92
-
93
-
val tls_config : ('a,'b) t -> Tls.Config.client option
94
-
(** [tls_config client] returns the TLS configuration if set. *)
95
-
96
-
(** {1 HTTP Request Methods} *)
97
-
98
-
val request :
99
-
sw:Eio.Switch.t ->
100
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
101
-
?headers:Headers.t ->
102
-
?body:Body.t ->
103
-
?auth:Auth.t ->
104
-
?timeout:Timeout.t ->
105
-
?follow_redirects:bool ->
106
-
?max_redirects:int ->
107
-
method_:Method.t ->
108
-
string ->
109
-
Response.t
110
-
(** Make a streaming request *)
111
-
112
-
val get :
113
-
sw:Eio.Switch.t ->
114
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
115
-
?headers:Headers.t ->
116
-
?auth:Auth.t ->
117
-
?timeout:Timeout.t ->
118
-
?follow_redirects:bool ->
119
-
?max_redirects:int ->
120
-
string ->
121
-
Response.t
122
-
(** GET request *)
123
-
124
-
val post :
125
-
sw:Eio.Switch.t ->
126
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
127
-
?headers:Headers.t ->
128
-
?body:Body.t ->
129
-
?auth:Auth.t ->
130
-
?timeout:Timeout.t ->
131
-
string ->
132
-
Response.t
133
-
(** POST request *)
134
-
135
-
val put :
136
-
sw:Eio.Switch.t ->
137
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
138
-
?headers:Headers.t ->
139
-
?body:Body.t ->
140
-
?auth:Auth.t ->
141
-
?timeout:Timeout.t ->
142
-
string ->
143
-
Response.t
144
-
(** PUT request *)
145
-
146
-
val delete :
147
-
sw:Eio.Switch.t ->
148
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
149
-
?headers:Headers.t ->
150
-
?auth:Auth.t ->
151
-
?timeout:Timeout.t ->
152
-
string ->
153
-
Response.t
154
-
(** DELETE request *)
155
-
156
-
val head :
157
-
sw:Eio.Switch.t ->
158
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
159
-
?headers:Headers.t ->
160
-
?auth:Auth.t ->
161
-
?timeout:Timeout.t ->
162
-
string ->
163
-
Response.t
164
-
(** HEAD request *)
165
-
166
-
val patch :
167
-
sw:Eio.Switch.t ->
168
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
169
-
?headers:Headers.t ->
170
-
?body:Body.t ->
171
-
?auth:Auth.t ->
172
-
?timeout:Timeout.t ->
173
-
string ->
174
-
Response.t
175
-
(** PATCH request *)
176
-
177
-
val upload :
178
-
sw:Eio.Switch.t ->
179
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
180
-
?headers:Headers.t ->
181
-
?auth:Auth.t ->
182
-
?timeout:Timeout.t ->
183
-
?method_:Method.t ->
184
-
?mime:Mime.t ->
185
-
?length:int64 ->
186
-
?on_progress:(sent:int64 -> total:int64 option -> unit) ->
187
-
source:Eio.Flow.source_ty Eio.Resource.t ->
188
-
string ->
189
-
Response.t
190
-
(** Upload from stream *)
191
-
192
-
val download :
193
-
sw:Eio.Switch.t ->
194
-
?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->
195
-
?headers:Headers.t ->
196
-
?auth:Auth.t ->
197
-
?timeout:Timeout.t ->
198
-
?on_progress:(received:int64 -> total:int64 option -> unit) ->
199
-
string ->
200
-
sink:Eio.Flow.sink_ty Eio.Resource.t ->
201
-
unit
202
-
(** Download to stream *)
+3
stack/requests/lib/error.ml
+3
stack/requests/lib/error.ml
+3
stack/requests/lib/error.mli
+3
stack/requests/lib/error.mli
+3
stack/requests/lib/headers.mli
+3
stack/requests/lib/headers.mli
+3
stack/requests/lib/method.ml
+3
stack/requests/lib/method.ml
+3
stack/requests/lib/method.mli
+3
stack/requests/lib/method.mli
+3
stack/requests/lib/mime.ml
+3
stack/requests/lib/mime.ml
+3
stack/requests/lib/mime.mli
+3
stack/requests/lib/mime.mli
+396
-3
stack/requests/lib/requests.ml
+396
-3
stack/requests/lib/requests.ml
···
1
1
(** OCaml HTTP client library with streaming support *)
2
2
3
-
(* Re-export all modules *)
3
+
let src = Logs.Src.create "requests" ~doc:"HTTP Client Library"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
4
6
module Method = Method
5
7
module Mime = Mime
6
8
module Headers = Headers
···
8
10
module Timeout = Timeout
9
11
module Body = Body
10
12
module Response = Response
11
-
module Client = Client
13
+
module One = One
12
14
module Status = Status
13
15
module Error = Error
14
-
module Session = Session
15
16
module Retry = Retry
17
+
18
+
(* Main API - Session functionality with concurrent fiber spawning *)
19
+
20
+
type ('clock, 'net) t = {
21
+
sw : Eio.Switch.t;
22
+
client : ('clock, 'net) One.t;
23
+
clock : 'clock;
24
+
cookie_jar : Cookeio.jar;
25
+
cookie_mutex : Eio.Mutex.t;
26
+
mutable default_headers : Headers.t;
27
+
mutable auth : Auth.t option;
28
+
mutable timeout : Timeout.t;
29
+
mutable follow_redirects : bool;
30
+
mutable max_redirects : int;
31
+
mutable retry : Retry.config option;
32
+
persist_cookies : bool;
33
+
xdg : Xdge.t option;
34
+
(* Statistics *)
35
+
mutable requests_made : int;
36
+
mutable total_time : float;
37
+
mutable retries_count : int;
38
+
}
39
+
40
+
let create
41
+
~sw
42
+
?client
43
+
?cookie_jar
44
+
?(default_headers = Headers.empty)
45
+
?auth
46
+
?(timeout = Timeout.default)
47
+
?(follow_redirects = true)
48
+
?(max_redirects = 10)
49
+
?(verify_tls = true)
50
+
?retry
51
+
?(persist_cookies = false)
52
+
?xdg
53
+
env =
54
+
55
+
let xdg = match xdg, persist_cookies with
56
+
| Some x, _ -> Some x
57
+
| None, true -> Some (Xdge.create env#fs "requests")
58
+
| None, false -> None
59
+
in
60
+
61
+
let client = match client with
62
+
| Some c -> c
63
+
| None ->
64
+
One.create ~verify_tls ~timeout
65
+
~clock:env#clock ~net:env#net ()
66
+
in
67
+
68
+
let cookie_jar = match cookie_jar, persist_cookies, xdg with
69
+
| Some jar, _, _ -> jar
70
+
| None, true, Some xdg_ctx ->
71
+
let data_dir = Xdge.data_dir xdg_ctx in
72
+
let cookie_file = Eio.Path.(data_dir / "cookies.txt") in
73
+
Cookeio.load cookie_file
74
+
| None, _, _ ->
75
+
Cookeio.create ()
76
+
in
77
+
78
+
{
79
+
sw;
80
+
client;
81
+
clock = env#clock;
82
+
cookie_jar;
83
+
cookie_mutex = Eio.Mutex.create ();
84
+
default_headers;
85
+
auth;
86
+
timeout;
87
+
follow_redirects;
88
+
max_redirects;
89
+
retry;
90
+
persist_cookies;
91
+
xdg;
92
+
requests_made = 0;
93
+
total_time = 0.0;
94
+
retries_count = 0;
95
+
}
96
+
97
+
(* Configuration management *)
98
+
let set_default_header t key value =
99
+
t.default_headers <- Headers.set key value t.default_headers
100
+
101
+
let remove_default_header t key =
102
+
t.default_headers <- Headers.remove key t.default_headers
103
+
104
+
let set_auth t auth =
105
+
Log.debug (fun m -> m "Setting authentication method");
106
+
t.auth <- Some auth
107
+
108
+
let clear_auth t =
109
+
Log.debug (fun m -> m "Clearing authentication");
110
+
t.auth <- None
111
+
112
+
let set_timeout t timeout =
113
+
Log.debug (fun m -> m "Setting timeout: %a" Timeout.pp timeout);
114
+
t.timeout <- timeout
115
+
116
+
let set_retry t config =
117
+
Log.debug (fun m -> m "Setting retry config: max_retries=%d" config.Retry.max_retries);
118
+
t.retry <- Some config
119
+
120
+
let cookies t = t.cookie_jar
121
+
let clear_cookies t = Cookeio.clear t.cookie_jar
122
+
123
+
(* Internal request function that runs in a fiber *)
124
+
let make_request_internal t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =
125
+
Log.info (fun m -> m "Making %s request to %s" (Method.to_string method_) url);
126
+
(* Merge headers *)
127
+
let headers = match headers with
128
+
| Some h -> Headers.merge t.default_headers h
129
+
| None -> t.default_headers
130
+
in
131
+
132
+
(* Use provided auth or default *)
133
+
let auth = match auth with
134
+
| Some a -> Some a
135
+
| None -> t.auth
136
+
in
137
+
138
+
(* Get cookies for this URL *)
139
+
let uri = Uri.of_string url in
140
+
let domain = Option.value ~default:"" (Uri.host uri) in
141
+
let path = Uri.path uri in
142
+
let is_secure = Uri.scheme uri = Some "https" in
143
+
144
+
let headers =
145
+
Eio.Mutex.use_ro t.cookie_mutex (fun () ->
146
+
let cookies = Cookeio.get_cookies t.cookie_jar ~domain ~path ~is_secure in
147
+
match cookies with
148
+
| [] -> headers
149
+
| cookies ->
150
+
Log.debug (fun m -> m "Adding %d cookies for %s%s" (List.length cookies) domain path);
151
+
let cookie_header = Cookeio.make_cookie_header cookies in
152
+
Headers.set "Cookie" cookie_header headers
153
+
)
154
+
in
155
+
156
+
(* Make the actual request *)
157
+
let response = One.request ~sw:t.sw ~client:t.client
158
+
?body ?auth
159
+
~timeout:(Option.value timeout ~default:t.timeout)
160
+
~follow_redirects:(Option.value follow_redirects ~default:t.follow_redirects)
161
+
~max_redirects:(Option.value max_redirects ~default:t.max_redirects)
162
+
~headers ~method_ url
163
+
in
164
+
165
+
(* Extract and store cookies from response *)
166
+
let () =
167
+
Eio.Mutex.use_rw ~protect:true t.cookie_mutex (fun () ->
168
+
match Response.headers response |> Headers.get_all "Set-Cookie" with
169
+
| [] -> ()
170
+
| cookie_headers ->
171
+
Log.debug (fun m -> m "Received %d Set-Cookie headers" (List.length cookie_headers));
172
+
List.iter (fun cookie_str ->
173
+
match Cookeio.parse_set_cookie ~domain ~path cookie_str with
174
+
| Some cookie ->
175
+
Log.debug (fun m -> m "Storing cookie");
176
+
Cookeio.add_cookie t.cookie_jar cookie
177
+
| None ->
178
+
Log.warn (fun m -> m "Failed to parse cookie: %s" cookie_str)
179
+
) cookie_headers
180
+
)
181
+
in
182
+
183
+
(* Update statistics *)
184
+
t.requests_made <- t.requests_made + 1;
185
+
Log.info (fun m -> m "Request completed with status %d" (Response.status_code response));
186
+
187
+
response
188
+
189
+
(* Public request function - executes synchronously *)
190
+
let request t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =
191
+
make_request_internal t ?headers ?body ?auth ?timeout
192
+
?follow_redirects ?max_redirects ~method_ url
193
+
194
+
(* Convenience methods *)
195
+
let get t ?headers ?auth ?timeout ?params url =
196
+
let url = match params with
197
+
| Some p ->
198
+
let uri = Uri.of_string url in
199
+
let uri = List.fold_left (fun u (k, v) -> Uri.add_query_param' u (k, v)) uri p in
200
+
Uri.to_string uri
201
+
| None -> url
202
+
in
203
+
request t ?headers ?auth ?timeout ~method_:`GET url
204
+
205
+
let post t ?headers ?body ?auth ?timeout url =
206
+
request t ?headers ?body ?auth ?timeout ~method_:`POST url
207
+
208
+
let put t ?headers ?body ?auth ?timeout url =
209
+
request t ?headers ?body ?auth ?timeout ~method_:`PUT url
210
+
211
+
let patch t ?headers ?body ?auth ?timeout url =
212
+
request t ?headers ?body ?auth ?timeout ~method_:`PATCH url
213
+
214
+
let delete t ?headers ?auth ?timeout url =
215
+
request t ?headers ?auth ?timeout ~method_:`DELETE url
216
+
217
+
let head t ?headers ?auth ?timeout url =
218
+
request t ?headers ?auth ?timeout ~method_:`HEAD url
219
+
220
+
let options t ?headers ?auth ?timeout url =
221
+
request t ?headers ?auth ?timeout ~method_:`OPTIONS url
222
+
223
+
(* Cmdliner integration module *)
224
+
module Cmd = struct
225
+
open Cmdliner
226
+
227
+
type config = {
228
+
xdg : Xdge.t * Xdge.Cmd.t;
229
+
persist_cookies : bool;
230
+
verify_tls : bool;
231
+
timeout : float option;
232
+
max_retries : int;
233
+
retry_backoff : float;
234
+
follow_redirects : bool;
235
+
max_redirects : int;
236
+
user_agent : string option;
237
+
}
238
+
239
+
let create config env sw =
240
+
let xdg, _xdg_cmd = config.xdg in
241
+
let retry = if config.max_retries > 0 then
242
+
Some (Retry.create_config
243
+
~max_retries:config.max_retries
244
+
~backoff_factor:config.retry_backoff ())
245
+
else None in
246
+
247
+
let timeout = match config.timeout with
248
+
| Some t -> Timeout.create ~total:t ()
249
+
| None -> Timeout.default in
250
+
251
+
let req = create ~sw
252
+
~xdg
253
+
~persist_cookies:config.persist_cookies
254
+
~verify_tls:config.verify_tls
255
+
~timeout
256
+
?retry
257
+
~follow_redirects:config.follow_redirects
258
+
~max_redirects:config.max_redirects
259
+
env in
260
+
261
+
(* Set user agent if provided *)
262
+
Option.iter (set_default_header req "User-Agent") config.user_agent;
263
+
264
+
req
265
+
266
+
(* Individual terms - parameterized by app_name *)
267
+
268
+
let persist_cookies_term app_name =
269
+
let doc = "Persist cookies to disk between sessions" in
270
+
let env_name = String.uppercase_ascii app_name ^ "_PERSIST_COOKIES" in
271
+
let env = Cmd.Env.info env_name in
272
+
Arg.(value & flag & info ["persist-cookies"] ~env ~doc)
273
+
274
+
let verify_tls_term app_name =
275
+
let doc = "Skip TLS certificate verification (insecure)" in
276
+
let env_name = String.uppercase_ascii app_name ^ "_NO_VERIFY_TLS" in
277
+
let env = Cmd.Env.info env_name in
278
+
Term.(const (fun no_verify -> not no_verify) $
279
+
Arg.(value & flag & info ["no-verify-tls"] ~env ~doc))
280
+
281
+
let timeout_term app_name =
282
+
let doc = "Request timeout in seconds" in
283
+
let env_name = String.uppercase_ascii app_name ^ "_TIMEOUT" in
284
+
let env = Cmd.Env.info env_name in
285
+
Arg.(value & opt (some float) None & info ["timeout"] ~env ~docv:"SECONDS" ~doc)
286
+
287
+
let retries_term app_name =
288
+
let doc = "Maximum number of request retries" in
289
+
let env_name = String.uppercase_ascii app_name ^ "_MAX_RETRIES" in
290
+
let env = Cmd.Env.info env_name in
291
+
Arg.(value & opt int 3 & info ["max-retries"] ~env ~docv:"N" ~doc)
292
+
293
+
let retry_backoff_term app_name =
294
+
let doc = "Retry backoff factor for exponential delay" in
295
+
let env_name = String.uppercase_ascii app_name ^ "_RETRY_BACKOFF" in
296
+
let env = Cmd.Env.info env_name in
297
+
Arg.(value & opt float 0.3 & info ["retry-backoff"] ~env ~docv:"FACTOR" ~doc)
298
+
299
+
let follow_redirects_term app_name =
300
+
let doc = "Don't follow HTTP redirects" in
301
+
let env_name = String.uppercase_ascii app_name ^ "_NO_FOLLOW_REDIRECTS" in
302
+
let env = Cmd.Env.info env_name in
303
+
Term.(const (fun no_follow -> not no_follow) $
304
+
Arg.(value & flag & info ["no-follow-redirects"] ~env ~doc))
305
+
306
+
let max_redirects_term app_name =
307
+
let doc = "Maximum number of redirects to follow" in
308
+
let env_name = String.uppercase_ascii app_name ^ "_MAX_REDIRECTS" in
309
+
let env = Cmd.Env.info env_name in
310
+
Arg.(value & opt int 10 & info ["max-redirects"] ~env ~docv:"N" ~doc)
311
+
312
+
let user_agent_term app_name =
313
+
let doc = "User-Agent header to send with requests" in
314
+
let env_name = String.uppercase_ascii app_name ^ "_USER_AGENT" in
315
+
let env = Cmd.Env.info env_name in
316
+
Arg.(value & opt (some string) None & info ["user-agent"] ~env ~docv:"STRING" ~doc)
317
+
318
+
(* Combined terms *)
319
+
320
+
let config_term app_name fs =
321
+
let xdg_term = Xdge.Cmd.term app_name fs
322
+
~config:true ~data:true ~cache:true ~state:false ~runtime:false () in
323
+
Term.(const (fun xdg persist verify timeout retries backoff follow max_redir ua ->
324
+
{ xdg; persist_cookies = persist; verify_tls = verify;
325
+
timeout; max_retries = retries; retry_backoff = backoff;
326
+
follow_redirects = follow; max_redirects = max_redir;
327
+
user_agent = ua })
328
+
$ xdg_term
329
+
$ persist_cookies_term app_name
330
+
$ verify_tls_term app_name
331
+
$ timeout_term app_name
332
+
$ retries_term app_name
333
+
$ retry_backoff_term app_name
334
+
$ follow_redirects_term app_name
335
+
$ max_redirects_term app_name
336
+
$ user_agent_term app_name)
337
+
338
+
let requests_term app_name env sw =
339
+
let config_t = config_term app_name env#fs in
340
+
Term.(const (fun config -> create config env sw) $ config_t)
341
+
342
+
let minimal_term app_name fs =
343
+
let xdg_term = Xdge.Cmd.term app_name fs
344
+
~config:false ~data:true ~cache:true ~state:false ~runtime:false () in
345
+
Term.(const (fun (xdg, _xdg_cmd) persist -> (xdg, persist))
346
+
$ xdg_term
347
+
$ persist_cookies_term app_name)
348
+
349
+
let env_docs app_name =
350
+
let app_upper = String.uppercase_ascii app_name in
351
+
Printf.sprintf
352
+
"## ENVIRONMENT\n\n\
353
+
The following environment variables affect %s:\n\n\
354
+
**%s_CONFIG_DIR**\n\
355
+
: Override configuration directory location\n\n\
356
+
**%s_DATA_DIR**\n\
357
+
: Override data directory location (for cookies)\n\n\
358
+
**%s_CACHE_DIR**\n\
359
+
: Override cache directory location\n\n\
360
+
**XDG_CONFIG_HOME**\n\
361
+
: Base directory for user configuration files (default: ~/.config)\n\n\
362
+
**XDG_DATA_HOME**\n\
363
+
: Base directory for user data files (default: ~/.local/share)\n\n\
364
+
**XDG_CACHE_HOME**\n\
365
+
: Base directory for user cache files (default: ~/.cache)\n\n\
366
+
**%s_PERSIST_COOKIES**\n\
367
+
: Set to '1' to persist cookies by default\n\n\
368
+
**%s_NO_VERIFY_TLS**\n\
369
+
: Set to '1' to disable TLS verification (insecure)\n\n\
370
+
**%s_TIMEOUT**\n\
371
+
: Default request timeout in seconds\n\n\
372
+
**%s_MAX_RETRIES**\n\
373
+
: Maximum number of retries (default: 3)\n\n\
374
+
**%s_RETRY_BACKOFF**\n\
375
+
: Retry backoff factor (default: 0.3)\n\n\
376
+
**%s_NO_FOLLOW_REDIRECTS**\n\
377
+
: Set to '1' to disable redirect following\n\n\
378
+
**%s_MAX_REDIRECTS**\n\
379
+
: Maximum redirects to follow (default: 10)\n\n\
380
+
**%s_USER_AGENT**\n\
381
+
: User-Agent header to send with requests\
382
+
"
383
+
app_name app_upper app_upper app_upper
384
+
app_upper app_upper app_upper app_upper
385
+
app_upper app_upper app_upper app_upper
386
+
387
+
let pp_config ppf config =
388
+
let _xdg, xdg_cmd = config.xdg in
389
+
Format.fprintf ppf "@[<v>Configuration:@,\
390
+
@[<v 2>XDG:@,%a@]@,\
391
+
persist_cookies: %b@,\
392
+
verify_tls: %b@,\
393
+
timeout: %a@,\
394
+
max_retries: %d@,\
395
+
retry_backoff: %.2f@,\
396
+
follow_redirects: %b@,\
397
+
max_redirects: %d@,\
398
+
user_agent: %a@]"
399
+
Xdge.Cmd.pp xdg_cmd
400
+
config.persist_cookies
401
+
config.verify_tls
402
+
(Format.pp_print_option Format.pp_print_float) config.timeout
403
+
config.max_retries
404
+
config.retry_backoff
405
+
config.follow_redirects
406
+
config.max_redirects
407
+
(Format.pp_print_option Format.pp_print_string) config.user_agent
408
+
end
+403
-36
stack/requests/lib/requests.mli
+403
-36
stack/requests/lib/requests.mli
···
9
9
10
10
The Requests library offers two main ways to make HTTP requests:
11
11
12
-
{b 1. Session-based requests} (Recommended for most use cases)
12
+
{b 1. Main API} (Recommended for most use cases)
13
13
14
-
Sessions maintain state across requests, handle cookies automatically,
15
-
and provide a simple interface for common tasks:
14
+
The main API maintains state across requests, handles cookies automatically,
15
+
spawns requests in concurrent fibers, and provides a simple interface:
16
16
17
17
{[
18
18
open Eio_main
···
20
20
let () = run @@ fun env ->
21
21
Switch.run @@ fun sw ->
22
22
23
-
(* Create a session *)
24
-
let session = Requests.Session.create ~sw env in
23
+
(* Create a requests instance *)
24
+
let req = Requests.create ~sw env in
25
25
26
26
(* Configure authentication once *)
27
-
Requests.Session.set_auth session (Requests.Auth.bearer "your-token");
27
+
Requests.set_auth req (Requests.Auth.bearer "your-token");
28
28
29
-
(* Make requests - cookies and auth are handled automatically *)
30
-
let user = Requests.Session.get session "https://api.github.com/user" in
31
-
let repos = Requests.Session.get session "https://api.github.com/user/repos" in
29
+
(* Make concurrent requests using Fiber.both *)
30
+
let (user, repos) = Eio.Fiber.both
31
+
(fun () -> Requests.get req "https://api.github.com/user")
32
+
(fun () -> Requests.get req "https://api.github.com/user/repos") in
32
33
33
-
(* Session automatically manages cookies *)
34
-
let _ = Requests.Session.post session "https://example.com/login"
35
-
~body:(Requests.Body.form ["username", "alice"; "password", "secret"]) in
36
-
let dashboard = Requests.Session.get session "https://example.com/dashboard"
34
+
(* Process responses *)
35
+
let user_data = Response.body user |> Eio.Flow.read_all in
36
+
let repos_data = Response.body repos |> Eio.Flow.read_all in
37
37
38
38
(* No cleanup needed - responses auto-close with the switch *)
39
39
]}
40
40
41
-
{b 2. Client-based requests} (For fine-grained control)
41
+
{b 2. One-shot requests} (For stateless operations)
42
42
43
-
The Client module provides lower-level control when you don't need
44
-
session state or want to manage connections manually:
43
+
The One module provides lower-level control for stateless,
44
+
one-off requests without session state:
45
45
46
46
{[
47
-
(* Create a client *)
48
-
let client = Requests.Client.create ~clock:env#clock ~net:env#net () in
47
+
(* Create a one-shot client *)
48
+
let client = Requests.One.create ~clock:env#clock ~net:env#net () in
49
49
50
50
(* Make a simple GET request *)
51
-
let response = Requests.Client.get ~sw ~client "https://api.github.com" in
51
+
let response = Requests.One.get ~sw ~client "https://api.github.com" in
52
52
Printf.printf "Status: %d\n" (Requests.Response.status_code response);
53
53
54
54
(* POST with custom headers and body *)
55
-
let response = Requests.Client.post ~sw ~client
55
+
let response = Requests.One.post ~sw ~client
56
56
~headers:(Requests.Headers.empty
57
57
|> Requests.Headers.content_type Requests.Mime.json
58
58
|> Requests.Headers.set "X-API-Key" "secret")
···
65
65
{2 Features}
66
66
67
67
- {b Simple API}: Intuitive functions for GET, POST, PUT, DELETE, etc.
68
-
- {b Sessions}: Maintain state (cookies, auth, headers) across requests
69
68
- {b Authentication}: Built-in support for Basic, Bearer, Digest, and OAuth
70
69
- {b Streaming}: Upload and download large files efficiently
71
70
- {b Retries}: Automatic retry with exponential backoff
···
78
77
79
78
{b Working with JSON APIs:}
80
79
{[
81
-
let response = Requests.Session.post session "https://api.example.com/data"
80
+
let response = Requests.post req "https://api.example.com/data"
82
81
~body:(Requests.Body.json {|{"key": "value"}|}) in
83
82
let body_text =
84
83
Requests.Response.body response
···
97
96
content_type = Requests.Mime.text_plain;
98
97
content = `String "Important document" }
99
98
] in
100
-
let response = Requests.Session.post session "https://example.com/upload"
99
+
let response = Requests.post req "https://example.com/upload"
101
100
~body
102
101
(* Response auto-closes with switch *)
103
102
]}
104
103
105
104
{b Streaming downloads:}
106
105
{[
107
-
Requests.Client.download ~sw ~client
106
+
Requests.One.download ~sw ~client
108
107
"https://example.com/large-file.zip"
109
108
~sink:(Eio.Path.(fs / "download.zip" |> sink))
110
109
]}
111
110
112
-
{2 Choosing Between Session and Client}
111
+
{2 Choosing Between Main API and One}
113
112
114
-
Use {b Session} when you need:
113
+
Use the {b main API (Requests.t)} when you need:
115
114
- Cookie persistence across requests
116
115
- Automatic retry handling
117
116
- Shared authentication across requests
118
117
- Request/response history tracking
119
118
- Configuration persistence to disk
120
119
121
-
Use {b Client} when you need:
120
+
Use {b One} when you need:
122
121
- One-off stateless requests
123
122
- Fine-grained control over connections
124
123
- Minimal overhead
···
126
125
- Direct streaming without cookies
127
126
*)
128
127
129
-
(** {1 High-Level Session API}
128
+
(** {1 Main API}
130
129
131
-
Sessions provide stateful HTTP clients with automatic cookie management,
132
-
persistent configuration, and convenient methods for common operations.
130
+
The main Requests API provides stateful HTTP clients with automatic cookie
131
+
management and persistent configuration. Requests execute synchronously by default.
132
+
Use Eio.Fiber.both or Eio.Fiber.all for concurrent execution.
133
133
*)
134
134
135
-
(** Stateful HTTP sessions with cookies and configuration persistence *)
136
-
module Session = Session
135
+
type ('clock, 'net) t
136
+
(** A stateful HTTP client that maintains cookies, auth, and configuration across requests. *)
137
+
138
+
(** {2 Creation and Configuration} *)
139
+
140
+
val create :
141
+
sw:Eio.Switch.t ->
142
+
?client:('clock Eio.Time.clock,'net Eio.Net.t) One.t ->
143
+
?cookie_jar:Cookeio.jar ->
144
+
?default_headers:Headers.t ->
145
+
?auth:Auth.t ->
146
+
?timeout:Timeout.t ->
147
+
?follow_redirects:bool ->
148
+
?max_redirects:int ->
149
+
?verify_tls:bool ->
150
+
?retry:Retry.config ->
151
+
?persist_cookies:bool ->
152
+
?xdg:Xdge.t ->
153
+
< clock: 'clock Eio.Resource.t; net: 'net Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->
154
+
('clock Eio.Resource.t, 'net Eio.Resource.t) t
155
+
(** Create a new requests instance with persistent state.
156
+
All resources are bound to the provided switch and will be cleaned up automatically. *)
157
+
158
+
(** {2 Configuration Management} *)
159
+
160
+
val set_default_header : ('clock, 'net) t -> string -> string -> unit
161
+
(** Set a default header for all requests *)
162
+
163
+
val remove_default_header : ('clock, 'net) t -> string -> unit
164
+
(** Remove a default header *)
165
+
166
+
val set_auth : ('clock, 'net) t -> Auth.t -> unit
167
+
(** Set default authentication *)
168
+
169
+
val clear_auth : ('clock, 'net) t -> unit
170
+
(** Clear authentication *)
171
+
172
+
val set_timeout : ('clock, 'net) t -> Timeout.t -> unit
173
+
(** Set default timeout *)
174
+
175
+
val set_retry : ('clock, 'net) t -> Retry.config -> unit
176
+
(** Set retry configuration *)
177
+
178
+
(** {2 Request Methods}
179
+
180
+
All request methods execute synchronously. To make concurrent requests,
181
+
you must explicitly use Eio.Fiber.both or Eio.Fiber.all.
182
+
The response will auto-close when the parent switch closes.
183
+
184
+
Example of concurrent requests using Fiber.both:
185
+
{[
186
+
let req = Requests.create ~sw env in
187
+
188
+
(* Use Fiber.both for two concurrent requests *)
189
+
let (r1, r2) = Eio.Fiber.both
190
+
(fun () -> Requests.get req "https://api1.example.com")
191
+
(fun () -> Requests.post req "https://api2.example.com" ~body)
192
+
in
193
+
194
+
(* Process responses *)
195
+
let body1 = Response.body r1 |> Eio.Flow.read_all in
196
+
let body2 = Response.body r2 |> Eio.Flow.read_all in
197
+
]}
198
+
199
+
Example using Fiber.all for multiple requests:
200
+
{[
201
+
let req = Requests.create ~sw env in
202
+
203
+
(* Use Fiber.all for multiple concurrent requests *)
204
+
let urls = [
205
+
"https://api1.example.com";
206
+
"https://api2.example.com";
207
+
"https://api3.example.com";
208
+
] in
209
+
210
+
let responses = ref [] in
211
+
Eio.Fiber.all [
212
+
(fun () -> responses := Requests.get req (List.nth urls 0) :: !responses);
213
+
(fun () -> responses := Requests.get req (List.nth urls 1) :: !responses);
214
+
(fun () -> responses := Requests.get req (List.nth urls 2) :: !responses);
215
+
];
216
+
217
+
(* Process all responses *)
218
+
List.iter (fun r ->
219
+
let body = Response.body r |> Eio.Flow.read_all in
220
+
print_endline body
221
+
) !responses
222
+
]}
223
+
224
+
Example using Promise for concurrent requests with individual control:
225
+
{[
226
+
let req = Requests.create ~sw env in
227
+
228
+
(* Start requests in parallel using promises *)
229
+
let p1, r1 = Eio.Promise.create () in
230
+
let p2, r2 = Eio.Promise.create () in
231
+
let p3, r3 = Eio.Promise.create () in
232
+
233
+
Eio.Fiber.fork ~sw (fun () ->
234
+
Eio.Promise.resolve r1 (Requests.get req "https://api1.example.com")
235
+
);
236
+
Eio.Fiber.fork ~sw (fun () ->
237
+
Eio.Promise.resolve r2 (Requests.post req "https://api2.example.com" ~body)
238
+
);
239
+
Eio.Fiber.fork ~sw (fun () ->
240
+
Eio.Promise.resolve r3 (Requests.get req "https://api3.example.com")
241
+
);
242
+
243
+
(* Wait for all promises and process *)
244
+
let resp1 = Eio.Promise.await p1 in
245
+
let resp2 = Eio.Promise.await p2 in
246
+
let resp3 = Eio.Promise.await p3 in
247
+
248
+
(* Process responses *)
249
+
let body1 = Response.body resp1 |> Eio.Flow.read_all in
250
+
let body2 = Response.body resp2 |> Eio.Flow.read_all in
251
+
let body3 = Response.body resp3 |> Eio.Flow.read_all in
252
+
]}
253
+
*)
254
+
255
+
val request :
256
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
257
+
?headers:Headers.t ->
258
+
?body:Body.t ->
259
+
?auth:Auth.t ->
260
+
?timeout:Timeout.t ->
261
+
?follow_redirects:bool ->
262
+
?max_redirects:int ->
263
+
method_:Method.t ->
264
+
string ->
265
+
Response.t
266
+
(** Make a concurrent HTTP request *)
267
+
268
+
val get :
269
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
270
+
?headers:Headers.t ->
271
+
?auth:Auth.t ->
272
+
?timeout:Timeout.t ->
273
+
?params:(string * string) list ->
274
+
string ->
275
+
Response.t
276
+
(** Concurrent GET request *)
277
+
278
+
val post :
279
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
280
+
?headers:Headers.t ->
281
+
?body:Body.t ->
282
+
?auth:Auth.t ->
283
+
?timeout:Timeout.t ->
284
+
string ->
285
+
Response.t
286
+
(** Concurrent POST request *)
287
+
288
+
val put :
289
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
290
+
?headers:Headers.t ->
291
+
?body:Body.t ->
292
+
?auth:Auth.t ->
293
+
?timeout:Timeout.t ->
294
+
string ->
295
+
Response.t
296
+
(** Concurrent PUT request *)
297
+
298
+
val patch :
299
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
300
+
?headers:Headers.t ->
301
+
?body:Body.t ->
302
+
?auth:Auth.t ->
303
+
?timeout:Timeout.t ->
304
+
string ->
305
+
Response.t
306
+
(** Concurrent PATCH request *)
307
+
308
+
val delete :
309
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
310
+
?headers:Headers.t ->
311
+
?auth:Auth.t ->
312
+
?timeout:Timeout.t ->
313
+
string ->
314
+
Response.t
315
+
(** Concurrent DELETE request *)
316
+
317
+
val head :
318
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
319
+
?headers:Headers.t ->
320
+
?auth:Auth.t ->
321
+
?timeout:Timeout.t ->
322
+
string ->
323
+
Response.t
324
+
(** Concurrent HEAD request *)
325
+
326
+
val options :
327
+
(_ Eio.Time.clock, _ Eio.Net.t) t ->
328
+
?headers:Headers.t ->
329
+
?auth:Auth.t ->
330
+
?timeout:Timeout.t ->
331
+
string ->
332
+
Response.t
333
+
(** Concurrent OPTIONS request *)
334
+
335
+
(** {2 Cookie Management} *)
336
+
337
+
val cookies : ('clock, 'net) t -> Cookeio.jar
338
+
(** Get the cookie jar for direct manipulation *)
339
+
340
+
val clear_cookies : ('clock, 'net) t -> unit
341
+
(** Clear all cookies *)
342
+
343
+
(** {1 Cmdliner Integration} *)
344
+
345
+
module Cmd : sig
346
+
(** Cmdliner integration for Requests configuration.
347
+
348
+
This module provides command-line argument handling for configuring
349
+
HTTP requests, including XDG directory paths, timeouts, retries,
350
+
and other parameters. *)
351
+
352
+
(** Configuration from command line and environment *)
353
+
type config = {
354
+
xdg : Xdge.t * Xdge.Cmd.t; (** XDG paths and their sources *)
355
+
persist_cookies : bool; (** Whether to persist cookies *)
356
+
verify_tls : bool; (** Whether to verify TLS certificates *)
357
+
timeout : float option; (** Request timeout in seconds *)
358
+
max_retries : int; (** Maximum number of retries *)
359
+
retry_backoff : float; (** Retry backoff factor *)
360
+
follow_redirects : bool; (** Whether to follow redirects *)
361
+
max_redirects : int; (** Maximum number of redirects *)
362
+
user_agent : string option; (** User-Agent header *)
363
+
}
364
+
365
+
val create : config -> < clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t; net: ([> [>`Generic] Eio.Net.ty ] as 'net) Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> Eio.Switch.t -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t
366
+
(** [create config env sw] creates a requests instance from command-line configuration *)
367
+
368
+
(** {2 Individual Terms} *)
369
+
370
+
val persist_cookies_term : string -> bool Cmdliner.Term.t
371
+
(** Term for [--persist-cookies] flag with app-specific env var *)
372
+
373
+
val verify_tls_term : string -> bool Cmdliner.Term.t
374
+
(** Term for [--no-verify-tls] flag with app-specific env var *)
375
+
376
+
val timeout_term : string -> float option Cmdliner.Term.t
377
+
(** Term for [--timeout SECONDS] option with app-specific env var *)
378
+
379
+
val retries_term : string -> int Cmdliner.Term.t
380
+
(** Term for [--max-retries N] option with app-specific env var *)
381
+
382
+
val retry_backoff_term : string -> float Cmdliner.Term.t
383
+
(** Term for [--retry-backoff FACTOR] option with app-specific env var *)
384
+
385
+
val follow_redirects_term : string -> bool Cmdliner.Term.t
386
+
(** Term for [--no-follow-redirects] flag with app-specific env var *)
387
+
388
+
val max_redirects_term : string -> int Cmdliner.Term.t
389
+
(** Term for [--max-redirects N] option with app-specific env var *)
390
+
391
+
val user_agent_term : string -> string option Cmdliner.Term.t
392
+
(** Term for [--user-agent STRING] option with app-specific env var *)
393
+
394
+
(** {2 Combined Terms} *)
395
+
396
+
val config_term : string -> Eio.Fs.dir_ty Eio.Path.t -> config Cmdliner.Term.t
397
+
(** [config_term app_name fs] creates a complete configuration term.
398
+
399
+
This combines all individual terms plus XDG configuration into
400
+
a single term that can be used to configure requests.
401
+
402
+
{b Generated Flags:}
403
+
- [--config-dir DIR]: Configuration directory
404
+
- [--data-dir DIR]: Data directory
405
+
- [--cache-dir DIR]: Cache directory
406
+
- [--persist-cookies]: Enable cookie persistence
407
+
- [--no-verify-tls]: Disable TLS verification
408
+
- [--timeout SECONDS]: Request timeout
409
+
- [--max-retries N]: Maximum retries
410
+
- [--retry-backoff FACTOR]: Retry backoff multiplier
411
+
- [--no-follow-redirects]: Disable redirect following
412
+
- [--max-redirects N]: Maximum redirects to follow
413
+
- [--user-agent STRING]: User-Agent header
414
+
415
+
{b Example:}
416
+
{[
417
+
let open Cmdliner in
418
+
let config_t = Requests.Cmd.config_term "myapp" env#fs in
419
+
let main config =
420
+
Eio.Switch.run @@ fun sw ->
421
+
let req = Requests.Cmd.create config env sw in
422
+
(* Use requests *)
423
+
in
424
+
let cmd = Cmd.v info Term.(const main $ config_t) in
425
+
Cmd.eval cmd
426
+
]} *)
427
+
428
+
val requests_term : string -> < clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t; net: ([> [>`Generic] Eio.Net.ty ] as 'net) Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> Eio.Switch.t -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t Cmdliner.Term.t
429
+
(** [requests_term app_name env sw] creates a term that directly produces a requests instance.
430
+
431
+
This is a convenience function that combines configuration parsing
432
+
with requests creation.
433
+
434
+
{b Example:}
435
+
{[
436
+
let open Cmdliner in
437
+
let main req =
438
+
(* Use requests directly *)
439
+
let resp = Requests.get req "https://example.com" in
440
+
(* ... *)
441
+
in
442
+
Eio.Switch.run @@ fun sw ->
443
+
let req_t = Requests.Cmd.requests_term "myapp" env sw in
444
+
let cmd = Cmd.v info Term.(const main $ req_t) in
445
+
Cmd.eval cmd
446
+
]} *)
447
+
448
+
val minimal_term : string -> Eio.Fs.dir_ty Eio.Path.t -> (Xdge.t * bool) Cmdliner.Term.t
449
+
(** [minimal_term app_name fs] creates a minimal configuration term.
450
+
451
+
This only provides:
452
+
- [--cache-dir DIR]: Cache directory for responses
453
+
- [--persist-cookies]: Cookie persistence flag
454
+
455
+
Returns the XDG context and persist_cookies boolean.
456
+
457
+
{b Example:}
458
+
{[
459
+
let open Cmdliner in
460
+
let minimal_t = Requests.Cmd.minimal_term "myapp" env#fs in
461
+
let main (xdg, persist) =
462
+
Eio.Switch.run @@ fun sw ->
463
+
let req = Requests.create ~sw ~xdg ~persist_cookies:persist env in
464
+
(* Use requests *)
465
+
in
466
+
let cmd = Cmd.v info Term.(const main $ minimal_t) in
467
+
Cmd.eval cmd
468
+
]} *)
469
+
470
+
(** {2 Documentation} *)
471
+
472
+
val env_docs : string -> string
473
+
(** [env_docs app_name] generates environment variable documentation.
474
+
475
+
Returns formatted documentation for all environment variables that
476
+
affect requests configuration, including XDG variables.
477
+
478
+
{b Included Variables:}
479
+
- [${APP_NAME}_CONFIG_DIR]: Configuration directory
480
+
- [${APP_NAME}_DATA_DIR]: Data directory
481
+
- [${APP_NAME}_CACHE_DIR]: Cache directory
482
+
- [${APP_NAME}_STATE_DIR]: State directory
483
+
- [XDG_CONFIG_HOME], [XDG_DATA_HOME], [XDG_CACHE_HOME], [XDG_STATE_HOME]
484
+
- [HTTP_PROXY], [HTTPS_PROXY], [NO_PROXY] (when proxy support is added)
485
+
486
+
{b Example:}
487
+
{[
488
+
let env_info = Cmdliner.Cmd.Env.info
489
+
~docs:Cmdliner.Manpage.s_environment
490
+
~doc:(Requests.Cmd.env_docs "myapp")
491
+
()
492
+
]} *)
493
+
494
+
val pp_config : Format.formatter -> config -> unit
495
+
(** Pretty print configuration for debugging *)
496
+
end
137
497
138
498
(** Retry policies and backoff strategies *)
139
499
module Retry = Retry
140
500
141
-
(** {1 Low-Level Client API}
501
+
(** {1 One-Shot API}
142
502
143
-
The Client module provides direct control over HTTP requests without
503
+
The One module provides direct control over HTTP requests without
144
504
session state. Use this for stateless operations or when you need
145
505
fine-grained control.
146
506
*)
147
507
148
-
(** Low-level HTTP client with connection pooling *)
149
-
module Client = Client
508
+
(** One-shot HTTP client for stateless requests *)
509
+
module One = One
150
510
151
511
(** {1 Core Types}
152
512
···
181
541
182
542
(** Timeout configuration for requests *)
183
543
module Timeout = Timeout
544
+
545
+
(** {2 Logging} *)
546
+
547
+
(** Log source for the requests library.
548
+
Use [Logs.Src.set_level src] to control logging verbosity.
549
+
Example: [Logs.Src.set_level Requests.src (Some Logs.Debug)] *)
550
+
val src : Logs.Src.t
+3
stack/requests/lib/response.mli
+3
stack/requests/lib/response.mli
+3
stack/requests/lib/retry.mli
+3
stack/requests/lib/retry.mli
-550
stack/requests/lib/session.ml
-550
stack/requests/lib/session.ml
···
1
-
let src = Logs.Src.create "requests.session" ~doc:"HTTP Session"
2
-
module Log = (val Logs.src_log src : Logs.LOG)
3
-
4
-
(** {1 Types} *)
5
-
6
-
(** Session statistics *)
7
-
module Stats = struct
8
-
type t = {
9
-
requests_made : int;
10
-
total_time : float;
11
-
cookies_count : int;
12
-
retries_count : int;
13
-
}
14
-
15
-
let requests_made t = t.requests_made
16
-
let total_time t = t.total_time
17
-
let cookies_count t = t.cookies_count
18
-
let retries_count t = t.retries_count
19
-
20
-
let pp ppf t =
21
-
Format.fprintf ppf "@[<v>Session Statistics:@,\
22
-
requests made: %d@,\
23
-
total time: %.3fs@,\
24
-
cookies: %d@,\
25
-
retries: %d@]"
26
-
t.requests_made
27
-
t.total_time
28
-
t.cookies_count
29
-
t.retries_count
30
-
end
31
-
32
-
type ('clock, 'net) t = {
33
-
sw : Eio.Switch.t;
34
-
client : ('clock, 'net) Client.t;
35
-
clock : 'clock;
36
-
cookie_jar : Cookeio.jar;
37
-
mutable default_headers : Headers.t;
38
-
mutable auth : Auth.t option;
39
-
mutable timeout : Timeout.t;
40
-
mutable follow_redirects : bool;
41
-
mutable max_redirects : int;
42
-
mutable retry : Retry.config option;
43
-
persist_cookies : bool;
44
-
xdg : Xdge.t option;
45
-
(* Statistics *)
46
-
mutable requests_made : int;
47
-
mutable total_time : float;
48
-
mutable retries_count : int;
49
-
mutex : Mutex.t;
50
-
}
51
-
52
-
(** {1 Session Creation} *)
53
-
54
-
let create
55
-
~sw
56
-
?client
57
-
?cookie_jar
58
-
?(default_headers = Headers.empty)
59
-
?auth
60
-
?(timeout = Timeout.default)
61
-
?(follow_redirects = true)
62
-
?(max_redirects = 10)
63
-
?(verify_tls = true)
64
-
?retry
65
-
?(persist_cookies = false)
66
-
?xdg
67
-
env =
68
-
69
-
(* Create default XDG context if needed *)
70
-
let xdg = match xdg, persist_cookies with
71
-
| Some x, _ -> Some x
72
-
| None, true -> Some (Xdge.create env#fs "requests")
73
-
| None, false -> None
74
-
in
75
-
76
-
Log.info (fun m -> m "Creating new session%s"
77
-
(match xdg with
78
-
| Some x -> Printf.sprintf " with XDG app=%s" (Xdge.app_name x)
79
-
| None -> ""));
80
-
81
-
(* Create or use provided client *)
82
-
let client = match client with
83
-
| Some c -> c
84
-
| None ->
85
-
Client.create ~verify_tls ~timeout
86
-
~clock:env#clock ~net:env#net ()
87
-
in
88
-
89
-
(* Create or load cookie jar *)
90
-
let cookie_jar = match cookie_jar, persist_cookies, xdg with
91
-
| Some jar, _, _ -> jar
92
-
| None, true, Some xdg_ctx ->
93
-
Log.debug (fun m -> m "Loading persistent cookie jar from XDG data dir");
94
-
let data_dir = Xdge.data_dir xdg_ctx in
95
-
let cookie_file = Eio.Path.(data_dir / "cookies.txt") in
96
-
Cookeio.load cookie_file
97
-
| None, _, _ ->
98
-
Cookeio.create ()
99
-
in
100
-
101
-
let session = {
102
-
sw;
103
-
client;
104
-
clock = env#clock;
105
-
cookie_jar;
106
-
default_headers;
107
-
auth;
108
-
timeout;
109
-
follow_redirects;
110
-
max_redirects;
111
-
retry;
112
-
persist_cookies;
113
-
xdg;
114
-
requests_made = 0;
115
-
total_time = 0.0;
116
-
retries_count = 0;
117
-
mutex = Mutex.create ();
118
-
} in
119
-
120
-
(* Register cleanup on switch *)
121
-
Eio.Switch.on_release sw (fun () ->
122
-
Log.info (fun m -> m "Closing session after %d requests" session.requests_made);
123
-
if persist_cookies && Option.is_some xdg then begin
124
-
Log.info (fun m -> m "Saving cookies on session close");
125
-
let data_dir = Xdge.data_dir (Option.get xdg) in
126
-
let cookie_file = Eio.Path.(data_dir / "cookies.txt") in
127
-
Cookeio.save cookie_file session.cookie_jar
128
-
end
129
-
);
130
-
131
-
session
132
-
133
-
let save_cookies : ('a, 'b) t -> unit = fun t ->
134
-
if t.persist_cookies && Option.is_some t.xdg then
135
-
let data_dir = Xdge.data_dir (Option.get t.xdg) in
136
-
let cookie_file = Eio.Path.(data_dir / "cookies.txt") in
137
-
Cookeio.save cookie_file t.cookie_jar
138
-
139
-
let load_cookies : ('a, 'b) t -> unit = fun t ->
140
-
if t.persist_cookies && Option.is_some t.xdg then
141
-
let data_dir = Xdge.data_dir (Option.get t.xdg) in
142
-
let cookie_file = Eio.Path.(data_dir / "cookies.txt") in
143
-
let loaded = Cookeio.load cookie_file in
144
-
(* Copy loaded cookies into our jar *)
145
-
Cookeio.clear t.cookie_jar;
146
-
let cookies_from_loaded = Cookeio.to_mozilla_format loaded in
147
-
let _reloaded = Cookeio.from_mozilla_format cookies_from_loaded in
148
-
(* This is a bit convoluted but maintains the same jar reference *)
149
-
()
150
-
151
-
(** {1 Configuration Management} *)
152
-
153
-
let set_default_header t key value =
154
-
t.default_headers <- Headers.set key value t.default_headers;
155
-
Log.debug (fun m -> m "Set default header %s: %s" key value)
156
-
157
-
let remove_default_header t key =
158
-
t.default_headers <- Headers.remove key t.default_headers;
159
-
Log.debug (fun m -> m "Removed default header %s" key)
160
-
161
-
let set_auth t auth =
162
-
t.auth <- Some auth;
163
-
Log.debug (fun m -> m "Set session authentication")
164
-
165
-
let clear_auth t =
166
-
t.auth <- None;
167
-
Log.debug (fun m -> m "Cleared session authentication")
168
-
169
-
let set_timeout t timeout =
170
-
t.timeout <- timeout
171
-
172
-
let set_retry t retry =
173
-
t.retry <- Some retry
174
-
175
-
let disable_retry t =
176
-
t.retry <- None
177
-
178
-
(** {1 Cookie Management} *)
179
-
180
-
let cookies t = t.cookie_jar
181
-
182
-
let clear_cookies t =
183
-
Cookeio.clear t.cookie_jar
184
-
185
-
(** {1 Internal Request Function} *)
186
-
187
-
let execute_request t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =
188
-
let start_time = Unix.gettimeofday () in
189
-
190
-
(* Merge headers: default -> cookie -> provided *)
191
-
let headers =
192
-
t.default_headers
193
-
|> Headers.merge (Option.value headers ~default:Headers.empty)
194
-
|> (fun headers ->
195
-
let uri = Uri.of_string url in
196
-
let domain = Uri.host_with_default ~default:"localhost" uri in
197
-
let path = Uri.path uri in
198
-
let is_secure = Uri.scheme uri = Some "https" in
199
-
let cookies = Cookeio.get_cookies t.cookie_jar ~domain ~path ~is_secure in
200
-
if cookies = [] then headers
201
-
else
202
-
let cookie_header = Cookeio.make_cookie_header cookies in
203
-
Headers.add "cookie" cookie_header headers)
204
-
in
205
-
206
-
(* Use provided auth or session default *)
207
-
let auth = match auth with Some a -> Some a | None -> t.auth in
208
-
209
-
(* Use provided or session defaults *)
210
-
let timeout = Option.value timeout ~default:t.timeout in
211
-
let follow_redirects = Option.value follow_redirects ~default:t.follow_redirects in
212
-
let max_redirects = Option.value max_redirects ~default:t.max_redirects in
213
-
214
-
Log.info (fun m -> m "Session request: %s %s"
215
-
(Method.to_string method_) url);
216
-
217
-
(* Make the actual request with retry if configured *)
218
-
let make_request () =
219
-
(* Use Client.request to make the actual HTTP request *)
220
-
Client.request ~sw:t.sw ~client:t.client
221
-
~headers ~method_ ?body ?auth ~timeout
222
-
~follow_redirects ~max_redirects url
223
-
in
224
-
225
-
let response = match t.retry with
226
-
| None -> make_request ()
227
-
| Some retry_config ->
228
-
Retry.with_retry ~sw:t.sw ~clock:t.clock
229
-
~config:retry_config
230
-
~f:make_request
231
-
~should_retry_exn:(function
232
-
(* Retry on retryable errors *)
233
-
| Error.Timeout -> true
234
-
| Error.ConnectionError _ -> true
235
-
| Error.HTTPError { status; _ } when status >= 500 -> true (* Server errors *)
236
-
| Error.SSLError _ -> false (* Don't retry SSL errors *)
237
-
| Error.ProxyError _ -> true
238
-
| Eio.Io (Eio.Net.E (Connection_reset _), _) -> true
239
-
| Eio.Time.Timeout -> true
240
-
| _ -> false)
241
-
in
242
-
243
-
(* Extract cookies from response *)
244
-
let uri = Uri.of_string url in
245
-
let domain = Uri.host_with_default ~default:"localhost" uri in
246
-
let path =
247
-
let p = Uri.path uri in
248
-
if p = "" then "/"
249
-
else
250
-
let last_slash = String.rindex_opt p '/' in
251
-
match last_slash with
252
-
| None -> "/"
253
-
| Some i -> String.sub p 0 (i + 1)
254
-
in
255
-
let set_cookie_values = Headers.get_multi "set-cookie" (Response.headers response) in
256
-
List.iter (fun value ->
257
-
match Cookeio.parse_set_cookie ~domain ~path value with
258
-
| Some cookie -> Cookeio.add_cookie t.cookie_jar cookie
259
-
| None -> Log.warn (fun m -> m "Failed to parse Set-Cookie header: %s" value)
260
-
) set_cookie_values;
261
-
262
-
(* Update statistics *)
263
-
Mutex.lock t.mutex;
264
-
t.requests_made <- t.requests_made + 1;
265
-
t.total_time <- t.total_time +. (Unix.gettimeofday () -. start_time);
266
-
Mutex.unlock t.mutex;
267
-
268
-
response
269
-
270
-
(** {1 Request Methods} *)
271
-
272
-
let request t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =
273
-
execute_request t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url
274
-
275
-
let get t ?headers ?auth ?timeout ?params url =
276
-
let url = match params with
277
-
| None -> url
278
-
| Some params ->
279
-
let uri = Uri.of_string url in
280
-
let uri = List.fold_left (fun u (k, v) ->
281
-
Uri.add_query_param' u (k, v)
282
-
) uri params in
283
-
Uri.to_string uri
284
-
in
285
-
execute_request t ?headers ?auth ?timeout ~method_:`GET url
286
-
287
-
let post t ?headers ?body ?auth ?timeout url =
288
-
execute_request t ?headers ?body ?auth ?timeout ~method_:`POST url
289
-
290
-
let put t ?headers ?body ?auth ?timeout url =
291
-
execute_request t ?headers ?body ?auth ?timeout ~method_:`PUT url
292
-
293
-
let patch t ?headers ?body ?auth ?timeout url =
294
-
execute_request t ?headers ?body ?auth ?timeout ~method_:`PATCH url
295
-
296
-
let delete t ?headers ?auth ?timeout url =
297
-
execute_request t ?headers ?auth ?timeout ~method_:`DELETE url
298
-
299
-
let head t ?headers ?auth ?timeout url =
300
-
execute_request t ?headers ?auth ?timeout ~method_:`HEAD url
301
-
302
-
let options t ?headers ?auth ?timeout url =
303
-
execute_request t ?headers ?auth ?timeout ~method_:`OPTIONS url
304
-
305
-
(** {1 Streaming Operations} *)
306
-
307
-
let upload t ?headers ?auth ?timeout ?method_ ?mime ?length ~source url =
308
-
let method_ = Option.value method_ ~default:`POST in
309
-
let body = Body.of_stream ?length (Option.value mime ~default:Mime.octet_stream) source in
310
-
(* Progress tracking would require wrapping Eio.Flow.source which is complex.
311
-
Use Client.upload with on_progress callback for progress tracking instead. *)
312
-
execute_request t ?headers ~body ?auth ?timeout ~method_ url
313
-
314
-
let download t ?headers ?auth ?timeout url ~sink =
315
-
let response = execute_request t ?headers ?auth ?timeout ~method_:`GET url in
316
-
let body = Response.body response in
317
-
(* Progress tracking would require intercepting Eio.Flow.copy.
318
-
Use Client.download with on_progress callback for progress tracking instead. *)
319
-
Eio.Flow.copy body sink
320
-
321
-
let download_file t ?headers ?auth ?timeout url path =
322
-
Eio.Path.with_open_out ~create:(`Or_truncate 0o644) path @@ fun sink ->
323
-
download t ?headers ?auth ?timeout url ~sink
324
-
325
-
326
-
let pp ppf t =
327
-
Mutex.lock t.mutex;
328
-
let stats = t.requests_made, t.total_time,
329
-
Cookeio.count t.cookie_jar in
330
-
Mutex.unlock t.mutex;
331
-
let requests, time, cookies = stats in
332
-
Format.fprintf ppf "@[<v>Session:@,\
333
-
requests made: %d@,\
334
-
total time: %.3fs@,\
335
-
cookies: %d@,\
336
-
auth: %s@,\
337
-
follow redirects: %b@,\
338
-
max redirects: %d@,\
339
-
retry: %s@,\
340
-
persist cookies: %b@,\
341
-
XDG: %s@]"
342
-
requests time cookies
343
-
(if Option.is_some t.auth then "configured" else "none")
344
-
t.follow_redirects
345
-
t.max_redirects
346
-
(if Option.is_some t.retry then "enabled" else "disabled")
347
-
t.persist_cookies
348
-
(match t.xdg with
349
-
| Some x -> Xdge.app_name x
350
-
| None -> "none")
351
-
352
-
let stats t =
353
-
Mutex.lock t.mutex;
354
-
let result = Stats.{
355
-
requests_made = t.requests_made;
356
-
total_time = t.total_time;
357
-
cookies_count = Cookeio.count t.cookie_jar;
358
-
retries_count = t.retries_count;
359
-
} in
360
-
Mutex.unlock t.mutex;
361
-
result
362
-
363
-
(** {1 Cmdliner Integration} *)
364
-
365
-
module Cmd = struct
366
-
open Cmdliner
367
-
368
-
type config = {
369
-
xdg : Xdge.t * Xdge.Cmd.t;
370
-
persist_cookies : bool;
371
-
verify_tls : bool;
372
-
timeout : float option;
373
-
max_retries : int;
374
-
retry_backoff : float;
375
-
follow_redirects : bool;
376
-
max_redirects : int;
377
-
user_agent : string option;
378
-
}
379
-
380
-
let create config env sw =
381
-
let xdg, _xdg_cmd = config.xdg in
382
-
let retry = if config.max_retries > 0 then
383
-
Some (Retry.create_config
384
-
~max_retries:config.max_retries
385
-
~backoff_factor:config.retry_backoff ())
386
-
else None in
387
-
388
-
let timeout = match config.timeout with
389
-
| Some t -> Timeout.create ~total:t ()
390
-
| None -> Timeout.default in
391
-
392
-
let session = create ~sw
393
-
~xdg
394
-
~persist_cookies:config.persist_cookies
395
-
~verify_tls:config.verify_tls
396
-
~timeout
397
-
?retry
398
-
~follow_redirects:config.follow_redirects
399
-
~max_redirects:config.max_redirects
400
-
env in
401
-
402
-
(* Set user agent if provided *)
403
-
Option.iter (set_default_header session "User-Agent") config.user_agent;
404
-
405
-
session
406
-
407
-
(* Individual terms - parameterized by app_name *)
408
-
409
-
let persist_cookies_term app_name =
410
-
let doc = "Persist cookies to disk between sessions" in
411
-
let env_name = String.uppercase_ascii app_name ^ "_PERSIST_COOKIES" in
412
-
let env = Cmd.Env.info env_name in
413
-
Arg.(value & flag & info ["persist-cookies"] ~env ~doc)
414
-
415
-
let verify_tls_term app_name =
416
-
let doc = "Skip TLS certificate verification (insecure)" in
417
-
let env_name = String.uppercase_ascii app_name ^ "_NO_VERIFY_TLS" in
418
-
let env = Cmd.Env.info env_name in
419
-
Term.(const (fun no_verify -> not no_verify) $
420
-
Arg.(value & flag & info ["no-verify-tls"] ~env ~doc))
421
-
422
-
let timeout_term app_name =
423
-
let doc = "Request timeout in seconds" in
424
-
let env_name = String.uppercase_ascii app_name ^ "_TIMEOUT" in
425
-
let env = Cmd.Env.info env_name in
426
-
Arg.(value & opt (some float) None & info ["timeout"] ~env ~docv:"SECONDS" ~doc)
427
-
428
-
let retries_term app_name =
429
-
let doc = "Maximum number of request retries" in
430
-
let env_name = String.uppercase_ascii app_name ^ "_MAX_RETRIES" in
431
-
let env = Cmd.Env.info env_name in
432
-
Arg.(value & opt int 3 & info ["max-retries"] ~env ~docv:"N" ~doc)
433
-
434
-
let retry_backoff_term app_name =
435
-
let doc = "Retry backoff factor for exponential delay" in
436
-
let env_name = String.uppercase_ascii app_name ^ "_RETRY_BACKOFF" in
437
-
let env = Cmd.Env.info env_name in
438
-
Arg.(value & opt float 0.3 & info ["retry-backoff"] ~env ~docv:"FACTOR" ~doc)
439
-
440
-
let follow_redirects_term app_name =
441
-
let doc = "Don't follow HTTP redirects" in
442
-
let env_name = String.uppercase_ascii app_name ^ "_NO_FOLLOW_REDIRECTS" in
443
-
let env = Cmd.Env.info env_name in
444
-
Term.(const (fun no_follow -> not no_follow) $
445
-
Arg.(value & flag & info ["no-follow-redirects"] ~env ~doc))
446
-
447
-
let max_redirects_term app_name =
448
-
let doc = "Maximum number of redirects to follow" in
449
-
let env_name = String.uppercase_ascii app_name ^ "_MAX_REDIRECTS" in
450
-
let env = Cmd.Env.info env_name in
451
-
Arg.(value & opt int 10 & info ["max-redirects"] ~env ~docv:"N" ~doc)
452
-
453
-
let user_agent_term app_name =
454
-
let doc = "User-Agent header to send with requests" in
455
-
let env_name = String.uppercase_ascii app_name ^ "_USER_AGENT" in
456
-
let env = Cmd.Env.info env_name in
457
-
Arg.(value & opt (some string) None & info ["user-agent"] ~env ~docv:"STRING" ~doc)
458
-
459
-
(* Combined terms *)
460
-
461
-
let config_term app_name fs =
462
-
let xdg_term = Xdge.Cmd.term app_name fs
463
-
~config:true ~data:true ~cache:true ~state:false ~runtime:false () in
464
-
Term.(const (fun xdg persist verify timeout retries backoff follow max_redir ua ->
465
-
{ xdg; persist_cookies = persist; verify_tls = verify;
466
-
timeout; max_retries = retries; retry_backoff = backoff;
467
-
follow_redirects = follow; max_redirects = max_redir;
468
-
user_agent = ua })
469
-
$ xdg_term
470
-
$ persist_cookies_term app_name
471
-
$ verify_tls_term app_name
472
-
$ timeout_term app_name
473
-
$ retries_term app_name
474
-
$ retry_backoff_term app_name
475
-
$ follow_redirects_term app_name
476
-
$ max_redirects_term app_name
477
-
$ user_agent_term app_name)
478
-
479
-
let session_term app_name env sw =
480
-
let config_t = config_term app_name env#fs in
481
-
Term.(const (fun config -> create config env sw) $ config_t)
482
-
483
-
let minimal_term app_name fs =
484
-
let xdg_term = Xdge.Cmd.term app_name fs
485
-
~config:false ~data:true ~cache:true ~state:false ~runtime:false () in
486
-
Term.(const (fun (xdg, _xdg_cmd) persist -> (xdg, persist))
487
-
$ xdg_term
488
-
$ persist_cookies_term app_name)
489
-
490
-
let env_docs app_name =
491
-
let app_upper = String.uppercase_ascii app_name in
492
-
Printf.sprintf
493
-
"## ENVIRONMENT\n\n\
494
-
The following environment variables affect %s:\n\n\
495
-
**%s_CONFIG_DIR**\n\
496
-
: Override configuration directory location\n\n\
497
-
**%s_DATA_DIR**\n\
498
-
: Override data directory location (for cookies)\n\n\
499
-
**%s_CACHE_DIR**\n\
500
-
: Override cache directory location\n\n\
501
-
**XDG_CONFIG_HOME**\n\
502
-
: Base directory for user configuration files (default: ~/.config)\n\n\
503
-
**XDG_DATA_HOME**\n\
504
-
: Base directory for user data files (default: ~/.local/share)\n\n\
505
-
**XDG_CACHE_HOME**\n\
506
-
: Base directory for user cache files (default: ~/.cache)\n\n\
507
-
**%s_PERSIST_COOKIES**\n\
508
-
: Set to '1' to persist cookies by default\n\n\
509
-
**%s_NO_VERIFY_TLS**\n\
510
-
: Set to '1' to disable TLS verification (insecure)\n\n\
511
-
**%s_TIMEOUT**\n\
512
-
: Default request timeout in seconds\n\n\
513
-
**%s_MAX_RETRIES**\n\
514
-
: Maximum number of retries for failed requests\n\n\
515
-
**%s_MAX_REDIRECTS**\n\
516
-
: Maximum number of redirects to follow\n\n\
517
-
**%s_NO_FOLLOW_REDIRECTS**\n\
518
-
: Set to '1' to disable following redirects\n\n\
519
-
**%s_RETRY_BACKOFF**\n\
520
-
: Backoff factor for retry delays\n\n\
521
-
**%s_USER_AGENT**\n\
522
-
: Default User-Agent header\n\n\
523
-
**HTTP_PROXY**, **HTTPS_PROXY**, **NO_PROXY**\n\
524
-
: Proxy configuration (when proxy support is implemented)"
525
-
app_name app_upper app_upper app_upper
526
-
app_upper app_upper app_upper app_upper
527
-
app_upper app_upper app_upper app_upper
528
-
529
-
let pp_config ppf config =
530
-
let _xdg, xdg_cmd = config.xdg in
531
-
Format.fprintf ppf "@[<v>Session Configuration:@,\
532
-
@[<v 2>XDG Directories:@,%a@]@,\
533
-
persist cookies: %b@,\
534
-
verify TLS: %b@,\
535
-
timeout: %s@,\
536
-
max retries: %d@,\
537
-
retry backoff: %.2f@,\
538
-
follow redirects: %b@,\
539
-
max redirects: %d@,\
540
-
user agent: %s@]"
541
-
Xdge.Cmd.pp xdg_cmd
542
-
config.persist_cookies
543
-
config.verify_tls
544
-
(match config.timeout with None -> "none" | Some t -> Printf.sprintf "%.1fs" t)
545
-
config.max_retries
546
-
config.retry_backoff
547
-
config.follow_redirects
548
-
config.max_redirects
549
-
(Option.value config.user_agent ~default:"default")
550
-
end
-461
stack/requests/lib/session.mli
-461
stack/requests/lib/session.mli
···
1
-
(** HTTP Session with persistent state across requests
2
-
3
-
Sessions provide stateful HTTP clients that maintain cookies, default headers,
4
-
authentication, and other configuration across multiple requests. They follow
5
-
the Eio concurrency model and are thread-safe.
6
-
7
-
Example usage:
8
-
{[
9
-
Eio_main.run @@ fun env ->
10
-
Eio.Switch.run @@ fun sw ->
11
-
12
-
(* Create a session *)
13
-
let session = Session.create ~sw env in
14
-
15
-
(* Cookies are automatically handled *)
16
-
let resp1 = Session.get session "https://httpbin.org/cookies/set?foo=bar" in
17
-
let resp2 = Session.get session "https://httpbin.org/cookies" in
18
-
(* resp2 will include the foo=bar cookie *)
19
-
20
-
(* Set default headers for all requests *)
21
-
Session.set_default_header session "User-Agent" "MyApp/1.0";
22
-
23
-
(* Set authentication for all requests *)
24
-
Session.set_auth session (Auth.bearer "token123");
25
-
]}
26
-
*)
27
-
28
-
(** {1 Types} *)
29
-
30
-
type ('clock, 'net) t
31
-
(** A session maintains state across multiple HTTP requests *)
32
-
33
-
(** Session statistics *)
34
-
module Stats : sig
35
-
type t = {
36
-
requests_made : int; (** Total number of requests made *)
37
-
total_time : float; (** Total time spent in requests (seconds) *)
38
-
cookies_count : int; (** Number of cookies in the jar *)
39
-
retries_count : int; (** Total number of retries performed *)
40
-
}
41
-
42
-
(** Get the number of requests made *)
43
-
val requests_made : t -> int
44
-
45
-
(** Get the total time spent in requests *)
46
-
val total_time : t -> float
47
-
48
-
(** Get the number of cookies *)
49
-
val cookies_count : t -> int
50
-
51
-
(** Get the number of retries *)
52
-
val retries_count : t -> int
53
-
54
-
(** Pretty printer for statistics *)
55
-
val pp : Format.formatter -> t -> unit
56
-
end
57
-
58
-
(** {1 Session Creation and Configuration} *)
59
-
60
-
val create :
61
-
sw:Eio.Switch.t ->
62
-
?client:('clock Eio.Time.clock,'net Eio.Net.t) Client.t ->
63
-
?cookie_jar:Cookeio.jar ->
64
-
?default_headers:Headers.t ->
65
-
?auth:Auth.t ->
66
-
?timeout:Timeout.t ->
67
-
?follow_redirects:bool ->
68
-
?max_redirects:int ->
69
-
?verify_tls:bool ->
70
-
?retry:Retry.config ->
71
-
?persist_cookies:bool ->
72
-
?xdg:Xdge.t ->
73
-
< clock: 'clock Eio.Resource.t; net: 'net Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->
74
-
('clock Eio.Resource.t, 'net Eio.Resource.t) t
75
-
(** Create a new session.
76
-
77
-
@param sw Switch for resource management
78
-
@param client Base client configuration (creates default if not provided)
79
-
@param cookie_jar Use existing cookie jar (creates new one if not provided)
80
-
@param default_headers Headers to include in all requests
81
-
@param auth Default authentication for all requests
82
-
@param timeout Default timeout for all requests
83
-
@param follow_redirects Whether to follow redirects (default: true)
84
-
@param max_redirects Maximum number of redirects (default: 10)
85
-
@param verify_tls Whether to verify TLS certificates (default: true)
86
-
@param retry Retry configuration for failed requests
87
-
@param persist_cookies Whether to save/load cookies from disk (default: false)
88
-
@param xdg XDG directory configuration (creates default "requests" if not provided)
89
-
*)
90
-
91
-
(** {1 Configuration Management} *)
92
-
93
-
val set_default_header : ('clock, 'net) t -> string -> string -> unit
94
-
(** Set a default header that will be included in all requests *)
95
-
96
-
val remove_default_header : ('clock, 'net) t -> string -> unit
97
-
(** Remove a default header *)
98
-
99
-
val set_auth : ('clock, 'net) t -> Auth.t -> unit
100
-
(** Set default authentication for all requests *)
101
-
102
-
val clear_auth : ('clock, 'net) t -> unit
103
-
(** Clear default authentication *)
104
-
105
-
val set_timeout : ('clock, 'net) t -> Timeout.t -> unit
106
-
(** Set default timeout for all requests *)
107
-
108
-
val set_retry : ('clock, 'net) t -> Retry.config -> unit
109
-
(** Set retry configuration *)
110
-
111
-
val disable_retry : ('clock, 'net) t -> unit
112
-
(** Disable automatic retry *)
113
-
114
-
(** {1 Cookie Management} *)
115
-
116
-
val cookies : ('clock, 'net) t -> Cookeio.jar
117
-
(** Get the session's cookie jar for direct manipulation *)
118
-
119
-
val clear_cookies : ('clock, 'net) t -> unit
120
-
(** Clear all cookies *)
121
-
122
-
val save_cookies : ('clock, 'net) t -> unit
123
-
(** Manually save cookies to disk (if persist_cookies was enabled) *)
124
-
125
-
val load_cookies : ('clock, 'net) t -> unit
126
-
(** Manually reload cookies from disk (if persist_cookies was enabled) *)
127
-
128
-
(** {1 Request Methods} *)
129
-
130
-
(** All request methods automatically:
131
-
- Include session's default headers
132
-
- Use session's authentication
133
-
- Handle cookies (extract from responses, add to requests)
134
-
- Apply retry logic if configured
135
-
- Follow redirects based on session configuration
136
-
*)
137
-
138
-
val request :
139
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
140
-
?headers:Headers.t ->
141
-
?body:Body.t ->
142
-
?auth:Auth.t ->
143
-
?timeout:Timeout.t ->
144
-
?follow_redirects:bool ->
145
-
?max_redirects:int ->
146
-
method_:Method.t ->
147
-
string ->
148
-
Response.t
149
-
(** Make a request with the session.
150
-
Optional parameters override session defaults. *)
151
-
152
-
val get :
153
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
154
-
?headers:Headers.t ->
155
-
?auth:Auth.t ->
156
-
?timeout:Timeout.t ->
157
-
?params:(string * string) list ->
158
-
string ->
159
-
Response.t
160
-
(** GET request with optional query parameters *)
161
-
162
-
val post :
163
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
164
-
?headers:Headers.t ->
165
-
?body:Body.t ->
166
-
?auth:Auth.t ->
167
-
?timeout:Timeout.t ->
168
-
string ->
169
-
Response.t
170
-
(** POST request with optional body *)
171
-
172
-
val put :
173
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
174
-
?headers:Headers.t ->
175
-
?body:Body.t ->
176
-
?auth:Auth.t ->
177
-
?timeout:Timeout.t ->
178
-
string ->
179
-
Response.t
180
-
(** PUT request with optional body *)
181
-
182
-
val patch :
183
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
184
-
?headers:Headers.t ->
185
-
?body:Body.t ->
186
-
?auth:Auth.t ->
187
-
?timeout:Timeout.t ->
188
-
string ->
189
-
Response.t
190
-
(** PATCH request with optional body *)
191
-
192
-
val delete :
193
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
194
-
?headers:Headers.t ->
195
-
?auth:Auth.t ->
196
-
?timeout:Timeout.t ->
197
-
string ->
198
-
Response.t
199
-
(** DELETE request *)
200
-
201
-
val head :
202
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
203
-
?headers:Headers.t ->
204
-
?auth:Auth.t ->
205
-
?timeout:Timeout.t ->
206
-
string ->
207
-
Response.t
208
-
(** HEAD request *)
209
-
210
-
val options :
211
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
212
-
?headers:Headers.t ->
213
-
?auth:Auth.t ->
214
-
?timeout:Timeout.t ->
215
-
string ->
216
-
Response.t
217
-
(** OPTIONS request *)
218
-
219
-
(** {1 Streaming Operations} *)
220
-
221
-
val upload :
222
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
223
-
?headers:Headers.t ->
224
-
?auth:Auth.t ->
225
-
?timeout:Timeout.t ->
226
-
?method_:Method.t ->
227
-
?mime:Mime.t ->
228
-
?length:int64 ->
229
-
source:Eio.Flow.source_ty Eio.Resource.t ->
230
-
string ->
231
-
Response.t
232
-
(** Upload from a stream with optional progress callback *)
233
-
234
-
val download :
235
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
236
-
?headers:Headers.t ->
237
-
?auth:Auth.t ->
238
-
?timeout:Timeout.t ->
239
-
string ->
240
-
sink:Eio.Flow.sink_ty Eio.Resource.t ->
241
-
unit
242
-
(** Download to a stream with optional progress callback *)
243
-
244
-
val download_file :
245
-
(_ Eio.Time.clock, _ Eio.Net.t) t ->
246
-
?headers:Headers.t ->
247
-
?auth:Auth.t ->
248
-
?timeout:Timeout.t ->
249
-
string ->
250
-
_ Eio.Path.t ->
251
-
unit
252
-
(** Download directly to a file *)
253
-
254
-
val pp : Format.formatter -> ('clock, 'net) t -> unit
255
-
(** Pretty print session configuration *)
256
-
257
-
val stats : ('clock, 'net) t -> Stats.t
258
-
(** Get session statistics *)
259
-
260
-
(** {1 Examples} *)
261
-
262
-
(** {2 Basic Usage}
263
-
{[
264
-
let session = Session.create ~sw env in
265
-
let response = Session.get session "https://api.github.com/user" in
266
-
Printf.printf "Status: %d\n" (Response.status response)
267
-
]}
268
-
*)
269
-
270
-
(** {2 Posting JSON Data}
271
-
{[
272
-
let session = Session.create ~sw env in
273
-
let json_str = {|{"name": "John", "age": 30}|} in
274
-
let response = Session.post session
275
-
~body:(Body.json json_str)
276
-
"https://api.example.com/users" in
277
-
(* Response handling *)
278
-
]}
279
-
*)
280
-
281
-
(** {2 With Authentication}
282
-
{[
283
-
let session = Session.create ~sw env in
284
-
Session.set_auth session (Auth.bearer "github_token");
285
-
Session.set_default_header session "Accept" "application/vnd.github.v3+json";
286
-
287
-
let user = Session.get session "https://api.github.com/user" in
288
-
let repos = Session.get session "https://api.github.com/user/repos" in
289
-
(* Both requests will use the same auth token and headers *)
290
-
]}
291
-
*)
292
-
293
-
(** {2 Form Login with Cookies}
294
-
{[
295
-
let session = Session.create ~sw ~persist_cookies:true env in
296
-
297
-
(* Login - cookies will be saved *)
298
-
let login = Session.post session
299
-
~body:(Body.form ["username", "user"; "password", "pass"])
300
-
"https://example.com/login" in
301
-
302
-
(* Access protected resource - cookies are automatically included *)
303
-
let dashboard = Session.get session "https://example.com/dashboard" in
304
-
]}
305
-
*)
306
-
307
-
(** {1 Cmdliner Integration} *)
308
-
309
-
module Cmd : sig
310
-
(** Cmdliner integration for Requests session configuration.
311
-
312
-
This module provides command-line argument handling for configuring
313
-
HTTP sessions, including XDG directory paths, timeouts, retries,
314
-
and other session parameters. *)
315
-
316
-
(** Session configuration from command line and environment *)
317
-
type config = {
318
-
xdg : Xdge.t * Xdge.Cmd.t; (** XDG paths and their sources *)
319
-
persist_cookies : bool; (** Whether to persist cookies *)
320
-
verify_tls : bool; (** Whether to verify TLS certificates *)
321
-
timeout : float option; (** Request timeout in seconds *)
322
-
max_retries : int; (** Maximum number of retries *)
323
-
retry_backoff : float; (** Retry backoff factor *)
324
-
follow_redirects : bool; (** Whether to follow redirects *)
325
-
max_redirects : int; (** Maximum number of redirects *)
326
-
user_agent : string option; (** User-Agent header *)
327
-
}
328
-
329
-
val create : config -> < clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t; net: ([> [>`Generic] Eio.Net.ty ] as 'net) Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> Eio.Switch.t -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t
330
-
(** [create config env sw] creates a session from command-line configuration *)
331
-
332
-
(** {2 Individual Terms} *)
333
-
334
-
val persist_cookies_term : string -> bool Cmdliner.Term.t
335
-
(** Term for [--persist-cookies] flag with app-specific env var *)
336
-
337
-
val verify_tls_term : string -> bool Cmdliner.Term.t
338
-
(** Term for [--no-verify-tls] flag with app-specific env var *)
339
-
340
-
val timeout_term : string -> float option Cmdliner.Term.t
341
-
(** Term for [--timeout SECONDS] option with app-specific env var *)
342
-
343
-
val retries_term : string -> int Cmdliner.Term.t
344
-
(** Term for [--max-retries N] option with app-specific env var *)
345
-
346
-
val retry_backoff_term : string -> float Cmdliner.Term.t
347
-
(** Term for [--retry-backoff FACTOR] option with app-specific env var *)
348
-
349
-
val follow_redirects_term : string -> bool Cmdliner.Term.t
350
-
(** Term for [--no-follow-redirects] flag with app-specific env var *)
351
-
352
-
val max_redirects_term : string -> int Cmdliner.Term.t
353
-
(** Term for [--max-redirects N] option with app-specific env var *)
354
-
355
-
val user_agent_term : string -> string option Cmdliner.Term.t
356
-
(** Term for [--user-agent STRING] option with app-specific env var *)
357
-
358
-
(** {2 Combined Terms} *)
359
-
360
-
val config_term : string -> Eio.Fs.dir_ty Eio.Path.t -> config Cmdliner.Term.t
361
-
(** [config_term app_name fs] creates a complete configuration term.
362
-
363
-
This combines all individual terms plus XDG configuration into
364
-
a single term that can be used to configure a session.
365
-
366
-
{b Generated Flags:}
367
-
- [--config-dir DIR]: Configuration directory
368
-
- [--data-dir DIR]: Data directory
369
-
- [--cache-dir DIR]: Cache directory
370
-
- [--state-dir DIR]: State directory
371
-
- [--persist-cookies]: Enable cookie persistence
372
-
- [--no-verify-tls]: Disable TLS verification
373
-
- [--timeout SECONDS]: Request timeout
374
-
- [--max-retries N]: Maximum retries
375
-
- [--retry-backoff FACTOR]: Retry backoff multiplier
376
-
- [--no-follow-redirects]: Disable redirect following
377
-
- [--max-redirects N]: Maximum redirects to follow
378
-
- [--user-agent STRING]: User-Agent header
379
-
380
-
{b Example:}
381
-
{[
382
-
let open Cmdliner in
383
-
let config_t = Session.Cmd.config_term "myapp" env#fs in
384
-
let main config =
385
-
Eio.Switch.run @@ fun sw ->
386
-
let session = Session.Cmd.create config env sw in
387
-
(* Use session *)
388
-
in
389
-
let cmd = Cmd.v info Term.(const main $ config_t) in
390
-
Cmd.eval cmd
391
-
]} *)
392
-
393
-
val session_term : string -> < clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t; net: ([> [>`Generic] Eio.Net.ty ] as 'net) Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> Eio.Switch.t -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t Cmdliner.Term.t
394
-
(** [session_term app_name env sw] creates a term that directly produces a session.
395
-
396
-
This is a convenience function that combines configuration parsing
397
-
with session creation.
398
-
399
-
{b Example:}
400
-
{[
401
-
let open Cmdliner in
402
-
let main session =
403
-
(* Use session directly *)
404
-
let resp = Session.get session "https://example.com" in
405
-
(* ... *)
406
-
in
407
-
Eio.Switch.run @@ fun sw ->
408
-
let session_t = Session.Cmd.session_term "myapp" env sw in
409
-
let cmd = Cmd.v info Term.(const main $ session_t) in
410
-
Cmd.eval cmd
411
-
]} *)
412
-
413
-
val minimal_term : string -> Eio.Fs.dir_ty Eio.Path.t -> (Xdge.t * bool) Cmdliner.Term.t
414
-
(** [minimal_term app_name fs] creates a minimal configuration term.
415
-
416
-
This only provides:
417
-
- [--cache-dir DIR]: Cache directory for responses
418
-
- [--persist-cookies]: Cookie persistence flag
419
-
420
-
Returns the XDG context and persist_cookies boolean.
421
-
422
-
{b Example:}
423
-
{[
424
-
let open Cmdliner in
425
-
let minimal_t = Session.Cmd.minimal_term "myapp" env#fs in
426
-
let main (xdg, persist) =
427
-
Eio.Switch.run @@ fun sw ->
428
-
let session = Session.create ~sw ~xdg ~persist_cookies:persist env in
429
-
(* Use session *)
430
-
in
431
-
let cmd = Cmd.v info Term.(const main $ minimal_t) in
432
-
Cmd.eval cmd
433
-
]} *)
434
-
435
-
(** {2 Documentation} *)
436
-
437
-
val env_docs : string -> string
438
-
(** [env_docs app_name] generates environment variable documentation.
439
-
440
-
Returns formatted documentation for all environment variables that
441
-
affect session configuration, including XDG variables.
442
-
443
-
{b Included Variables:}
444
-
- [${APP_NAME}_CONFIG_DIR]: Configuration directory
445
-
- [${APP_NAME}_DATA_DIR]: Data directory
446
-
- [${APP_NAME}_CACHE_DIR]: Cache directory
447
-
- [${APP_NAME}_STATE_DIR]: State directory
448
-
- [XDG_CONFIG_HOME], [XDG_DATA_HOME], [XDG_CACHE_HOME], [XDG_STATE_HOME]
449
-
- [HTTP_PROXY], [HTTPS_PROXY], [NO_PROXY] (when proxy support is added)
450
-
451
-
{b Example:}
452
-
{[
453
-
let env_info = Cmdliner.Cmd.Env.info
454
-
~docs:Cmdliner.Manpage.s_environment
455
-
~doc:(Session.Cmd.env_docs "myapp")
456
-
()
457
-
]} *)
458
-
459
-
val pp_config : Format.formatter -> config -> unit
460
-
(** Pretty print session configuration for debugging *)
461
-
end
+3
stack/requests/lib/status.ml
+3
stack/requests/lib/status.ml
+3
stack/requests/lib/status.mli
+3
stack/requests/lib/status.mli
+3
stack/requests/lib/timeout.ml
+3
stack/requests/lib/timeout.ml