ocaml http/1, http/2 and websocket client and server library
release: v0.5.0 — full HTTP method support, request builder DSL bridge
Add PUT, PATCH, DELETE, HEAD, OPTIONS and generic request() to all
client layers (Client, H1_client, H2_client). Introduce Client.execute
to bridge the Http request builder DSL to actual client execution.
All convenience methods now accept per-request ~headers.
- Refactor H1_client/H2_client: extract generic request function,
build GET/POST and new methods as thin wrappers on top
- Add Client.execute for Http DSL -> client execution bridge
- Rename stateless one-shot API to get'/post' (pooled API is primary)
- Fix CLI (hc) to use real methods instead of falling back to GET/POST
- Add 25 new tests covering all methods, DSL execute, per-request
headers, custom methods, H1 low-level, and backward compat
- Update all documentation to reflect new API and DSL usage
- Bump version to 0.5.0, update CHANGELOG and opam
+1336
-278
+38
CHANGELOG.md
+38
CHANGELOG.md
···
5
5
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
6
6
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
7
7
8
+
## [0.5.0] - 2026-03-24
9
+
10
+
### Added
11
+
12
+
- **Full HTTP method support** in `Client`, `H1_client`, and `H2_client`:
13
+
`PUT`, `PATCH`, `DELETE`, `HEAD`, `OPTIONS`, and arbitrary custom methods
14
+
via the generic `request` function
15
+
- **Generic `request` function** at all client layers accepting any HTTP method,
16
+
optional body, and per-request headers
17
+
- **`Client.execute`**: Bridge between the `Http` request builder DSL and actual
18
+
client execution, enabling fluent API usage:
19
+
```ocaml
20
+
Http.post url |> Http.bearer token |> Http.body_json data |> Http.build
21
+
|> Client.execute client
22
+
```
23
+
- **Per-request headers** on all convenience methods (`get`, `post`, `put`, etc.)
24
+
via optional `~headers` parameter
25
+
- **25 new tests** (`test_client_methods`) covering all HTTP methods, the
26
+
`Client.execute` DSL bridge, `H1_client` low-level methods, per-request
27
+
headers, custom methods (e.g. `PURGE`), and backward compatibility
28
+
29
+
### Changed
30
+
31
+
- `Client.get` and `Client.post` now take a pooled client `t` as first argument
32
+
instead of `~sw ~net ~clock` (pooled API is now the primary interface)
33
+
- Stateless one-shot API moved to `Client.get'` and `Client.post'`
34
+
(backward-compatible via rename)
35
+
- `H1_client.get`, `H1_client.post` and `H2_client.get`, `H2_client.post`
36
+
refactored to thin wrappers around the new generic `request` function
37
+
- CLI (`hc`) now uses real HTTP methods for all `-X` values instead of
38
+
falling back to GET/POST
39
+
40
+
## [0.4.1] - 2026-02-15
41
+
42
+
### Fixed
43
+
44
+
- Minor stability improvements
45
+
8
46
## [0.4.0] - 2026-01-12
9
47
10
48
### Added
+5
-14
bin/hc.ml
+5
-14
bin/hc.ml
···
127
127
end;
128
128
129
129
(* Make request based on method *)
130
-
let result =
131
-
match (method_, data) with
132
-
| "GET", None -> Client.get ~sw ~net ~clock ~config url
133
-
| "HEAD", None -> Client.get ~sw ~net ~clock ~config url
134
-
| "POST", Some body -> Client.post ~sw ~net ~clock ~config url ~body
135
-
| "POST", None -> Client.post ~sw ~net ~clock ~config url ~body:""
136
-
| "PUT", Some body -> Client.post ~sw ~net ~clock ~config url ~body
137
-
| "PUT", None -> Client.post ~sw ~net ~clock ~config url ~body:""
138
-
| "DELETE", _ -> Client.get ~sw ~net ~clock ~config url
139
-
| "OPTIONS", _ -> Client.get ~sw ~net ~clock ~config url
140
-
| meth, _ ->
141
-
Printf.eprintf "Method %s not fully supported yet, using GET\n" meth;
142
-
Client.get ~sw ~net ~clock ~config url
143
-
in
130
+
let client = Client.create ~sw ~net ~clock ~config () in
131
+
let body = Option.value data ~default:"" in
132
+
let meth = Http.meth_of_string method_ in
133
+
let result = Client.request client meth ~body url in
134
+
Client.close client;
144
135
145
136
match result with
146
137
| Error err ->
+1
-1
docs/README.md
+1
-1
docs/README.md
···
25
25
26
26
Using HCS as an HTTP client:
27
27
28
-
- [Basic Requests](client/basic-requests.md) - GET, POST, headers, and bodies
28
+
- [Basic Requests](client/basic-requests.md) - All HTTP methods, request builder DSL, and per-request headers
29
29
- [HTTP/2](client/http2.md) - HTTP/2 multiplexing and server push
30
30
- [SSE Client](client/sse.md) - Consume Server-Sent Events streams
31
31
- [Connection Pooling](client/connection-pooling.md) - Reuse connections efficiently
+274
-33
docs/client/basic-requests.md
+274
-33
docs/client/basic-requests.md
···
1
1
# HTTP Client: Basic Requests
2
2
3
-
The HCS client provides a unified interface for HTTP/1.1 and HTTP/2 requests with connection pooling.
3
+
The HCS client provides a unified interface for HTTP/1.1 and HTTP/2 requests with connection pooling. All standard HTTP methods are supported, along with a request builder DSL for complex requests.
4
4
5
5
## Creating a Client
6
6
···
17
17
Client.close client
18
18
```
19
19
20
-
## GET Requests
20
+
## HTTP Methods
21
+
22
+
### GET
21
23
22
24
```ocaml
23
-
match Client.request client "https://example.com/api/users" with
25
+
match Client.get client "https://example.com/api/users" with
24
26
| Ok resp ->
25
27
Printf.printf "Status: %d\n" resp.status;
26
28
Printf.printf "Body: %s\n" resp.body
27
-
| Error err ->
28
-
Printf.printf "Error: %s\n" (error_to_string err)
29
+
| Error err -> handle_error err
30
+
```
31
+
32
+
### POST
33
+
34
+
```ocaml
35
+
let body = {|{"name": "Alice", "email": "alice@example.com"}|} in
36
+
match Client.post client "https://api.example.com/users" ~body with
37
+
| Ok resp -> Printf.printf "Created: %s\n" resp.body
38
+
| Error err -> handle_error err
39
+
```
40
+
41
+
### PUT
42
+
43
+
```ocaml
44
+
let body = {|{"name": "Alice Updated"}|} in
45
+
match Client.put client "https://api.example.com/users/1" ~body with
46
+
| Ok resp -> Printf.printf "Updated: %d\n" resp.status
47
+
| Error err -> handle_error err
48
+
```
49
+
50
+
### PATCH
51
+
52
+
```ocaml
53
+
let body = {|{"email": "new@example.com"}|} in
54
+
match Client.patch client "https://api.example.com/users/1" ~body with
55
+
| Ok resp -> Printf.printf "Patched: %d\n" resp.status
56
+
| Error err -> handle_error err
57
+
```
58
+
59
+
### DELETE
60
+
61
+
```ocaml
62
+
match Client.delete client "https://api.example.com/users/1" with
63
+
| Ok resp -> Printf.printf "Deleted: %d\n" resp.status
64
+
| Error err -> handle_error err
65
+
```
66
+
67
+
DELETE also accepts an optional body for APIs that require it:
68
+
69
+
```ocaml
70
+
Client.delete client ~body:{|{"reason":"spam"}|} "https://api.example.com/users/1"
29
71
```
30
72
31
-
One-shot GET (creates and closes client automatically):
73
+
### HEAD
32
74
33
75
```ocaml
34
-
match Client.get ~sw ~net ~clock "https://example.com/" with
76
+
match Client.head client "https://example.com/large-file.zip" with
77
+
| Ok resp ->
78
+
let size = List.assoc_opt "content-length" resp.headers in
79
+
Printf.printf "File size: %s\n" (Option.value size ~default:"unknown")
80
+
| Error err -> handle_error err
81
+
```
82
+
83
+
### OPTIONS
84
+
85
+
```ocaml
86
+
match Client.options client "https://api.example.com/users" with
87
+
| Ok resp ->
88
+
let allow = List.assoc_opt "allow" resp.headers in
89
+
Printf.printf "Allowed: %s\n" (Option.value allow ~default:"unknown")
90
+
| Error err -> handle_error err
91
+
```
92
+
93
+
### Generic Request
94
+
95
+
For any method, including custom ones, use `Client.request` with an `Http.meth` value:
96
+
97
+
```ocaml
98
+
(* Standard method *)
99
+
Client.request client Http.PATCH ~body:"data" "https://api.example.com/resource"
100
+
101
+
(* Custom method *)
102
+
Client.request client (Http.Other "PURGE") "https://cdn.example.com/cache/key"
103
+
```
104
+
105
+
## Per-Request Headers
106
+
107
+
All methods accept an optional `~headers` parameter for request-specific headers. These are merged with default headers from the client configuration:
108
+
109
+
```ocaml
110
+
let headers = [
111
+
("Authorization", "Bearer tok-123");
112
+
("Accept", "application/json");
113
+
("X-Request-Id", "req-001");
114
+
] in
115
+
match Client.get client ~headers "https://api.example.com/me" with
35
116
| Ok resp -> Printf.printf "%s\n" resp.body
36
-
| Error _ -> print_endline "Request failed"
117
+
| Error _ -> ()
118
+
```
119
+
120
+
```ocaml
121
+
let headers = [("Content-Type", "application/json")] in
122
+
Client.post client ~headers "https://api.example.com/data"
123
+
~body:{|{"key":"value"}|}
37
124
```
38
125
39
-
## POST Requests
126
+
## Request Builder DSL
127
+
128
+
For complex requests with authentication, query parameters, and structured bodies, use the `Http` module builder and `Client.execute`:
129
+
130
+
### Basic Usage
40
131
41
132
```ocaml
42
-
let body = {|{"name": "Alice", "email": "alice@example.com"}|} in
43
-
match Client.request_post client "https://api.example.com/users" ~body with
44
-
| Ok resp -> Printf.printf "Created: %s\n" resp.body
133
+
open Http
134
+
135
+
let req =
136
+
post "https://api.example.com/users"
137
+
|> bearer "my-token"
138
+
|> body_json {|{"name":"Alice"}|}
139
+
|> build
140
+
141
+
match Client.execute client req with
142
+
| Ok resp -> Printf.printf "Created: %d\n" resp.status
45
143
| Error err -> handle_error err
46
144
```
47
145
48
-
One-shot POST:
146
+
### Headers and Authentication
147
+
148
+
```ocaml
149
+
open Http
150
+
151
+
(* Bearer token *)
152
+
let req = get url |> bearer "tok-123" |> build
153
+
154
+
(* Basic auth *)
155
+
let req = get url |> basic_auth ~user:"admin" ~pass:"secret" |> build
156
+
157
+
(* Custom headers *)
158
+
let req =
159
+
get url
160
+
|> header "X-API-Key" "abc"
161
+
|> header "X-Trace-Id" "trace-001"
162
+
|> accept "application/json"
163
+
|> user_agent "MyApp/1.0"
164
+
|> build
165
+
```
166
+
167
+
### Query Parameters
168
+
169
+
```ocaml
170
+
open Http
171
+
172
+
let req =
173
+
get "https://api.example.com/search"
174
+
|> query "q" "ocaml http"
175
+
|> query "limit" "10"
176
+
|> query "offset" "0"
177
+
|> build
178
+
(* URL becomes: https://api.example.com/search?q=ocaml+http&limit=10&offset=0 *)
179
+
```
180
+
181
+
### Body Types
182
+
183
+
```ocaml
184
+
open Http
185
+
186
+
(* JSON body *)
187
+
let req =
188
+
post url
189
+
|> body_json {|{"name":"Alice","age":30}|}
190
+
|> build
191
+
(* Sets Content-Type: application/json automatically *)
192
+
193
+
(* Plain string body *)
194
+
let req =
195
+
put url
196
+
|> body_string ~content_type:"text/plain" "Hello, World!"
197
+
|> build
198
+
199
+
(* Form-encoded body *)
200
+
let req =
201
+
post url
202
+
|> form [("username", "alice"); ("password", "secret")]
203
+
|> build
204
+
(* Sets Content-Type: application/x-www-form-urlencoded automatically *)
205
+
```
206
+
207
+
### Cookies
208
+
209
+
```ocaml
210
+
open Http
211
+
212
+
let req =
213
+
get "https://example.com/dashboard"
214
+
|> cookie "session" "abc123"
215
+
|> cookie "theme" "dark"
216
+
|> build
217
+
```
218
+
219
+
### All HTTP Methods
220
+
221
+
The builder supports all standard methods plus custom ones:
222
+
223
+
```ocaml
224
+
open Http
225
+
226
+
let _ = get url |> build
227
+
let _ = post url |> body_json data |> build
228
+
let _ = put url |> body_string content |> build
229
+
let _ = patch url |> body_json partial |> build
230
+
let _ = delete url |> build
231
+
let _ = head url |> build
232
+
let _ = options url |> build
233
+
234
+
(* Custom method *)
235
+
let _ = create (Other "PURGE") url |> build
236
+
```
237
+
238
+
### Complete REST API Example
239
+
240
+
```ocaml
241
+
open Http
242
+
243
+
(* Helper to add common auth *)
244
+
let with_auth b = b |> bearer "my-token" |> accept "application/json"
245
+
246
+
(* List resources *)
247
+
let list_users client =
248
+
let req = get "https://api.example.com/users" |> with_auth |> build in
249
+
Client.execute client req
250
+
251
+
(* Create a resource *)
252
+
let create_user client name email =
253
+
let body = Printf.sprintf {|{"name":"%s","email":"%s"}|} name email in
254
+
let req = post "https://api.example.com/users" |> with_auth |> body_json body |> build in
255
+
Client.execute client req
256
+
257
+
(* Update a resource *)
258
+
let update_user client id name =
259
+
let body = Printf.sprintf {|{"name":"%s"}|} name in
260
+
let url = Printf.sprintf "https://api.example.com/users/%d" id in
261
+
let req = patch url |> with_auth |> body_json body |> build in
262
+
Client.execute client req
263
+
264
+
(* Delete a resource *)
265
+
let delete_user client id =
266
+
let url = Printf.sprintf "https://api.example.com/users/%d" id in
267
+
let req = delete url |> with_auth |> build in
268
+
Client.execute client req
269
+
```
270
+
271
+
## One-Shot Convenience API
272
+
273
+
For simple scripts or one-off requests where you don't need connection pooling, use the stateless `get'` and `post'` functions:
49
274
50
275
```ocaml
51
-
Client.post ~sw ~net ~clock
52
-
"https://api.example.com/users"
276
+
(* One-shot GET *)
277
+
match Client.get' ~sw ~net ~clock "https://example.com/" with
278
+
| Ok resp -> Printf.printf "%s\n" resp.body
279
+
| Error _ -> print_endline "Request failed"
280
+
281
+
(* One-shot POST *)
282
+
Client.post' ~sw ~net ~clock
283
+
"https://api.example.com/users"
53
284
~body:{|{"name": "Bob"}|}
285
+
286
+
(* One-shot GET with config *)
287
+
let config = Client.default_config |> Client.with_http2 in
288
+
Client.get' ~sw ~net ~clock ~config "https://example.com/"
54
289
```
55
290
56
-
### Large Request Bodies
291
+
These create a temporary client for each request, so they don't benefit from connection pooling. For multiple requests, use a persistent client instead.
292
+
293
+
## Large Request Bodies
57
294
58
295
Both HTTP/1.1 and HTTP/2 handle large request bodies correctly. No special configuration is needed for multi-megabyte uploads:
59
296
60
297
```ocaml
61
-
(* Upload a large JSON payload *)
62
298
let large_body = generate_report () (* Could be several MB *)
63
-
match Client.request_post client url ~body:large_body with
299
+
match Client.post client url ~body:large_body with
64
300
| Ok resp -> Printf.printf "Uploaded successfully\n"
65
301
| Error _ -> ()
66
302
```
67
303
68
-
For HTTP/2, flow control is handled automatically—the client respects the server's flow control window and waits for `WINDOW_UPDATE` frames as needed.
304
+
For HTTP/2, flow control is handled automatically -- the client respects the server's flow control window and waits for `WINDOW_UPDATE` frames as needed.
69
305
70
306
## Configuration
71
307
72
308
Customize client behavior with config modifiers:
73
309
74
310
```ocaml
75
-
let config =
311
+
let config =
76
312
Client.default_config
77
313
|> Client.with_timeout 10.0
78
314
|> Client.with_redirects 5
···
93
329
| `without_redirects` | - | Don't follow redirects |
94
330
| `with_buffer_size` | 16384 | Buffer size in bytes |
95
331
| `with_max_response_body` | None | Max response body size |
96
-
| `with_default_header` | - | Add default header |
332
+
| `with_default_header` | - | Add default header to all requests |
97
333
| `with_default_headers` | - | Add multiple default headers |
98
334
| `with_insecure_tls` | false | Skip TLS verification |
335
+
| `with_http2` | - | Prefer HTTP/2 with h2 ALPN |
336
+
| `with_http11` | - | Prefer HTTP/1.1 |
337
+
| `with_max_connections` | 10 | Per-host connection pool size |
99
338
100
339
## Response Structure
101
340
···
111
350
Accessing response data:
112
351
113
352
```ocaml
114
-
match Client.request client url with
353
+
match Client.get client url with
115
354
| Ok resp ->
116
-
let content_type =
117
-
List.assoc_opt "content-type"
355
+
let content_type =
356
+
List.assoc_opt "content-type"
118
357
(List.map (fun (k, v) -> (String.lowercase_ascii k, v)) resp.headers)
119
358
in
120
-
Printf.printf "Protocol: %s\n"
359
+
Printf.printf "Protocol: %s\n"
121
360
(if resp.protocol = HTTP_2 then "HTTP/2" else "HTTP/1.1");
122
-
Printf.printf "Content-Type: %s\n"
361
+
Printf.printf "Content-Type: %s\n"
123
362
(Option.value ~default:"unknown" content_type)
124
363
| Error _ -> ()
125
364
```
···
152
391
153
392
## Multiple Requests
154
393
155
-
Reuse a client for multiple requests:
394
+
Reuse a client for multiple requests with connection pooling:
156
395
157
396
```ocaml
158
397
let client = Client.create ~sw ~net ~clock () in
···
163
402
"https://api.example.com/comments";
164
403
] in
165
404
166
-
let results = List.map (Client.request client) urls in
405
+
let results = List.map (Client.get client) urls in
167
406
168
407
Client.close client;
169
408
results
···
177
416
let client = Client.create ~sw ~net ~clock () in
178
417
179
418
let results = Eio.Fiber.List.map (fun url ->
180
-
Client.request client url
419
+
Client.get client url
181
420
) urls in
182
421
183
422
Client.close client
184
423
```
185
424
186
-
## Headers
425
+
## Default Headers
187
426
188
-
Set custom headers via config:
427
+
Set headers applied to every request via config:
189
428
190
429
```ocaml
191
-
let config =
430
+
let config =
192
431
Client.default_config
193
432
|> Client.with_default_headers [
194
433
("Authorization", "Bearer token");
···
199
438
let client = Client.create ~sw ~net ~clock ~config ()
200
439
```
201
440
441
+
Per-request headers override default headers with the same name.
442
+
202
443
## Timeouts
203
444
204
445
Configure different timeout values:
205
446
206
447
```ocaml
207
-
let config =
448
+
let config =
208
449
Client.default_config
209
450
|> Client.with_connect_timeout 5.0 (* 5s to connect *)
210
451
|> Client.with_read_timeout 60.0 (* 60s to read response *)
+3
-3
docs/client/connection-pooling.md
+3
-3
docs/client/connection-pooling.md
···
10
10
let client = Client.create ~sw ~net ~clock () in
11
11
12
12
(* These requests reuse connections when possible *)
13
-
let _ = Client.request client "https://api.example.com/users" in
14
-
let _ = Client.request client "https://api.example.com/posts" in
15
-
let _ = Client.request client "https://api.example.com/comments" in
13
+
let _ = Client.get client "https://api.example.com/users" in
14
+
let _ = Client.get client "https://api.example.com/posts" in
15
+
let _ = Client.get client "https://api.example.com/comments" in
16
16
17
17
Client.close client
18
18
```
+36
-10
docs/client/http2.md
+36
-10
docs/client/http2.md
···
51
51
let client = Client.create ~sw ~net ~clock ~config () in
52
52
53
53
(* This uses h2c *)
54
-
match Client.request client "http://localhost:8080/api" with
54
+
match Client.get client "http://localhost:8080/api" with
55
55
| Ok resp -> Printf.printf "Status: %d\n" resp.status
56
56
| Error _ -> ()
57
57
```
···
59
59
## Checking Protocol Used
60
60
61
61
```ocaml
62
-
match Client.request client url with
62
+
match Client.get client url with
63
63
| Ok resp ->
64
64
(match resp.protocol with
65
65
| Client.HTTP_1_1 -> print_endline "Used HTTP/1.1"
···
67
67
| Error _ -> ()
68
68
```
69
69
70
-
## POST Requests
70
+
## All HTTP Methods
71
71
72
-
POST requests work the same as HTTP/1.1:
72
+
All methods work identically over HTTP/2 as they do over HTTP/1.1:
73
73
74
74
```ocaml
75
75
let config = Client.default_config |> Client.with_http2 in
76
76
let client = Client.create ~sw ~net ~clock ~config () in
77
77
78
+
(* POST *)
78
79
let body = {|{"name": "Alice", "email": "alice@example.com"}|} in
79
-
match Client.request_post client "https://api.example.com/users" ~body with
80
+
let _ = Client.post client "https://api.example.com/users" ~body in
81
+
82
+
(* PUT *)
83
+
let _ = Client.put client "https://api.example.com/users/1" ~body in
84
+
85
+
(* PATCH *)
86
+
let _ = Client.patch client "https://api.example.com/users/1" ~body:{|{"name":"Bob"}|} in
87
+
88
+
(* DELETE *)
89
+
let _ = Client.delete client "https://api.example.com/users/1" in
90
+
91
+
Client.close client
92
+
```
93
+
94
+
The request builder DSL also works seamlessly with HTTP/2:
95
+
96
+
```ocaml
97
+
open Http
98
+
99
+
let req =
100
+
post "https://api.example.com/users"
101
+
|> bearer "my-token"
102
+
|> body_json {|{"name":"Alice"}|}
103
+
|> build
104
+
105
+
match Client.execute client req with
80
106
| Ok resp -> Printf.printf "Created: %s\n" resp.body
81
107
| Error err -> handle_error err
82
108
```
83
109
84
110
### Large Request Bodies
85
111
86
-
HTTP/2 handles large request bodies (multi-megabyte uploads) correctly. Flow control is managed automatically—the client sends data up to the flow control window, waits for `WINDOW_UPDATE` frames from the server, then continues.
112
+
HTTP/2 handles large request bodies (multi-megabyte uploads) correctly. Flow control is managed automatically -- the client sends data up to the flow control window, waits for `WINDOW_UPDATE` frames from the server, then continues.
87
113
88
114
```ocaml
89
115
(* Upload a large file *)
90
116
let large_body = load_file "data.json" in (* Could be several MB *)
91
-
match Client.request_post client url ~body:large_body with
117
+
match Client.post client url ~body:large_body with
92
118
| Ok resp -> Printf.printf "Uploaded %d bytes\n" (String.length large_body)
93
119
| Error _ -> ()
94
120
```
···
114
140
115
141
(* All requests multiplex over the same connection *)
116
142
let results = Eio.Fiber.List.map (fun url ->
117
-
Client.request client url
143
+
Client.get client url
118
144
) urls in
119
145
120
146
Client.close client
···
126
152
let benchmark ~config name urls =
127
153
let start = Eio.Time.now clock in
128
154
let client = Client.create ~sw ~net ~clock ~config () in
129
-
let _ = Eio.Fiber.List.map (Client.request client) urls in
155
+
let _ = Eio.Fiber.List.map (Client.get client) urls in
130
156
Client.close client;
131
157
let elapsed = Eio.Time.now clock -. start in
132
158
Printf.printf "%s: %.3fs\n" name elapsed
···
168
194
HTTP/2 specific errors:
169
195
170
196
```ocaml
171
-
match Client.request client url with
197
+
match Client.get client url with
172
198
| Error (Client.Protocol_error msg) ->
173
199
(* HTTP/2 protocol-level error *)
174
200
Printf.printf "HTTP/2 error: %s\n" msg
+5
-5
docs/client/tls.md
+5
-5
docs/client/tls.md
···
10
10
11
11
```ocaml
12
12
(* System certs used automatically for https:// URLs *)
13
-
match Hcs.Client.get ~sw ~net ~clock "https://example.com" with
13
+
match Hcs.Client.get' ~sw ~net ~clock "https://example.com" with
14
14
| Ok resp -> print_endline resp.body
15
15
| Error (`Tls msg) -> Printf.eprintf "TLS error: %s\n" msg
16
16
| Error _ -> print_endline "Request failed"
···
26
26
|> with_insecure_tls
27
27
)
28
28
29
-
match Hcs.Client.get ~sw ~net ~clock ~config "https://localhost:8443" with
29
+
match Hcs.Client.get' ~sw ~net ~clock ~config "https://localhost:8443" with
30
30
| Ok resp -> print_endline resp.body
31
31
| Error _ -> print_endline "Request failed"
32
32
```
···
246
246
### Client Errors
247
247
248
248
```ocaml
249
-
match Hcs.Client.get ~sw ~net ~clock url with
249
+
match Hcs.Client.get' ~sw ~net ~clock url with
250
250
| Ok resp -> handle_response resp
251
-
| Error (`Tls msg) ->
251
+
| Error (Hcs.Client.Tls_error msg) ->
252
252
(* Certificate verification failed, handshake error, etc. *)
253
253
Printf.eprintf "TLS error: %s\n" msg
254
-
| Error (`Connection msg) ->
254
+
| Error (Hcs.Client.Connection_failed msg) ->
255
255
Printf.eprintf "Connection failed: %s\n" msg
256
256
| Error _ -> ()
257
257
```
+117
-52
docs/getting-started/first-client.md
+117
-52
docs/getting-started/first-client.md
···
1
1
# Your First Client
2
2
3
-
This guide covers making HTTP requests with HCS. You'll learn the one-shot and persistent client patterns.
3
+
This guide covers making HTTP requests with HCS. You'll learn the one-shot convenience API, the persistent pooled client, and the request builder DSL.
4
4
5
5
## One-Shot Requests
6
6
7
-
For simple requests, use `Client.get` or `Client.post`:
7
+
For quick requests, use `Client.get'` or `Client.post'`. These create a temporary client, make the request, and close it:
8
8
9
9
```ocaml
10
10
let () =
···
12
12
Eio.Switch.run @@ fun sw ->
13
13
let net = Eio.Stdenv.net env in
14
14
let clock = Eio.Stdenv.clock env in
15
-
match Hcs.Client.get ~sw ~net ~clock "https://httpbin.org/get" with
15
+
match Hcs.Client.get' ~sw ~net ~clock "https://httpbin.org/get" with
16
16
| Ok resp ->
17
17
Printf.printf "Status: %d\n" resp.status;
18
18
Printf.printf "Body: %s\n" resp.body
···
27
27
POST with a body:
28
28
29
29
```ocaml
30
-
let () =
31
-
Eio_main.run @@ fun env ->
32
-
Eio.Switch.run @@ fun sw ->
33
-
let net = Eio.Stdenv.net env in
34
-
let clock = Eio.Stdenv.clock env in
35
-
let body = {|{"name":"test"}|} in
36
-
match Hcs.Client.post ~sw ~net ~clock "https://httpbin.org/post" ~body with
37
-
| Ok resp -> Printf.printf "Response: %s\n" resp.body
38
-
| Error _ -> Printf.eprintf "Request failed\n"
30
+
let body = {|{"name":"test"}|} in
31
+
match Hcs.Client.post' ~sw ~net ~clock "https://httpbin.org/post" ~body with
32
+
| Ok resp -> Printf.printf "Response: %s\n" resp.body
33
+
| Error _ -> Printf.eprintf "Request failed\n"
39
34
```
40
35
41
36
## Persistent Client
42
37
43
-
For multiple requests, create a client once and reuse it:
38
+
For multiple requests, create a client once and reuse it. Connections are pooled automatically:
44
39
45
40
```ocaml
46
41
let () =
···
50
45
let clock = Eio.Stdenv.clock env in
51
46
let client = Hcs.Client.create ~sw ~net ~clock () in
52
47
53
-
(* Make multiple requests *)
54
-
let _ = Hcs.Client.request client "https://httpbin.org/get" in
55
-
let _ = Hcs.Client.request client "https://httpbin.org/headers" in
56
-
let _ = Hcs.Client.request client "https://httpbin.org/ip" in
48
+
(* GET *)
49
+
let _ = Hcs.Client.get client "https://httpbin.org/get" in
50
+
51
+
(* POST *)
52
+
let _ = Hcs.Client.post client "https://httpbin.org/post" ~body:"data" in
53
+
54
+
(* PUT *)
55
+
let _ = Hcs.Client.put client "https://httpbin.org/put" ~body:"updated" in
56
+
57
+
(* DELETE *)
58
+
let _ = Hcs.Client.delete client "https://httpbin.org/delete" in
57
59
58
60
Hcs.Client.close client
59
61
```
60
62
61
-
The persistent client pools connections for better performance.
63
+
All HTTP methods are available: `get`, `post`, `put`, `patch`, `delete`, `head`, `options`. For any method, including custom ones, use the generic `request`:
64
+
65
+
```ocaml
66
+
let _ = Hcs.Client.request client Hcs.Http.PATCH ~body:"partial" url in
67
+
let _ = Hcs.Client.request client (Hcs.Http.Other "PURGE") url in
68
+
```
69
+
70
+
## Request Builder DSL
71
+
72
+
For more complex requests, use the `Http` module to build requests with a fluent API, then execute them with `Client.execute`:
73
+
74
+
```ocaml
75
+
open Hcs.Http
76
+
77
+
let req =
78
+
post "https://api.example.com/users"
79
+
|> bearer "my-token"
80
+
|> body_json {|{"name":"Alice"}|}
81
+
|> build
82
+
83
+
match Hcs.Client.execute client req with
84
+
| Ok resp -> Printf.printf "Created: %d\n" resp.status
85
+
| Error _ -> Printf.eprintf "Failed\n"
86
+
```
87
+
88
+
The builder supports headers, authentication, query parameters, and different body types:
89
+
90
+
```ocaml
91
+
open Hcs.Http
92
+
93
+
(* GET with auth and query parameters *)
94
+
let req =
95
+
get "https://api.example.com/search"
96
+
|> bearer "tok-123"
97
+
|> query "q" "ocaml"
98
+
|> query "limit" "10"
99
+
|> accept "application/json"
100
+
|> build
101
+
102
+
(* PUT with form data *)
103
+
let req =
104
+
put "https://api.example.com/profile"
105
+
|> form [("name", "Alice"); ("email", "alice@example.com")]
106
+
|> build
107
+
108
+
(* PATCH with string body and custom headers *)
109
+
let req =
110
+
patch "https://api.example.com/items/42"
111
+
|> header "X-Request-Id" "abc-123"
112
+
|> body_string ~content_type:"text/plain" "updated name"
113
+
|> build
114
+
115
+
(* DELETE *)
116
+
let req = delete "https://api.example.com/items/42" |> build
117
+
```
62
118
63
119
## Reading Responses
64
120
65
121
The response contains status, headers, body, and protocol:
66
122
67
123
```ocaml
68
-
match Hcs.Client.get ~sw ~net ~clock url with
124
+
match Hcs.Client.get client url with
69
125
| Ok resp ->
70
126
Printf.printf "Status: %d\n" resp.status;
71
127
Printf.printf "Protocol: %s\n"
···
79
135
| Error _ -> ()
80
136
```
81
137
138
+
## Per-Request Headers
139
+
140
+
All convenience methods accept an optional `~headers` parameter for request-specific headers (these are merged with default headers from the config):
141
+
142
+
```ocaml
143
+
let headers = [("Authorization", "Bearer tok-123"); ("Accept", "application/json")] in
144
+
match Hcs.Client.get client ~headers "https://api.example.com/me" with
145
+
| Ok resp -> Printf.printf "%s\n" resp.body
146
+
| Error _ -> ()
147
+
```
148
+
82
149
## Client Configuration
83
150
84
151
Customize timeouts, redirects, and protocols:
···
107
174
| `with_http11` | - | Prefer HTTP/1.1 |
108
175
| `with_insecure_tls` | - | Skip TLS verification |
109
176
110
-
## HTTP/2
111
-
112
-
Force HTTP/2:
113
-
114
-
```ocaml
115
-
let config = Hcs.Client.default_config |> Hcs.Client.with_http2
116
-
117
-
let () =
118
-
Eio_main.run @@ fun env ->
119
-
Eio.Switch.run @@ fun sw ->
120
-
let net = Eio.Stdenv.net env in
121
-
let clock = Eio.Stdenv.clock env in
122
-
match Hcs.Client.get ~sw ~net ~clock ~config "https://nghttp2.org/httpbin/get" with
123
-
| Ok resp ->
124
-
Printf.printf "Protocol: %s\n"
125
-
(match resp.protocol with
126
-
| Hcs.Client.HTTP_2 -> "HTTP/2"
127
-
| _ -> "HTTP/1.1")
128
-
| Error _ -> ()
129
-
```
130
-
131
177
## Error Handling
132
178
133
179
The client returns a `result` with typed errors:
134
180
135
181
```ocaml
136
-
match Hcs.Client.get ~sw ~net ~clock url with
182
+
match Hcs.Client.get client url with
137
183
| Ok resp -> handle_response resp
138
184
| Error e ->
139
185
match e with
···
153
199
154
200
## Complete Example
155
201
156
-
A program that fetches multiple URLs:
202
+
A program that interacts with a REST API:
157
203
158
204
```ocaml
159
-
let fetch_url client url =
160
-
match Hcs.Client.request client url with
161
-
| Ok resp -> Printf.printf "%s -> %d\n" url resp.status
162
-
| Error _ -> Printf.printf "%s -> failed\n" url
205
+
open Hcs.Http
163
206
164
207
let () =
165
208
Eio_main.run @@ fun env ->
···
172
215
in
173
216
let client = Hcs.Client.create ~sw ~net ~clock ~config () in
174
217
175
-
let urls = [
176
-
"https://httpbin.org/get";
177
-
"https://httpbin.org/status/404";
178
-
"https://httpbin.org/delay/1";
179
-
] in
180
-
List.iter (fetch_url client) urls;
218
+
(* List users *)
219
+
(match Hcs.Client.get client "https://api.example.com/users" with
220
+
| Ok resp -> Printf.printf "Users: %s\n" resp.body
221
+
| Error _ -> Printf.eprintf "Failed to list users\n");
222
+
223
+
(* Create a user with the DSL *)
224
+
let req =
225
+
post "https://api.example.com/users"
226
+
|> bearer "my-token"
227
+
|> body_json {|{"name":"Alice"}|}
228
+
|> build
229
+
in
230
+
(match Hcs.Client.execute client req with
231
+
| Ok resp -> Printf.printf "Created (status %d)\n" resp.status
232
+
| Error _ -> Printf.eprintf "Failed to create user\n");
233
+
234
+
(* Update the user *)
235
+
(match Hcs.Client.patch client "https://api.example.com/users/1"
236
+
~headers:[("Authorization", "Bearer my-token")]
237
+
~body:{|{"name":"Bob"}|} with
238
+
| Ok resp -> Printf.printf "Updated (status %d)\n" resp.status
239
+
| Error _ -> Printf.eprintf "Failed to update user\n");
240
+
241
+
(* Delete the user *)
242
+
(match Hcs.Client.delete client "https://api.example.com/users/1" with
243
+
| Ok resp -> Printf.printf "Deleted (status %d)\n" resp.status
244
+
| Error _ -> Printf.eprintf "Failed to delete user\n");
181
245
182
246
Hcs.Client.close client
183
247
```
184
248
185
249
## Next Steps
186
250
251
+
- [Basic Requests](../client/basic-requests.md) - Full reference for all methods, DSL, and headers
187
252
- [HTTP/2 Client](../client/http2.md) - HTTP/2 multiplexing
188
253
- [Connection Pooling](../client/connection-pooling.md) - Pool configuration
189
254
- [TLS Configuration](../client/tls.md) - Certificates and security
+1
-1
dune-project
+1
-1
dune-project
+1
-1
hcs.opam
+1
-1
hcs.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
-
version: "0.4.1"
3
+
version: "0.5.0"
4
4
synopsis: "Eio based HTTP client/server library for OCaml 5+"
5
5
description:
6
6
"HCS is a HTTP client/server library for OCaml 5+ supporting HTTP/1.1, HTTP/2, and WebSocket. Built on Eio."
+61
-30
lib/client.ml
+61
-30
lib/client.ml
···
173
173
| H2_client.Timeout -> Timeout
174
174
| H2_client.Invalid_response msg -> Invalid_response msg
175
175
176
-
let request t url =
176
+
(** Convert an {!Http.meth} to [H1.Method.t] (= [H2.Method.t]) for use with the
177
+
underlying protocol clients. *)
178
+
let h1_method_of_meth = Http.meth_to_h1
179
+
180
+
(** Perform an HTTP request with any method using the unified client.
181
+
182
+
[~headers] are extra per-request headers merged on top of defaults.
183
+
[~body] is the optional request body string. *)
184
+
let request t (meth : Http.meth) ?(headers = []) ?(body = "") url =
185
+
let h1_meth = h1_method_of_meth meth in
177
186
if should_use_h2 t.config url then
178
-
match H2_client.get t.h2_client url with
187
+
match H2_client.request t.h2_client h1_meth ~headers ~body url with
179
188
| Ok resp ->
180
189
Ok
181
190
{
···
186
195
}
187
196
| Error e -> Error (map_h2_error e)
188
197
else
189
-
match H1_client.get t.h1_client url with
198
+
match H1_client.request t.h1_client h1_meth ~headers ~body url with
190
199
| Ok resp ->
191
200
Ok
192
201
{
···
197
206
}
198
207
| Error e -> Error (map_h1_error e)
199
208
200
-
let request_post t url ~body:request_body =
201
-
if should_use_h2 t.config url then
202
-
match H2_client.post t.h2_client url ~body:request_body with
203
-
| Ok resp ->
204
-
Ok
205
-
{
206
-
status = h2_status_to_int resp.H2_client.status;
207
-
headers = h2_headers_to_list resp.headers;
208
-
body = resp.body;
209
-
protocol = HTTP_2;
210
-
}
211
-
| Error e -> Error (map_h2_error e)
212
-
else
213
-
match H1_client.post t.h1_client url ~body:request_body with
214
-
| Ok resp ->
215
-
Ok
216
-
{
217
-
status = h1_status_to_int resp.H1_client.status;
218
-
headers = h1_headers_to_list resp.headers;
219
-
body = resp.body;
220
-
protocol = HTTP_1_1;
221
-
}
222
-
| Error e -> Error (map_h1_error e)
209
+
(** {2 Convenience methods} *)
210
+
211
+
(** Perform a GET request *)
212
+
let get t ?(headers = []) url = request t GET ~headers url
213
+
214
+
(** Perform a POST request *)
215
+
let post t ?(headers = []) url ~body = request t POST ~headers ~body url
216
+
217
+
(** Perform a PUT request *)
218
+
let put t ?(headers = []) url ~body = request t PUT ~headers ~body url
219
+
220
+
(** Perform a PATCH request *)
221
+
let patch t ?(headers = []) url ~body = request t PATCH ~headers ~body url
222
+
223
+
(** Perform a DELETE request *)
224
+
let delete t ?(headers = []) ?body url = request t DELETE ~headers ?body url
225
+
226
+
(** Perform a HEAD request *)
227
+
let head t ?(headers = []) url = request t HEAD ~headers url
228
+
229
+
(** Perform an OPTIONS request *)
230
+
let options t ?(headers = []) url = request t OPTIONS ~headers url
231
+
232
+
(** {2 Execute an Http.request built with the Http DSL}
233
+
234
+
This bridges the {!Http} request builder to the actual client execution.
235
+
236
+
{[
237
+
let req =
238
+
Http.post "https://api.example.com/users"
239
+
|> Http.bearer "my-token"
240
+
|> Http.body_json {|{"name":"Alice"}|}
241
+
|> Http.build
242
+
in
243
+
Client.execute client req
244
+
]} *)
245
+
let execute t (req : Http.request) =
246
+
let url = Http.url req in
247
+
let headers = req.req_headers in
248
+
let body = Http.body_to_string req.req_body in
249
+
request t req.req_meth ~headers ~body url
250
+
251
+
(** {1 Backward-compatible stateless API} *)
223
252
224
-
let get ~sw ~net ~clock ?(config = default_config) url =
253
+
(** Perform a GET request (creates temporary client, no pooling benefit) *)
254
+
let get' ~sw ~net ~clock ?(config = default_config) url =
225
255
let t = create ~sw ~net ~clock ~config () in
226
-
let result = request t url in
256
+
let result = get t url in
227
257
close t;
228
258
result
229
259
230
-
let post ~sw ~net ~clock ?(config = default_config) url ~body =
260
+
(** Perform a POST request (creates temporary client, no pooling benefit) *)
261
+
let post' ~sw ~net ~clock ?(config = default_config) url ~body =
231
262
let t = create ~sw ~net ~clock ~config () in
232
-
let result = request_post t url ~body in
263
+
let result = post t url ~body in
233
264
close t;
234
265
result
+47
-54
lib/h1_client.ml
+47
-54
lib/h1_client.ml
···
393
393
in
394
394
default_headers @ headers
395
395
396
-
(** Perform a GET request using pooled connections *)
397
-
let get t url =
396
+
(** Determine if an HTTP method may carry a request body *)
397
+
let method_has_body = function
398
+
| `POST | `PUT | `Other "PATCH" -> true
399
+
| `DELETE -> true (* allow body on DELETE, some APIs use it *)
400
+
| _ -> false
401
+
402
+
(** Perform an HTTP request with any method using pooled connections.
403
+
404
+
[~body] is the optional request body string.
405
+
[~headers] are extra per-request headers merged on top of defaults. *)
406
+
let request t (meth : H1.Method.t) ?(headers = []) ?(body = "") url =
398
407
let uri = Uri.of_string url in
399
408
let scheme = Uri.scheme uri |> Option.value ~default:"http" in
400
409
let is_https = String.equal scheme "https" in
···
410
419
match acquire_connection t ~host ~port ~is_https with
411
420
| Error e -> Error e
412
421
| Ok conn -> (
422
+
let has_body = body <> "" || method_has_body meth in
413
423
let base_headers =
414
-
[ ("Host", host); ("Connection", "keep-alive") ]
424
+
let base =
425
+
[ ("Host", host); ("Connection", "keep-alive") ]
426
+
in
427
+
if has_body then
428
+
("Content-Length", string_of_int (String.length body)) :: base
429
+
else base
415
430
in
416
-
let headers =
417
-
if t.config.default_headers = [] then base_headers
431
+
let all_headers = headers @ base_headers in
432
+
let merged =
433
+
if t.config.default_headers = [] then all_headers
418
434
else if t.config.default_headers = default_config.default_headers
419
-
then t.config.default_headers @ base_headers
435
+
then t.config.default_headers @ all_headers
420
436
else
421
437
merge_headers ~default_headers:t.config.default_headers
422
-
~headers:base_headers
438
+
~headers:all_headers
423
439
in
424
440
let req =
425
-
H1.Request.create ~headers:(H1.Headers.of_list headers) `GET path
441
+
H1.Request.create ~headers:(H1.Headers.of_list merged) meth path
426
442
in
427
-
match do_request conn req with
443
+
match do_request ~request_body:body conn req with
428
444
| Ok (resp, keep_alive) ->
429
445
release_connection t ~host ~port ~is_https conn ~keep_alive;
430
446
Ok resp
···
435
451
with
436
452
| Some result -> result
437
453
| None -> Error Timeout
454
+
455
+
(** {2 Convenience methods} *)
456
+
457
+
(** Perform a GET request using pooled connections *)
458
+
let get t ?(headers = []) url = request t `GET ~headers url
438
459
439
460
(** Perform a POST request using pooled connections *)
440
-
let post t url ~body:request_body =
441
-
let uri = Uri.of_string url in
442
-
let scheme = Uri.scheme uri |> Option.value ~default:"http" in
443
-
let is_https = String.equal scheme "https" in
444
-
let host = Uri.host uri |> Option.value ~default:"localhost" in
445
-
let default_port = if is_https then 443 else 80 in
446
-
let port = Uri.port uri |> Option.value ~default:default_port in
447
-
let path = Uri.path_and_query uri in
448
-
let path = if path = "" then "/" else path in
461
+
let post t ?(headers = []) url ~body = request t `POST ~headers ~body url
462
+
463
+
(** Perform a PUT request using pooled connections *)
464
+
let put t ?(headers = []) url ~body = request t `PUT ~headers ~body url
465
+
466
+
(** Perform a PATCH request using pooled connections *)
467
+
let patch t ?(headers = []) url ~body =
468
+
request t (`Other "PATCH") ~headers ~body url
469
+
470
+
(** Perform a DELETE request using pooled connections *)
471
+
let delete t ?(headers = []) ?body url =
472
+
request t `DELETE ~headers ?body url
449
473
450
-
let total_timeout = t.config.connect_timeout +. t.config.read_timeout in
451
-
match
452
-
t.with_timeout total_timeout (fun () ->
453
-
match acquire_connection t ~host ~port ~is_https with
454
-
| Error e -> Error e
455
-
| Ok conn -> (
456
-
let content_length = String.length request_body in
457
-
let base_headers =
458
-
[
459
-
("Host", host);
460
-
("Connection", "keep-alive");
461
-
("Content-Length", string_of_int content_length);
462
-
]
463
-
in
464
-
let headers =
465
-
if t.config.default_headers = [] then base_headers
466
-
else if t.config.default_headers = default_config.default_headers
467
-
then t.config.default_headers @ base_headers
468
-
else
469
-
merge_headers ~default_headers:t.config.default_headers
470
-
~headers:base_headers
471
-
in
472
-
let req =
473
-
H1.Request.create ~headers:(H1.Headers.of_list headers) `POST path
474
-
in
475
-
match do_request ~request_body conn req with
476
-
| Ok (resp, keep_alive) ->
477
-
release_connection t ~host ~port ~is_https conn ~keep_alive;
478
-
Ok resp
479
-
| Error e ->
480
-
release_connection t ~host ~port ~is_https conn
481
-
~keep_alive:false;
482
-
Error e))
483
-
with
484
-
| Some result -> result
485
-
| None -> Error Timeout
474
+
(** Perform a HEAD request using pooled connections *)
475
+
let head t ?(headers = []) url = request t `HEAD ~headers url
476
+
477
+
(** Perform an OPTIONS request using pooled connections *)
478
+
let options t ?(headers = []) url = request t `OPTIONS ~headers url
486
479
487
480
(** {1 Backward-compatible stateless API} *)
488
481
+59
-55
lib/h2_client.ml
+59
-55
lib/h2_client.ml
···
399
399
in
400
400
pseudo @ default_headers @ regular
401
401
402
-
let get t url =
403
-
let uri = Uri.of_string url in
404
-
let scheme = Uri.scheme uri |> Option.value ~default:"https" in
405
-
let is_https = String.equal scheme "https" in
406
-
let host = Uri.host uri |> Option.value ~default:"localhost" in
407
-
let default_port = if is_https then 443 else 80 in
408
-
let port = Uri.port uri |> Option.value ~default:default_port in
409
-
let path = Uri.path_and_query uri in
410
-
let path = if path = "" then "/" else path in
402
+
(** Determine if an HTTP method may carry a request body *)
403
+
let method_has_body = function
404
+
| `POST | `PUT | `Other "PATCH" -> true
405
+
| `DELETE -> true
406
+
| _ -> false
411
407
412
-
let total_timeout = t.config.connect_timeout +. t.config.read_timeout in
413
-
match
414
-
t.with_timeout total_timeout (fun () ->
415
-
match acquire_connection t ~host ~port ~is_https with
416
-
| Error e -> Error e
417
-
| Ok conn -> (
418
-
let base_headers = [ (":authority", host) ] in
419
-
let headers =
420
-
if t.config.default_headers = [] then base_headers
421
-
else if t.config.default_headers = default_default_headers then
422
-
base_headers @ t.config.default_headers
423
-
else
424
-
merge_headers ~default_headers:t.config.default_headers
425
-
~headers:base_headers
426
-
in
427
-
let headers = H2.Headers.of_list headers in
428
-
let req = H2.Request.create ~headers ~scheme `GET path in
429
-
match do_request conn.flow req with
430
-
| Ok resp ->
431
-
release_connection t ~host ~port ~is_https conn ~keep_alive:true;
432
-
Ok resp
433
-
| Error e ->
434
-
release_connection t ~host ~port ~is_https conn
435
-
~keep_alive:false;
436
-
Error e))
437
-
with
438
-
| Some result -> result
439
-
| None -> Error Timeout
408
+
(** Perform an HTTP/2 request with any method using pooled connections.
440
409
441
-
let post t url ~body:request_body =
410
+
[~body] is the optional request body string.
411
+
[~headers] are extra per-request headers merged on top of defaults. *)
412
+
let request t (meth : H2.Method.t) ?(headers = []) ?(body = "") url =
442
413
let uri = Uri.of_string url in
443
414
let scheme = Uri.scheme uri |> Option.value ~default:"https" in
444
415
let is_https = String.equal scheme "https" in
···
454
425
match acquire_connection t ~host ~port ~is_https with
455
426
| Error e -> Error e
456
427
| Ok conn -> (
457
-
let content_length = String.length request_body in
428
+
let has_body = body <> "" || method_has_body meth in
458
429
let base_pseudo = [ (":authority", host) ] in
459
430
let base_regular =
460
-
[
461
-
("content-length", string_of_int content_length);
462
-
("content-type", "application/octet-stream");
463
-
]
431
+
if has_body then
432
+
[
433
+
("content-length", string_of_int (String.length body));
434
+
("content-type", "application/octet-stream");
435
+
]
436
+
else []
464
437
in
465
-
let headers =
466
-
if t.config.default_headers = [] then base_pseudo @ base_regular
438
+
(* Lowercase user-supplied header names for HTTP/2 compliance *)
439
+
let user_headers =
440
+
List.map (fun (k, v) -> (String.lowercase_ascii k, v)) headers
441
+
in
442
+
let all_headers = base_pseudo @ user_headers @ base_regular in
443
+
let merged =
444
+
if t.config.default_headers = [] then all_headers
467
445
else if t.config.default_headers = default_default_headers then
468
-
base_pseudo @ t.config.default_headers @ base_regular
446
+
base_pseudo @ t.config.default_headers @ user_headers
447
+
@ base_regular
469
448
else
470
449
merge_headers ~default_headers:t.config.default_headers
471
-
~headers:(base_pseudo @ base_regular)
450
+
~headers:all_headers
472
451
in
473
-
let headers = H2.Headers.of_list headers in
474
-
let req = H2.Request.create ~headers ~scheme `POST path in
475
-
match do_request ~body:request_body conn.flow req with
452
+
let h2_headers = H2.Headers.of_list merged in
453
+
let req = H2.Request.create ~headers:h2_headers ~scheme meth path in
454
+
match do_request ~body conn.flow req with
476
455
| Ok resp ->
477
456
release_connection t ~host ~port ~is_https conn ~keep_alive:true;
478
457
Ok resp
···
484
463
| Some result -> result
485
464
| None -> Error Timeout
486
465
487
-
let post' ~sw ~net ~clock ?config url ~body =
488
-
let t = create ~sw ~net ~clock ?config () in
489
-
let result = post t url ~body in
490
-
close t;
491
-
result
466
+
(** {2 Convenience methods} *)
467
+
468
+
(** Perform a GET request using pooled connections *)
469
+
let get t ?(headers = []) url = request t `GET ~headers url
470
+
471
+
(** Perform a POST request using pooled connections *)
472
+
let post t ?(headers = []) url ~body = request t `POST ~headers ~body url
473
+
474
+
(** Perform a PUT request using pooled connections *)
475
+
let put t ?(headers = []) url ~body = request t `PUT ~headers ~body url
476
+
477
+
(** Perform a PATCH request using pooled connections *)
478
+
let patch t ?(headers = []) url ~body =
479
+
request t (`Other "PATCH") ~headers ~body url
480
+
481
+
(** Perform a DELETE request using pooled connections *)
482
+
let delete t ?(headers = []) ?body url =
483
+
request t `DELETE ~headers ?body url
484
+
485
+
(** Perform a HEAD request using pooled connections *)
486
+
let head t ?(headers = []) url = request t `HEAD ~headers url
487
+
488
+
(** Perform an OPTIONS request using pooled connections *)
489
+
let options t ?(headers = []) url = request t `OPTIONS ~headers url
492
490
493
491
(** {1 Backward-compatible stateless API} *)
494
492
···
497
495
let result = get t url in
498
496
close t;
499
497
result
498
+
499
+
let post' ~sw ~net ~clock ?config url ~body =
500
+
let t = create ~sw ~net ~clock ?config () in
501
+
let result = post t url ~body in
502
+
close t;
503
+
result
+5
test/dune
+5
test/dune
+2
-2
test/test_alpn_client.ml
+2
-2
test/test_alpn_client.ml
···
17
17
18
18
Eio.traceln "\n--- HTTP/1.1 mode ---";
19
19
let config = Hcs.Client.default_config |> Hcs.Client.with_http11 in
20
-
(match Hcs.Client.get ~sw ~net ~clock ~config url with
20
+
(match Hcs.Client.get' ~sw ~net ~clock ~config url with
21
21
| Ok resp ->
22
22
let proto =
23
23
match resp.protocol with
···
40
40
41
41
Eio.traceln "\n--- HTTP/2 mode ---";
42
42
let config = Hcs.Client.default_config |> Hcs.Client.with_http2 in
43
-
match Hcs.Client.get ~sw ~net ~clock ~config url with
43
+
match Hcs.Client.get' ~sw ~net ~clock ~config url with
44
44
| Ok resp ->
45
45
let proto =
46
46
match resp.protocol with
+1
-1
test/test_client_default_headers.ml
+1
-1
test/test_client_default_headers.ml
+10
-10
test/test_client_integration.ml
+10
-10
test/test_client_integration.ml
···
27
27
(* Test 1: Simple GET request *)
28
28
Printf.printf "Test 1: GET /get ... ";
29
29
(try
30
-
let resp = Hcs.Client.get ~sw ~net ~clock (httpbin_url ^ "/get") in
30
+
let resp = Hcs.Client.get' ~sw ~net ~clock (httpbin_url ^ "/get") in
31
31
match resp with
32
32
| Ok resp ->
33
33
if resp.status = 200 then begin
···
52
52
Printf.printf "Test 2: GET /get?foo=bar ... ";
53
53
(try
54
54
let resp =
55
-
Hcs.Client.get ~sw ~net ~clock (httpbin_url ^ "/get?foo=bar&baz=qux")
55
+
Hcs.Client.get' ~sw ~net ~clock (httpbin_url ^ "/get?foo=bar&baz=qux")
56
56
in
57
57
match resp with
58
58
| Ok resp ->
···
66
66
Printf.printf "Test 3: POST /post with body ... ";
67
67
(try
68
68
let body = "Hello, httpbin!" in
69
-
let resp = Hcs.Client.post ~sw ~net ~clock ~body (httpbin_url ^ "/post") in
69
+
let resp = Hcs.Client.post' ~sw ~net ~clock ~body (httpbin_url ^ "/post") in
70
70
match resp with
71
71
| Ok resp ->
72
72
if resp.status = 200 then Printf.printf "OK\n"
···
77
77
(* Test 4: Status code 201 *)
78
78
Printf.printf "Test 4: GET /status/201 ... ";
79
79
(try
80
-
let resp = Hcs.Client.get ~sw ~net ~clock (httpbin_url ^ "/status/201") in
80
+
let resp = Hcs.Client.get' ~sw ~net ~clock (httpbin_url ^ "/status/201") in
81
81
match resp with
82
82
| Ok resp ->
83
83
if resp.status = 201 then Printf.printf "OK\n"
···
88
88
(* Test 5: User-Agent header *)
89
89
Printf.printf "Test 5: GET /user-agent ... ";
90
90
(try
91
-
let resp = Hcs.Client.get ~sw ~net ~clock (httpbin_url ^ "/user-agent") in
91
+
let resp = Hcs.Client.get' ~sw ~net ~clock (httpbin_url ^ "/user-agent") in
92
92
match resp with
93
93
| Ok resp ->
94
94
if resp.status = 200 && String.length resp.body > 0 then
···
101
101
Printf.printf "Test 6: GET /response-headers?X-Test=value ... ";
102
102
(try
103
103
let resp =
104
-
Hcs.Client.get ~sw ~net ~clock
104
+
Hcs.Client.get' ~sw ~net ~clock
105
105
(httpbin_url ^ "/response-headers?X-Test=hello")
106
106
in
107
107
match resp with
···
122
122
(* Use config without redirects *)
123
123
let config = Hcs.Client.without_redirects Hcs.Client.default_config in
124
124
let resp =
125
-
Hcs.Client.get ~sw ~net ~clock ~config
125
+
Hcs.Client.get' ~sw ~net ~clock ~config
126
126
(httpbin_url ^ "/absolute-redirect/1")
127
127
in
128
128
match resp with
···
136
136
Printf.printf "Test 8: GET /get with HTTP/2 ... ";
137
137
(try
138
138
let config = Hcs.Client.with_http2 Hcs.Client.default_config in
139
-
let resp = Hcs.Client.get ~sw ~net ~clock ~config (httpbin_url ^ "/get") in
139
+
let resp = Hcs.Client.get' ~sw ~net ~clock ~config (httpbin_url ^ "/get") in
140
140
match resp with
141
141
| Ok resp ->
142
142
let proto =
···
151
151
(* Test 9: gzip response *)
152
152
Printf.printf "Test 9: GET /gzip ... ";
153
153
(try
154
-
let resp = Hcs.Client.get ~sw ~net ~clock (httpbin_url ^ "/gzip") in
154
+
let resp = Hcs.Client.get' ~sw ~net ~clock (httpbin_url ^ "/gzip") in
155
155
match resp with
156
156
| Ok resp ->
157
157
if resp.status = 200 then Printf.printf "OK\n"
···
162
162
(* Test 10: Large response *)
163
163
Printf.printf "Test 10: GET /bytes/10000 ... ";
164
164
(try
165
-
let resp = Hcs.Client.get ~sw ~net ~clock (httpbin_url ^ "/bytes/10000") in
165
+
let resp = Hcs.Client.get' ~sw ~net ~clock (httpbin_url ^ "/bytes/10000") in
166
166
match resp with
167
167
| Ok resp ->
168
168
if resp.status = 200 && String.length resp.body = 10000 then
+664
test/test_client_methods.ml
+664
test/test_client_methods.ml
···
1
+
(** Tests for all HTTP methods and the Client.execute / Http DSL bridge.
2
+
3
+
Spins up a local HTTP/1.1 server that echoes the request method, path,
4
+
headers, and body back as the response body, then exercises every method
5
+
through the pooled Client API, the stateless convenience API, the
6
+
H1_client low-level API, and the Http DSL -> Client.execute bridge. *)
7
+
8
+
open Alcotest
9
+
10
+
(* ---------------------------------------------------------------------- *)
11
+
(* Helpers *)
12
+
(* ---------------------------------------------------------------------- *)
13
+
14
+
let error_to_string = function
15
+
| Hcs.Client.Connection_failed s -> "Connection_failed: " ^ s
16
+
| Hcs.Client.Tls_error s -> "Tls_error: " ^ s
17
+
| Hcs.Client.Protocol_error s -> "Protocol_error: " ^ s
18
+
| Hcs.Client.Timeout -> "Timeout"
19
+
| Hcs.Client.Invalid_response s -> "Invalid_response: " ^ s
20
+
| Hcs.Client.Too_many_redirects -> "Too_many_redirects"
21
+
22
+
let h1_error_to_string = function
23
+
| Hcs.H1_client.Connection_failed s -> "Connection_failed: " ^ s
24
+
| Hcs.H1_client.Tls_error s -> "Tls_error: " ^ s
25
+
| Hcs.H1_client.Timeout -> "Timeout"
26
+
| Hcs.H1_client.Invalid_response s -> "Invalid_response: " ^ s
27
+
| Hcs.H1_client.Too_many_redirects -> "Too_many_redirects"
28
+
29
+
(** Parse the echo response body. Format:
30
+
{v METHOD /path\nheader1: value1\nheader2: value2\n\nbody-content v} *)
31
+
let parse_echo body =
32
+
match String.split_on_char '\n' body with
33
+
| [] -> ("", "", [], "")
34
+
| first :: rest ->
35
+
let meth, path =
36
+
match String.index_opt first ' ' with
37
+
| Some i ->
38
+
( String.sub first 0 i,
39
+
String.sub first (i + 1) (String.length first - i - 1) )
40
+
| None -> (first, "")
41
+
in
42
+
(* Split rest into headers (before blank line) and body (after blank line) *)
43
+
let rec split_headers acc = function
44
+
| "" :: body_lines -> (List.rev acc, String.concat "\n" body_lines)
45
+
| h :: tl -> split_headers (h :: acc) tl
46
+
| [] -> (List.rev acc, "")
47
+
in
48
+
let header_lines, body_content = split_headers [] rest in
49
+
let headers =
50
+
List.filter_map
51
+
(fun line ->
52
+
match String.index_opt line ':' with
53
+
| Some i ->
54
+
let k =
55
+
String.lowercase_ascii (String.trim (String.sub line 0 i))
56
+
in
57
+
let v =
58
+
String.trim
59
+
(String.sub line (i + 1) (String.length line - i - 1))
60
+
in
61
+
Some (k, v)
62
+
| None -> None)
63
+
header_lines
64
+
in
65
+
(meth, path, headers, body_content)
66
+
67
+
let find_header name headers =
68
+
let name = String.lowercase_ascii name in
69
+
List.find_map
70
+
(fun (k, v) -> if String.lowercase_ascii k = name then Some v else None)
71
+
headers
72
+
73
+
(* ---------------------------------------------------------------------- *)
74
+
(* Echo server *)
75
+
(* ---------------------------------------------------------------------- *)
76
+
77
+
(** Start an echo server that returns "METHOD /path\nheaders\n\nbody" *)
78
+
let start_echo_server ~sw ~net ~clock ~port =
79
+
let handler (req : Hcs.Server.request) =
80
+
let method_str = H1.Method.to_string req.meth in
81
+
let buf = Buffer.create 256 in
82
+
Buffer.add_string buf method_str;
83
+
Buffer.add_char buf ' ';
84
+
Buffer.add_string buf req.target;
85
+
Buffer.add_char buf '\n';
86
+
List.iter
87
+
(fun (k, v) ->
88
+
Buffer.add_string buf k;
89
+
Buffer.add_string buf ": ";
90
+
Buffer.add_string buf v;
91
+
Buffer.add_char buf '\n')
92
+
req.headers;
93
+
Buffer.add_char buf '\n';
94
+
Buffer.add_string buf req.body;
95
+
Hcs.Server.respond (Buffer.contents buf)
96
+
in
97
+
let config =
98
+
Hcs.Server.
99
+
{
100
+
default_config with
101
+
host = "127.0.0.1";
102
+
port;
103
+
gc_tuning = None;
104
+
}
105
+
in
106
+
Eio.Fiber.fork_daemon ~sw (fun[@warning "-21"] () ->
107
+
Hcs.Server.run ~sw ~net ~config handler;
108
+
`Stop_daemon);
109
+
Eio.Time.sleep clock 0.05
110
+
111
+
(* ---------------------------------------------------------------------- *)
112
+
(* Test: Unified Client — all methods via pooled API *)
113
+
(* ---------------------------------------------------------------------- *)
114
+
115
+
let base_port = 18100
116
+
117
+
let test_client_get () =
118
+
Eio_main.run @@ fun env ->
119
+
Eio.Switch.run @@ fun sw ->
120
+
let net = Eio.Stdenv.net env in
121
+
let clock = Eio.Stdenv.clock env in
122
+
let port = base_port + (Unix.getpid () mod 100) in
123
+
start_echo_server ~sw ~net ~clock ~port;
124
+
let client = Hcs.Client.create ~sw ~net ~clock () in
125
+
let url = Printf.sprintf "http://127.0.0.1:%d/test" port in
126
+
match Hcs.Client.get client url with
127
+
| Error e -> fail (error_to_string e)
128
+
| Ok resp ->
129
+
let meth, path, _, _ = parse_echo resp.body in
130
+
check string "method" "GET" meth;
131
+
check string "path" "/test" path;
132
+
check int "status" 200 resp.status;
133
+
Hcs.Client.close client
134
+
135
+
let test_client_post () =
136
+
Eio_main.run @@ fun env ->
137
+
Eio.Switch.run @@ fun sw ->
138
+
let net = Eio.Stdenv.net env in
139
+
let clock = Eio.Stdenv.clock env in
140
+
let port = base_port + 1 + (Unix.getpid () mod 100) in
141
+
start_echo_server ~sw ~net ~clock ~port;
142
+
let client = Hcs.Client.create ~sw ~net ~clock () in
143
+
let url = Printf.sprintf "http://127.0.0.1:%d/submit" port in
144
+
match Hcs.Client.post client url ~body:"hello" with
145
+
| Error e -> fail (error_to_string e)
146
+
| Ok resp ->
147
+
let meth, path, _, body = parse_echo resp.body in
148
+
check string "method" "POST" meth;
149
+
check string "path" "/submit" path;
150
+
check string "body" "hello" body;
151
+
Hcs.Client.close client
152
+
153
+
let test_client_put () =
154
+
Eio_main.run @@ fun env ->
155
+
Eio.Switch.run @@ fun sw ->
156
+
let net = Eio.Stdenv.net env in
157
+
let clock = Eio.Stdenv.clock env in
158
+
let port = base_port + 2 + (Unix.getpid () mod 100) in
159
+
start_echo_server ~sw ~net ~clock ~port;
160
+
let client = Hcs.Client.create ~sw ~net ~clock () in
161
+
let url = Printf.sprintf "http://127.0.0.1:%d/resource/1" port in
162
+
match Hcs.Client.put client url ~body:"updated" with
163
+
| Error e -> fail (error_to_string e)
164
+
| Ok resp ->
165
+
let meth, path, _, body = parse_echo resp.body in
166
+
check string "method" "PUT" meth;
167
+
check string "path" "/resource/1" path;
168
+
check string "body" "updated" body;
169
+
Hcs.Client.close client
170
+
171
+
let test_client_patch () =
172
+
Eio_main.run @@ fun env ->
173
+
Eio.Switch.run @@ fun sw ->
174
+
let net = Eio.Stdenv.net env in
175
+
let clock = Eio.Stdenv.clock env in
176
+
let port = base_port + 3 + (Unix.getpid () mod 100) in
177
+
start_echo_server ~sw ~net ~clock ~port;
178
+
let client = Hcs.Client.create ~sw ~net ~clock () in
179
+
let url = Printf.sprintf "http://127.0.0.1:%d/resource/2" port in
180
+
match Hcs.Client.patch client url ~body:"partial" with
181
+
| Error e -> fail (error_to_string e)
182
+
| Ok resp ->
183
+
let meth, path, _, body = parse_echo resp.body in
184
+
check string "method" "PATCH" meth;
185
+
check string "path" "/resource/2" path;
186
+
check string "body" "partial" body;
187
+
Hcs.Client.close client
188
+
189
+
let test_client_delete () =
190
+
Eio_main.run @@ fun env ->
191
+
Eio.Switch.run @@ fun sw ->
192
+
let net = Eio.Stdenv.net env in
193
+
let clock = Eio.Stdenv.clock env in
194
+
let port = base_port + 4 + (Unix.getpid () mod 100) in
195
+
start_echo_server ~sw ~net ~clock ~port;
196
+
let client = Hcs.Client.create ~sw ~net ~clock () in
197
+
let url = Printf.sprintf "http://127.0.0.1:%d/resource/3" port in
198
+
match Hcs.Client.delete client url with
199
+
| Error e -> fail (error_to_string e)
200
+
| Ok resp ->
201
+
let meth, path, _, _ = parse_echo resp.body in
202
+
check string "method" "DELETE" meth;
203
+
check string "path" "/resource/3" path;
204
+
Hcs.Client.close client
205
+
206
+
let test_client_delete_with_body () =
207
+
(* Note: our echo server doesn't read bodies for DELETE (common HTTP server
208
+
behaviour). This test verifies the client sends the request correctly and
209
+
that the Content-Length header is set, even though the server discards
210
+
the body. *)
211
+
Eio_main.run @@ fun env ->
212
+
Eio.Switch.run @@ fun sw ->
213
+
let net = Eio.Stdenv.net env in
214
+
let clock = Eio.Stdenv.clock env in
215
+
let port = base_port + 5 + (Unix.getpid () mod 100) in
216
+
start_echo_server ~sw ~net ~clock ~port;
217
+
let client = Hcs.Client.create ~sw ~net ~clock () in
218
+
let url = Printf.sprintf "http://127.0.0.1:%d/resource/4" port in
219
+
match Hcs.Client.delete client ~body:"reason" url with
220
+
| Error e -> fail (error_to_string e)
221
+
| Ok resp ->
222
+
let meth, path, hdrs, _ = parse_echo resp.body in
223
+
check string "method" "DELETE" meth;
224
+
check string "path" "/resource/4" path;
225
+
(* Verify Content-Length was sent even though server discards the body *)
226
+
check (option string) "content-length" (Some "6")
227
+
(find_header "content-length" hdrs);
228
+
Hcs.Client.close client
229
+
230
+
let test_client_head () =
231
+
Eio_main.run @@ fun env ->
232
+
Eio.Switch.run @@ fun sw ->
233
+
let net = Eio.Stdenv.net env in
234
+
let clock = Eio.Stdenv.clock env in
235
+
let port = base_port + 6 + (Unix.getpid () mod 100) in
236
+
start_echo_server ~sw ~net ~clock ~port;
237
+
let client = Hcs.Client.create ~sw ~net ~clock () in
238
+
let url = Printf.sprintf "http://127.0.0.1:%d/info" port in
239
+
match Hcs.Client.head client url with
240
+
| Error e -> fail (error_to_string e)
241
+
| Ok resp ->
242
+
(* HEAD responses have no body returned by the server but the
243
+
request method on the server side should be HEAD *)
244
+
check int "status" 200 resp.status;
245
+
Hcs.Client.close client
246
+
247
+
let test_client_options () =
248
+
Eio_main.run @@ fun env ->
249
+
Eio.Switch.run @@ fun sw ->
250
+
let net = Eio.Stdenv.net env in
251
+
let clock = Eio.Stdenv.clock env in
252
+
let port = base_port + 7 + (Unix.getpid () mod 100) in
253
+
start_echo_server ~sw ~net ~clock ~port;
254
+
let client = Hcs.Client.create ~sw ~net ~clock () in
255
+
let url = Printf.sprintf "http://127.0.0.1:%d/api" port in
256
+
match Hcs.Client.options client url with
257
+
| Error e -> fail (error_to_string e)
258
+
| Ok resp ->
259
+
let meth, path, _, _ = parse_echo resp.body in
260
+
check string "method" "OPTIONS" meth;
261
+
check string "path" "/api" path;
262
+
Hcs.Client.close client
263
+
264
+
(* ---------------------------------------------------------------------- *)
265
+
(* Test: Generic request with Http.meth + custom headers *)
266
+
(* ---------------------------------------------------------------------- *)
267
+
268
+
let test_client_request_generic () =
269
+
Eio_main.run @@ fun env ->
270
+
Eio.Switch.run @@ fun sw ->
271
+
let net = Eio.Stdenv.net env in
272
+
let clock = Eio.Stdenv.clock env in
273
+
let port = base_port + 8 + (Unix.getpid () mod 100) in
274
+
start_echo_server ~sw ~net ~clock ~port;
275
+
let client = Hcs.Client.create ~sw ~net ~clock () in
276
+
let url = Printf.sprintf "http://127.0.0.1:%d/generic" port in
277
+
let headers = [ ("X-Custom", "test-value") ] in
278
+
match Hcs.Client.request client Hcs.Http.PUT ~headers ~body:"data" url with
279
+
| Error e -> fail (error_to_string e)
280
+
| Ok resp ->
281
+
let meth, path, hdrs, body = parse_echo resp.body in
282
+
check string "method" "PUT" meth;
283
+
check string "path" "/generic" path;
284
+
check string "body" "data" body;
285
+
check (option string) "custom header" (Some "test-value")
286
+
(find_header "x-custom" hdrs);
287
+
Hcs.Client.close client
288
+
289
+
let test_client_request_custom_method () =
290
+
Eio_main.run @@ fun env ->
291
+
Eio.Switch.run @@ fun sw ->
292
+
let net = Eio.Stdenv.net env in
293
+
let clock = Eio.Stdenv.clock env in
294
+
let port = base_port + 9 + (Unix.getpid () mod 100) in
295
+
start_echo_server ~sw ~net ~clock ~port;
296
+
let client = Hcs.Client.create ~sw ~net ~clock () in
297
+
let url = Printf.sprintf "http://127.0.0.1:%d/custom" port in
298
+
match
299
+
Hcs.Client.request client (Hcs.Http.Other "PURGE") ~body:"" url
300
+
with
301
+
| Error e -> fail (error_to_string e)
302
+
| Ok resp ->
303
+
let meth, _, _, _ = parse_echo resp.body in
304
+
check string "method" "PURGE" meth;
305
+
Hcs.Client.close client
306
+
307
+
(* ---------------------------------------------------------------------- *)
308
+
(* Test: Http DSL -> Client.execute bridge *)
309
+
(* ---------------------------------------------------------------------- *)
310
+
311
+
let test_execute_get () =
312
+
Eio_main.run @@ fun env ->
313
+
Eio.Switch.run @@ fun sw ->
314
+
let net = Eio.Stdenv.net env in
315
+
let clock = Eio.Stdenv.clock env in
316
+
let port = base_port + 10 + (Unix.getpid () mod 100) in
317
+
start_echo_server ~sw ~net ~clock ~port;
318
+
let client = Hcs.Client.create ~sw ~net ~clock () in
319
+
let req =
320
+
Hcs.Http.get (Printf.sprintf "http://127.0.0.1:%d/dsl-get" port)
321
+
|> Hcs.Http.header "Accept" "application/json"
322
+
|> Hcs.Http.build
323
+
in
324
+
match Hcs.Client.execute client req with
325
+
| Error e -> fail (error_to_string e)
326
+
| Ok resp ->
327
+
let meth, path, hdrs, _ = parse_echo resp.body in
328
+
check string "method" "GET" meth;
329
+
check string "path" "/dsl-get" path;
330
+
check (option string) "accept" (Some "application/json")
331
+
(find_header "accept" hdrs);
332
+
Hcs.Client.close client
333
+
334
+
let test_execute_post_json () =
335
+
Eio_main.run @@ fun env ->
336
+
Eio.Switch.run @@ fun sw ->
337
+
let net = Eio.Stdenv.net env in
338
+
let clock = Eio.Stdenv.clock env in
339
+
let port = base_port + 11 + (Unix.getpid () mod 100) in
340
+
start_echo_server ~sw ~net ~clock ~port;
341
+
let client = Hcs.Client.create ~sw ~net ~clock () in
342
+
let req =
343
+
Hcs.Http.post (Printf.sprintf "http://127.0.0.1:%d/dsl-post" port)
344
+
|> Hcs.Http.body_json {|{"key":"value"}|}
345
+
|> Hcs.Http.build
346
+
in
347
+
match Hcs.Client.execute client req with
348
+
| Error e -> fail (error_to_string e)
349
+
| Ok resp ->
350
+
let meth, path, hdrs, body = parse_echo resp.body in
351
+
check string "method" "POST" meth;
352
+
check string "path" "/dsl-post" path;
353
+
check string "body" {|{"key":"value"}|} body;
354
+
check (option string) "content-type" (Some "application/json")
355
+
(find_header "content-type" hdrs);
356
+
Hcs.Client.close client
357
+
358
+
let test_execute_put_with_bearer () =
359
+
Eio_main.run @@ fun env ->
360
+
Eio.Switch.run @@ fun sw ->
361
+
let net = Eio.Stdenv.net env in
362
+
let clock = Eio.Stdenv.clock env in
363
+
let port = base_port + 12 + (Unix.getpid () mod 100) in
364
+
start_echo_server ~sw ~net ~clock ~port;
365
+
let client = Hcs.Client.create ~sw ~net ~clock () in
366
+
let req =
367
+
Hcs.Http.put (Printf.sprintf "http://127.0.0.1:%d/dsl-put" port)
368
+
|> Hcs.Http.bearer "tok-123"
369
+
|> Hcs.Http.body_string "payload"
370
+
|> Hcs.Http.build
371
+
in
372
+
match Hcs.Client.execute client req with
373
+
| Error e -> fail (error_to_string e)
374
+
| Ok resp ->
375
+
let meth, _, hdrs, body = parse_echo resp.body in
376
+
check string "method" "PUT" meth;
377
+
check string "body" "payload" body;
378
+
check (option string) "authorization" (Some "Bearer tok-123")
379
+
(find_header "authorization" hdrs);
380
+
Hcs.Client.close client
381
+
382
+
let test_execute_delete () =
383
+
Eio_main.run @@ fun env ->
384
+
Eio.Switch.run @@ fun sw ->
385
+
let net = Eio.Stdenv.net env in
386
+
let clock = Eio.Stdenv.clock env in
387
+
let port = base_port + 13 + (Unix.getpid () mod 100) in
388
+
start_echo_server ~sw ~net ~clock ~port;
389
+
let client = Hcs.Client.create ~sw ~net ~clock () in
390
+
let req =
391
+
Hcs.Http.delete (Printf.sprintf "http://127.0.0.1:%d/dsl-del" port)
392
+
|> Hcs.Http.build
393
+
in
394
+
match Hcs.Client.execute client req with
395
+
| Error e -> fail (error_to_string e)
396
+
| Ok resp ->
397
+
let meth, path, _, _ = parse_echo resp.body in
398
+
check string "method" "DELETE" meth;
399
+
check string "path" "/dsl-del" path;
400
+
Hcs.Client.close client
401
+
402
+
let test_execute_patch_with_form () =
403
+
Eio_main.run @@ fun env ->
404
+
Eio.Switch.run @@ fun sw ->
405
+
let net = Eio.Stdenv.net env in
406
+
let clock = Eio.Stdenv.clock env in
407
+
let port = base_port + 14 + (Unix.getpid () mod 100) in
408
+
start_echo_server ~sw ~net ~clock ~port;
409
+
let client = Hcs.Client.create ~sw ~net ~clock () in
410
+
let req =
411
+
Hcs.Http.patch (Printf.sprintf "http://127.0.0.1:%d/dsl-patch" port)
412
+
|> Hcs.Http.form [ ("name", "Alice"); ("age", "30") ]
413
+
|> Hcs.Http.build
414
+
in
415
+
match Hcs.Client.execute client req with
416
+
| Error e -> fail (error_to_string e)
417
+
| Ok resp ->
418
+
let meth, _, hdrs, body = parse_echo resp.body in
419
+
check string "method" "PATCH" meth;
420
+
check (option string) "content-type"
421
+
(Some "application/x-www-form-urlencoded")
422
+
(find_header "content-type" hdrs);
423
+
(* Form body should contain url-encoded fields *)
424
+
check bool "has name field" true (String.length body > 0);
425
+
Hcs.Client.close client
426
+
427
+
(* ---------------------------------------------------------------------- *)
428
+
(* Test: H1_client low-level all methods *)
429
+
(* ---------------------------------------------------------------------- *)
430
+
431
+
let test_h1_put () =
432
+
Eio_main.run @@ fun env ->
433
+
Eio.Switch.run @@ fun sw ->
434
+
let net = Eio.Stdenv.net env in
435
+
let clock = Eio.Stdenv.clock env in
436
+
let port = base_port + 15 + (Unix.getpid () mod 100) in
437
+
start_echo_server ~sw ~net ~clock ~port;
438
+
let h1 = Hcs.H1_client.create ~sw ~net ~clock () in
439
+
let url = Printf.sprintf "http://127.0.0.1:%d/h1-put" port in
440
+
match Hcs.H1_client.put h1 url ~body:"h1data" with
441
+
| Error e -> fail (h1_error_to_string e)
442
+
| Ok resp ->
443
+
let body = resp.Hcs.H1_client.body in
444
+
let meth, _, _, rbody = parse_echo body in
445
+
check string "method" "PUT" meth;
446
+
check string "body" "h1data" rbody;
447
+
Hcs.H1_client.close h1
448
+
449
+
let test_h1_patch () =
450
+
Eio_main.run @@ fun env ->
451
+
Eio.Switch.run @@ fun sw ->
452
+
let net = Eio.Stdenv.net env in
453
+
let clock = Eio.Stdenv.clock env in
454
+
let port = base_port + 16 + (Unix.getpid () mod 100) in
455
+
start_echo_server ~sw ~net ~clock ~port;
456
+
let h1 = Hcs.H1_client.create ~sw ~net ~clock () in
457
+
let url = Printf.sprintf "http://127.0.0.1:%d/h1-patch" port in
458
+
match Hcs.H1_client.patch h1 url ~body:"h1patch" with
459
+
| Error e -> fail (h1_error_to_string e)
460
+
| Ok resp ->
461
+
let body = resp.Hcs.H1_client.body in
462
+
let meth, _, _, rbody = parse_echo body in
463
+
check string "method" "PATCH" meth;
464
+
check string "body" "h1patch" rbody;
465
+
Hcs.H1_client.close h1
466
+
467
+
let test_h1_delete () =
468
+
Eio_main.run @@ fun env ->
469
+
Eio.Switch.run @@ fun sw ->
470
+
let net = Eio.Stdenv.net env in
471
+
let clock = Eio.Stdenv.clock env in
472
+
let port = base_port + 17 + (Unix.getpid () mod 100) in
473
+
start_echo_server ~sw ~net ~clock ~port;
474
+
let h1 = Hcs.H1_client.create ~sw ~net ~clock () in
475
+
let url = Printf.sprintf "http://127.0.0.1:%d/h1-delete" port in
476
+
match Hcs.H1_client.delete h1 url with
477
+
| Error e -> fail (h1_error_to_string e)
478
+
| Ok resp ->
479
+
let body = resp.Hcs.H1_client.body in
480
+
let meth, _, _, _ = parse_echo body in
481
+
check string "method" "DELETE" meth;
482
+
Hcs.H1_client.close h1
483
+
484
+
let test_h1_head () =
485
+
Eio_main.run @@ fun env ->
486
+
Eio.Switch.run @@ fun sw ->
487
+
let net = Eio.Stdenv.net env in
488
+
let clock = Eio.Stdenv.clock env in
489
+
let port = base_port + 18 + (Unix.getpid () mod 100) in
490
+
start_echo_server ~sw ~net ~clock ~port;
491
+
let h1 = Hcs.H1_client.create ~sw ~net ~clock () in
492
+
let url = Printf.sprintf "http://127.0.0.1:%d/h1-head" port in
493
+
match Hcs.H1_client.head h1 url with
494
+
| Error e -> fail (h1_error_to_string e)
495
+
| Ok resp ->
496
+
check int "status" 200 (H1.Status.to_code resp.Hcs.H1_client.status);
497
+
Hcs.H1_client.close h1
498
+
499
+
let test_h1_options () =
500
+
Eio_main.run @@ fun env ->
501
+
Eio.Switch.run @@ fun sw ->
502
+
let net = Eio.Stdenv.net env in
503
+
let clock = Eio.Stdenv.clock env in
504
+
let port = base_port + 19 + (Unix.getpid () mod 100) in
505
+
start_echo_server ~sw ~net ~clock ~port;
506
+
let h1 = Hcs.H1_client.create ~sw ~net ~clock () in
507
+
let url = Printf.sprintf "http://127.0.0.1:%d/h1-options" port in
508
+
match Hcs.H1_client.options h1 url with
509
+
| Error e -> fail (h1_error_to_string e)
510
+
| Ok resp ->
511
+
let body = resp.Hcs.H1_client.body in
512
+
let meth, _, _, _ = parse_echo body in
513
+
check string "method" "OPTIONS" meth;
514
+
Hcs.H1_client.close h1
515
+
516
+
let test_h1_request_with_headers () =
517
+
Eio_main.run @@ fun env ->
518
+
Eio.Switch.run @@ fun sw ->
519
+
let net = Eio.Stdenv.net env in
520
+
let clock = Eio.Stdenv.clock env in
521
+
let port = base_port + 20 + (Unix.getpid () mod 100) in
522
+
start_echo_server ~sw ~net ~clock ~port;
523
+
let h1 = Hcs.H1_client.create ~sw ~net ~clock () in
524
+
let url = Printf.sprintf "http://127.0.0.1:%d/h1-headers" port in
525
+
let headers = [ ("X-Trace-Id", "abc-123") ] in
526
+
match Hcs.H1_client.request h1 `GET ~headers url with
527
+
| Error e -> fail (h1_error_to_string e)
528
+
| Ok resp ->
529
+
let body = resp.Hcs.H1_client.body in
530
+
let _, _, hdrs, _ = parse_echo body in
531
+
check (option string) "trace header" (Some "abc-123")
532
+
(find_header "x-trace-id" hdrs);
533
+
Hcs.H1_client.close h1
534
+
535
+
(* ---------------------------------------------------------------------- *)
536
+
(* Test: Per-request headers on convenience methods *)
537
+
(* ---------------------------------------------------------------------- *)
538
+
539
+
let test_client_get_with_headers () =
540
+
Eio_main.run @@ fun env ->
541
+
Eio.Switch.run @@ fun sw ->
542
+
let net = Eio.Stdenv.net env in
543
+
let clock = Eio.Stdenv.clock env in
544
+
let port = base_port + 21 + (Unix.getpid () mod 100) in
545
+
start_echo_server ~sw ~net ~clock ~port;
546
+
let client = Hcs.Client.create ~sw ~net ~clock () in
547
+
let url = Printf.sprintf "http://127.0.0.1:%d/with-hdrs" port in
548
+
let headers = [ ("X-Request-Id", "req-001") ] in
549
+
match Hcs.Client.get client ~headers url with
550
+
| Error e -> fail (error_to_string e)
551
+
| Ok resp ->
552
+
let _, _, hdrs, _ = parse_echo resp.body in
553
+
check (option string) "request-id header" (Some "req-001")
554
+
(find_header "x-request-id" hdrs);
555
+
Hcs.Client.close client
556
+
557
+
let test_client_post_with_headers () =
558
+
Eio_main.run @@ fun env ->
559
+
Eio.Switch.run @@ fun sw ->
560
+
let net = Eio.Stdenv.net env in
561
+
let clock = Eio.Stdenv.clock env in
562
+
let port = base_port + 22 + (Unix.getpid () mod 100) in
563
+
start_echo_server ~sw ~net ~clock ~port;
564
+
let client = Hcs.Client.create ~sw ~net ~clock () in
565
+
let url = Printf.sprintf "http://127.0.0.1:%d/post-hdrs" port in
566
+
let headers = [ ("Content-Type", "text/plain") ] in
567
+
match Hcs.Client.post client ~headers url ~body:"text" with
568
+
| Error e -> fail (error_to_string e)
569
+
| Ok resp ->
570
+
let meth, _, hdrs, body = parse_echo resp.body in
571
+
check string "method" "POST" meth;
572
+
check string "body" "text" body;
573
+
check (option string) "content-type" (Some "text/plain")
574
+
(find_header "content-type" hdrs);
575
+
Hcs.Client.close client
576
+
577
+
(* ---------------------------------------------------------------------- *)
578
+
(* Test: Backward-compatible stateless API still works *)
579
+
(* ---------------------------------------------------------------------- *)
580
+
581
+
let test_stateless_get () =
582
+
Eio_main.run @@ fun env ->
583
+
Eio.Switch.run @@ fun sw ->
584
+
let net = Eio.Stdenv.net env in
585
+
let clock = Eio.Stdenv.clock env in
586
+
let port = base_port + 23 + (Unix.getpid () mod 100) in
587
+
start_echo_server ~sw ~net ~clock ~port;
588
+
let url = Printf.sprintf "http://127.0.0.1:%d/compat-get" port in
589
+
match Hcs.Client.get' ~sw ~net ~clock url with
590
+
| Error e -> fail (error_to_string e)
591
+
| Ok resp ->
592
+
let meth, path, _, _ = parse_echo resp.body in
593
+
check string "method" "GET" meth;
594
+
check string "path" "/compat-get" path
595
+
596
+
let test_stateless_post () =
597
+
Eio_main.run @@ fun env ->
598
+
Eio.Switch.run @@ fun sw ->
599
+
let net = Eio.Stdenv.net env in
600
+
let clock = Eio.Stdenv.clock env in
601
+
let port = base_port + 24 + (Unix.getpid () mod 100) in
602
+
start_echo_server ~sw ~net ~clock ~port;
603
+
let url = Printf.sprintf "http://127.0.0.1:%d/compat-post" port in
604
+
match Hcs.Client.post' ~sw ~net ~clock url ~body:"compat" with
605
+
| Error e -> fail (error_to_string e)
606
+
| Ok resp ->
607
+
let meth, _, _, body = parse_echo resp.body in
608
+
check string "method" "POST" meth;
609
+
check string "body" "compat" body
610
+
611
+
(* ---------------------------------------------------------------------- *)
612
+
(* Main *)
613
+
(* ---------------------------------------------------------------------- *)
614
+
615
+
let () =
616
+
run "Client HTTP Methods"
617
+
[
618
+
( "unified_client",
619
+
[
620
+
test_case "GET" `Quick test_client_get;
621
+
test_case "POST" `Quick test_client_post;
622
+
test_case "PUT" `Quick test_client_put;
623
+
test_case "PATCH" `Quick test_client_patch;
624
+
test_case "DELETE" `Quick test_client_delete;
625
+
test_case "DELETE with body" `Quick test_client_delete_with_body;
626
+
test_case "HEAD" `Quick test_client_head;
627
+
test_case "OPTIONS" `Quick test_client_options;
628
+
] );
629
+
( "generic_request",
630
+
[
631
+
test_case "generic PUT with headers" `Quick
632
+
test_client_request_generic;
633
+
test_case "custom method PURGE" `Quick
634
+
test_client_request_custom_method;
635
+
] );
636
+
( "execute_dsl",
637
+
[
638
+
test_case "execute GET" `Quick test_execute_get;
639
+
test_case "execute POST JSON" `Quick test_execute_post_json;
640
+
test_case "execute PUT with bearer" `Quick test_execute_put_with_bearer;
641
+
test_case "execute DELETE" `Quick test_execute_delete;
642
+
test_case "execute PATCH with form" `Quick test_execute_patch_with_form;
643
+
] );
644
+
( "h1_client",
645
+
[
646
+
test_case "H1 PUT" `Quick test_h1_put;
647
+
test_case "H1 PATCH" `Quick test_h1_patch;
648
+
test_case "H1 DELETE" `Quick test_h1_delete;
649
+
test_case "H1 HEAD" `Quick test_h1_head;
650
+
test_case "H1 OPTIONS" `Quick test_h1_options;
651
+
test_case "H1 request with headers" `Quick
652
+
test_h1_request_with_headers;
653
+
] );
654
+
( "per_request_headers",
655
+
[
656
+
test_case "GET with headers" `Quick test_client_get_with_headers;
657
+
test_case "POST with headers" `Quick test_client_post_with_headers;
658
+
] );
659
+
( "backward_compat",
660
+
[
661
+
test_case "stateless get'" `Quick test_stateless_get;
662
+
test_case "stateless post'" `Quick test_stateless_post;
663
+
] );
664
+
]
+5
-5
test/test_large_body.ml
+5
-5
test/test_large_body.ml
···
34
34
in
35
35
let url = Printf.sprintf "http://127.0.0.1:%d/upload" port in
36
36
Printf.printf " %6dKB... %!" size_kb;
37
-
match Hcs.Client.post ~sw ~net ~clock ~config url ~body:payload with
37
+
match Hcs.Client.post' ~sw ~net ~clock ~config url ~body:payload with
38
38
| Ok resp ->
39
39
if resp.status <> 200 then begin
40
40
Printf.printf "FAIL (status %d)\n%!" resp.status;
···
69
69
in
70
70
let url = Printf.sprintf "http://127.0.0.1:%d/integrity" port in
71
71
Printf.printf " %6dKB integrity... %!" size_kb;
72
-
match Hcs.Client.post ~sw ~net ~clock ~config url ~body:payload with
72
+
match Hcs.Client.post' ~sw ~net ~clock ~config url ~body:payload with
73
73
| Ok resp ->
74
74
if resp.status = 200 && resp.body = "ok" then begin
75
75
Printf.printf "OK\n%!";
···
107
107
Eio.Time.sleep clock 0.1;
108
108
Printf.printf " max_body_size (1KB limit)... %!";
109
109
let url = Printf.sprintf "http://127.0.0.1:%d/upload" port in
110
-
match Hcs.Client.post ~sw ~net ~clock url ~body:payload with
110
+
match Hcs.Client.post' ~sw ~net ~clock url ~body:payload with
111
111
| Ok resp ->
112
112
if resp.status = 413 && not !handler_called then begin
113
113
Printf.printf "OK (413)\n%!";
···
157
157
in
158
158
let url = Printf.sprintf "http://127.0.0.1:%d/upload" port in
159
159
Printf.printf " %6dKB... %!" size_kb;
160
-
match Hcs.Client.post ~sw ~net ~clock ~config url ~body:payload with
160
+
match Hcs.Client.post' ~sw ~net ~clock ~config url ~body:payload with
161
161
| Ok resp ->
162
162
if resp.status <> 200 then begin
163
163
Printf.printf "FAIL (status %d)\n%!" resp.status;
···
197
197
in
198
198
let url = Printf.sprintf "http://127.0.0.1:%d/integrity" port in
199
199
Printf.printf " %6dKB integrity... %!" size_kb;
200
-
match Hcs.Client.post ~sw ~net ~clock ~config url ~body:payload with
200
+
match Hcs.Client.post' ~sw ~net ~clock ~config url ~body:payload with
201
201
| Ok resp ->
202
202
if resp.status = 200 && resp.body = "ok" then begin
203
203
Printf.printf "OK\n%!";