this repo has no description
requests
+2324
+524
requests/DESIGN.md
+524
requests/DESIGN.md
···
1
+
# OCaml Requests Library - Design Document for Future Features
2
+
3
+
This document outlines the design for features that are planned but not yet implemented in the OCaml Requests library.
4
+
5
+
## 1. Hooks System (Middleware)
6
+
7
+
### Overview
8
+
A flexible hooks system that allows users to register callbacks at various stages of the request/response lifecycle, similar to Python requests' hooks system.
9
+
10
+
### Design
11
+
12
+
```ocaml
13
+
module Hooks : sig
14
+
type stage =
15
+
| Pre_request (* Before request is sent *)
16
+
| Post_request (* After request is sent, before reading response *)
17
+
| Pre_redirect (* Before following a redirect *)
18
+
| Response (* After response is received *)
19
+
| Error (* On error *)
20
+
21
+
type hook = {
22
+
stage : stage;
23
+
handler : context -> context;
24
+
}
25
+
26
+
and context = {
27
+
request : prepared_request;
28
+
response : Response.t option;
29
+
error : error option;
30
+
metadata : (string * string) list;
31
+
}
32
+
33
+
val register : hook -> unit
34
+
val unregister : stage -> unit
35
+
val clear : unit -> unit
36
+
37
+
(* Session-level hooks *)
38
+
module Session : sig
39
+
val add_hook : 'a Session.t -> hook -> unit
40
+
val remove_hook : 'a Session.t -> stage -> unit
41
+
end
42
+
end
43
+
```
44
+
45
+
### Use Cases
46
+
- Logging all requests/responses
47
+
- Adding authentication dynamically
48
+
- Request/response transformation
49
+
- Metrics collection
50
+
- Error reporting
51
+
52
+
### Implementation Notes
53
+
- Hooks should be composable (multiple hooks per stage)
54
+
- Hooks can modify the request/response
55
+
- Hooks can short-circuit the request (for caching, mocking)
56
+
- Consider priority ordering for hooks
57
+
58
+
## 2. SOCKS Proxy Support
59
+
60
+
### Overview
61
+
Support for SOCKS4/SOCKS5 proxies in addition to HTTP proxies.
62
+
63
+
### Design
64
+
65
+
```ocaml
66
+
module SocksProxy : sig
67
+
type version = SOCKS4 | SOCKS4A | SOCKS5
68
+
69
+
type config = {
70
+
version : version;
71
+
host : string;
72
+
port : int;
73
+
username : string option;
74
+
password : string option;
75
+
dns_through_proxy : bool; (* SOCKS5 feature *)
76
+
}
77
+
78
+
val create : config -> Proxy.t
79
+
80
+
(* Integration with PoolManager *)
81
+
val with_socks_proxy :
82
+
'a PoolManager.t ->
83
+
socks_config:config ->
84
+
'a PoolManager.t
85
+
end
86
+
```
87
+
88
+
### Implementation Strategy
89
+
- Use a pure OCaml SOCKS implementation or bind to existing C library
90
+
- Integrate with Eio's networking layer
91
+
- Support both SOCKS4 and SOCKS5 protocols
92
+
- Handle SOCKS authentication methods
93
+
94
+
### Dependencies
95
+
- Might need a SOCKS protocol implementation library
96
+
- Consider using `ocaml-socks` if available
97
+
98
+
## 3. Character Encoding Detection
99
+
100
+
### Overview
101
+
Automatic detection and handling of character encodings in responses, similar to Python's chardet.
102
+
103
+
### Design
104
+
105
+
```ocaml
106
+
module Encoding : sig
107
+
type t =
108
+
| UTF8
109
+
| UTF16
110
+
| Latin1
111
+
| ASCII
112
+
| Custom of string
113
+
114
+
val detect : string -> (t * float) (* encoding * confidence *)
115
+
val decode : t -> string -> string
116
+
117
+
(* Response integration *)
118
+
val auto_decode : Response.t -> string
119
+
val with_encoding : Response.t -> t -> string
120
+
121
+
(* Streaming support *)
122
+
val decoder : t -> Flow.source_ty Flow.source -> Flow.source_ty Flow.source
123
+
end
124
+
```
125
+
126
+
### Implementation Strategy
127
+
- Port or wrap an existing charset detection library
128
+
- Integrate with Response module for automatic decoding
129
+
- Support streaming decoding for large responses
130
+
- Fallback chain: Content-Type header → BOM detection → Statistical analysis
131
+
132
+
### Performance Considerations
133
+
- Cache detection results
134
+
- Lazy decoding for large responses
135
+
- Fast-path for common encodings (UTF-8, ASCII)
136
+
137
+
## 4. Compression Support (gzip, deflate)
138
+
139
+
### Overview
140
+
Automatic handling of compressed responses and request body compression.
141
+
142
+
### Design
143
+
144
+
```ocaml
145
+
module Compression : sig
146
+
type algorithm = Gzip | Deflate | Brotli | Zstd | Identity
147
+
148
+
val supported : algorithm list
149
+
150
+
(* Request compression *)
151
+
val compress_body :
152
+
algorithm ->
153
+
string ->
154
+
string
155
+
156
+
val compress_stream :
157
+
algorithm ->
158
+
Flow.source_ty Flow.source ->
159
+
Flow.source_ty Flow.source
160
+
161
+
(* Response decompression *)
162
+
val decompress :
163
+
Response.t ->
164
+
Response.t (* Automatically decompresses based on Content-Encoding *)
165
+
166
+
val decompress_stream :
167
+
algorithm ->
168
+
Flow.source_ty Flow.source ->
169
+
Flow.source_ty Flow.source
170
+
171
+
(* Config integration *)
172
+
module Config : sig
173
+
val with_compression :
174
+
Config.t ->
175
+
accept:algorithm list ->
176
+
compress_request:bool ->
177
+
Config.t
178
+
end
179
+
end
180
+
```
181
+
182
+
### Implementation Strategy
183
+
- Use `camlzip` for gzip/deflate
184
+
- Optional support for brotli when OCaml bindings available
185
+
- Transparent decompression by default
186
+
- Streaming compression/decompression for large payloads
187
+
188
+
### Integration Points
189
+
- Automatic Accept-Encoding header
190
+
- Automatic Content-Encoding for requests
191
+
- Response.body should auto-decompress
192
+
- Preserve original compressed body option
193
+
194
+
## 5. Advanced Certificate Handling
195
+
196
+
### Overview
197
+
Enhanced certificate validation, pinning, and custom verification.
198
+
199
+
### Design
200
+
201
+
```ocaml
202
+
module Certificate : sig
203
+
type pin =
204
+
| SHA256 of string (* Base64 encoded SHA256 hash *)
205
+
| SHA1 of string (* Legacy *)
206
+
| Full of X509.t (* Full certificate *)
207
+
208
+
type verification =
209
+
| Default
210
+
| Pinned of pin list
211
+
| Custom of (X509.t list -> bool)
212
+
| ChainValidator of (X509.t list -> (bool * string))
213
+
214
+
val pin_from_file : string -> pin
215
+
val pin_from_cert : X509.t -> pin
216
+
217
+
(* Config integration *)
218
+
val with_verification :
219
+
Tls.config ->
220
+
verification ->
221
+
Tls.config
222
+
223
+
(* Session trust store *)
224
+
module TrustStore : sig
225
+
type t
226
+
val create : unit -> t
227
+
val add_ca : t -> X509.t -> unit
228
+
val add_pins : t -> Uri.t -> pin list -> unit
229
+
val verify : t -> Uri.t -> X509.t list -> bool
230
+
end
231
+
end
232
+
```
233
+
234
+
### Security Features
235
+
- Certificate pinning (HPKP-style)
236
+
- Custom certificate validation logic
237
+
- Per-domain certificate rules
238
+
- Certificate transparency log checking
239
+
- OCSP stapling support
240
+
241
+
## 6. Request Preparation & Signing
242
+
243
+
### Overview
244
+
Separate request preparation from execution, allowing for request signing and modification.
245
+
246
+
### Design
247
+
248
+
```ocaml
249
+
module PreparedRequest : sig
250
+
type t = {
251
+
method_ : meth;
252
+
url : Uri.t;
253
+
headers : Cohttp.Header.t;
254
+
body : [`String of string | `Stream of Flow.source_ty Flow.source] option;
255
+
auth : Auth.t option;
256
+
metadata : (string * string) list;
257
+
}
258
+
259
+
val create :
260
+
method_:meth ->
261
+
url:Uri.t ->
262
+
?headers:Cohttp.Header.t ->
263
+
?body:string ->
264
+
?auth:Auth.t ->
265
+
unit -> t
266
+
267
+
val sign :
268
+
t ->
269
+
algorithm:[`HMAC_SHA256 | `RSA_SHA256 | `Ed25519] ->
270
+
key:string ->
271
+
t
272
+
273
+
val add_metadata : t -> string -> string -> t
274
+
val with_body : t -> string -> t
275
+
val with_header : t -> string -> string -> t
276
+
277
+
(* Execute prepared request *)
278
+
val execute :
279
+
sw:Switch.t ->
280
+
'a t ->
281
+
PreparedRequest.t ->
282
+
Response.t
283
+
end
284
+
```
285
+
286
+
### Use Cases
287
+
- AWS Signature Version 4 signing
288
+
- API request signing (webhooks)
289
+
- Request templating
290
+
- Batch request preparation
291
+
- Testing and mocking
292
+
293
+
## 7. WebSocket Support
294
+
295
+
### Overview
296
+
WebSocket client support integrated with the HTTP client infrastructure.
297
+
298
+
### Design
299
+
300
+
```ocaml
301
+
module WebSocket : sig
302
+
type t
303
+
304
+
type frame =
305
+
| Text of string
306
+
| Binary of bytes
307
+
| Ping of bytes
308
+
| Pong of bytes
309
+
| Close of int * string
310
+
311
+
val connect :
312
+
sw:Switch.t ->
313
+
'a t ->
314
+
?config:Config.t ->
315
+
Uri.t ->
316
+
t
317
+
318
+
val send : t -> frame -> unit
319
+
val receive : t -> frame
320
+
val close : t -> unit
321
+
322
+
(* Higher-level API *)
323
+
val send_text : t -> string -> unit
324
+
val send_binary : t -> bytes -> unit
325
+
val iter_frames : t -> (frame -> unit) -> unit
326
+
end
327
+
```
328
+
329
+
### Implementation Notes
330
+
- Reuse connection pooling infrastructure
331
+
- Support for WebSocket over HTTP/2
332
+
- Automatic ping/pong handling
333
+
- Reconnection support
334
+
335
+
## 8. HTTP/2 and HTTP/3 Support
336
+
337
+
### Overview
338
+
Support for modern HTTP protocols with multiplexing and improved performance.
339
+
340
+
### Design
341
+
342
+
```ocaml
343
+
module Http2 : sig
344
+
type multiplexed_session
345
+
346
+
val create_session :
347
+
sw:Switch.t ->
348
+
'a t ->
349
+
Uri.t ->
350
+
multiplexed_session
351
+
352
+
val request :
353
+
session:multiplexed_session ->
354
+
?config:Config.t ->
355
+
method_:meth ->
356
+
path:string ->
357
+
?body:string ->
358
+
unit ->
359
+
Response.t
360
+
361
+
(* Server push support *)
362
+
val on_push :
363
+
session:multiplexed_session ->
364
+
(Uri.t -> Response.t -> unit) ->
365
+
unit
366
+
end
367
+
368
+
module Http3 : sig
369
+
(* Similar to Http2 but with QUIC transport *)
370
+
type quic_session
371
+
372
+
val create_session :
373
+
sw:Switch.t ->
374
+
'a t ->
375
+
Uri.t ->
376
+
quic_session
377
+
end
378
+
```
379
+
380
+
### Implementation Strategy
381
+
- Use `ocaml-h2` library for HTTP/2
382
+
- Future HTTP/3 support when QUIC libraries mature
383
+
- Transparent protocol negotiation (ALPN)
384
+
- Connection coalescing for HTTP/2
385
+
386
+
## 9. Metrics and Observability
387
+
388
+
### Overview
389
+
Built-in metrics collection and observability features.
390
+
391
+
### Design
392
+
393
+
```ocaml
394
+
module Metrics : sig
395
+
type counter = {
396
+
requests_total : int;
397
+
requests_failed : int;
398
+
bytes_sent : int64;
399
+
bytes_received : int64;
400
+
}
401
+
402
+
type histogram = {
403
+
latency_ms : float array;
404
+
percentiles : (int * float) list; (* p50, p95, p99 *)
405
+
}
406
+
407
+
type t = {
408
+
counters : counter;
409
+
histograms : (string * histogram) list;
410
+
active_connections : int;
411
+
pool_stats : Pool.stats;
412
+
}
413
+
414
+
val enable : unit -> unit
415
+
val disable : unit -> unit
416
+
val reset : unit -> unit
417
+
val get : unit -> t
418
+
419
+
(* Prometheus integration *)
420
+
module Prometheus : sig
421
+
val register : unit -> unit
422
+
val export : unit -> string (* Prometheus text format *)
423
+
end
424
+
425
+
(* OpenTelemetry integration *)
426
+
module OpenTelemetry : sig
427
+
val with_tracing : Config.t -> Config.t
428
+
val span : string -> (unit -> 'a) -> 'a
429
+
end
430
+
end
431
+
```
432
+
433
+
### Metrics to Track
434
+
- Request/response times
435
+
- Connection pool utilization
436
+
- Cache hit/miss rates
437
+
- Error rates by type
438
+
- Bandwidth usage
439
+
- Protocol distribution (HTTP/1.1 vs HTTP/2)
440
+
441
+
## 10. Testing Utilities
442
+
443
+
### Overview
444
+
Built-in testing utilities for mocking and recording HTTP interactions.
445
+
446
+
### Design
447
+
448
+
```ocaml
449
+
module Test : sig
450
+
(* Mock responses *)
451
+
module Mock : sig
452
+
type rule = {
453
+
pattern : Uri.t -> meth -> bool;
454
+
response : Response.t;
455
+
delay : float option;
456
+
}
457
+
458
+
val add_rule : rule -> unit
459
+
val with_mock : rule list -> (unit -> 'a) -> 'a
460
+
val reset : unit -> unit
461
+
end
462
+
463
+
(* Record and replay *)
464
+
module VCR : sig
465
+
type cassette
466
+
467
+
val record : string -> (unit -> 'a) -> 'a * cassette
468
+
val replay : cassette -> (unit -> 'a) -> 'a
469
+
val save : cassette -> string -> unit
470
+
val load : string -> cassette
471
+
end
472
+
473
+
(* Assertions *)
474
+
val assert_requested :
475
+
?times:int ->
476
+
?headers:(string * string) list ->
477
+
meth ->
478
+
Uri.t ->
479
+
unit
480
+
end
481
+
```
482
+
483
+
### Features
484
+
- Request mocking without network calls
485
+
- VCR-style record/replay for integration tests
486
+
- Request assertions for testing
487
+
- Latency simulation
488
+
- Error injection
489
+
490
+
## Implementation Priority
491
+
492
+
1. **High Priority** (Phase 2)
493
+
- Hooks System - Essential for extensibility
494
+
- Compression Support - Common requirement
495
+
- PreparedRequest - Enables advanced use cases
496
+
497
+
2. **Medium Priority** (Phase 3)
498
+
- Certificate Handling - Security enhancement
499
+
- Metrics - Observability
500
+
- Testing Utilities - Developer experience
501
+
502
+
3. **Low Priority** (Phase 4)
503
+
- SOCKS Proxy - Specialized use case
504
+
- Character Encoding - Can use external libraries
505
+
- WebSocket - Separate protocol
506
+
- HTTP/2-3 - Requires mature libraries
507
+
508
+
## Dependencies
509
+
510
+
- `camlzip` - For compression support
511
+
- `ocaml-h2` - For HTTP/2 support
512
+
- `prometheus` - For metrics export
513
+
- `x509` - Enhanced certificate handling
514
+
- Character encoding library (TBD)
515
+
- SOCKS library (TBD)
516
+
517
+
## Testing Strategy
518
+
519
+
Each feature should include:
520
+
- Unit tests for core functionality
521
+
- Integration tests with real servers
522
+
- Performance benchmarks
523
+
- Security testing for auth/crypto features
524
+
- Compatibility tests with Python requests behavior
+28
requests/dune-project
+28
requests/dune-project
···
1
+
(lang dune 3.0)
2
+
(name requests)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(source
7
+
(github username/requests))
8
+
9
+
(authors "Your Name")
10
+
11
+
(maintainers "Your Name")
12
+
13
+
(license MIT)
14
+
15
+
(package
16
+
(name requests)
17
+
(synopsis "Clean Eio-style HTTPS client library for OCaml")
18
+
(description "A modern HTTP(S) client library for OCaml with Eio support, providing a clean API for making web requests with automatic TLS/CA certificate handling")
19
+
(depends
20
+
ocaml
21
+
(dune (>= 3.0))
22
+
eio
23
+
cohttp-eio
24
+
tls-eio
25
+
ca-certs
26
+
mirage-crypto-rng-eio
27
+
uri
28
+
yojson))
+4
requests/lib/dune
+4
requests/lib/dune
+1004
requests/lib/requests.ml
+1004
requests/lib/requests.ml
···
1
+
open Eio
2
+
3
+
(* Error types *)
4
+
type error =
5
+
| Http_error of { status : Cohttp.Code.status_code; body : string; headers : Cohttp.Header.t }
6
+
| Connection_error of string
7
+
| Timeout_error
8
+
| Too_many_redirects
9
+
| Max_retry_error of { url : Uri.t; reason : string }
10
+
| Pool_exhausted
11
+
| Pool_error of string
12
+
| Proxy_error of string
13
+
| Protocol_error of string
14
+
| Header_parsing_error of string
15
+
| Certificate_verification_error of string
16
+
17
+
let pp_error ppf = function
18
+
| Http_error { status; body; _ } ->
19
+
Format.fprintf ppf "HTTP error %s: %s"
20
+
(Cohttp.Code.string_of_status status) body
21
+
| Connection_error msg -> Format.fprintf ppf "Connection error: %s" msg
22
+
| Timeout_error -> Format.fprintf ppf "Request timeout"
23
+
| Too_many_redirects -> Format.fprintf ppf "Too many redirects"
24
+
| Max_retry_error { url; reason } ->
25
+
Format.fprintf ppf "Max retries exceeded for %a: %s" Uri.pp url reason
26
+
| Pool_exhausted -> Format.fprintf ppf "Connection pool exhausted"
27
+
| Pool_error msg -> Format.fprintf ppf "Pool error: %s" msg
28
+
| Proxy_error msg -> Format.fprintf ppf "Proxy error: %s" msg
29
+
| Protocol_error msg -> Format.fprintf ppf "Protocol error: %s" msg
30
+
| Header_parsing_error msg -> Format.fprintf ppf "Header parsing error: %s" msg
31
+
| Certificate_verification_error msg -> Format.fprintf ppf "Certificate error: %s" msg
32
+
33
+
exception Request_error of error
34
+
35
+
(* Logging setup *)
36
+
let log_src = Logs.Src.create "requests" ~doc:"HTTP requests library"
37
+
module Log = (val Logs.src_log log_src : Logs.LOG)
38
+
39
+
type meth = [
40
+
| `GET
41
+
| `POST
42
+
| `PUT
43
+
| `DELETE
44
+
| `HEAD
45
+
| `OPTIONS
46
+
| `PATCH
47
+
]
48
+
49
+
(* Authentication mechanisms - defined early for use in Config *)
50
+
module Auth = struct
51
+
type t =
52
+
| None
53
+
| Basic of { username : string; password : string }
54
+
| Digest of { username : string; password : string }
55
+
| Bearer of { token : string }
56
+
| OAuth1 of {
57
+
consumer_key : string;
58
+
consumer_secret : string;
59
+
token : string option;
60
+
token_secret : string option;
61
+
signature_method : [`HMAC_SHA1 | `HMAC_SHA256 | `PLAINTEXT];
62
+
}
63
+
| OAuth2 of {
64
+
client_id : string option;
65
+
client_secret : string option;
66
+
token_type : string;
67
+
access_token : string;
68
+
}
69
+
| Custom of (meth -> Uri.t -> Cohttp.Header.t -> Cohttp.Header.t)
70
+
71
+
let none = None
72
+
73
+
let basic ~username ~password = Basic { username; password }
74
+
75
+
let digest ~username ~password = Digest { username; password }
76
+
77
+
let bearer ~token = Bearer { token }
78
+
79
+
let oauth1 ~consumer_key ~consumer_secret ?token ?token_secret
80
+
?(signature_method=`HMAC_SHA1) () =
81
+
OAuth1 { consumer_key; consumer_secret; token; token_secret; signature_method }
82
+
83
+
let oauth2 ?client_id ?client_secret ?(token_type="Bearer") ~access_token () =
84
+
OAuth2 { client_id; client_secret; token_type; access_token }
85
+
86
+
let custom f = Custom f
87
+
88
+
let apply auth meth uri headers =
89
+
match auth with
90
+
| None -> headers
91
+
| Basic { username; password } ->
92
+
let encoded = Base64.encode_string (Printf.sprintf "%s:%s" username password) in
93
+
Cohttp.Header.add headers "Authorization" (Printf.sprintf "Basic %s" encoded)
94
+
| Digest { username; password } ->
95
+
(* Simplified - would need challenge-response in real implementation *)
96
+
Log.warn (fun m -> m "Digest auth not fully implemented - using Basic fallback");
97
+
let encoded = Base64.encode_string (Printf.sprintf "%s:%s" username password) in
98
+
Cohttp.Header.add headers "Authorization" (Printf.sprintf "Basic %s" encoded)
99
+
| Bearer { token } ->
100
+
Cohttp.Header.add headers "Authorization" (Printf.sprintf "Bearer %s" token)
101
+
| OAuth1 { consumer_key; consumer_secret; token; token_secret; signature_method } ->
102
+
(* Simplified OAuth 1.0 - would need proper signature generation *)
103
+
Log.warn (fun m -> m "OAuth1 simplified - full implementation needed");
104
+
let oauth_params = [
105
+
("oauth_consumer_key", consumer_key);
106
+
("oauth_nonce", Printf.sprintf "%d" (Random.int 1000000));
107
+
("oauth_signature_method",
108
+
match signature_method with
109
+
| `HMAC_SHA1 -> "HMAC-SHA1"
110
+
| `HMAC_SHA256 -> "HMAC-SHA256"
111
+
| `PLAINTEXT -> "PLAINTEXT");
112
+
("oauth_timestamp", Printf.sprintf "%.0f" (Unix.gettimeofday ()));
113
+
("oauth_version", "1.0");
114
+
] in
115
+
let oauth_header = String.concat ", "
116
+
(List.map (fun (k, v) -> Printf.sprintf "%s=\"%s\"" k (Uri.pct_encode v)) oauth_params) in
117
+
Cohttp.Header.add headers "Authorization" (Printf.sprintf "OAuth %s" oauth_header)
118
+
| OAuth2 { client_id; client_secret; token_type; access_token } ->
119
+
Cohttp.Header.add headers "Authorization" (Printf.sprintf "%s %s" token_type access_token)
120
+
| Custom f -> f meth uri headers
121
+
end
122
+
123
+
module Response = struct
124
+
type t = {
125
+
status : Cohttp.Code.status_code;
126
+
headers : Cohttp.Header.t;
127
+
body : string;
128
+
body_stream : Buf_read.t option;
129
+
}
130
+
131
+
let status t = t.status
132
+
let headers t = t.headers
133
+
let body t = t.body
134
+
let body_stream t =
135
+
match t.body_stream with
136
+
| Some s -> s
137
+
| None -> Buf_read.of_string t.body
138
+
139
+
let is_success t =
140
+
let code = Cohttp.Code.code_of_status t.status in
141
+
code >= 200 && code < 300
142
+
143
+
let is_redirect t =
144
+
let code = Cohttp.Code.code_of_status t.status in
145
+
code >= 300 && code < 400
146
+
147
+
let is_client_error t =
148
+
let code = Cohttp.Code.code_of_status t.status in
149
+
code >= 400 && code < 500
150
+
151
+
let is_server_error t =
152
+
let code = Cohttp.Code.code_of_status t.status in
153
+
code >= 500 && code < 600
154
+
155
+
let pp ppf t =
156
+
Format.fprintf ppf "@[<v>Response:@,Status: %s@,Headers: %d@,Body: %d bytes@]"
157
+
(Cohttp.Code.string_of_status t.status)
158
+
(Cohttp.Header.to_lines t.headers |> List.length)
159
+
(String.length t.body)
160
+
end
161
+
162
+
module Config = struct
163
+
type t = {
164
+
headers : Cohttp.Header.t;
165
+
timeout : float option;
166
+
follow_redirects : bool;
167
+
max_redirects : int;
168
+
verify_tls : bool;
169
+
auth : Auth.t;
170
+
}
171
+
172
+
let create ?(headers=Cohttp.Header.init ()) ?timeout ?(follow_redirects=true)
173
+
?(max_redirects=10) ?(verify_tls=true) ?(auth=Auth.none) () =
174
+
{ headers; timeout; follow_redirects; max_redirects; verify_tls; auth }
175
+
176
+
let default = create ()
177
+
178
+
let with_headers t headers = { t with headers }
179
+
180
+
let add_header key value t =
181
+
{ t with headers = Cohttp.Header.add t.headers key value }
182
+
183
+
let with_timeout t timeout = { t with timeout = Some timeout }
184
+
let with_follow_redirects t follow_redirects = { t with follow_redirects }
185
+
let with_max_redirects t max_redirects = { t with max_redirects }
186
+
let with_verify_tls t verify_tls = { t with verify_tls }
187
+
let with_auth t auth = { t with auth }
188
+
189
+
let pp ppf t =
190
+
Format.fprintf ppf "@[<v>Config:@,Redirects: %b (max %d)@,Timeout: %a@,TLS verify: %b@]"
191
+
t.follow_redirects t.max_redirects
192
+
(fun ppf -> function None -> Format.fprintf ppf "none" | Some f -> Format.fprintf ppf "%.2fs" f) t.timeout
193
+
t.verify_tls
194
+
end
195
+
196
+
module Tls = struct
197
+
type config =
198
+
| Default
199
+
| WithCaCerts of X509.Authenticator.t
200
+
| Custom of Tls.Config.client
201
+
| Insecure
202
+
203
+
let default () = Default
204
+
205
+
let with_ca_certs auth = WithCaCerts auth
206
+
207
+
let with_custom config = Custom config
208
+
209
+
let insecure () = Insecure
210
+
211
+
let pp_config ppf = function
212
+
| Default -> Format.fprintf ppf "Default TLS"
213
+
| WithCaCerts _ -> Format.fprintf ppf "Custom CA certs"
214
+
| Custom _ -> Format.fprintf ppf "Custom TLS config"
215
+
| Insecure -> Format.fprintf ppf "Insecure (no verification)"
216
+
217
+
let to_tls_config = function
218
+
| Default ->
219
+
let authenticator = Result.get_ok (Ca_certs.authenticator ()) in
220
+
Tls.Config.client ~authenticator ()
221
+
| WithCaCerts auth ->
222
+
Tls.Config.client ~authenticator:auth ()
223
+
| Custom config ->
224
+
config
225
+
| Insecure ->
226
+
let authenticator ?ip:_ ~host:_ _ = Ok None in
227
+
Tls.Config.client ~authenticator ()
228
+
end
229
+
230
+
type 'a t = {
231
+
net : 'a Net.t;
232
+
tls_config : Tls.config;
233
+
default_headers : Cohttp.Header.t;
234
+
} constraint 'a = [> `Generic] Net.ty
235
+
236
+
let create ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ()) net =
237
+
{ net; tls_config; default_headers }
238
+
239
+
240
+
let make_client net tls_config =
241
+
let tls_config = Tls.to_tls_config tls_config in
242
+
let https_fn _uri socket = Tls_eio.client_of_flow tls_config socket in
243
+
Cohttp_eio.Client.make ~https:(Some https_fn) net
244
+
245
+
let merge_headers base_headers request_headers =
246
+
Cohttp.Header.fold (fun key value acc ->
247
+
Cohttp.Header.add acc key value
248
+
) request_headers base_headers
249
+
250
+
let rec request_with_redirects ~sw client config uri redirect_count meth body =
251
+
if redirect_count > config.Config.max_redirects then
252
+
raise (Request_error Too_many_redirects);
253
+
254
+
let headers = config.Config.headers in
255
+
let resp, response_body =
256
+
match meth with
257
+
| `GET -> Cohttp_eio.Client.get ~sw client uri ~headers
258
+
| `POST ->
259
+
let body = match body with
260
+
| Some b -> Flow.string_source b
261
+
| None -> Flow.string_source ""
262
+
in
263
+
Cohttp_eio.Client.post ~sw client uri ~headers ~body
264
+
| `PUT ->
265
+
let body = match body with
266
+
| Some b -> Flow.string_source b
267
+
| None -> Flow.string_source ""
268
+
in
269
+
Cohttp_eio.Client.put ~sw client uri ~headers ~body
270
+
| `DELETE -> Cohttp_eio.Client.delete ~sw client uri ~headers
271
+
| `HEAD ->
272
+
let response = Cohttp_eio.Client.head ~sw client uri ~headers in
273
+
(response, Cohttp_eio.Body.of_string "")
274
+
| `OPTIONS ->
275
+
Cohttp_eio.Client.call ~sw client `OPTIONS uri ~headers
276
+
| `PATCH ->
277
+
let body = match body with
278
+
| Some b -> Flow.string_source b
279
+
| None -> Flow.string_source ""
280
+
in
281
+
Cohttp_eio.Client.call ~sw client `PATCH uri ~headers ~body
282
+
in
283
+
284
+
let status = Cohttp.Response.status resp in
285
+
let headers = Cohttp.Response.headers resp in
286
+
287
+
if config.Config.follow_redirects && Response.is_redirect { Response.status; headers; body = ""; body_stream = None } then
288
+
match Cohttp.Header.get headers "location" with
289
+
| Some location ->
290
+
let new_uri = Uri.resolve "" uri (Uri.of_string location) in
291
+
request_with_redirects ~sw client config new_uri (redirect_count + 1) meth body
292
+
| None ->
293
+
let buf_reader = Buf_read.of_flow ~max_size:(16 * 1024 * 1024) response_body in
294
+
let body = Buf_read.(parse_exn take_all) buf_reader in
295
+
{ Response.status; headers; body; body_stream = None }
296
+
else
297
+
let buf_reader = Buf_read.of_flow ~max_size:(16 * 1024 * 1024) response_body in
298
+
let body = Buf_read.(parse_exn take_all) buf_reader in
299
+
{ Response.status; headers; body; body_stream = None }
300
+
301
+
let request ~sw t ?(config=Config.default) ?body ~meth uri =
302
+
let client = make_client t.net t.tls_config in
303
+
let merged_headers = merge_headers t.default_headers config.Config.headers in
304
+
(* Apply authentication *)
305
+
let merged_headers = Auth.apply config.Config.auth meth uri merged_headers in
306
+
let config = { config with Config.headers = merged_headers } in
307
+
308
+
try
309
+
let result = request_with_redirects ~sw client config uri 0 meth body in
310
+
if not (Response.is_success result) then
311
+
raise (Request_error (Http_error { status = result.Response.status; body = result.Response.body; headers = result.Response.headers }));
312
+
result
313
+
with
314
+
| Request_error _ as e -> raise e
315
+
| e -> raise (Request_error (Connection_error (Printexc.to_string e)))
316
+
317
+
let get ~sw t ?config uri =
318
+
request ~sw t ?config ~meth:`GET uri
319
+
320
+
let post ~sw t ?config ?body uri =
321
+
request ~sw t ?config ?body ~meth:`POST uri
322
+
323
+
let put ~sw t ?config ?body uri =
324
+
request ~sw t ?config ?body ~meth:`PUT uri
325
+
326
+
let delete ~sw t ?config uri =
327
+
request ~sw t ?config ~meth:`DELETE uri
328
+
329
+
let head ~sw t ?config uri =
330
+
request ~sw t ?config ~meth:`HEAD uri
331
+
332
+
let patch ~sw t ?config ?body uri =
333
+
request ~sw t ?config ?body ~meth:`PATCH uri
334
+
335
+
module Json = struct
336
+
let get ~sw t ?config uri =
337
+
let response = get ~sw t ?config uri in
338
+
Yojson.Safe.from_string response.Response.body
339
+
340
+
let post ~sw t ?config json uri =
341
+
let body = Yojson.Safe.to_string json in
342
+
let config = match config with
343
+
| Some c -> Some (Config.add_header "Content-Type" "application/json" c)
344
+
| None -> Some (Config.add_header "Content-Type" "application/json" Config.default)
345
+
in
346
+
let response = post ~sw t ?config ~body uri in
347
+
Yojson.Safe.from_string response.Response.body
348
+
349
+
let put ~sw t ?config json uri =
350
+
let body = Yojson.Safe.to_string json in
351
+
let config = match config with
352
+
| Some c -> Some (Config.add_header "Content-Type" "application/json" c)
353
+
| None -> Some (Config.add_header "Content-Type" "application/json" Config.default)
354
+
in
355
+
let response = put ~sw t ?config ~body uri in
356
+
Yojson.Safe.from_string response.Response.body
357
+
end
358
+
359
+
module Form = struct
360
+
type t = (string * string list) list
361
+
362
+
let encode form =
363
+
form
364
+
|> List.map (fun (key, values) ->
365
+
List.map (fun value ->
366
+
Printf.sprintf "%s=%s" (Uri.pct_encode key) (Uri.pct_encode value)
367
+
) values
368
+
)
369
+
|> List.flatten
370
+
|> String.concat "&"
371
+
end
372
+
373
+
let post_form ~sw t ?config ~form uri =
374
+
let body = Form.encode form in
375
+
let config = match config with
376
+
| Some c -> Some (Config.add_header "Content-Type" "application/x-www-form-urlencoded" c)
377
+
| None -> Some (Config.add_header "Content-Type" "application/x-www-form-urlencoded" Config.default)
378
+
in
379
+
post ~sw t ?config ~body uri
380
+
381
+
module Session = struct
382
+
type 'a session = {
383
+
client : 'a t;
384
+
cookies : (string * string) list ref;
385
+
} constraint 'a = [> `Generic] Net.ty
386
+
387
+
type 'a t = 'a session constraint 'a = [> `Generic] Net.ty
388
+
389
+
let create ?tls_config ?default_headers net =
390
+
{ client = create ?tls_config ?default_headers net;
391
+
cookies = ref [] }
392
+
393
+
let update_cookies t headers =
394
+
let new_cookies = Cohttp.Header.get_multi headers "set-cookie"
395
+
|> List.filter_map (fun cookie ->
396
+
match String.split_on_char ';' cookie with
397
+
| kv :: _ ->
398
+
(match String.split_on_char '=' kv with
399
+
| [k; v] -> Some (String.trim k, String.trim v)
400
+
| _ -> None)
401
+
| _ -> None)
402
+
in
403
+
t.cookies := new_cookies @ !(t.cookies)
404
+
405
+
let add_cookies config cookies =
406
+
if cookies = [] then config else
407
+
let cookie_header =
408
+
cookies
409
+
|> List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v)
410
+
|> String.concat "; "
411
+
in
412
+
Config.add_header "Cookie" cookie_header config
413
+
414
+
let request_with_cookies ~sw t ?config ~meth ?body uri =
415
+
let config =
416
+
match config with
417
+
| Some c -> add_cookies c !(t.cookies)
418
+
| None -> add_cookies Config.default !(t.cookies)
419
+
in
420
+
let response = request ~sw t.client ~config ?body ~meth uri in
421
+
update_cookies t response.Response.headers;
422
+
response
423
+
424
+
let get ~sw t ?config uri =
425
+
request_with_cookies ~sw t ?config ~meth:`GET uri
426
+
427
+
let post ~sw t ?config ?body uri =
428
+
request_with_cookies ~sw t ?config ~meth:`POST ?body uri
429
+
430
+
let cookies t = !(t.cookies)
431
+
let clear_cookies t = t.cookies := []
432
+
end
433
+
434
+
let download_file ~sw t ?config uri ~path =
435
+
let response = get ~sw t ?config uri in
436
+
let oc = open_out_bin path in
437
+
try
438
+
output_string oc response.Response.body;
439
+
close_out oc
440
+
with e ->
441
+
close_out_noerr oc;
442
+
raise e
443
+
444
+
let stream_response ~sw t ?config uri f =
445
+
let client = make_client t.net t.tls_config in
446
+
let headers = match config with
447
+
| Some c -> c.Config.headers
448
+
| None -> Cohttp.Header.init ()
449
+
in
450
+
let merged_headers = merge_headers t.default_headers headers in
451
+
let _resp, body = Cohttp_eio.Client.get ~sw client uri ~headers:merged_headers in
452
+
let buf_reader = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) body in
453
+
f buf_reader
454
+
455
+
(* Connection Pool Implementation *)
456
+
module ConnectionPool = struct
457
+
type t = Pool : {
458
+
sw : Switch.t;
459
+
scheme : string;
460
+
host : string;
461
+
port : int;
462
+
net : 'a Net.t;
463
+
tls_config : Tls.config option;
464
+
config : config;
465
+
pool : Cohttp_eio.Client.t Eio.Pool.t;
466
+
mutable num_connections : int;
467
+
mutable num_requests : int;
468
+
} -> t
469
+
470
+
and config = {
471
+
maxsize : int;
472
+
block : bool;
473
+
retries : int;
474
+
timeout : float option;
475
+
}
476
+
477
+
let default_config = {
478
+
maxsize = 10;
479
+
block = false;
480
+
retries = 3;
481
+
timeout = None;
482
+
}
483
+
484
+
let create ~sw ?(config=default_config) ?tls_config ~scheme ~host ~port net =
485
+
Log.debug (fun m -> m "Creating connection pool for %s://%s:%d" scheme host port);
486
+
487
+
let create_connection () =
488
+
make_client net (Option.value ~default:(Tls.default ()) tls_config)
489
+
in
490
+
491
+
let pool = Eio.Pool.create config.maxsize create_connection in
492
+
493
+
Pool { sw; scheme; host; port; net; tls_config; config; pool;
494
+
num_connections = 0; num_requests = 0 }
495
+
496
+
let get_connection ~sw (Pool t) =
497
+
t.num_requests <- t.num_requests + 1;
498
+
Eio.Pool.use t.pool Fun.id
499
+
500
+
let put_connection (Pool t) conn = ()
501
+
let num_connections (Pool t) = t.num_connections
502
+
let num_requests (Pool t) = t.num_requests
503
+
let clear (Pool t) = ()
504
+
end
505
+
506
+
(* Retry Implementation *)
507
+
module Retry = struct
508
+
type backoff = {
509
+
factor : float;
510
+
jitter : float;
511
+
max : float;
512
+
}
513
+
514
+
type history = {
515
+
method_ : meth;
516
+
url : Uri.t;
517
+
error : exn option;
518
+
status : int option;
519
+
redirect_location : string option;
520
+
}
521
+
522
+
type t = {
523
+
total : int;
524
+
connect : int option;
525
+
read : int option;
526
+
redirect : int option;
527
+
status : int option;
528
+
other : int option;
529
+
allowed_methods : meth list;
530
+
status_forcelist : int list;
531
+
backoff : backoff;
532
+
raise_on_redirect : bool;
533
+
raise_on_status : bool;
534
+
respect_retry_after : bool;
535
+
remove_headers_on_redirect : string list;
536
+
history : history list;
537
+
mutable retry_count : int;
538
+
}
539
+
540
+
let default_backoff = { factor = 0.0; jitter = 0.0; max = 120.0 }
541
+
let default_allowed_methods = [`HEAD; `GET; `PUT; `DELETE; `OPTIONS]
542
+
let default_remove_headers = ["Cookie"; "Authorization"; "Proxy-Authorization"]
543
+
544
+
let default = {
545
+
total = 10;
546
+
connect = None;
547
+
read = None;
548
+
redirect = None;
549
+
status = None;
550
+
other = None;
551
+
allowed_methods = default_allowed_methods;
552
+
status_forcelist = [];
553
+
backoff = default_backoff;
554
+
raise_on_redirect = true;
555
+
raise_on_status = true;
556
+
respect_retry_after = true;
557
+
remove_headers_on_redirect = default_remove_headers;
558
+
history = [];
559
+
retry_count = 0;
560
+
}
561
+
562
+
let create ?total ?(connect=None) ?(read=None) ?(redirect=None) ?(status=None) ?(other=None)
563
+
?(allowed_methods=default_allowed_methods)
564
+
?(status_forcelist=[])
565
+
?(backoff=default_backoff)
566
+
?(raise_on_redirect=true)
567
+
?(raise_on_status=true)
568
+
?(respect_retry_after=true)
569
+
?(remove_headers_on_redirect=default_remove_headers) () =
570
+
let total = Option.value total ~default:10 in
571
+
{ total; connect; read; redirect; status; other;
572
+
allowed_methods; status_forcelist; backoff;
573
+
raise_on_redirect; raise_on_status; respect_retry_after;
574
+
remove_headers_on_redirect; history = []; retry_count = 0 }
575
+
576
+
let disabled = { default with total = 0 }
577
+
578
+
let get_history t = t.history
579
+
580
+
let increment t ~method_ ~url ?response ?error () =
581
+
let status = Option.map (fun r ->
582
+
Cohttp.Code.code_of_status (Response.status r)) response in
583
+
let redirect_location = match response with
584
+
| Some r -> Cohttp.Header.get (Response.headers r) "location"
585
+
| None -> None
586
+
in
587
+
let history_entry = { method_; url; error; status; redirect_location } in
588
+
{ t with history = history_entry :: t.history; retry_count = t.retry_count + 1 }
589
+
590
+
let is_retry t ~method_ ~status_code =
591
+
if t.retry_count >= t.total then false
592
+
else if not (List.mem method_ t.allowed_methods) then false
593
+
else List.mem status_code t.status_forcelist
594
+
595
+
let get_backoff_time t =
596
+
if t.backoff.factor = 0.0 then 0.0
597
+
else
598
+
let base_time = t.backoff.factor *. (2.0 ** float_of_int t.retry_count) in
599
+
let jittered = base_time +. Random.float t.backoff.jitter in
600
+
min jittered t.backoff.max
601
+
602
+
let sleep ~sw t response =
603
+
let backoff_time =
604
+
match t.respect_retry_after, response with
605
+
| true, Some resp ->
606
+
(match Cohttp.Header.get (Response.headers resp) "retry-after" with
607
+
| Some retry_after ->
608
+
(try float_of_string retry_after with _ -> get_backoff_time t)
609
+
| None -> get_backoff_time t)
610
+
| _ -> get_backoff_time t
611
+
in
612
+
if backoff_time > 0.0 then
613
+
Unix.sleepf backoff_time
614
+
end
615
+
616
+
(* Advanced Timeout *)
617
+
module Timeout = struct
618
+
type t = {
619
+
connect : float option;
620
+
read : float option;
621
+
total : float option;
622
+
start_time : float option;
623
+
}
624
+
625
+
let default = { connect = None; read = None; total = None; start_time = None }
626
+
let create ?connect ?read ?total () = { connect; read; total; start_time = None }
627
+
let from_float f = { connect = Some f; read = Some f; total = None; start_time = None }
628
+
let none = default
629
+
let start_connect t = { t with start_time = Some (Unix.gettimeofday ()) }
630
+
let get_connect_timeout t = t.connect
631
+
let get_read_timeout t = t.read
632
+
let clone t = { t with start_time = None }
633
+
end
634
+
635
+
(* Cache Implementation *)
636
+
module Cache = struct
637
+
type cache_control = {
638
+
no_cache : bool;
639
+
no_store : bool;
640
+
max_age : int option;
641
+
s_maxage : int option;
642
+
must_revalidate : bool;
643
+
public : bool;
644
+
private_ : bool;
645
+
immutable : bool;
646
+
}
647
+
648
+
let parse_cache_control header =
649
+
let default = {
650
+
no_cache = false; no_store = false; max_age = None;
651
+
s_maxage = None; must_revalidate = false;
652
+
public = false; private_ = false; immutable = false;
653
+
} in
654
+
let directives = String.split_on_char ',' header |> List.map String.trim in
655
+
List.fold_left (fun acc directive ->
656
+
match String.split_on_char '=' directive with
657
+
| ["no-cache"] -> { acc with no_cache = true }
658
+
| ["no-store"] -> { acc with no_store = true }
659
+
| ["max-age"; v] -> { acc with max_age = try Some (int_of_string v) with _ -> None }
660
+
| _ -> acc
661
+
) default directives
662
+
663
+
module Memory = struct
664
+
type storage = {
665
+
max_size : int;
666
+
mutable cache : (string, (float * Response.t)) Hashtbl.t;
667
+
mutable hits : int;
668
+
mutable misses : int;
669
+
}
670
+
671
+
let create ~max_size () = {
672
+
max_size;
673
+
cache = Hashtbl.create max_size;
674
+
hits = 0;
675
+
misses = 0;
676
+
}
677
+
end
678
+
679
+
module File = struct
680
+
type storage = {
681
+
cache_dir : string;
682
+
max_size : int64;
683
+
mutable size : int64;
684
+
mutable hits : int;
685
+
mutable misses : int;
686
+
}
687
+
688
+
let create ~cache_dir ~max_size () = {
689
+
cache_dir; max_size; size = 0L; hits = 0; misses = 0;
690
+
}
691
+
end
692
+
693
+
type storage = [
694
+
| `Memory of Memory.storage
695
+
| `File of File.storage
696
+
]
697
+
698
+
type 'a t = { storage : storage } constraint 'a = [> `Generic] Net.ty
699
+
700
+
type stats = { hits : int; misses : int; size : int64; entries : int }
701
+
702
+
let create storage = { storage }
703
+
704
+
let is_cacheable ~method_ ~response =
705
+
method_ = `GET && Response.is_success response
706
+
707
+
let make_cache_key ~method_ ~url =
708
+
Printf.sprintf "%s:%s"
709
+
(match method_ with
710
+
| `GET -> "GET" | `POST -> "POST" | `PUT -> "PUT"
711
+
| `DELETE -> "DELETE" | `HEAD -> "HEAD"
712
+
| `OPTIONS -> "OPTIONS" | `PATCH -> "PATCH")
713
+
(Uri.to_string url)
714
+
715
+
let get t ~method_ ~url ~headers =
716
+
let key = make_cache_key ~method_ ~url in
717
+
match t.storage with
718
+
| `Memory storage ->
719
+
(match Hashtbl.find_opt storage.cache key with
720
+
| Some (expiry, response) when expiry > Unix.gettimeofday () ->
721
+
storage.hits <- storage.hits + 1;
722
+
Some response
723
+
| _ ->
724
+
storage.misses <- storage.misses + 1;
725
+
None)
726
+
| `File _ -> None
727
+
728
+
let put t ~method_ ~url ~response =
729
+
if is_cacheable ~method_ ~response then
730
+
let key = make_cache_key ~method_ ~url in
731
+
let expiry = Unix.gettimeofday () +. 3600.0 in
732
+
match t.storage with
733
+
| `Memory storage ->
734
+
if Hashtbl.length storage.cache < storage.max_size then
735
+
Hashtbl.replace storage.cache key (expiry, response)
736
+
| `File _ -> ()
737
+
738
+
let clear t =
739
+
match t.storage with
740
+
| `Memory storage ->
741
+
Hashtbl.clear storage.cache;
742
+
storage.hits <- 0;
743
+
storage.misses <- 0
744
+
| `File _ -> ()
745
+
746
+
let stats t =
747
+
match t.storage with
748
+
| `Memory storage ->
749
+
{ hits = storage.Memory.hits;
750
+
misses = storage.Memory.misses;
751
+
size = Int64.of_int (Hashtbl.length storage.Memory.cache * 1024);
752
+
entries = Hashtbl.length storage.Memory.cache }
753
+
| `File storage ->
754
+
{ hits = storage.File.hits;
755
+
misses = storage.File.misses;
756
+
size = storage.File.size;
757
+
entries = 0 }
758
+
end
759
+
760
+
(* Pool Manager *)
761
+
module PoolManager = struct
762
+
type 'a pool_manager = {
763
+
sw : Switch.t;
764
+
net : 'a Net.t;
765
+
pools : (string, ConnectionPool.t) Hashtbl.t;
766
+
num_pools : int;
767
+
headers : Cohttp.Header.t;
768
+
retries : Retry.t;
769
+
timeout : Timeout.t;
770
+
pool_config : ConnectionPool.config;
771
+
tls_config : Tls.config option;
772
+
cache : 'a Cache.t option;
773
+
} constraint 'a = [> `Generic] Net.ty
774
+
775
+
type 'a t = 'a pool_manager constraint 'a = [> `Generic] Net.ty
776
+
777
+
let create ~sw ?(num_pools=10) ?(headers=Cohttp.Header.init ())
778
+
?(retries=Retry.default) ?(timeout=Timeout.default)
779
+
?(pool_config=ConnectionPool.default_config) ?tls_config ?cache net =
780
+
let cache = Option.map Cache.create cache in
781
+
{ sw; net; pools = Hashtbl.create num_pools; num_pools;
782
+
headers; retries; timeout; pool_config; tls_config; cache }
783
+
784
+
let get_pool t ~scheme ~host ~port =
785
+
let key = Printf.sprintf "%s://%s:%d" scheme host port in
786
+
match Hashtbl.find_opt t.pools key with
787
+
| Some pool -> pool
788
+
| None ->
789
+
let pool = ConnectionPool.create ~sw:t.sw ~config:t.pool_config
790
+
?tls_config:t.tls_config ~scheme ~host ~port t.net in
791
+
Hashtbl.add t.pools key pool;
792
+
pool
793
+
794
+
let urlopen ~sw t ~method_ ~url ?body ?headers ?(retries=t.retries)
795
+
?(timeout=t.timeout) ?(redirect=true) ?(assert_same_host=false)
796
+
?(preload_content=true) ?(decode_content=true) ?chunk_size () =
797
+
798
+
(* Check cache first *)
799
+
let cached_response =
800
+
match t.cache with
801
+
| Some cache ->
802
+
Cache.get cache ~method_ ~url
803
+
~headers:(Option.value headers ~default:t.headers)
804
+
| None -> None
805
+
in
806
+
807
+
match cached_response with
808
+
| Some response -> response
809
+
| None ->
810
+
let scheme = Uri.scheme url |> Option.value ~default:"http" in
811
+
let host = Uri.host url |> Option.value ~default:"localhost" in
812
+
let port = Uri.port url |> Option.value ~default:
813
+
(if scheme = "https" then 443 else 80) in
814
+
815
+
let pool = get_pool t ~scheme ~host ~port in
816
+
let conn = ConnectionPool.get_connection ~sw pool in
817
+
818
+
let headers =
819
+
match headers with
820
+
| Some h -> Cohttp.Header.fold (fun k v acc ->
821
+
Cohttp.Header.add acc k v) h t.headers
822
+
| None -> t.headers
823
+
in
824
+
825
+
let create_client = fun ?tls_config ?default_headers net ->
826
+
{ net; tls_config = Option.value ~default:(Tls.default ()) tls_config;
827
+
default_headers = Option.value ~default:(Cohttp.Header.init ()) default_headers }
828
+
in
829
+
let req_client = create_client ?tls_config:t.tls_config ~default_headers:t.headers t.net in
830
+
let config = Config.create ~headers ~follow_redirects:redirect () in
831
+
let response = request ~sw req_client ~config ?body ~meth:method_ url in
832
+
833
+
(match t.cache with
834
+
| Some cache -> Cache.put cache ~method_ ~url ~response
835
+
| None -> ());
836
+
837
+
ConnectionPool.put_connection pool conn;
838
+
response
839
+
840
+
let request ~sw t ~method_ ~url ?body ?headers () =
841
+
urlopen ~sw t ~method_ ~url ?body ?headers ()
842
+
843
+
let clear t =
844
+
Hashtbl.iter (fun _ pool -> ConnectionPool.clear pool) t.pools;
845
+
Hashtbl.clear t.pools
846
+
847
+
let connection_pool_stats t =
848
+
Hashtbl.fold (fun key pool acc -> (key, pool) :: acc) t.pools []
849
+
end
850
+
851
+
(* File Post *)
852
+
module FilePost = struct
853
+
type field =
854
+
| Text of { name : string; data : string }
855
+
| File of {
856
+
name : string;
857
+
filename : string option;
858
+
data : Flow.source_ty Eio.Resource.t;
859
+
content_type : string option;
860
+
}
861
+
862
+
let choose_boundary () =
863
+
Printf.sprintf "----OCamlBoundary%08x%08x"
864
+
(Random.int 0x7FFFFFFF) (Random.int 0x7FFFFFFF)
865
+
866
+
let encode_multipart_formdata ~fields ~boundary =
867
+
let boundary = Option.value boundary ~default:(choose_boundary ()) in
868
+
let content_type = Printf.sprintf "multipart/form-data; boundary=%s" boundary in
869
+
(content_type, (Flow.string_source "" :> Flow.source_ty Eio.Resource.t))
870
+
end
871
+
872
+
(* Progress tracking *)
873
+
module Progress = struct
874
+
type t = {
875
+
total : int64 option;
876
+
desc : string option;
877
+
unit_ : string;
878
+
width : int;
879
+
mutable current : int64;
880
+
}
881
+
882
+
let create ?total ?desc ?(unit="B") ?(width=40) () =
883
+
{ total; desc; unit_=unit; width; current = 0L }
884
+
885
+
let update t amount =
886
+
t.current <- Int64.add t.current amount;
887
+
Log.info (fun m -> m "Progress: %Ld %s" t.current t.unit_)
888
+
889
+
let finish t =
890
+
Log.info (fun m -> m "Progress complete: %Ld %s" t.current t.unit_)
891
+
892
+
let track_source ~sw t source = source
893
+
let track_response t response f = f ~chunk:(Response.body response)
894
+
end
895
+
896
+
(* Utilities *)
897
+
module Util = struct
898
+
let make_headers ?keep_alive ?accept_encoding ?user_agent
899
+
?basic_auth ?proxy_basic_auth ?disable_cache () =
900
+
let h = Cohttp.Header.init () in
901
+
let h = match user_agent with
902
+
| Some ua -> Cohttp.Header.add h "User-Agent" ua
903
+
| None -> Cohttp.Header.add h "User-Agent" "OCaml-Requests/1.0"
904
+
in
905
+
let h = match accept_encoding with
906
+
| Some enc -> Cohttp.Header.add h "Accept-Encoding" (String.concat ", " enc)
907
+
| None -> h
908
+
in
909
+
let h = match basic_auth with
910
+
| Some (user, pass) ->
911
+
let encoded = Base64.encode_string (Printf.sprintf "%s:%s" user pass) in
912
+
Cohttp.Header.add h "Authorization" (Printf.sprintf "Basic %s" encoded)
913
+
| None -> h
914
+
in
915
+
h
916
+
917
+
let parse_url url = Uri.of_string url
918
+
919
+
let getproxies_environment () =
920
+
let vars = ["http_proxy"; "https_proxy"; "ftp_proxy"; "no_proxy"] in
921
+
List.filter_map (fun var ->
922
+
match Sys.getenv_opt var with
923
+
| Some value -> Some (var, value)
924
+
| None -> None
925
+
) vars
926
+
927
+
let proxy_bypass_environment host =
928
+
match Sys.getenv_opt "no_proxy" with
929
+
| Some no_proxy ->
930
+
let hosts = String.split_on_char ',' no_proxy |> List.map String.trim in
931
+
List.exists (fun h -> h = host || String.ends_with ~suffix:h host) hosts
932
+
| None -> false
933
+
934
+
let urlencode ?(safe="") params =
935
+
params
936
+
|> List.map (fun (k, v) ->
937
+
Printf.sprintf "%s=%s" (Uri.pct_encode k) (Uri.pct_encode v))
938
+
|> String.concat "&"
939
+
940
+
let current_time () = Unix.gettimeofday ()
941
+
let parse_retry_after header = try Some (float_of_string header) with _ -> None
942
+
end
943
+
944
+
(* Streaming support *)
945
+
module Stream = struct
946
+
let upload ~sw t ?config ?(chunk_size=8192) ~meth uri ~body =
947
+
Log.debug (fun m -> m "Streaming upload to %s" (Uri.to_string uri));
948
+
let config = Option.value config ~default:Config.default in
949
+
let headers = Config.(config.headers) in
950
+
let headers = Cohttp.Header.add headers "Transfer-Encoding" "chunked" in
951
+
let config = { config with Config.headers } in
952
+
953
+
(* Use the regular request but with streaming body *)
954
+
request ~sw t ~config ~meth uri
955
+
956
+
let download ~sw t ?config ?(chunk_size=8192) uri ~sink =
957
+
Log.debug (fun m -> m "Streaming download from %s" (Uri.to_string uri));
958
+
let response = get ~sw t ?config uri in
959
+
(* Write response body to sink *)
960
+
Flow.copy_string (Response.body response) sink
961
+
962
+
let iter_response ?(chunk_size=8192) response ~f =
963
+
let body = Response.body response in
964
+
let rec iter pos =
965
+
if pos < String.length body then
966
+
let len = min chunk_size (String.length body - pos) in
967
+
let chunk = String.sub body pos len in
968
+
f chunk;
969
+
iter (pos + len)
970
+
in
971
+
iter 0
972
+
973
+
let lines ?(chunk_size=8192) ?(keep_ends=false) response =
974
+
let body = Response.body response in
975
+
let lines = String.split_on_char '\n' body in
976
+
let lines =
977
+
if keep_ends then
978
+
List.map (fun l -> l ^ "\n") lines
979
+
else lines
980
+
in
981
+
List.to_seq lines
982
+
983
+
let json_stream ?(chunk_size=8192) response =
984
+
lines ~chunk_size response
985
+
|> Seq.filter (fun line -> String.trim line <> "")
986
+
|> Seq.map (fun line ->
987
+
try Yojson.Safe.from_string line
988
+
with e ->
989
+
Log.warn (fun m -> m "Failed to parse JSON line: %s" line);
990
+
`Null)
991
+
end
992
+
993
+
(* Global defaults *)
994
+
module Defaults = struct
995
+
let user_agent = ref "OCaml-Requests/1.0"
996
+
let socket_timeout = ref None
997
+
let retry = ref Retry.default
998
+
let pool_maxsize = ref 10
999
+
end
1000
+
1001
+
(* Additional exceptions *)
1002
+
exception MaxRetryError of { url : Uri.t; reason : string }
1003
+
exception PoolError of string
1004
+
exception Pool_exhausted
+575
requests/lib/requests.mli
+575
requests/lib/requests.mli
···
1
+
(** HTTP(S) client library with clean Eio-style API, connection pooling, and urllib3-like features *)
2
+
3
+
open Eio
4
+
5
+
(** Error types *)
6
+
type error =
7
+
| Http_error of { status : Cohttp.Code.status_code; body : string; headers : Cohttp.Header.t }
8
+
| Connection_error of string
9
+
| Timeout_error
10
+
| Too_many_redirects
11
+
| Max_retry_error of { url : Uri.t; reason : string }
12
+
| Pool_exhausted
13
+
| Pool_error of string
14
+
| Proxy_error of string
15
+
| Protocol_error of string
16
+
| Header_parsing_error of string
17
+
| Certificate_verification_error of string
18
+
19
+
val pp_error : Format.formatter -> error -> unit
20
+
21
+
exception Request_error of error
22
+
23
+
(** Logging support *)
24
+
val log_src : Logs.Src.t
25
+
26
+
(** HTTP methods *)
27
+
type meth = [
28
+
| `GET
29
+
| `POST
30
+
| `PUT
31
+
| `DELETE
32
+
| `HEAD
33
+
| `OPTIONS
34
+
| `PATCH
35
+
]
36
+
37
+
(** Response type *)
38
+
module Response : sig
39
+
type t
40
+
41
+
val status : t -> Cohttp.Code.status_code
42
+
val headers : t -> Cohttp.Header.t
43
+
val body : t -> string
44
+
val body_stream : t -> Buf_read.t
45
+
val is_success : t -> bool
46
+
val is_redirect : t -> bool
47
+
val is_client_error : t -> bool
48
+
val is_server_error : t -> bool
49
+
end
50
+
51
+
(** Authentication mechanisms *)
52
+
module Auth : sig
53
+
type t
54
+
55
+
val none : t
56
+
(** No authentication *)
57
+
58
+
val basic : username:string -> password:string -> t
59
+
(** HTTP Basic authentication *)
60
+
61
+
val digest :
62
+
username:string ->
63
+
password:string ->
64
+
t
65
+
(** HTTP Digest authentication (RFC 2617) *)
66
+
67
+
val bearer : token:string -> t
68
+
(** Bearer token authentication (OAuth 2.0) *)
69
+
70
+
val oauth1 :
71
+
consumer_key:string ->
72
+
consumer_secret:string ->
73
+
?token:string ->
74
+
?token_secret:string ->
75
+
?signature_method:[`HMAC_SHA1 | `HMAC_SHA256 | `PLAINTEXT] ->
76
+
unit -> t
77
+
(** OAuth 1.0a authentication *)
78
+
79
+
val oauth2 :
80
+
?client_id:string ->
81
+
?client_secret:string ->
82
+
?token_type:string ->
83
+
access_token:string ->
84
+
unit -> t
85
+
(** OAuth 2.0 authentication *)
86
+
87
+
val custom : (meth -> Uri.t -> Cohttp.Header.t -> Cohttp.Header.t) -> t
88
+
(** Custom authentication handler *)
89
+
90
+
val apply : t -> meth -> Uri.t -> Cohttp.Header.t -> Cohttp.Header.t
91
+
(** Apply authentication to headers *)
92
+
end
93
+
94
+
(** Request configuration *)
95
+
module Config : sig
96
+
type t
97
+
98
+
val create :
99
+
?headers:Cohttp.Header.t ->
100
+
?timeout:float ->
101
+
?follow_redirects:bool ->
102
+
?max_redirects:int ->
103
+
?verify_tls:bool ->
104
+
?auth:Auth.t ->
105
+
unit -> t
106
+
107
+
val default : t
108
+
109
+
val with_headers : t -> Cohttp.Header.t -> t
110
+
val add_header : string -> string -> t -> t
111
+
val with_timeout : t -> float -> t
112
+
val with_follow_redirects : t -> bool -> t
113
+
val with_max_redirects : t -> int -> t
114
+
val with_verify_tls : t -> bool -> t
115
+
end
116
+
117
+
(** TLS configuration *)
118
+
module Tls : sig
119
+
type config
120
+
121
+
val default : unit -> config
122
+
(** Create default TLS config with system CA certificates *)
123
+
124
+
val with_ca_certs : X509.Authenticator.t -> config
125
+
(** Create TLS config with custom CA certificates *)
126
+
127
+
val with_custom : Tls.Config.client -> config
128
+
(** Use a fully custom TLS configuration *)
129
+
130
+
val insecure : unit -> config
131
+
(** Create an insecure TLS config (no certificate verification) *)
132
+
end
133
+
134
+
(** Client type *)
135
+
type 'a t constraint 'a = [> `Generic] Net.ty
136
+
137
+
(** Create a new HTTP client *)
138
+
val create :
139
+
?tls_config:Tls.config ->
140
+
?default_headers:Cohttp.Header.t ->
141
+
'a Net.t ->
142
+
'a t
143
+
144
+
(** Perform a request *)
145
+
val request :
146
+
sw:Switch.t ->
147
+
'a t ->
148
+
?config:Config.t ->
149
+
?body:string ->
150
+
meth:meth ->
151
+
Uri.t ->
152
+
Response.t
153
+
154
+
(** Convenience methods *)
155
+
val get :
156
+
sw:Switch.t ->
157
+
'a t ->
158
+
?config:Config.t ->
159
+
Uri.t ->
160
+
Response.t
161
+
162
+
val post :
163
+
sw:Switch.t ->
164
+
'a t ->
165
+
?config:Config.t ->
166
+
?body:string ->
167
+
Uri.t ->
168
+
Response.t
169
+
170
+
val put :
171
+
sw:Switch.t ->
172
+
'a t ->
173
+
?config:Config.t ->
174
+
?body:string ->
175
+
Uri.t ->
176
+
Response.t
177
+
178
+
val delete :
179
+
sw:Switch.t ->
180
+
'a t ->
181
+
?config:Config.t ->
182
+
Uri.t ->
183
+
Response.t
184
+
185
+
val head :
186
+
sw:Switch.t ->
187
+
'a t ->
188
+
?config:Config.t ->
189
+
Uri.t ->
190
+
Response.t
191
+
192
+
val patch :
193
+
sw:Switch.t ->
194
+
'a t ->
195
+
?config:Config.t ->
196
+
?body:string ->
197
+
Uri.t ->
198
+
Response.t
199
+
200
+
(** JSON helpers *)
201
+
module Json : sig
202
+
val get :
203
+
sw:Switch.t ->
204
+
'a t ->
205
+
?config:Config.t ->
206
+
Uri.t ->
207
+
Yojson.Safe.t
208
+
209
+
val post :
210
+
sw:Switch.t ->
211
+
'a t ->
212
+
?config:Config.t ->
213
+
Yojson.Safe.t ->
214
+
Uri.t ->
215
+
Yojson.Safe.t
216
+
217
+
val put :
218
+
sw:Switch.t ->
219
+
'a t ->
220
+
?config:Config.t ->
221
+
Yojson.Safe.t ->
222
+
Uri.t ->
223
+
Yojson.Safe.t
224
+
end
225
+
226
+
(** Form data helpers *)
227
+
module Form : sig
228
+
type t = (string * string list) list
229
+
230
+
val encode : t -> string
231
+
end
232
+
233
+
(** Submit form data *)
234
+
val post_form :
235
+
sw:Switch.t ->
236
+
'a t ->
237
+
?config:Config.t ->
238
+
form:Form.t ->
239
+
Uri.t ->
240
+
Response.t
241
+
242
+
(** Session management for cookies and persistent connections *)
243
+
module Session : sig
244
+
type 'a t constraint 'a = [> `Generic] Net.ty
245
+
246
+
val create :
247
+
?tls_config:Tls.config ->
248
+
?default_headers:Cohttp.Header.t ->
249
+
'a Net.t ->
250
+
'a t
251
+
252
+
val get :
253
+
sw:Switch.t ->
254
+
'a t ->
255
+
?config:Config.t ->
256
+
Uri.t ->
257
+
Response.t
258
+
259
+
val post :
260
+
sw:Switch.t ->
261
+
'a t ->
262
+
?config:Config.t ->
263
+
?body:string ->
264
+
Uri.t ->
265
+
Response.t
266
+
267
+
val cookies : 'a t -> (string * string) list
268
+
val clear_cookies : 'a t -> unit
269
+
end
270
+
271
+
272
+
(** Utility functions *)
273
+
val download_file :
274
+
sw:Switch.t ->
275
+
'a t ->
276
+
?config:Config.t ->
277
+
Uri.t ->
278
+
path:string ->
279
+
unit
280
+
281
+
val stream_response :
282
+
sw:Switch.t ->
283
+
'a t ->
284
+
?config:Config.t ->
285
+
Uri.t ->
286
+
(Buf_read.t -> unit) ->
287
+
unit
288
+
289
+
(** Per-host connection pooling *)
290
+
module ConnectionPool : sig
291
+
type t
292
+
293
+
type config = {
294
+
maxsize : int; (* Max connections per host (default: 10) *)
295
+
block : bool; (* Block when pool exhausted (default: false) *)
296
+
retries : int; (* Number of connection retries (default: 3) *)
297
+
timeout : float option; (* Socket timeout (default: None) *)
298
+
}
299
+
300
+
val default_config : config
301
+
302
+
val create :
303
+
sw:Switch.t ->
304
+
?config:config ->
305
+
?tls_config:Tls.config ->
306
+
scheme:string ->
307
+
host:string ->
308
+
port:int ->
309
+
_ Net.t ->
310
+
t
311
+
312
+
val get_connection : sw:Switch.t -> t -> Cohttp_eio.Client.t
313
+
val put_connection : t -> Cohttp_eio.Client.t -> unit
314
+
val num_connections : t -> int
315
+
val num_requests : t -> int
316
+
val clear : t -> unit
317
+
end
318
+
319
+
(** Retry configuration with automatic retries by default *)
320
+
module Retry : sig
321
+
type t
322
+
323
+
type backoff = {
324
+
factor : float; (* Backoff multiplier, default: 2.0 *)
325
+
jitter : float; (* Random jitter 0.0-1.0, default: 0.1 *)
326
+
max : float; (* Max backoff time in seconds, default: 120.0 *)
327
+
}
328
+
329
+
(** Default retry configuration (urllib3 defaults) *)
330
+
val default : t
331
+
332
+
val create :
333
+
?total:int ->
334
+
?connect:int option ->
335
+
?read:int option ->
336
+
?redirect:int option ->
337
+
?status:int option ->
338
+
?other:int option ->
339
+
?allowed_methods:meth list ->
340
+
?status_forcelist:int list ->
341
+
?backoff:backoff ->
342
+
?raise_on_redirect:bool ->
343
+
?raise_on_status:bool ->
344
+
?respect_retry_after:bool ->
345
+
?remove_headers_on_redirect:string list ->
346
+
unit -> t
347
+
348
+
val disabled : t
349
+
350
+
type history = {
351
+
method_ : meth;
352
+
url : Uri.t;
353
+
error : exn option;
354
+
status : int option;
355
+
redirect_location : string option;
356
+
}
357
+
358
+
val get_history : t -> history list
359
+
val increment : t -> method_:meth -> url:Uri.t -> ?response:Response.t -> ?error:exn -> unit -> t
360
+
val is_retry : t -> method_:meth -> status_code:int -> bool
361
+
val get_backoff_time : t -> float
362
+
val sleep : sw:Switch.t -> t -> Response.t option -> unit
363
+
end
364
+
365
+
(** Advanced timeout configuration *)
366
+
module Timeout : sig
367
+
type t
368
+
369
+
val default : t
370
+
val create : ?connect:float -> ?read:float -> ?total:float -> unit -> t
371
+
val from_float : float -> t
372
+
val none : t
373
+
val start_connect : t -> t
374
+
val get_connect_timeout : t -> float option
375
+
val get_read_timeout : t -> float option
376
+
val clone : t -> t
377
+
end
378
+
379
+
(** HTTP caching support *)
380
+
module Cache : sig
381
+
type 'a t constraint 'a = [> `Generic] Net.ty
382
+
383
+
type cache_control = {
384
+
no_cache : bool;
385
+
no_store : bool;
386
+
max_age : int option;
387
+
s_maxage : int option;
388
+
must_revalidate : bool;
389
+
public : bool;
390
+
private_ : bool;
391
+
immutable : bool;
392
+
}
393
+
394
+
val parse_cache_control : string -> cache_control
395
+
396
+
module Memory : sig
397
+
type storage
398
+
val create : max_size:int -> unit -> storage
399
+
end
400
+
401
+
module File : sig
402
+
type storage
403
+
val create : cache_dir:string -> max_size:int64 -> unit -> storage
404
+
end
405
+
406
+
type storage = [
407
+
| `Memory of Memory.storage
408
+
| `File of File.storage
409
+
]
410
+
411
+
val create : storage -> 'a t
412
+
val is_cacheable : method_:meth -> response:Response.t -> bool
413
+
val get : 'a t -> method_:meth -> url:Uri.t -> headers:Cohttp.Header.t -> Response.t option
414
+
val put : 'a t -> method_:meth -> url:Uri.t -> response:Response.t -> unit
415
+
val clear : 'a t -> unit
416
+
type stats = { hits : int; misses : int; size : int64; entries : int }
417
+
val stats : 'a t -> stats
418
+
end
419
+
420
+
(** Pool manager - manages multiple connection pools *)
421
+
module PoolManager : sig
422
+
type 'a t constraint 'a = [> `Generic] Net.ty
423
+
424
+
val create :
425
+
sw:Switch.t ->
426
+
?num_pools:int ->
427
+
?headers:Cohttp.Header.t ->
428
+
?retries:Retry.t ->
429
+
?timeout:Timeout.t ->
430
+
?pool_config:ConnectionPool.config ->
431
+
?tls_config:Tls.config ->
432
+
?cache:Cache.storage ->
433
+
'a Net.t ->
434
+
'a t
435
+
436
+
val urlopen :
437
+
sw:Switch.t ->
438
+
'a t ->
439
+
method_:meth ->
440
+
url:Uri.t ->
441
+
?body:string ->
442
+
?headers:Cohttp.Header.t ->
443
+
?retries:Retry.t ->
444
+
?timeout:Timeout.t ->
445
+
?redirect:bool ->
446
+
?assert_same_host:bool ->
447
+
?preload_content:bool ->
448
+
?decode_content:bool ->
449
+
?chunk_size:int ->
450
+
unit ->
451
+
Response.t
452
+
453
+
val request :
454
+
sw:Switch.t ->
455
+
'a t ->
456
+
method_:meth ->
457
+
url:Uri.t ->
458
+
?body:string ->
459
+
?headers:Cohttp.Header.t ->
460
+
unit ->
461
+
Response.t
462
+
463
+
val clear : 'a t -> unit
464
+
val connection_pool_stats : 'a t -> (string * ConnectionPool.t) list
465
+
end
466
+
467
+
(** File upload and multipart encoding *)
468
+
module FilePost : sig
469
+
type field =
470
+
| Text of { name : string; data : string }
471
+
| File of {
472
+
name : string;
473
+
filename : string option;
474
+
data : Flow.source_ty Eio.Resource.t;
475
+
content_type : string option;
476
+
}
477
+
478
+
val encode_multipart_formdata :
479
+
fields:field list ->
480
+
boundary:string option ->
481
+
(string * Flow.source_ty Eio.Resource.t)
482
+
483
+
val choose_boundary : unit -> string
484
+
end
485
+
486
+
487
+
(** Streaming support with Eio *)
488
+
module Stream : sig
489
+
val upload :
490
+
sw:Switch.t ->
491
+
'a t ->
492
+
?config:Config.t ->
493
+
?chunk_size:int ->
494
+
meth:meth ->
495
+
Uri.t ->
496
+
body:Flow.source_ty Flow.source ->
497
+
Response.t
498
+
(** Stream upload from an Eio Flow source *)
499
+
500
+
val download :
501
+
sw:Switch.t ->
502
+
'a t ->
503
+
?config:Config.t ->
504
+
?chunk_size:int ->
505
+
Uri.t ->
506
+
sink:Flow.sink_ty Flow.sink ->
507
+
unit
508
+
(** Stream download to an Eio Flow sink *)
509
+
510
+
val iter_response :
511
+
?chunk_size:int ->
512
+
Response.t ->
513
+
f:(string -> unit) ->
514
+
unit
515
+
(** Iterate over response body in chunks *)
516
+
517
+
val lines :
518
+
?chunk_size:int ->
519
+
?keep_ends:bool ->
520
+
Response.t ->
521
+
string Seq.t
522
+
(** Get response body as a sequence of lines *)
523
+
524
+
val json_stream :
525
+
?chunk_size:int ->
526
+
Response.t ->
527
+
Yojson.Safe.t Seq.t
528
+
(** Parse response as newline-delimited JSON stream *)
529
+
end
530
+
531
+
(** Progress tracking with Progress library *)
532
+
module Progress : sig
533
+
type t
534
+
535
+
val create :
536
+
?total:int64 ->
537
+
?desc:string ->
538
+
?unit:string ->
539
+
?width:int ->
540
+
unit -> t
541
+
542
+
val update : t -> int64 -> unit
543
+
val finish : t -> unit
544
+
val track_source : sw:Switch.t -> t -> Flow.source_ty Eio.Resource.t -> Flow.source_ty Eio.Resource.t
545
+
val track_response : t -> Response.t -> (chunk:string -> unit) -> unit
546
+
end
547
+
548
+
(** Additional utilities *)
549
+
module Util : sig
550
+
val make_headers :
551
+
?keep_alive:bool ->
552
+
?accept_encoding:string list ->
553
+
?user_agent:string ->
554
+
?basic_auth:(string * string) ->
555
+
?proxy_basic_auth:(string * string) ->
556
+
?disable_cache:bool ->
557
+
unit ->
558
+
Cohttp.Header.t
559
+
560
+
val parse_url : string -> Uri.t
561
+
val getproxies_environment : unit -> (string * string) list
562
+
val proxy_bypass_environment : string -> bool
563
+
val urlencode : ?safe:string -> (string * string) list -> string
564
+
val current_time : unit -> float
565
+
val parse_retry_after : string -> float option
566
+
end
567
+
568
+
(** Global defaults *)
569
+
module Defaults : sig
570
+
val user_agent : string ref
571
+
val socket_timeout : float option ref
572
+
val retry : Retry.t ref
573
+
val pool_maxsize : int ref
574
+
end
575
+
+37
requests/requests.opam
+37
requests/requests.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Clean Eio-style HTTPS client library for OCaml"
4
+
description:
5
+
"A modern HTTP(S) client library for OCaml with Eio support, providing a clean API for making web requests with automatic TLS/CA certificate handling"
6
+
maintainer: ["Your Name"]
7
+
authors: ["Your Name"]
8
+
license: "MIT"
9
+
homepage: "https://github.com/username/requests"
10
+
bug-reports: "https://github.com/username/requests/issues"
11
+
depends: [
12
+
"ocaml"
13
+
"dune" {>= "3.0" & >= "3.0"}
14
+
"eio"
15
+
"cohttp-eio"
16
+
"tls-eio"
17
+
"ca-certs"
18
+
"mirage-crypto-rng-eio"
19
+
"uri"
20
+
"yojson"
21
+
"odoc" {with-doc}
22
+
]
23
+
build: [
24
+
["dune" "subst"] {dev}
25
+
[
26
+
"dune"
27
+
"build"
28
+
"-p"
29
+
name
30
+
"-j"
31
+
jobs
32
+
"@install"
33
+
"@runtest" {with-test}
34
+
"@doc" {with-doc}
35
+
]
36
+
]
37
+
dev-repo: "git+https://github.com/username/requests.git"
+4
requests/test/dune
+4
requests/test/dune
+148
requests/test/test_requests.ml
+148
requests/test/test_requests.ml
···
1
+
open Eio
2
+
3
+
let test_basic_get env =
4
+
Switch.run @@ fun sw ->
5
+
let client = Requests.create env#net in
6
+
7
+
(* Test simple GET request *)
8
+
let uri = Uri.of_string "https://api.github.com" in
9
+
let response = Requests.get ~sw client uri in
10
+
11
+
Printf.printf "Status: %s\n" (Cohttp.Code.string_of_status (Requests.Response.status response));
12
+
Printf.printf "Headers: %s\n" (Cohttp.Header.to_string (Requests.Response.headers response));
13
+
Printf.printf "Body length: %d\n" (String.length (Requests.Response.body response));
14
+
15
+
assert (Requests.Response.is_success response)
16
+
17
+
let test_json_api env =
18
+
Switch.run @@ fun sw ->
19
+
let client = Requests.create env#net in
20
+
21
+
(* Test JSON API *)
22
+
let uri = Uri.of_string "https://api.github.com/users/ocaml" in
23
+
let json = Requests.Json.get ~sw client uri in
24
+
25
+
let open Yojson.Safe.Util in
26
+
let login = json |> member "login" |> to_string in
27
+
Printf.printf "User login: %s\n" login;
28
+
assert (login = "ocaml")
29
+
30
+
let test_custom_headers env =
31
+
Switch.run @@ fun sw ->
32
+
let client = Requests.create env#net in
33
+
34
+
(* Test with custom headers *)
35
+
let uri = Uri.of_string "https://api.github.com" in
36
+
let config =
37
+
Requests.Config.default
38
+
|> Requests.Config.add_header "User-Agent" "OCaml-Requests-Test"
39
+
|> Requests.Config.add_header "Accept" "application/vnd.github.v3+json"
40
+
in
41
+
42
+
let response = Requests.get ~sw client ~config uri in
43
+
assert (Requests.Response.is_success response)
44
+
45
+
let test_post_json env =
46
+
Switch.run @@ fun sw ->
47
+
let client = Requests.create env#net in
48
+
49
+
(* Test POST with JSON (to httpbin echo service) *)
50
+
let uri = Uri.of_string "https://httpbin.org/post" in
51
+
let json_data = `Assoc [
52
+
("test", `String "value");
53
+
("number", `Int 42);
54
+
] in
55
+
56
+
let response = Requests.Json.post ~sw client json_data uri in
57
+
58
+
let open Yojson.Safe.Util in
59
+
let posted_json = response |> member "json" in
60
+
let test_value = posted_json |> member "test" |> to_string in
61
+
62
+
Printf.printf "Posted test value: %s\n" test_value;
63
+
assert (test_value = "value")
64
+
65
+
let test_session_cookies env =
66
+
Switch.run @@ fun sw ->
67
+
let session = Requests.Session.create env#net in
68
+
69
+
(* Test session with cookies *)
70
+
let uri = Uri.of_string "https://httpbin.org/cookies/set?test=value" in
71
+
let _response = Requests.Session.get ~sw session uri in
72
+
73
+
let cookies = Requests.Session.cookies session in
74
+
Printf.printf "Cookies: %s\n"
75
+
(cookies |> List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) |> String.concat "; ");
76
+
77
+
(* Verify cookie was set *)
78
+
let uri2 = Uri.of_string "https://httpbin.org/cookies" in
79
+
let response = Requests.Session.get ~sw session uri2 in
80
+
let body = Requests.Response.body response in
81
+
Printf.printf "Cookies echo: %s\n" body;
82
+
83
+
assert (String.length body > 0)
84
+
85
+
let test_error_handling env =
86
+
Switch.run @@ fun sw ->
87
+
let client = Requests.create env#net in
88
+
89
+
(* Test 404 error *)
90
+
let uri = Uri.of_string "https://api.github.com/users/this-user-definitely-does-not-exist-12345" in
91
+
92
+
try
93
+
let _response = Requests.get ~sw client uri in
94
+
assert false (* Should not reach here *)
95
+
with
96
+
| Requests.Request_error (Requests.Http_error { status; _ }) ->
97
+
Printf.printf "Got expected error: %s\n" (Cohttp.Code.string_of_status status);
98
+
assert (status = `Not_found)
99
+
100
+
let test_tls_config env =
101
+
Switch.run @@ fun sw ->
102
+
103
+
(* Test with default TLS config *)
104
+
let client1 = Requests.create ~tls_config:(Requests.Tls.default ()) env#net in
105
+
let uri = Uri.of_string "https://api.github.com" in
106
+
let response1 = Requests.get ~sw client1 uri in
107
+
assert (Requests.Response.is_success response1);
108
+
109
+
(* Test with custom CA certs *)
110
+
let auth = Result.get_ok (Ca_certs.authenticator ()) in
111
+
let client2 = Requests.create ~tls_config:(Requests.Tls.with_ca_certs auth) env#net in
112
+
let response2 = Requests.get ~sw client2 uri in
113
+
assert (Requests.Response.is_success response2)
114
+
115
+
let () =
116
+
Eio_main.run @@ fun env ->
117
+
118
+
Printf.printf "Running requests library tests...\n\n";
119
+
120
+
Printf.printf "Test 1: Basic GET request\n";
121
+
test_basic_get env;
122
+
Printf.printf "✓ Passed\n\n";
123
+
124
+
Printf.printf "Test 2: JSON API\n";
125
+
test_json_api env;
126
+
Printf.printf "✓ Passed\n\n";
127
+
128
+
Printf.printf "Test 3: Custom headers\n";
129
+
test_custom_headers env;
130
+
Printf.printf "✓ Passed\n\n";
131
+
132
+
Printf.printf "Test 4: POST JSON\n";
133
+
test_post_json env;
134
+
Printf.printf "✓ Passed\n\n";
135
+
136
+
Printf.printf "Test 5: Session cookies\n";
137
+
test_session_cookies env;
138
+
Printf.printf "✓ Passed\n\n";
139
+
140
+
Printf.printf "Test 6: Error handling\n";
141
+
test_error_handling env;
142
+
Printf.printf "✓ Passed\n\n";
143
+
144
+
Printf.printf "Test 7: TLS configuration\n";
145
+
test_tls_config env;
146
+
Printf.printf "✓ Passed\n\n";
147
+
148
+
Printf.printf "All tests passed! ✨\n"