ocaml http/1, http/2 and websocket client and server library
feat(assigns): add type-safe request metadata map (v0.6.0)
Add Hcs.Assigns — a phantom-typed heterogeneous map for passing
data from plugs to handlers without string parsing or unsafe casts.
- New Assigns module with type-safe key/value storage
- Server.request gains 'assigns : Assigns.t' field
- All request construction sites updated with assigns = Assigns.empty
- 5 new tests covering add, find, missing keys, last-wins, and key isolation
- Docs updated in request-lifecycle.md and plug-system.md
- Bump version to 0.6.0, update CHANGELOG
- Disable dream/piaf bench targets (missing deps in default builds)
+223
-10
+15
CHANGELOG.md
+15
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.6.0] - 2026-04-26
9
+
10
+
### Added
11
+
12
+
- **`Hcs.Assigns`**: Type-safe heterogeneous map for passing data from plugs
13
+
to handlers. Each key is phantom-typed — `add` and `find` preserve the
14
+
value's OCaml type without any parsing or casting.
15
+
- **`assigns` field on `Server.request`**: Every request now carries an
16
+
`assigns : Hcs.Assigns.t` field, initialized to empty by the server.
17
+
18
+
### Changed
19
+
20
+
- **`Server.request` type** gained an `assigns` field. All existing code
21
+
that constructs `Server.request` records must include `assigns = Hcs.Assigns.empty`.
22
+
8
23
## [0.5.0] - 2026-03-24
9
24
10
25
### Added
+1
bench/dream/dune
+1
bench/dream/dune
+1
bench/piaf/dune
+1
bench/piaf/dune
+29
docs/guides/plug-system.md
+29
docs/guides/plug-system.md
···
167
167
| `Session` | Session management |
168
168
| `Negotiate` | Content negotiation |
169
169
170
+
## Passing Data with Assigns
171
+
172
+
Use [`Hcs.Assigns`](#) to pass typed data from plugs to handlers:
173
+
174
+
```ocaml
175
+
(* Register typed keys in one place *)
176
+
module Keys = struct
177
+
let account : Models.Account.t Hcs.Assigns.key = Hcs.Assigns.create_key ()
178
+
end
179
+
180
+
(* Plug: store data *)
181
+
let auth_plug : Plug.t = fun handler req ->
182
+
match lookup_user req with
183
+
| None -> redirect "/login"
184
+
| Some user ->
185
+
let req = { req with assigns =
186
+
Hcs.Assigns.add Keys.account user req.assigns } in
187
+
handler req
188
+
189
+
(* Handler: retrieve data, fully typed *)
190
+
let handler req =
191
+
match Hcs.Assigns.find Keys.account req.assigns with
192
+
| Some user -> render_dashboard user
193
+
| None -> redirect "/login"
194
+
```
195
+
196
+
Keys are phantom-typed: `add` and `find` preserve the value's OCaml type
197
+
without any parsing or casting.
198
+
170
199
## Common Plug Examples
171
200
172
201
### Logging
+4
-2
docs/guides/request-lifecycle.md
+4
-2
docs/guides/request-lifecycle.md
···
31
31
type request = {
32
32
meth : H1.Method.t; (* GET, POST, etc. *)
33
33
target : string; (* Path + query string *)
34
-
headers : H1.Headers.t;
35
-
body_reader : body_reader; (* Lazy body reader *)
34
+
headers : (string * string) list; (* HTTP headers *)
35
+
body : string; (* Full request body *)
36
+
version : protocol_version; (* HTTP_1_1 or HTTP_2 *)
37
+
assigns : Assigns.t; (* Type-safe app data attached by plugs *)
36
38
}
37
39
```
38
40
+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.5.0"
3
+
version: "0.6.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."
+35
lib/assigns.ml
+35
lib/assigns.ml
···
1
+
(** Implementation of the type-safe assigns map.
2
+
3
+
See {!Hcs.Assigns.mli} for the full API documentation. *)
4
+
5
+
(** {1 Keys} *)
6
+
7
+
type 'a key = {
8
+
uid : int;
9
+
}
10
+
11
+
(** {1 Bindings and Map} *)
12
+
13
+
type binding = Binding : 'a key * 'a -> binding
14
+
15
+
type t = binding list
16
+
17
+
(** {1 Key Creation} *)
18
+
19
+
let counter = ref 0
20
+
21
+
let create_key () : 'a key =
22
+
let uid = !counter in
23
+
incr counter;
24
+
{ uid }
25
+
26
+
(** {1 Operations} *)
27
+
28
+
let empty = []
29
+
30
+
let add : type a. a key -> a -> t -> t = fun k v t -> Binding (k, v) :: t
31
+
32
+
let find : type a. a key -> t -> a option = fun k t ->
33
+
List.find_map (fun (Binding (k', v)) ->
34
+
if k.uid = k'.uid then Some (Obj.magic v) else None)
35
+
t
+59
lib/assigns.mli
+59
lib/assigns.mli
···
1
+
(** Type-safe assignable values attached to each request.
2
+
3
+
[Assigns] provides a heterogeneous map where each key is
4
+
phantom-typed. Plugs store data here using [add], and handlers
5
+
(or downstream plugs) retrieve it with [find].
6
+
7
+
Each project registers its own typed keys with [create_key]:
8
+
9
+
{[
10
+
module My_keys = struct
11
+
let user : User.t Hcs.Assigns.key = Hcs.Assigns.create_key ()
12
+
let request_id : string Hcs.Assigns.key = Hcs.Assigns.create_key ()
13
+
end
14
+
]}
15
+
16
+
In a plug:
17
+
{[
18
+
let req = { req with assigns =
19
+
Hcs.Assigns.add My_keys.user user req.assigns }
20
+
]}
21
+
22
+
In a handler:
23
+
{[
24
+
match Hcs.Assigns.find My_keys.user req.assigns with
25
+
| Some user -> ...
26
+
| None -> ...
27
+
]} *)
28
+
29
+
(** {1 Core Types} *)
30
+
31
+
(** Phantom-typed key for storing typed values in {!t}. *)
32
+
type 'a key
33
+
34
+
(** A single binding in the map: {i some type} paired with its
35
+
phantom-typed key and value. *)
36
+
type binding
37
+
38
+
(** The assigns map itself — an opaque type of bindings. *)
39
+
type t
40
+
41
+
(** {1 Operations} *)
42
+
43
+
(** A unique phantom-typed key.
44
+
45
+
Each call returns a key with a unique identity; use it to [add]
46
+
and [find] values of the key's type. *)
47
+
val create_key : unit -> 'a key
48
+
49
+
(** The empty assigns map. *)
50
+
val empty : t
51
+
52
+
(** [add k v t] associates value [v] with key [k], returning the
53
+
updated map. Adding the same key multiple times pushes a new
54
+
binding; [find] returns the most recent. *)
55
+
val add : 'a key -> 'a -> t -> t
56
+
57
+
(** [find k t] returns the most recent value associated with key
58
+
[k], or [None] if the key has never been added. *)
59
+
val find : 'a key -> t -> 'a option
+3
lib/hcs.ml
+3
lib/hcs.ml
+3
lib/server.ml
+3
lib/server.ml
···
200
200
headers : (string * string) list; (** Headers as association list *)
201
201
body : string; (** Request body (empty for GET/HEAD) *)
202
202
version : protocol_version; (** Protocol version *)
203
+
assigns : Assigns.t; (** Type-safe application data attached by plugs *)
203
204
}
204
205
(** Request type exposed to handlers. *)
205
206
···
389
390
headers = h1_headers_to_list req.headers;
390
391
body;
391
392
version = HTTP_1_1;
393
+
assigns = Assigns.empty;
392
394
}
393
395
in
394
396
let response = handler request in
···
730
732
headers = h2_headers_to_list req.headers;
731
733
body;
732
734
version = HTTP_2;
735
+
assigns = Assigns.empty;
733
736
}
734
737
in
735
738
let response = handler request in
+2
-2
test/test_hcs.ml
+2
-2
test/test_hcs.ml
···
481
481
in
482
482
let p = create [ mark_plug ] in
483
483
let dummy_req : Hcs.Server.request =
484
-
{ meth = `GET; target = "/"; headers = []; body = ""; version = HTTP_1_1 }
484
+
{ meth = `GET; target = "/"; headers = []; body = ""; version = HTTP_1_1; assigns = Hcs.Assigns.empty }
485
485
in
486
486
let handler _req = Hcs.Server.respond "ok" in
487
487
let wrapped = apply p handler in
···
895
895
open Hcs
896
896
897
897
let make_request ?(body = "") target : Server.request =
898
-
{ meth = `GET; target; headers = []; body; version = Server.HTTP_1_1 }
898
+
{ meth = `GET; target; headers = []; body; version = Server.HTTP_1_1; assigns = Hcs.Assigns.empty }
899
899
900
900
let test_query_basic () =
901
901
let req = make_request "/search?q=ocaml&limit=10" in
+69
-4
test/test_plug.ml
+69
-4
test/test_plug.ml
···
279
279
version = Hcs.Server.HTTP_1_1;
280
280
headers = [];
281
281
body = "";
282
+
assigns = Hcs.Assigns.empty;
282
283
}
283
284
in
284
285
check
···
498
499
version = HTTP_1_1;
499
500
headers = [ ("X-Client-IP", "127.0.0.1") ];
500
501
body = "";
502
+
assigns = Hcs.Assigns.empty;
501
503
}
502
504
503
505
let test_allows_within_limit env =
···
579
581
module Test_circuit_breaker = struct
580
582
let make_request () =
581
583
Hcs.Server.
582
-
{ meth = `GET; target = "/"; version = HTTP_1_1; headers = []; body = "" }
584
+
{ meth = `GET; target = "/"; version = HTTP_1_1; headers = []; body = ""; assigns = Hcs.Assigns.empty }
583
585
584
586
let test_closed_allows_requests env =
585
587
let clock = Eio.Stdenv.clock env in
···
719
721
720
722
let make_request ?(headers = []) () =
721
723
Hcs.Server.
722
-
{ meth = `GET; target = "/"; version = HTTP_1_1; headers; body = "" }
724
+
{ meth = `GET; target = "/"; version = HTTP_1_1; headers; body = ""; assigns = Hcs.Assigns.empty }
723
725
724
726
let test_memory_store_put_get () =
725
727
Eio_main.run @@ fun _env ->
···
903
905
headers;
904
906
body = "";
905
907
version = Hcs.Server.HTTP_1_1;
908
+
assigns = Hcs.Assigns.empty;
906
909
}
907
910
908
911
let test_parse_accept_encoding_gzip () =
···
981
984
open Hcs.Plug.Cors
982
985
983
986
let make_request ?(headers = []) ?(meth = `GET) () : Hcs.Server.request =
984
-
{ meth; target = "/"; headers; body = ""; version = Hcs.Server.HTTP_1_1 }
987
+
{ meth; target = "/"; headers; body = ""; version = Hcs.Server.HTTP_1_1; assigns = Hcs.Assigns.empty }
985
988
986
989
let echo_handler _req = Hcs.Server.respond "ok"
987
990
···
1091
1094
1092
1095
let make_request ?(headers = []) ?(meth = `GET) ?(body = "") () :
1093
1096
Hcs.Server.request =
1094
-
{ meth; target = "/"; headers; body; version = Hcs.Server.HTTP_1_1 }
1097
+
{ meth; target = "/"; headers; body; version = Hcs.Server.HTTP_1_1; assigns = Hcs.Assigns.empty }
1095
1098
1096
1099
let echo_handler _req = Hcs.Server.respond "ok"
1097
1100
···
1220
1223
headers;
1221
1224
body = "";
1222
1225
version = Hcs.Server.HTTP_1_1;
1226
+
assigns = Hcs.Assigns.empty;
1223
1227
}
1224
1228
1225
1229
let echo_handler _req = Hcs.Server.respond "ok"
···
1366
1370
headers = [];
1367
1371
body = "";
1368
1372
version = Hcs.Server.HTTP_1_1;
1373
+
assigns = Hcs.Assigns.empty;
1369
1374
}
1370
1375
in
1371
1376
let clock = Eio.Stdenv.clock env in
···
1451
1456
version = Hcs.Server.HTTP_1_1;
1452
1457
headers = [];
1453
1458
body = "";
1459
+
assigns = Hcs.Assigns.empty;
1454
1460
}
1455
1461
1456
1462
let request_id_plug = Hcs.Plug.Request_id.create ()
···
1621
1627
]
1622
1628
end
1623
1629
1630
+
module Test_assigns = struct
1631
+
let test_add_and_find () =
1632
+
let k : string Hcs.Assigns.key = Hcs.Assigns.create_key () in
1633
+
let t = Hcs.Assigns.empty in
1634
+
let t = Hcs.Assigns.add k "hello" t in
1635
+
match Hcs.Assigns.find k t with
1636
+
| Some v -> Alcotest.(check string) "find added value" "hello" v
1637
+
| None -> Alcotest.fail "expected Some, got None"
1638
+
1639
+
let test_find_missing () =
1640
+
let k : int Hcs.Assigns.key = Hcs.Assigns.create_key () in
1641
+
let t = Hcs.Assigns.empty in
1642
+
match Hcs.Assigns.find k t with
1643
+
| Some _ -> Alcotest.fail "expected None, got Some"
1644
+
| None -> ()
1645
+
1646
+
let test_find_last_wins () =
1647
+
let k : float Hcs.Assigns.key = Hcs.Assigns.create_key () in
1648
+
let t = Hcs.Assigns.empty in
1649
+
let t = Hcs.Assigns.add k 1.0 t in
1650
+
let t = Hcs.Assigns.add k 2.0 t in
1651
+
match Hcs.Assigns.find k t with
1652
+
| Some v -> Alcotest.(check (float 1e-10)) "last wins" 2.0 v
1653
+
| None -> Alcotest.fail "expected Some, got None"
1654
+
1655
+
let test_different_keys () =
1656
+
let k1 : string Hcs.Assigns.key = Hcs.Assigns.create_key () in
1657
+
let k2 : int Hcs.Assigns.key = Hcs.Assigns.create_key () in
1658
+
let t = Hcs.Assigns.empty in
1659
+
let t = Hcs.Assigns.add k1 "a" t in
1660
+
let t = Hcs.Assigns.add k2 42 t in
1661
+
begin match Hcs.Assigns.find k1 t with
1662
+
| Some v -> Alcotest.(check string) "k1" "a" v
1663
+
| None -> Alcotest.fail "expected k1"
1664
+
end;
1665
+
begin match Hcs.Assigns.find k2 t with
1666
+
| Some v -> Alcotest.(check int) "k2" 42 v
1667
+
| None -> Alcotest.fail "expected k2"
1668
+
end
1669
+
1670
+
let test_empty () =
1671
+
let k : string Hcs.Assigns.key = Hcs.Assigns.create_key () in
1672
+
let t = Hcs.Assigns.empty in
1673
+
begin match Hcs.Assigns.find k t with
1674
+
| Some _ -> Alcotest.fail "expected None from empty map"
1675
+
| None -> ()
1676
+
end
1677
+
1678
+
let tests =
1679
+
[
1680
+
Alcotest.test_case "add_and_find" `Quick test_add_and_find;
1681
+
Alcotest.test_case "find_missing" `Quick test_find_missing;
1682
+
Alcotest.test_case "last_wins" `Quick test_find_last_wins;
1683
+
Alcotest.test_case "different_keys" `Quick test_different_keys;
1684
+
Alcotest.test_case "empty" `Quick test_empty;
1685
+
]
1686
+
end
1687
+
1624
1688
let () =
1625
1689
Random.self_init ();
1626
1690
Eio_main.run @@ fun env ->
···
1640
1704
("Retry", Test_retry.tests env);
1641
1705
("Endpoint_pipeline", Test_endpoint_pipeline.tests);
1642
1706
("Static", Test_static.tests);
1707
+
("Assigns", Test_assigns.tests);
1643
1708
]