OCaml HTTP cookie handling library with support for Eio-based storage jars
anil.recoil.org
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6open Cookeio
7open Cookeio_jar
8
9(* Testable helpers for Priority 2 types *)
10let expiration_testable : Cookeio.Expiration.t Alcotest.testable =
11 Alcotest.testable Cookeio.Expiration.pp Cookeio.Expiration.equal
12
13let span_testable : Ptime.Span.t Alcotest.testable =
14 Alcotest.testable Ptime.Span.pp Ptime.Span.equal
15
16let same_site_testable : Cookeio.SameSite.t Alcotest.testable =
17 Alcotest.testable Cookeio.SameSite.pp Cookeio.SameSite.equal
18
19let cookie_testable : Cookeio.t Alcotest.testable =
20 Alcotest.testable
21 (fun ppf c ->
22 Format.fprintf ppf
23 "{ name=%S; value=%S; domain=%S; path=%S; secure=%b; http_only=%b; \
24 partitioned=%b; expires=%a; max_age=%a; same_site=%a }"
25 (Cookeio.name c) (Cookeio.value c) (Cookeio.domain c) (Cookeio.path c)
26 (Cookeio.secure c) (Cookeio.http_only c) (Cookeio.partitioned c)
27 (Format.pp_print_option (fun ppf e ->
28 match e with
29 | `Session -> Format.pp_print_string ppf "Session"
30 | `DateTime t -> Format.fprintf ppf "DateTime(%a)" Ptime.pp t))
31 (Cookeio.expires c)
32 (Format.pp_print_option Ptime.Span.pp)
33 (Cookeio.max_age c)
34 (Format.pp_print_option (fun ppf -> function
35 | `Strict -> Format.pp_print_string ppf "Strict"
36 | `Lax -> Format.pp_print_string ppf "Lax"
37 | `None -> Format.pp_print_string ppf "None"))
38 (Cookeio.same_site c))
39 (fun c1 c2 ->
40 let expires_equal e1 e2 =
41 match (e1, e2) with
42 | None, None -> true
43 | Some `Session, Some `Session -> true
44 | Some (`DateTime t1), Some (`DateTime t2) -> Ptime.equal t1 t2
45 | _ -> false
46 in
47 Cookeio.name c1 = Cookeio.name c2
48 && Cookeio.value c1 = Cookeio.value c2
49 && Cookeio.domain c1 = Cookeio.domain c2
50 && Cookeio.path c1 = Cookeio.path c2
51 && Cookeio.secure c1 = Cookeio.secure c2
52 && Cookeio.http_only c1 = Cookeio.http_only c2
53 && Cookeio.partitioned c1 = Cookeio.partitioned c2
54 && expires_equal (Cookeio.expires c1) (Cookeio.expires c2)
55 && Option.equal Ptime.Span.equal (Cookeio.max_age c1) (Cookeio.max_age c2)
56 && Option.equal ( = ) (Cookeio.same_site c1) (Cookeio.same_site c2))
57
58let test_load_mozilla_cookies env =
59 let clock = Eio.Stdenv.clock env in
60 let content =
61 {|# Netscape HTTP Cookie File
62# http://curl.haxx.se/rfc/cookie_spec.html
63# This is a generated file! Do not edit.
64
65example.com FALSE /foo/ FALSE 0 cookie-1 v$1
66.example.com TRUE /foo/ FALSE 0 cookie-2 v$2
67example.com FALSE /foo/ FALSE 1257894000 cookie-3 v$3
68example.com FALSE /foo/ FALSE 1257894000 cookie-4 v$4
69example.com FALSE /foo/ TRUE 1257894000 cookie-5 v$5
70#HttpOnly_example.com FALSE /foo/ FALSE 1257894000 cookie-6 v$6
71#HttpOnly_.example.com TRUE /foo/ FALSE 1257894000 cookie-7 v$7
72|}
73 in
74 let jar = from_mozilla_format ~clock content in
75 let cookies = get_all_cookies jar in
76
77 (* Check total number of cookies (should skip commented lines) *)
78 Alcotest.(check int) "cookie count" 5 (List.length cookies);
79 Alcotest.(check int) "count function" 5 (count jar);
80 Alcotest.(check bool) "not empty" false (is_empty jar);
81
82 let find_cookie name = List.find (fun c -> Cookeio.name c = name) cookies in
83
84 (* Test cookie-1: session cookie on exact domain *)
85 let cookie1 = find_cookie "cookie-1" in
86 Alcotest.(check string)
87 "cookie-1 domain" "example.com" (Cookeio.domain cookie1);
88 Alcotest.(check string) "cookie-1 path" "/foo/" (Cookeio.path cookie1);
89 Alcotest.(check string) "cookie-1 name" "cookie-1" (Cookeio.name cookie1);
90 Alcotest.(check string) "cookie-1 value" "v$1" (Cookeio.value cookie1);
91 Alcotest.(check bool) "cookie-1 secure" false (Cookeio.secure cookie1);
92 Alcotest.(check bool) "cookie-1 http_only" false (Cookeio.http_only cookie1);
93 Alcotest.(check (option expiration_testable))
94 "cookie-1 expires" None (Cookeio.expires cookie1);
95 Alcotest.(
96 check
97 (option
98 (Alcotest.testable
99 (fun ppf -> function
100 | `Strict -> Format.pp_print_string ppf "Strict"
101 | `Lax -> Format.pp_print_string ppf "Lax"
102 | `None -> Format.pp_print_string ppf "None")
103 ( = ))))
104 "cookie-1 same_site" None
105 (Cookeio.same_site cookie1);
106
107 (* Test cookie-2: session cookie on subdomain pattern *)
108 let cookie2 = find_cookie "cookie-2" in
109 Alcotest.(check string)
110 "cookie-2 domain" "example.com" (Cookeio.domain cookie2);
111 Alcotest.(check string) "cookie-2 path" "/foo/" (Cookeio.path cookie2);
112 Alcotest.(check string) "cookie-2 name" "cookie-2" (Cookeio.name cookie2);
113 Alcotest.(check string) "cookie-2 value" "v$2" (Cookeio.value cookie2);
114 Alcotest.(check bool) "cookie-2 secure" false (Cookeio.secure cookie2);
115 Alcotest.(check bool) "cookie-2 http_only" false (Cookeio.http_only cookie2);
116 Alcotest.(check (option expiration_testable))
117 "cookie-2 expires" None (Cookeio.expires cookie2);
118
119 (* Test cookie-3: non-session cookie with expiry *)
120 let cookie3 = find_cookie "cookie-3" in
121 let expected_expiry = Ptime.of_float_s 1257894000.0 in
122 Alcotest.(check string)
123 "cookie-3 domain" "example.com" (Cookeio.domain cookie3);
124 Alcotest.(check string) "cookie-3 path" "/foo/" (Cookeio.path cookie3);
125 Alcotest.(check string) "cookie-3 name" "cookie-3" (Cookeio.name cookie3);
126 Alcotest.(check string) "cookie-3 value" "v$3" (Cookeio.value cookie3);
127 Alcotest.(check bool) "cookie-3 secure" false (Cookeio.secure cookie3);
128 Alcotest.(check bool) "cookie-3 http_only" false (Cookeio.http_only cookie3);
129 begin match expected_expiry with
130 | Some t ->
131 Alcotest.(check (option expiration_testable))
132 "cookie-3 expires"
133 (Some (`DateTime t))
134 (Cookeio.expires cookie3)
135 | None -> Alcotest.fail "Expected expiry time for cookie-3"
136 end;
137
138 (* Test cookie-4: another non-session cookie *)
139 let cookie4 = find_cookie "cookie-4" in
140 Alcotest.(check string)
141 "cookie-4 domain" "example.com" (Cookeio.domain cookie4);
142 Alcotest.(check string) "cookie-4 path" "/foo/" (Cookeio.path cookie4);
143 Alcotest.(check string) "cookie-4 name" "cookie-4" (Cookeio.name cookie4);
144 Alcotest.(check string) "cookie-4 value" "v$4" (Cookeio.value cookie4);
145 Alcotest.(check bool) "cookie-4 secure" false (Cookeio.secure cookie4);
146 Alcotest.(check bool) "cookie-4 http_only" false (Cookeio.http_only cookie4);
147 begin match expected_expiry with
148 | Some t ->
149 Alcotest.(check (option expiration_testable))
150 "cookie-4 expires"
151 (Some (`DateTime t))
152 (Cookeio.expires cookie4)
153 | None -> Alcotest.fail "Expected expiry time for cookie-4"
154 end;
155
156 (* Test cookie-5: secure cookie *)
157 let cookie5 = find_cookie "cookie-5" in
158 Alcotest.(check string)
159 "cookie-5 domain" "example.com" (Cookeio.domain cookie5);
160 Alcotest.(check string) "cookie-5 path" "/foo/" (Cookeio.path cookie5);
161 Alcotest.(check string) "cookie-5 name" "cookie-5" (Cookeio.name cookie5);
162 Alcotest.(check string) "cookie-5 value" "v$5" (Cookeio.value cookie5);
163 Alcotest.(check bool) "cookie-5 secure" true (Cookeio.secure cookie5);
164 Alcotest.(check bool) "cookie-5 http_only" false (Cookeio.http_only cookie5);
165 begin match expected_expiry with
166 | Some t ->
167 Alcotest.(check (option expiration_testable))
168 "cookie-5 expires"
169 (Some (`DateTime t))
170 (Cookeio.expires cookie5)
171 | None -> Alcotest.fail "Expected expiry time for cookie-5"
172 end
173
174let test_load_from_file env =
175 (* This test loads from the actual test/cookies.txt file using the load function *)
176 let clock = Eio.Stdenv.clock env in
177 let cwd = Eio.Stdenv.cwd env in
178 let cookie_path = Eio.Path.(cwd / "cookies.txt") in
179 let jar = load ~clock cookie_path in
180 let cookies = get_all_cookies jar in
181
182 (* Should have the same 5 cookies as the string test *)
183 Alcotest.(check int) "file load cookie count" 5 (List.length cookies);
184
185 let find_cookie name = List.find (fun c -> Cookeio.name c = name) cookies in
186
187 (* Verify a few key cookies are loaded correctly *)
188 let cookie1 = find_cookie "cookie-1" in
189 Alcotest.(check string) "file cookie-1 value" "v$1" (Cookeio.value cookie1);
190 Alcotest.(check string)
191 "file cookie-1 domain" "example.com" (Cookeio.domain cookie1);
192 Alcotest.(check bool) "file cookie-1 secure" false (Cookeio.secure cookie1);
193 Alcotest.(check (option expiration_testable))
194 "file cookie-1 expires" None (Cookeio.expires cookie1);
195
196 let cookie5 = find_cookie "cookie-5" in
197 Alcotest.(check string) "file cookie-5 value" "v$5" (Cookeio.value cookie5);
198 Alcotest.(check bool) "file cookie-5 secure" true (Cookeio.secure cookie5);
199 let expected_expiry = Ptime.of_float_s 1257894000.0 in
200 begin match expected_expiry with
201 | Some t ->
202 Alcotest.(check (option expiration_testable))
203 "file cookie-5 expires"
204 (Some (`DateTime t))
205 (Cookeio.expires cookie5)
206 | None -> Alcotest.fail "Expected expiry time for cookie-5"
207 end;
208
209 (* Verify subdomain cookie *)
210 let cookie2 = find_cookie "cookie-2" in
211 Alcotest.(check string)
212 "file cookie-2 domain" "example.com" (Cookeio.domain cookie2);
213 Alcotest.(check (option expiration_testable))
214 "file cookie-2 expires" None (Cookeio.expires cookie2)
215
216let test_cookie_matching env =
217 let clock = Eio.Stdenv.clock env in
218 let jar = create () in
219
220 (* Add test cookies with different domain patterns *)
221 let exact_cookie =
222 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"exact" ~value:"test1"
223 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
224 ~creation_time:Ptime.epoch ~last_access:Ptime.epoch ()
225 in
226 let subdomain_cookie =
227 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"subdomain"
228 ~value:"test2" ~secure:false ~http_only:false ?expires:None
229 ?same_site:None ?max_age:None ~creation_time:Ptime.epoch
230 ~last_access:Ptime.epoch ()
231 in
232 let secure_cookie =
233 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"secure" ~value:"test3"
234 ~secure:true ~http_only:false ?expires:None ?same_site:None ?max_age:None
235 ~creation_time:Ptime.epoch ~last_access:Ptime.epoch ()
236 in
237
238 add_cookie jar exact_cookie;
239 add_cookie jar subdomain_cookie;
240 add_cookie jar secure_cookie;
241
242 (* Test exact domain matching - all three cookies should match example.com *)
243 let cookies_http =
244 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
245 in
246 Alcotest.(check int) "http cookies count" 2 (List.length cookies_http);
247
248 let cookies_https =
249 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:true
250 in
251 Alcotest.(check int) "https cookies count" 3 (List.length cookies_https);
252
253 (* Test subdomain matching - all cookies should match subdomains now *)
254 let cookies_sub =
255 get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false
256 in
257 Alcotest.(check int) "subdomain cookies count" 2 (List.length cookies_sub)
258
259let test_empty_jar env =
260 let clock = Eio.Stdenv.clock env in
261 let jar = create () in
262 Alcotest.(check bool) "empty jar" true (is_empty jar);
263 Alcotest.(check int) "empty count" 0 (count jar);
264 Alcotest.(check (list cookie_testable))
265 "empty cookies" [] (get_all_cookies jar);
266
267 let cookies =
268 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
269 in
270 Alcotest.(check int) "no matching cookies" 0 (List.length cookies)
271
272let test_round_trip_mozilla_format env =
273 let clock = Eio.Stdenv.clock env in
274 let jar = create () in
275
276 let test_cookie =
277 let expires =
278 match Ptime.of_float_s 1257894000.0 with
279 | Some t -> Some (`DateTime t)
280 | None -> None
281 in
282 Cookeio.make ~domain:"example.com" ~path:"/test/" ~name:"test"
283 ~value:"value" ~secure:true ~http_only:false ?expires ~same_site:`Strict
284 ?max_age:None ~creation_time:Ptime.epoch ~last_access:Ptime.epoch ()
285 in
286
287 add_cookie jar test_cookie;
288
289 (* Convert to Mozilla format and back *)
290 let mozilla_format = to_mozilla_format jar in
291 let jar2 = from_mozilla_format ~clock mozilla_format in
292 let cookies2 = get_all_cookies jar2 in
293
294 Alcotest.(check int) "round trip count" 1 (List.length cookies2);
295 let cookie2 = List.hd cookies2 in
296 Alcotest.(check string) "round trip name" "test" (Cookeio.name cookie2);
297 Alcotest.(check string) "round trip value" "value" (Cookeio.value cookie2);
298 Alcotest.(check string)
299 "round trip domain" "example.com" (Cookeio.domain cookie2);
300 Alcotest.(check string) "round trip path" "/test/" (Cookeio.path cookie2);
301 Alcotest.(check bool) "round trip secure" true (Cookeio.secure cookie2);
302 (* Note: http_only and same_site are lost in Mozilla format *)
303 begin match Ptime.of_float_s 1257894000.0 with
304 | Some t ->
305 Alcotest.(check (option expiration_testable))
306 "round trip expires"
307 (Some (`DateTime t))
308 (Cookeio.expires cookie2)
309 | None -> Alcotest.fail "Expected expiry time"
310 end
311
312let test_cookie_expiry_with_mock_clock () =
313 Eio_mock.Backend.run @@ fun () ->
314 let clock = Eio_mock.Clock.make () in
315
316 (* Start at time 1000.0 for convenience *)
317 Eio_mock.Clock.set_time clock 1000.0;
318
319 let jar = create () in
320
321 (* Add a cookie that expires at time 1500.0 (expires in 500 seconds) *)
322 let expires_soon = Ptime.of_float_s 1500.0 |> Option.get in
323 let cookie1 =
324 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_soon"
325 ~value:"value1" ~secure:false ~http_only:false
326 ~expires:(`DateTime expires_soon) ?same_site:None ?max_age:None
327 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
328 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
329 ()
330 in
331
332 (* Add a cookie that expires at time 2000.0 (expires in 1000 seconds) *)
333 let expires_later = Ptime.of_float_s 2000.0 |> Option.get in
334 let cookie2 =
335 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_later"
336 ~value:"value2" ~secure:false ~http_only:false
337 ~expires:(`DateTime expires_later) ?same_site:None ?max_age:None
338 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
339 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
340 ()
341 in
342
343 (* Add a session cookie (no expiry) *)
344 let cookie3 =
345 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"value3"
346 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
347 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
348 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
349 ()
350 in
351
352 add_cookie jar cookie1;
353 add_cookie jar cookie2;
354 add_cookie jar cookie3;
355
356 Alcotest.(check int) "initial count" 3 (count jar);
357
358 (* Advance time to 1600.0 - first cookie should expire *)
359 Eio_mock.Clock.set_time clock 1600.0;
360 clear_expired jar ~clock;
361
362 Alcotest.(check int) "after first expiry" 2 (count jar);
363
364 let cookies = get_all_cookies jar in
365 let names = List.map Cookeio.name cookies |> List.sort String.compare in
366 Alcotest.(check (list string))
367 "remaining cookies after 1600s"
368 [ "expires_later"; "session" ]
369 names;
370
371 (* Advance time to 2100.0 - second cookie should expire *)
372 Eio_mock.Clock.set_time clock 2100.0;
373 clear_expired jar ~clock;
374
375 Alcotest.(check int) "after second expiry" 1 (count jar);
376
377 let remaining = get_all_cookies jar in
378 Alcotest.(check string)
379 "only session cookie remains" "session"
380 (Cookeio.name (List.hd remaining))
381
382let test_get_cookies_filters_expired () =
383 Eio_mock.Backend.run @@ fun () ->
384 let clock = Eio_mock.Clock.make () in
385 Eio_mock.Clock.set_time clock 1000.0;
386
387 let jar = create () in
388
389 (* Add an expired cookie (expired at time 500) *)
390 let expired = Ptime.of_float_s 500.0 |> Option.get in
391 let cookie_expired =
392 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expired"
393 ~value:"old" ~secure:false ~http_only:false
394 ~expires:(`DateTime expired)
395 ~creation_time:(Ptime.of_float_s 100.0 |> Option.get)
396 ~last_access:(Ptime.of_float_s 100.0 |> Option.get)
397 ()
398 in
399
400 (* Add a valid cookie (expires at time 2000) *)
401 let valid_time = Ptime.of_float_s 2000.0 |> Option.get in
402 let cookie_valid =
403 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"valid"
404 ~value:"current" ~secure:false ~http_only:false
405 ~expires:(`DateTime valid_time)
406 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
407 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
408 ()
409 in
410
411 (* Add a session cookie (no expiry) *)
412 let cookie_session =
413 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session"
414 ~value:"sess" ~secure:false ~http_only:false
415 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
416 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
417 ()
418 in
419
420 add_cookie jar cookie_expired;
421 add_cookie jar cookie_valid;
422 add_cookie jar cookie_session;
423
424 (* get_all_cookies returns all including expired (for inspection) *)
425 Alcotest.(check int) "get_all_cookies includes expired" 3
426 (List.length (get_all_cookies jar));
427
428 (* get_cookies should automatically filter out expired cookies *)
429 let cookies =
430 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
431 in
432 Alcotest.(check int) "get_cookies filters expired" 2 (List.length cookies);
433
434 let names = List.map Cookeio.name cookies |> List.sort String.compare in
435 Alcotest.(check (list string))
436 "only non-expired cookies returned"
437 [ "session"; "valid" ]
438 names
439
440let test_max_age_parsing_with_mock_clock () =
441 Eio_mock.Backend.run @@ fun () ->
442 let clock = Eio_mock.Clock.make () in
443
444 (* Start at a known time *)
445 Eio_mock.Clock.set_time clock 5000.0;
446
447 (* Parse a Set-Cookie header with Max-Age *)
448 let header = "session=abc123; Max-Age=3600; Secure; HttpOnly" in
449 let cookie_opt =
450 of_set_cookie_header
451 ~now:(fun () ->
452 Ptime.of_float_s (Eio.Time.now clock)
453 |> Option.value ~default:Ptime.epoch)
454 ~domain:"example.com" ~path:"/" header
455 in
456
457 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
458
459 let cookie = Result.get_ok cookie_opt in
460 Alcotest.(check string) "cookie name" "session" (Cookeio.name cookie);
461 Alcotest.(check string) "cookie value" "abc123" (Cookeio.value cookie);
462 Alcotest.(check bool) "cookie secure" true (Cookeio.secure cookie);
463 Alcotest.(check bool) "cookie http_only" true (Cookeio.http_only cookie);
464
465 (* Verify the expiry time is set correctly (5000.0 + 3600 = 8600.0) *)
466 let expected_expiry = Ptime.of_float_s 8600.0 in
467 begin match expected_expiry with
468 | Some t ->
469 Alcotest.(check (option expiration_testable))
470 "expires set from max-age"
471 (Some (`DateTime t))
472 (Cookeio.expires cookie)
473 | None -> Alcotest.fail "Expected expiry time"
474 end;
475
476 (* Verify creation time matches clock time *)
477 let expected_creation = Ptime.of_float_s 5000.0 in
478 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
479 "creation time" expected_creation
480 (Some (Cookeio.creation_time cookie))
481
482let test_last_access_time_with_mock_clock () =
483 Eio_mock.Backend.run @@ fun () ->
484 let clock = Eio_mock.Clock.make () in
485
486 (* Start at time 3000.0 *)
487 Eio_mock.Clock.set_time clock 3000.0;
488
489 let jar = create () in
490
491 (* Add a cookie *)
492 let cookie =
493 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
494 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
495 ~creation_time:(Ptime.of_float_s 3000.0 |> Option.get)
496 ~last_access:(Ptime.of_float_s 3000.0 |> Option.get)
497 ()
498 in
499 add_cookie jar cookie;
500
501 (* Verify initial last access time *)
502 let cookies1 = get_all_cookies jar in
503 let cookie1 = List.hd cookies1 in
504 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
505 "initial last access" (Ptime.of_float_s 3000.0)
506 (Some (Cookeio.last_access cookie1));
507
508 (* Advance time to 4000.0 *)
509 Eio_mock.Clock.set_time clock 4000.0;
510
511 (* Get cookies, which should update last access time to current clock time *)
512 let _retrieved =
513 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
514 in
515
516 (* Verify last access time was updated to the new clock time *)
517 let cookies2 = get_all_cookies jar in
518 let cookie2 = List.hd cookies2 in
519 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
520 "updated last access" (Ptime.of_float_s 4000.0)
521 (Some (Cookeio.last_access cookie2))
522
523let test_of_set_cookie_header_with_expires () =
524 Eio_mock.Backend.run @@ fun () ->
525 let clock = Eio_mock.Clock.make () in
526
527 (* Start at a known time *)
528 Eio_mock.Clock.set_time clock 6000.0;
529
530 (* Use RFC3339 format which is what Ptime.of_rfc3339 expects *)
531 let header =
532 "id=xyz789; Expires=2025-10-21T07:28:00Z; Path=/; Domain=.example.com"
533 in
534 let cookie_opt =
535 of_set_cookie_header
536 ~now:(fun () ->
537 Ptime.of_float_s (Eio.Time.now clock)
538 |> Option.value ~default:Ptime.epoch)
539 ~domain:"example.com" ~path:"/" header
540 in
541
542 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
543
544 let cookie = Result.get_ok cookie_opt in
545 Alcotest.(check string) "cookie name" "id" (Cookeio.name cookie);
546 Alcotest.(check string) "cookie value" "xyz789" (Cookeio.value cookie);
547 Alcotest.(check string) "cookie domain" "example.com" (Cookeio.domain cookie);
548 Alcotest.(check string) "cookie path" "/" (Cookeio.path cookie);
549
550 (* Verify expires is parsed correctly *)
551 Alcotest.(check bool)
552 "has expiry" true
553 (Option.is_some (Cookeio.expires cookie));
554
555 (* Verify the specific expiry time parsed from the RFC3339 date *)
556 let expected_expiry = Ptime.of_rfc3339 "2025-10-21T07:28:00Z" in
557 match expected_expiry with
558 | Ok (time, _, _) ->
559 Alcotest.(check (option expiration_testable))
560 "expires matches parsed value"
561 (Some (`DateTime time))
562 (Cookeio.expires cookie)
563 | Error _ -> Alcotest.fail "Failed to parse expected expiry time"
564
565let test_samesite_none_validation () =
566 Eio_mock.Backend.run @@ fun () ->
567 let clock = Eio_mock.Clock.make () in
568
569 (* Start at a known time *)
570 Eio_mock.Clock.set_time clock 7000.0;
571
572 (* This should be rejected: SameSite=None without Secure *)
573 let invalid_header = "token=abc; SameSite=None" in
574 let cookie_opt =
575 of_set_cookie_header
576 ~now:(fun () ->
577 Ptime.of_float_s (Eio.Time.now clock)
578 |> Option.value ~default:Ptime.epoch)
579 ~domain:"example.com" ~path:"/" invalid_header
580 in
581
582 Alcotest.(check bool)
583 "invalid cookie rejected" true
584 (Result.is_error cookie_opt);
585
586 (* This should be accepted: SameSite=None with Secure *)
587 let valid_header = "token=abc; SameSite=None; Secure" in
588 let cookie_opt2 =
589 of_set_cookie_header
590 ~now:(fun () ->
591 Ptime.of_float_s (Eio.Time.now clock)
592 |> Option.value ~default:Ptime.epoch)
593 ~domain:"example.com" ~path:"/" valid_header
594 in
595
596 Alcotest.(check bool)
597 "valid cookie accepted" true
598 (Result.is_ok cookie_opt2);
599
600 let cookie = Result.get_ok cookie_opt2 in
601 Alcotest.(check bool) "cookie is secure" true (Cookeio.secure cookie);
602 Alcotest.(
603 check
604 (option
605 (Alcotest.testable
606 (fun ppf -> function
607 | `Strict -> Format.pp_print_string ppf "Strict"
608 | `Lax -> Format.pp_print_string ppf "Lax"
609 | `None -> Format.pp_print_string ppf "None")
610 ( = ))))
611 "samesite is None" (Some `None) (Cookeio.same_site cookie)
612
613let test_domain_normalization () =
614 Eio_mock.Backend.run @@ fun () ->
615 let clock = Eio_mock.Clock.make () in
616 Eio_mock.Clock.set_time clock 1000.0;
617
618 (* Test parsing ".example.com" stores as "example.com" *)
619 let header = "test=value; Domain=.example.com" in
620 let cookie_opt =
621 of_set_cookie_header
622 ~now:(fun () ->
623 Ptime.of_float_s (Eio.Time.now clock)
624 |> Option.value ~default:Ptime.epoch)
625 ~domain:"example.com" ~path:"/" header
626 in
627 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
628 let cookie = Result.get_ok cookie_opt in
629 Alcotest.(check string)
630 "domain normalized" "example.com" (Cookeio.domain cookie);
631
632 (* Test round-trip through Mozilla format normalizes domains *)
633 let jar = create () in
634 let test_cookie =
635 Cookeio.make ~domain:".example.com" ~path:"/" ~name:"test" ~value:"val"
636 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
637 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
638 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
639 ()
640 in
641 add_cookie jar test_cookie;
642
643 let mozilla_format = to_mozilla_format jar in
644 let jar2 = from_mozilla_format ~clock mozilla_format in
645 let cookies2 = get_all_cookies jar2 in
646 Alcotest.(check int) "one cookie" 1 (List.length cookies2);
647 Alcotest.(check string)
648 "domain normalized after round-trip" "example.com"
649 (Cookeio.domain (List.hd cookies2))
650
651let test_max_age_stored_separately () =
652 Eio_mock.Backend.run @@ fun () ->
653 let clock = Eio_mock.Clock.make () in
654 Eio_mock.Clock.set_time clock 5000.0;
655
656 (* Parse a Set-Cookie header with Max-Age *)
657 let header = "session=abc123; Max-Age=3600" in
658 let cookie_opt =
659 of_set_cookie_header
660 ~now:(fun () ->
661 Ptime.of_float_s (Eio.Time.now clock)
662 |> Option.value ~default:Ptime.epoch)
663 ~domain:"example.com" ~path:"/" header
664 in
665 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
666
667 let cookie = Result.get_ok cookie_opt in
668
669 (* Verify max_age is stored as a Ptime.Span *)
670 Alcotest.(check bool)
671 "max_age is set" true
672 (Option.is_some (Cookeio.max_age cookie));
673 let max_age_span = Option.get (Cookeio.max_age cookie) in
674 Alcotest.(check (option int))
675 "max_age is 3600 seconds" (Some 3600)
676 (Ptime.Span.to_int_s max_age_span);
677
678 (* Verify expires is also computed correctly *)
679 let expected_expiry = Ptime.of_float_s 8600.0 in
680 begin match expected_expiry with
681 | Some t ->
682 Alcotest.(check (option expiration_testable))
683 "expires computed from max-age"
684 (Some (`DateTime t))
685 (Cookeio.expires cookie)
686 | None -> Alcotest.fail "Expected expiry time"
687 end
688
689let test_max_age_negative_becomes_zero () =
690 Eio_mock.Backend.run @@ fun () ->
691 let clock = Eio_mock.Clock.make () in
692 Eio_mock.Clock.set_time clock 5000.0;
693
694 (* Parse a Set-Cookie header with negative Max-Age *)
695 let header = "session=abc123; Max-Age=-100" in
696 let cookie_opt =
697 of_set_cookie_header
698 ~now:(fun () ->
699 Ptime.of_float_s (Eio.Time.now clock)
700 |> Option.value ~default:Ptime.epoch)
701 ~domain:"example.com" ~path:"/" header
702 in
703 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
704
705 let cookie = Result.get_ok cookie_opt in
706
707 (* Verify max_age is stored as 0 per RFC 6265 *)
708 Alcotest.(check bool)
709 "max_age is set" true
710 (Option.is_some (Cookeio.max_age cookie));
711 let max_age_span = Option.get (Cookeio.max_age cookie) in
712 Alcotest.(check (option int))
713 "negative max_age becomes 0" (Some 0)
714 (Ptime.Span.to_int_s max_age_span);
715
716 (* Verify expires is computed with 0 seconds *)
717 let expected_expiry = Ptime.of_float_s 5000.0 in
718 begin match expected_expiry with
719 | Some t ->
720 Alcotest.(check (option expiration_testable))
721 "expires computed with 0 seconds"
722 (Some (`DateTime t))
723 (Cookeio.expires cookie)
724 | None -> Alcotest.fail "Expected expiry time"
725 end
726
727let string_contains_substring s sub =
728 try
729 let len = String.length sub in
730 let rec search i =
731 if i + len > String.length s then false
732 else if String.sub s i len = sub then true
733 else search (i + 1)
734 in
735 search 0
736 with _ -> false
737
738let test_make_set_cookie_header_includes_max_age () =
739 Eio_mock.Backend.run @@ fun () ->
740 let clock = Eio_mock.Clock.make () in
741 Eio_mock.Clock.set_time clock 5000.0;
742
743 (* Create a cookie with max_age *)
744 let max_age_span = Ptime.Span.of_int_s 3600 in
745 let expires_time = Ptime.of_float_s 8600.0 |> Option.get in
746 let cookie =
747 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"abc123"
748 ~secure:true ~http_only:true
749 ?expires:(Some (`DateTime expires_time))
750 ?max_age:(Some max_age_span) ?same_site:(Some `Strict)
751 ~creation_time:(Ptime.of_float_s 5000.0 |> Option.get)
752 ~last_access:(Ptime.of_float_s 5000.0 |> Option.get)
753 ()
754 in
755
756 let header = make_set_cookie_header cookie in
757
758 (* Verify the header includes Max-Age *)
759 Alcotest.(check bool)
760 "header includes Max-Age" true
761 (string_contains_substring header "Max-Age=3600");
762
763 (* Verify the header includes Expires *)
764 Alcotest.(check bool)
765 "header includes Expires" true
766 (string_contains_substring header "Expires=");
767
768 (* Verify the header includes other attributes *)
769 Alcotest.(check bool)
770 "header includes Secure" true
771 (string_contains_substring header "Secure");
772 Alcotest.(check bool)
773 "header includes HttpOnly" true
774 (string_contains_substring header "HttpOnly");
775 Alcotest.(check bool)
776 "header includes SameSite" true
777 (string_contains_substring header "SameSite=Strict")
778
779let test_max_age_round_trip () =
780 Eio_mock.Backend.run @@ fun () ->
781 let clock = Eio_mock.Clock.make () in
782 Eio_mock.Clock.set_time clock 5000.0;
783
784 (* Parse a cookie with Max-Age *)
785 let header = "session=xyz; Max-Age=7200; Secure; HttpOnly" in
786 let cookie_opt =
787 of_set_cookie_header
788 ~now:(fun () ->
789 Ptime.of_float_s (Eio.Time.now clock)
790 |> Option.value ~default:Ptime.epoch)
791 ~domain:"example.com" ~path:"/" header
792 in
793 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
794 let cookie = Result.get_ok cookie_opt in
795
796 (* Generate Set-Cookie header from the cookie *)
797 let set_cookie_header = make_set_cookie_header cookie in
798
799 (* Parse it back *)
800 Eio_mock.Clock.set_time clock 5000.0;
801 (* Reset clock to same time *)
802 let cookie2_opt =
803 of_set_cookie_header
804 ~now:(fun () ->
805 Ptime.of_float_s (Eio.Time.now clock)
806 |> Option.value ~default:Ptime.epoch)
807 ~domain:"example.com" ~path:"/" set_cookie_header
808 in
809 Alcotest.(check bool) "cookie re-parsed" true (Result.is_ok cookie2_opt);
810 let cookie2 = Result.get_ok cookie2_opt in
811
812 (* Verify max_age is preserved *)
813 Alcotest.(check (option int))
814 "max_age preserved"
815 (Ptime.Span.to_int_s (Option.get (Cookeio.max_age cookie)))
816 (Ptime.Span.to_int_s (Option.get (Cookeio.max_age cookie2)))
817
818let test_domain_matching () =
819 Eio_mock.Backend.run @@ fun () ->
820 let clock = Eio_mock.Clock.make () in
821 Eio_mock.Clock.set_time clock 2000.0;
822
823 let jar = create () in
824
825 (* Create a cookie with domain "example.com" *)
826 let cookie =
827 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
828 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
829 ~creation_time:(Ptime.of_float_s 2000.0 |> Option.get)
830 ~last_access:(Ptime.of_float_s 2000.0 |> Option.get)
831 ()
832 in
833 add_cookie jar cookie;
834
835 (* Test "example.com" cookie matches "example.com" request *)
836 let cookies1 =
837 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
838 in
839 Alcotest.(check int) "matches exact domain" 1 (List.length cookies1);
840
841 (* Test "example.com" cookie matches "sub.example.com" request *)
842 let cookies2 =
843 get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false
844 in
845 Alcotest.(check int) "matches subdomain" 1 (List.length cookies2);
846
847 (* Test "example.com" cookie matches "deep.sub.example.com" request *)
848 let cookies3 =
849 get_cookies jar ~clock ~domain:"deep.sub.example.com" ~path:"/"
850 ~is_secure:false
851 in
852 Alcotest.(check int) "matches deep subdomain" 1 (List.length cookies3);
853
854 (* Test "example.com" cookie doesn't match "notexample.com" *)
855 let cookies4 =
856 get_cookies jar ~clock ~domain:"notexample.com" ~path:"/" ~is_secure:false
857 in
858 Alcotest.(check int) "doesn't match different domain" 0 (List.length cookies4);
859
860 (* Test "example.com" cookie doesn't match "fakeexample.com" *)
861 let cookies5 =
862 get_cookies jar ~clock ~domain:"fakeexample.com" ~path:"/" ~is_secure:false
863 in
864 Alcotest.(check int) "doesn't match prefix domain" 0 (List.length cookies5)
865
866(** {1 HTTP Date Parsing Tests} *)
867
868let test_http_date_fmt1 () =
869 Eio_mock.Backend.run @@ fun () ->
870 let clock = Eio_mock.Clock.make () in
871 Eio_mock.Clock.set_time clock 1000.0;
872
873 (* Test FMT1: "Wed, 21 Oct 2015 07:28:00 GMT" (RFC 1123) *)
874 let header = "session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GMT" in
875 let cookie_opt =
876 of_set_cookie_header
877 ~now:(fun () ->
878 Ptime.of_float_s (Eio.Time.now clock)
879 |> Option.value ~default:Ptime.epoch)
880 ~domain:"example.com" ~path:"/" header
881 in
882 Alcotest.(check bool) "FMT1 cookie parsed" true (Result.is_ok cookie_opt);
883
884 let cookie = Result.get_ok cookie_opt in
885 Alcotest.(check bool)
886 "FMT1 has expiry" true
887 (Option.is_some (Cookeio.expires cookie));
888
889 (* Verify the parsed time matches expected value *)
890 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
891 begin match expected with
892 | Some t ->
893 Alcotest.(check (option expiration_testable))
894 "FMT1 expiry correct"
895 (Some (`DateTime t))
896 (Cookeio.expires cookie)
897 | None -> Alcotest.fail "Expected expiry time for FMT1"
898 end
899
900let test_http_date_fmt2 () =
901 Eio_mock.Backend.run @@ fun () ->
902 let clock = Eio_mock.Clock.make () in
903 Eio_mock.Clock.set_time clock 1000.0;
904
905 (* Test FMT2: "Wednesday, 21-Oct-15 07:28:00 GMT" (RFC 850 with abbreviated year) *)
906 let header = "session=abc; Expires=Wednesday, 21-Oct-15 07:28:00 GMT" in
907 let cookie_opt =
908 of_set_cookie_header
909 ~now:(fun () ->
910 Ptime.of_float_s (Eio.Time.now clock)
911 |> Option.value ~default:Ptime.epoch)
912 ~domain:"example.com" ~path:"/" header
913 in
914 Alcotest.(check bool) "FMT2 cookie parsed" true (Result.is_ok cookie_opt);
915
916 let cookie = Result.get_ok cookie_opt in
917 Alcotest.(check bool)
918 "FMT2 has expiry" true
919 (Option.is_some (Cookeio.expires cookie));
920
921 (* Year 15 should be normalized to 2015 *)
922 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
923 begin match expected with
924 | Some t ->
925 Alcotest.(check (option expiration_testable))
926 "FMT2 expiry correct with year normalization"
927 (Some (`DateTime t))
928 (Cookeio.expires cookie)
929 | None -> Alcotest.fail "Expected expiry time for FMT2"
930 end
931
932let test_http_date_fmt3 () =
933 Eio_mock.Backend.run @@ fun () ->
934 let clock = Eio_mock.Clock.make () in
935 Eio_mock.Clock.set_time clock 1000.0;
936
937 (* Test FMT3: "Wed Oct 21 07:28:00 2015" (asctime) *)
938 let header = "session=abc; Expires=Wed Oct 21 07:28:00 2015" in
939 let cookie_opt =
940 of_set_cookie_header
941 ~now:(fun () ->
942 Ptime.of_float_s (Eio.Time.now clock)
943 |> Option.value ~default:Ptime.epoch)
944 ~domain:"example.com" ~path:"/" header
945 in
946 Alcotest.(check bool) "FMT3 cookie parsed" true (Result.is_ok cookie_opt);
947
948 let cookie = Result.get_ok cookie_opt in
949 Alcotest.(check bool)
950 "FMT3 has expiry" true
951 (Option.is_some (Cookeio.expires cookie));
952
953 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
954 begin match expected with
955 | Some t ->
956 Alcotest.(check (option expiration_testable))
957 "FMT3 expiry correct"
958 (Some (`DateTime t))
959 (Cookeio.expires cookie)
960 | None -> Alcotest.fail "Expected expiry time for FMT3"
961 end
962
963let test_http_date_fmt4 () =
964 Eio_mock.Backend.run @@ fun () ->
965 let clock = Eio_mock.Clock.make () in
966 Eio_mock.Clock.set_time clock 1000.0;
967
968 (* Test FMT4: "Wed, 21-Oct-2015 07:28:00 GMT" (variant) *)
969 let header = "session=abc; Expires=Wed, 21-Oct-2015 07:28:00 GMT" in
970 let cookie_opt =
971 of_set_cookie_header
972 ~now:(fun () ->
973 Ptime.of_float_s (Eio.Time.now clock)
974 |> Option.value ~default:Ptime.epoch)
975 ~domain:"example.com" ~path:"/" header
976 in
977 Alcotest.(check bool) "FMT4 cookie parsed" true (Result.is_ok cookie_opt);
978
979 let cookie = Result.get_ok cookie_opt in
980 Alcotest.(check bool)
981 "FMT4 has expiry" true
982 (Option.is_some (Cookeio.expires cookie));
983
984 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
985 begin match expected with
986 | Some t ->
987 Alcotest.(check (option expiration_testable))
988 "FMT4 expiry correct"
989 (Some (`DateTime t))
990 (Cookeio.expires cookie)
991 | None -> Alcotest.fail "Expected expiry time for FMT4"
992 end
993
994let test_abbreviated_year_69_to_99 () =
995 Eio_mock.Backend.run @@ fun () ->
996 let clock = Eio_mock.Clock.make () in
997 Eio_mock.Clock.set_time clock 1000.0;
998
999 (* Year 95 should become 1995 *)
1000 let header = "session=abc; Expires=Wed, 21-Oct-95 07:28:00 GMT" in
1001 let cookie_opt =
1002 of_set_cookie_header
1003 ~now:(fun () ->
1004 Ptime.of_float_s (Eio.Time.now clock)
1005 |> Option.value ~default:Ptime.epoch)
1006 ~domain:"example.com" ~path:"/" header
1007 in
1008 let cookie = Result.get_ok cookie_opt in
1009 let expected = Ptime.of_date_time ((1995, 10, 21), ((07, 28, 00), 0)) in
1010 begin match expected with
1011 | Some t ->
1012 Alcotest.(check (option expiration_testable))
1013 "year 95 becomes 1995"
1014 (Some (`DateTime t))
1015 (Cookeio.expires cookie)
1016 | None -> Alcotest.fail "Expected expiry time for year 95"
1017 end;
1018
1019 (* Year 69 should become 1969 *)
1020 let header2 = "session=abc; Expires=Wed, 10-Sep-69 20:00:00 GMT" in
1021 let cookie_opt2 =
1022 of_set_cookie_header
1023 ~now:(fun () ->
1024 Ptime.of_float_s (Eio.Time.now clock)
1025 |> Option.value ~default:Ptime.epoch)
1026 ~domain:"example.com" ~path:"/" header2
1027 in
1028 let cookie2 = Result.get_ok cookie_opt2 in
1029 let expected2 = Ptime.of_date_time ((1969, 9, 10), ((20, 0, 0), 0)) in
1030 begin match expected2 with
1031 | Some t ->
1032 Alcotest.(check (option expiration_testable))
1033 "year 69 becomes 1969"
1034 (Some (`DateTime t))
1035 (Cookeio.expires cookie2)
1036 | None -> Alcotest.fail "Expected expiry time for year 69"
1037 end;
1038
1039 (* Year 99 should become 1999 *)
1040 let header3 = "session=abc; Expires=Thu, 10-Sep-99 20:00:00 GMT" in
1041 let cookie_opt3 =
1042 of_set_cookie_header
1043 ~now:(fun () ->
1044 Ptime.of_float_s (Eio.Time.now clock)
1045 |> Option.value ~default:Ptime.epoch)
1046 ~domain:"example.com" ~path:"/" header3
1047 in
1048 let cookie3 = Result.get_ok cookie_opt3 in
1049 let expected3 = Ptime.of_date_time ((1999, 9, 10), ((20, 0, 0), 0)) in
1050 begin match expected3 with
1051 | Some t ->
1052 Alcotest.(check (option expiration_testable))
1053 "year 99 becomes 1999"
1054 (Some (`DateTime t))
1055 (Cookeio.expires cookie3)
1056 | None -> Alcotest.fail "Expected expiry time for year 99"
1057 end
1058
1059let test_abbreviated_year_0_to_68 () =
1060 Eio_mock.Backend.run @@ fun () ->
1061 let clock = Eio_mock.Clock.make () in
1062 Eio_mock.Clock.set_time clock 1000.0;
1063
1064 (* Year 25 should become 2025 *)
1065 let header = "session=abc; Expires=Wed, 21-Oct-25 07:28:00 GMT" in
1066 let cookie_opt =
1067 of_set_cookie_header
1068 ~now:(fun () ->
1069 Ptime.of_float_s (Eio.Time.now clock)
1070 |> Option.value ~default:Ptime.epoch)
1071 ~domain:"example.com" ~path:"/" header
1072 in
1073 let cookie = Result.get_ok cookie_opt in
1074 let expected = Ptime.of_date_time ((2025, 10, 21), ((07, 28, 00), 0)) in
1075 begin match expected with
1076 | Some t ->
1077 Alcotest.(check (option expiration_testable))
1078 "year 25 becomes 2025"
1079 (Some (`DateTime t))
1080 (Cookeio.expires cookie)
1081 | None -> Alcotest.fail "Expected expiry time for year 25"
1082 end;
1083
1084 (* Year 0 should become 2000 *)
1085 let header2 = "session=abc; Expires=Fri, 01-Jan-00 00:00:00 GMT" in
1086 let cookie_opt2 =
1087 of_set_cookie_header
1088 ~now:(fun () ->
1089 Ptime.of_float_s (Eio.Time.now clock)
1090 |> Option.value ~default:Ptime.epoch)
1091 ~domain:"example.com" ~path:"/" header2
1092 in
1093 let cookie2 = Result.get_ok cookie_opt2 in
1094 let expected2 = Ptime.of_date_time ((2000, 1, 1), ((0, 0, 0), 0)) in
1095 begin match expected2 with
1096 | Some t ->
1097 Alcotest.(check (option expiration_testable))
1098 "year 0 becomes 2000"
1099 (Some (`DateTime t))
1100 (Cookeio.expires cookie2)
1101 | None -> Alcotest.fail "Expected expiry time for year 0"
1102 end;
1103
1104 (* Year 68 should become 2068 *)
1105 let header3 = "session=abc; Expires=Thu, 10-Sep-68 20:00:00 GMT" in
1106 let cookie_opt3 =
1107 of_set_cookie_header
1108 ~now:(fun () ->
1109 Ptime.of_float_s (Eio.Time.now clock)
1110 |> Option.value ~default:Ptime.epoch)
1111 ~domain:"example.com" ~path:"/" header3
1112 in
1113 let cookie3 = Result.get_ok cookie_opt3 in
1114 let expected3 = Ptime.of_date_time ((2068, 9, 10), ((20, 0, 0), 0)) in
1115 begin match expected3 with
1116 | Some t ->
1117 Alcotest.(check (option expiration_testable))
1118 "year 68 becomes 2068"
1119 (Some (`DateTime t))
1120 (Cookeio.expires cookie3)
1121 | None -> Alcotest.fail "Expected expiry time for year 68"
1122 end
1123
1124let test_rfc3339_still_works () =
1125 Eio_mock.Backend.run @@ fun () ->
1126 let clock = Eio_mock.Clock.make () in
1127 Eio_mock.Clock.set_time clock 1000.0;
1128
1129 (* Ensure RFC 3339 format still works for backward compatibility *)
1130 let header = "session=abc; Expires=2025-10-21T07:28:00Z" in
1131 let cookie_opt =
1132 of_set_cookie_header
1133 ~now:(fun () ->
1134 Ptime.of_float_s (Eio.Time.now clock)
1135 |> Option.value ~default:Ptime.epoch)
1136 ~domain:"example.com" ~path:"/" header
1137 in
1138 Alcotest.(check bool)
1139 "RFC 3339 cookie parsed" true
1140 (Result.is_ok cookie_opt);
1141
1142 let cookie = Result.get_ok cookie_opt in
1143 Alcotest.(check bool)
1144 "RFC 3339 has expiry" true
1145 (Option.is_some (Cookeio.expires cookie));
1146
1147 (* Verify the time was parsed correctly *)
1148 let expected = Ptime.of_rfc3339 "2025-10-21T07:28:00Z" in
1149 match expected with
1150 | Ok (time, _, _) ->
1151 Alcotest.(check (option expiration_testable))
1152 "RFC 3339 expiry correct"
1153 (Some (`DateTime time))
1154 (Cookeio.expires cookie)
1155 | Error _ -> Alcotest.fail "Failed to parse expected RFC 3339 time"
1156
1157let test_invalid_date_format_logs_warning () =
1158 Eio_mock.Backend.run @@ fun () ->
1159 let clock = Eio_mock.Clock.make () in
1160 Eio_mock.Clock.set_time clock 1000.0;
1161
1162 (* Invalid date format should log a warning but still parse the cookie *)
1163 let header = "session=abc; Expires=InvalidDate" in
1164 let cookie_opt =
1165 of_set_cookie_header
1166 ~now:(fun () ->
1167 Ptime.of_float_s (Eio.Time.now clock)
1168 |> Option.value ~default:Ptime.epoch)
1169 ~domain:"example.com" ~path:"/" header
1170 in
1171
1172 (* Cookie should still be parsed, just without expires *)
1173 Alcotest.(check bool)
1174 "cookie parsed despite invalid date" true
1175 (Result.is_ok cookie_opt);
1176 let cookie = Result.get_ok cookie_opt in
1177 Alcotest.(check string) "cookie name correct" "session" (Cookeio.name cookie);
1178 Alcotest.(check string) "cookie value correct" "abc" (Cookeio.value cookie);
1179 (* expires should be None since date was invalid *)
1180 Alcotest.(check (option expiration_testable))
1181 "expires is None for invalid date" None (Cookeio.expires cookie)
1182
1183let test_case_insensitive_month_parsing () =
1184 Eio_mock.Backend.run @@ fun () ->
1185 let clock = Eio_mock.Clock.make () in
1186 Eio_mock.Clock.set_time clock 1000.0;
1187
1188 (* Test various case combinations for month names *)
1189 let test_cases =
1190 [
1191 ("session=abc; Expires=Wed, 21 oct 2015 07:28:00 GMT", "lowercase month");
1192 ("session=abc; Expires=Wed, 21 OCT 2015 07:28:00 GMT", "uppercase month");
1193 ("session=abc; Expires=Wed, 21 OcT 2015 07:28:00 GMT", "mixed case month");
1194 ("session=abc; Expires=Wed, 21 oCt 2015 07:28:00 GMT", "weird case month");
1195 ]
1196 in
1197
1198 List.iter
1199 (fun (header, description) ->
1200 let cookie_opt =
1201 of_set_cookie_header
1202 ~now:(fun () ->
1203 Ptime.of_float_s (Eio.Time.now clock)
1204 |> Option.value ~default:Ptime.epoch)
1205 ~domain:"example.com" ~path:"/" header
1206 in
1207 Alcotest.(check bool)
1208 (description ^ " parsed") true
1209 (Result.is_ok cookie_opt);
1210
1211 let cookie = Result.get_ok cookie_opt in
1212 Alcotest.(check bool)
1213 (description ^ " has expiry")
1214 true
1215 (Option.is_some (Cookeio.expires cookie));
1216
1217 (* Verify the date was parsed correctly regardless of case *)
1218 let expires = Option.get (Cookeio.expires cookie) in
1219 match expires with
1220 | `DateTime ptime ->
1221 let year, month, _ = Ptime.to_date ptime in
1222 Alcotest.(check int) (description ^ " year correct") 2015 year;
1223 Alcotest.(check int)
1224 (description ^ " month correct (October=10)")
1225 10 month
1226 | `Session -> Alcotest.fail (description ^ " should not be session cookie"))
1227 test_cases
1228
1229let test_case_insensitive_gmt_parsing () =
1230 Eio_mock.Backend.run @@ fun () ->
1231 let clock = Eio_mock.Clock.make () in
1232 Eio_mock.Clock.set_time clock 1000.0;
1233
1234 (* Test various case combinations for GMT timezone *)
1235 let test_cases =
1236 [
1237 ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GMT", "uppercase GMT");
1238 ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 gmt", "lowercase gmt");
1239 ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 Gmt", "mixed case Gmt");
1240 ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GmT", "weird case GmT");
1241 ]
1242 in
1243
1244 List.iter
1245 (fun (header, description) ->
1246 let cookie_opt =
1247 of_set_cookie_header
1248 ~now:(fun () ->
1249 Ptime.of_float_s (Eio.Time.now clock)
1250 |> Option.value ~default:Ptime.epoch)
1251 ~domain:"example.com" ~path:"/" header
1252 in
1253 Alcotest.(check bool)
1254 (description ^ " parsed") true
1255 (Result.is_ok cookie_opt);
1256
1257 let cookie = Result.get_ok cookie_opt in
1258 Alcotest.(check bool)
1259 (description ^ " has expiry")
1260 true
1261 (Option.is_some (Cookeio.expires cookie));
1262
1263 (* Verify the date was parsed correctly regardless of GMT case *)
1264 let expires = Option.get (Cookeio.expires cookie) in
1265 match expires with
1266 | `DateTime ptime ->
1267 let year, month, day = Ptime.to_date ptime in
1268 Alcotest.(check int) (description ^ " year correct") 2015 year;
1269 Alcotest.(check int)
1270 (description ^ " month correct (October=10)")
1271 10 month;
1272 Alcotest.(check int) (description ^ " day correct") 21 day
1273 | `Session -> Alcotest.fail (description ^ " should not be session cookie"))
1274 test_cases
1275
1276(** {1 Delta Tracking Tests} *)
1277
1278let test_add_original_not_in_delta () =
1279 Eio_mock.Backend.run @@ fun () ->
1280 let clock = Eio_mock.Clock.make () in
1281 Eio_mock.Clock.set_time clock 1000.0;
1282
1283 let jar = create () in
1284 let cookie =
1285 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
1286 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1287 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1288 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1289 ()
1290 in
1291 add_original jar cookie;
1292
1293 (* Delta should be empty *)
1294 let delta = delta jar in
1295 Alcotest.(check int) "delta is empty" 0 (List.length delta);
1296
1297 (* But the cookie should be in the jar *)
1298 Alcotest.(check int) "jar count is 1" 1 (count jar)
1299
1300let test_add_cookie_appears_in_delta () =
1301 Eio_mock.Backend.run @@ fun () ->
1302 let clock = Eio_mock.Clock.make () in
1303 Eio_mock.Clock.set_time clock 1000.0;
1304
1305 let jar = create () in
1306 let cookie =
1307 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
1308 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1309 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1310 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1311 ()
1312 in
1313 add_cookie jar cookie;
1314
1315 (* Delta should contain the cookie *)
1316 let delta = delta jar in
1317 Alcotest.(check int) "delta has 1 cookie" 1 (List.length delta);
1318 let delta_cookie = List.hd delta in
1319 Alcotest.(check string) "delta cookie name" "test" (Cookeio.name delta_cookie);
1320 Alcotest.(check string)
1321 "delta cookie value" "value"
1322 (Cookeio.value delta_cookie)
1323
1324let test_remove_original_creates_removal_cookie () =
1325 Eio_mock.Backend.run @@ fun () ->
1326 let clock = Eio_mock.Clock.make () in
1327 Eio_mock.Clock.set_time clock 1000.0;
1328
1329 let jar = create () in
1330 let cookie =
1331 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
1332 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1333 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1334 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1335 ()
1336 in
1337 add_original jar cookie;
1338
1339 (* Remove the cookie *)
1340 remove jar ~clock cookie;
1341
1342 (* Delta should contain a removal cookie *)
1343 let delta = delta jar in
1344 Alcotest.(check int) "delta has 1 removal cookie" 1 (List.length delta);
1345 let removal_cookie = List.hd delta in
1346 Alcotest.(check string)
1347 "removal cookie name" "test"
1348 (Cookeio.name removal_cookie);
1349 Alcotest.(check string)
1350 "removal cookie has empty value" ""
1351 (Cookeio.value removal_cookie);
1352
1353 (* Check Max-Age is 0 *)
1354 match Cookeio.max_age removal_cookie with
1355 | Some span ->
1356 Alcotest.(check (option int))
1357 "removal cookie Max-Age is 0" (Some 0) (Ptime.Span.to_int_s span)
1358 | None -> Alcotest.fail "removal cookie should have Max-Age"
1359
1360let test_remove_delta_cookie_removes_it () =
1361 Eio_mock.Backend.run @@ fun () ->
1362 let clock = Eio_mock.Clock.make () in
1363 Eio_mock.Clock.set_time clock 1000.0;
1364
1365 let jar = create () in
1366 let cookie =
1367 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
1368 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1369 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1370 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1371 ()
1372 in
1373 add_cookie jar cookie;
1374
1375 (* Remove the cookie *)
1376 remove jar ~clock cookie;
1377
1378 (* Delta should be empty *)
1379 let delta = delta jar in
1380 Alcotest.(check int)
1381 "delta is empty after removing delta cookie" 0 (List.length delta)
1382
1383let test_get_cookies_combines_original_and_delta () =
1384 Eio_mock.Backend.run @@ fun () ->
1385 let clock = Eio_mock.Clock.make () in
1386 Eio_mock.Clock.set_time clock 1000.0;
1387
1388 let jar = create () in
1389
1390 (* Add an original cookie *)
1391 let original =
1392 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"original"
1393 ~value:"orig_val" ~secure:false ~http_only:false ?expires:None
1394 ?same_site:None ?max_age:None
1395 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1396 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1397 ()
1398 in
1399 add_original jar original;
1400
1401 (* Add a delta cookie *)
1402 let delta_cookie =
1403 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"delta"
1404 ~value:"delta_val" ~secure:false ~http_only:false ?expires:None
1405 ?same_site:None ?max_age:None
1406 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1407 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1408 ()
1409 in
1410 add_cookie jar delta_cookie;
1411
1412 (* Get cookies should return both *)
1413 let cookies =
1414 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
1415 in
1416 Alcotest.(check int) "both cookies returned" 2 (List.length cookies);
1417
1418 let names = List.map Cookeio.name cookies |> List.sort String.compare in
1419 Alcotest.(check (list string)) "cookie names" [ "delta"; "original" ] names
1420
1421let test_get_cookies_delta_takes_precedence () =
1422 Eio_mock.Backend.run @@ fun () ->
1423 let clock = Eio_mock.Clock.make () in
1424 Eio_mock.Clock.set_time clock 1000.0;
1425
1426 let jar = create () in
1427
1428 (* Add an original cookie *)
1429 let original =
1430 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"orig_val"
1431 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1432 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1433 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1434 ()
1435 in
1436 add_original jar original;
1437
1438 (* Add a delta cookie with the same name/domain/path *)
1439 let delta_cookie =
1440 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"delta_val"
1441 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1442 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1443 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1444 ()
1445 in
1446 add_cookie jar delta_cookie;
1447
1448 (* Get cookies should return only the delta cookie *)
1449 let cookies =
1450 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
1451 in
1452 Alcotest.(check int) "only one cookie returned" 1 (List.length cookies);
1453 let cookie = List.hd cookies in
1454 Alcotest.(check string)
1455 "delta cookie value" "delta_val" (Cookeio.value cookie)
1456
1457let test_get_cookies_excludes_removal_cookies () =
1458 Eio_mock.Backend.run @@ fun () ->
1459 let clock = Eio_mock.Clock.make () in
1460 Eio_mock.Clock.set_time clock 1000.0;
1461
1462 let jar = create () in
1463
1464 (* Add an original cookie *)
1465 let original =
1466 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
1467 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1468 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1469 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1470 ()
1471 in
1472 add_original jar original;
1473
1474 (* Remove it *)
1475 remove jar ~clock original;
1476
1477 (* Get cookies should return nothing *)
1478 let cookies =
1479 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
1480 in
1481 Alcotest.(check int) "no cookies returned" 0 (List.length cookies);
1482
1483 (* But delta should have the removal cookie *)
1484 let delta = delta jar in
1485 Alcotest.(check int) "delta has removal cookie" 1 (List.length delta)
1486
1487let test_delta_returns_only_changed_cookies () =
1488 Eio_mock.Backend.run @@ fun () ->
1489 let clock = Eio_mock.Clock.make () in
1490 Eio_mock.Clock.set_time clock 1000.0;
1491
1492 let jar = create () in
1493
1494 (* Add original cookies *)
1495 let original1 =
1496 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"orig1" ~value:"val1"
1497 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1498 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1499 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1500 ()
1501 in
1502 add_original jar original1;
1503
1504 let original2 =
1505 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"orig2" ~value:"val2"
1506 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1507 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1508 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1509 ()
1510 in
1511 add_original jar original2;
1512
1513 (* Add a new delta cookie *)
1514 let new_cookie =
1515 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"new" ~value:"new_val"
1516 ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
1517 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1518 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1519 ()
1520 in
1521 add_cookie jar new_cookie;
1522
1523 (* Delta should only contain the new cookie *)
1524 let delta = delta jar in
1525 Alcotest.(check int) "delta has 1 cookie" 1 (List.length delta);
1526 let delta_cookie = List.hd delta in
1527 Alcotest.(check string) "delta cookie name" "new" (Cookeio.name delta_cookie)
1528
1529let test_removal_cookie_format () =
1530 Eio_mock.Backend.run @@ fun () ->
1531 let clock = Eio_mock.Clock.make () in
1532 Eio_mock.Clock.set_time clock 1000.0;
1533
1534 let jar = create () in
1535 let cookie =
1536 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
1537 ~secure:true ~http_only:true ?expires:None ~same_site:`Strict
1538 ?max_age:None
1539 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
1540 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
1541 ()
1542 in
1543 add_original jar cookie;
1544
1545 (* Remove the cookie *)
1546 remove jar ~clock cookie;
1547
1548 (* Get the removal cookie *)
1549 let delta = delta jar in
1550 let removal = List.hd delta in
1551
1552 (* Check all properties *)
1553 Alcotest.(check string)
1554 "removal cookie has empty value" "" (Cookeio.value removal);
1555 Alcotest.(check (option int))
1556 "removal cookie Max-Age is 0" (Some 0)
1557 (Option.bind (Cookeio.max_age removal) Ptime.Span.to_int_s);
1558
1559 (* Check expires is in the past *)
1560 let now = Ptime.of_float_s 1000.0 |> Option.get in
1561 match Cookeio.expires removal with
1562 | Some (`DateTime exp) ->
1563 Alcotest.(check bool)
1564 "expires is in the past" true
1565 (Ptime.compare exp now < 0)
1566 | _ -> Alcotest.fail "removal cookie should have DateTime expires"
1567
1568(* ============================================================================ *)
1569(* Priority 2 Tests *)
1570(* ============================================================================ *)
1571
1572(* Priority 2.1: Partitioned Cookies *)
1573
1574let test_partitioned_parsing env =
1575 let clock = Eio.Stdenv.clock env in
1576
1577 match
1578 of_set_cookie_header
1579 ~now:(fun () ->
1580 Ptime.of_float_s (Eio.Time.now clock)
1581 |> Option.value ~default:Ptime.epoch)
1582 ~domain:"widget.com" ~path:"/" "id=123; Partitioned; Secure"
1583 with
1584 | Ok c ->
1585 Alcotest.(check bool) "partitioned flag" true (partitioned c);
1586 Alcotest.(check bool) "secure flag" true (secure c)
1587 | Error msg -> Alcotest.fail ("Should parse valid Partitioned cookie: " ^ msg)
1588
1589let test_partitioned_serialization env =
1590 let clock = Eio.Stdenv.clock env in
1591 let now =
1592 Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch
1593 in
1594
1595 let cookie =
1596 make ~domain:"widget.com" ~path:"/" ~name:"id" ~value:"123" ~secure:true
1597 ~partitioned:true ~creation_time:now ~last_access:now ()
1598 in
1599
1600 let header = make_set_cookie_header cookie in
1601 let contains_substring s sub =
1602 try
1603 let _ = Str.search_forward (Str.regexp_string sub) s 0 in
1604 true
1605 with Not_found -> false
1606 in
1607 let has_partitioned = contains_substring header "Partitioned" in
1608 let has_secure = contains_substring header "Secure" in
1609 Alcotest.(check bool) "contains Partitioned" true has_partitioned;
1610 Alcotest.(check bool) "contains Secure" true has_secure
1611
1612let test_partitioned_requires_secure env =
1613 let clock = Eio.Stdenv.clock env in
1614
1615 (* Partitioned without Secure should be rejected *)
1616 match
1617 of_set_cookie_header
1618 ~now:(fun () ->
1619 Ptime.of_float_s (Eio.Time.now clock)
1620 |> Option.value ~default:Ptime.epoch)
1621 ~domain:"widget.com" ~path:"/" "id=123; Partitioned"
1622 with
1623 | Error _ -> () (* Expected *)
1624 | Ok _ -> Alcotest.fail "Should reject Partitioned without Secure"
1625
1626(* Priority 2.2: Expiration Variants *)
1627
1628let test_expiration_variants env =
1629 let clock = Eio.Stdenv.clock env in
1630 let now =
1631 Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch
1632 in
1633 let make_base ~name ?expires () =
1634 make ~domain:"ex.com" ~path:"/" ~name ~value:"v" ?expires ~creation_time:now
1635 ~last_access:now ()
1636 in
1637
1638 (* No expiration *)
1639 let c1 = make_base ~name:"no_expiry" () in
1640 Alcotest.(check (option expiration_testable))
1641 "no expiration" None (expires c1);
1642
1643 (* Session cookie *)
1644 let c2 = make_base ~name:"session" ~expires:`Session () in
1645 Alcotest.(check (option expiration_testable))
1646 "session cookie" (Some `Session) (expires c2);
1647
1648 (* Explicit expiration *)
1649 let future = Ptime.add_span now (Ptime.Span.of_int_s 3600) |> Option.get in
1650 let c3 = make_base ~name:"persistent" ~expires:(`DateTime future) () in
1651 match expires c3 with
1652 | Some (`DateTime t) when Ptime.equal t future -> ()
1653 | _ -> Alcotest.fail "Expected DateTime expiration"
1654
1655let test_parse_session_expiration env =
1656 let clock = Eio.Stdenv.clock env in
1657
1658 (* Expires=0 should parse as Session *)
1659 match
1660 of_set_cookie_header
1661 ~now:(fun () ->
1662 Ptime.of_float_s (Eio.Time.now clock)
1663 |> Option.value ~default:Ptime.epoch)
1664 ~domain:"ex.com" ~path:"/" "id=123; Expires=0"
1665 with
1666 | Ok c ->
1667 Alcotest.(check (option expiration_testable))
1668 "expires=0 is session" (Some `Session) (expires c)
1669 | Error msg -> Alcotest.fail ("Should parse Expires=0: " ^ msg)
1670
1671let test_serialize_expiration_variants env =
1672 let clock = Eio.Stdenv.clock env in
1673 let now =
1674 Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch
1675 in
1676 let contains_substring s sub =
1677 try
1678 let _ = Str.search_forward (Str.regexp_string sub) s 0 in
1679 true
1680 with Not_found -> false
1681 in
1682
1683 (* Session cookie serialization *)
1684 let c1 =
1685 make ~domain:"ex.com" ~path:"/" ~name:"s" ~value:"v" ~expires:`Session
1686 ~creation_time:now ~last_access:now ()
1687 in
1688 let h1 = make_set_cookie_header c1 in
1689 let has_expires = contains_substring h1 "Expires=" in
1690 Alcotest.(check bool) "session has Expires" true has_expires;
1691
1692 (* DateTime serialization *)
1693 let future = Ptime.add_span now (Ptime.Span.of_int_s 3600) |> Option.get in
1694 let c2 =
1695 make ~domain:"ex.com" ~path:"/" ~name:"p" ~value:"v"
1696 ~expires:(`DateTime future) ~creation_time:now ~last_access:now ()
1697 in
1698 let h2 = make_set_cookie_header c2 in
1699 let has_expires2 = contains_substring h2 "Expires=" in
1700 Alcotest.(check bool) "datetime has Expires" true has_expires2
1701
1702(* Priority 2.3: Value Trimming *)
1703
1704let test_quoted_cookie_values env =
1705 let clock = Eio.Stdenv.clock env in
1706 (* Test valid RFC 6265 cookie values:
1707 cookie-value = *cookie-octet / ( DQUOTE *cookie-octet DQUOTE )
1708 Valid cases have either no quotes or properly paired DQUOTE wrapper *)
1709 let valid_cases =
1710 [
1711 ("name=value", "value", "value"); (* No quotes *)
1712 ("name=\"value\"", "\"value\"", "value"); (* Properly quoted *)
1713 ("name=\"\"", "\"\"", ""); (* Empty quoted value *)
1714 ]
1715 in
1716
1717 List.iter
1718 (fun (input, expected_raw, expected_trimmed) ->
1719 match
1720 of_set_cookie_header
1721 ~now:(fun () ->
1722 Ptime.of_float_s (Eio.Time.now clock)
1723 |> Option.value ~default:Ptime.epoch)
1724 ~domain:"ex.com" ~path:"/" input
1725 with
1726 | Ok c ->
1727 Alcotest.(check string)
1728 (Printf.sprintf "raw value for %s" input)
1729 expected_raw (value c);
1730 Alcotest.(check string)
1731 (Printf.sprintf "trimmed value for %s" input)
1732 expected_trimmed (value_trimmed c)
1733 | Error msg -> Alcotest.fail ("Parse failed: " ^ input ^ ": " ^ msg))
1734 valid_cases;
1735
1736 (* Test invalid RFC 6265 cookie values are rejected *)
1737 let invalid_cases =
1738 [
1739 "name=\"partial"; (* Opening quote without closing *)
1740 "name=\"val\"\""; (* Embedded quote *)
1741 "name=val\""; (* Trailing quote without opening *)
1742 ]
1743 in
1744
1745 List.iter
1746 (fun input ->
1747 match
1748 of_set_cookie_header
1749 ~now:(fun () ->
1750 Ptime.of_float_s (Eio.Time.now clock)
1751 |> Option.value ~default:Ptime.epoch)
1752 ~domain:"ex.com" ~path:"/" input
1753 with
1754 | Error _ -> () (* Expected - invalid values are rejected *)
1755 | Ok _ ->
1756 Alcotest.fail
1757 (Printf.sprintf "Should reject invalid value: %s" input))
1758 invalid_cases
1759
1760let test_trimmed_value_not_used_for_equality env =
1761 let clock = Eio.Stdenv.clock env in
1762
1763 match
1764 of_set_cookie_header
1765 ~now:(fun () ->
1766 Ptime.of_float_s (Eio.Time.now clock)
1767 |> Option.value ~default:Ptime.epoch)
1768 ~domain:"ex.com" ~path:"/" "name=\"value\""
1769 with
1770 | Ok c1 -> begin
1771 match
1772 of_set_cookie_header
1773 ~now:(fun () ->
1774 Ptime.of_float_s (Eio.Time.now clock)
1775 |> Option.value ~default:Ptime.epoch)
1776 ~domain:"ex.com" ~path:"/" "name=value"
1777 with
1778 | Ok c2 ->
1779 (* Different raw values *)
1780 Alcotest.(check bool)
1781 "different raw values" false
1782 (value c1 = value c2);
1783 (* Same trimmed values *)
1784 Alcotest.(check string)
1785 "same trimmed values" (value_trimmed c1) (value_trimmed c2)
1786 | Error msg -> Alcotest.fail ("Parse failed for unquoted: " ^ msg)
1787 end
1788 | Error msg -> Alcotest.fail ("Parse failed for quoted: " ^ msg)
1789
1790(* Priority 2.4: Cookie Header Parsing *)
1791
1792let test_cookie_header_parsing_basic env =
1793 let clock = Eio.Stdenv.clock env in
1794 let result =
1795 of_cookie_header
1796 ~now:(fun () ->
1797 Ptime.of_float_s (Eio.Time.now clock)
1798 |> Option.value ~default:Ptime.epoch)
1799 ~domain:"ex.com" ~path:"/" "session=abc123; theme=dark; lang=en"
1800 in
1801
1802 match result with
1803 | Error msg -> Alcotest.fail ("Parse failed: " ^ msg)
1804 | Ok cookies ->
1805 Alcotest.(check int) "parsed 3 cookies" 3 (List.length cookies);
1806
1807 let find name_val = List.find (fun c -> name c = name_val) cookies in
1808 Alcotest.(check string) "session value" "abc123" (value (find "session"));
1809 Alcotest.(check string) "theme value" "dark" (value (find "theme"));
1810 Alcotest.(check string) "lang value" "en" (value (find "lang"))
1811
1812let test_cookie_header_defaults env =
1813 let clock = Eio.Stdenv.clock env in
1814
1815 match
1816 of_cookie_header
1817 ~now:(fun () ->
1818 Ptime.of_float_s (Eio.Time.now clock)
1819 |> Option.value ~default:Ptime.epoch)
1820 ~domain:"example.com" ~path:"/app" "session=xyz"
1821 with
1822 | Ok [ c ] ->
1823 (* Domain and path from request context *)
1824 Alcotest.(check string) "domain from context" "example.com" (domain c);
1825 Alcotest.(check string) "path from context" "/app" (path c);
1826
1827 (* Security flags default to false *)
1828 Alcotest.(check bool) "secure default" false (secure c);
1829 Alcotest.(check bool) "http_only default" false (http_only c);
1830 Alcotest.(check bool) "partitioned default" false (partitioned c);
1831
1832 (* Optional attributes default to None *)
1833 Alcotest.(check (option expiration_testable))
1834 "no expiration" None (expires c);
1835 Alcotest.(check (option span_testable)) "no max_age" None (max_age c);
1836 Alcotest.(check (option same_site_testable))
1837 "no same_site" None (same_site c)
1838 | Ok _ -> Alcotest.fail "Should parse single cookie"
1839 | Error msg -> Alcotest.fail ("Parse failed: " ^ msg)
1840
1841let test_cookie_header_edge_cases env =
1842 let clock = Eio.Stdenv.clock env in
1843
1844 let test input expected_count description =
1845 let result =
1846 of_cookie_header
1847 ~now:(fun () ->
1848 Ptime.of_float_s (Eio.Time.now clock)
1849 |> Option.value ~default:Ptime.epoch)
1850 ~domain:"ex.com" ~path:"/" input
1851 in
1852 match result with
1853 | Ok cookies ->
1854 Alcotest.(check int) description expected_count (List.length cookies)
1855 | Error msg ->
1856 Alcotest.fail (description ^ " failed: " ^ msg)
1857 in
1858
1859 test "" 0 "empty string";
1860 test ";;" 0 "only separators";
1861 test "a=1;;b=2" 2 "double separator";
1862 test " a=1 ; b=2 " 2 "excess whitespace";
1863 test " " 0 "only whitespace"
1864
1865let test_cookie_header_with_errors env =
1866 let clock = Eio.Stdenv.clock env in
1867
1868 (* Invalid cookie (empty name) should cause entire parse to fail *)
1869 let result =
1870 of_cookie_header
1871 ~now:(fun () ->
1872 Ptime.of_float_s (Eio.Time.now clock)
1873 |> Option.value ~default:Ptime.epoch)
1874 ~domain:"ex.com" ~path:"/" "valid=1;=noname;valid2=2"
1875 in
1876
1877 (* Error should have descriptive message about the invalid cookie *)
1878 let contains_substring s sub =
1879 try
1880 let _ = Str.search_forward (Str.regexp_string sub) s 0 in
1881 true
1882 with Not_found -> false
1883 in
1884 match result with
1885 | Error msg ->
1886 let has_name = contains_substring msg "name" in
1887 let has_empty = contains_substring msg "empty" in
1888 Alcotest.(check bool)
1889 "error mentions name or empty" true (has_name || has_empty)
1890 | Ok _ -> Alcotest.fail "Expected error for empty cookie name"
1891
1892(* Max-Age and Expires Interaction *)
1893
1894let test_max_age_and_expires_both_present env =
1895 let clock = Eio.Stdenv.clock env in
1896 let now =
1897 Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch
1898 in
1899 let future = Ptime.add_span now (Ptime.Span.of_int_s 7200) |> Option.get in
1900
1901 (* Create cookie with both *)
1902 let cookie =
1903 make ~domain:"ex.com" ~path:"/" ~name:"dual" ~value:"val"
1904 ~max_age:(Ptime.Span.of_int_s 3600) ~expires:(`DateTime future)
1905 ~creation_time:now ~last_access:now ()
1906 in
1907
1908 (* Both should be present *)
1909 begin match max_age cookie with
1910 | Some span -> begin
1911 match Ptime.Span.to_int_s span with
1912 | Some s ->
1913 Alcotest.(check int64) "max_age present" 3600L (Int64.of_int s)
1914 | None -> Alcotest.fail "max_age span could not be converted to int"
1915 end
1916 | None -> Alcotest.fail "max_age should be present"
1917 end;
1918
1919 begin match expires cookie with
1920 | Some (`DateTime t) when Ptime.equal t future -> ()
1921 | _ -> Alcotest.fail "expires should be present"
1922 end;
1923
1924 (* Both should appear in serialization *)
1925 let header = make_set_cookie_header cookie in
1926 let contains_substring s sub =
1927 try
1928 let _ = Str.search_forward (Str.regexp_string sub) s 0 in
1929 true
1930 with Not_found -> false
1931 in
1932 let has_max_age = contains_substring header "Max-Age=3600" in
1933 let has_expires = contains_substring header "Expires=" in
1934 Alcotest.(check bool) "contains Max-Age" true has_max_age;
1935 Alcotest.(check bool) "contains Expires" true has_expires
1936
1937let test_parse_max_age_and_expires env =
1938 let clock = Eio.Stdenv.clock env in
1939
1940 (* Parse Set-Cookie with both attributes *)
1941 match
1942 of_set_cookie_header
1943 ~now:(fun () ->
1944 Ptime.of_float_s (Eio.Time.now clock)
1945 |> Option.value ~default:Ptime.epoch)
1946 ~domain:"ex.com" ~path:"/"
1947 "id=123; Max-Age=3600; Expires=Wed, 21 Oct 2025 07:28:00 GMT"
1948 with
1949 | Ok c ->
1950 (* Both should be stored *)
1951 begin match max_age c with
1952 | Some span -> begin
1953 match Ptime.Span.to_int_s span with
1954 | Some s ->
1955 Alcotest.(check int64) "max_age parsed" 3600L (Int64.of_int s)
1956 | None -> Alcotest.fail "max_age span could not be converted to int"
1957 end
1958 | None -> Alcotest.fail "max_age should be parsed"
1959 end;
1960
1961 begin match expires c with
1962 | Some (`DateTime _) -> ()
1963 | _ -> Alcotest.fail "expires should be parsed"
1964 end
1965 | Error msg -> Alcotest.fail ("Should parse cookie with both attributes: " ^ msg)
1966
1967(* ============================================================================ *)
1968(* Host-Only Flag Tests (RFC 6265 Section 5.3) *)
1969(* ============================================================================ *)
1970
1971let test_host_only_without_domain_attribute () =
1972 Eio_mock.Backend.run @@ fun () ->
1973 let clock = Eio_mock.Clock.make () in
1974 Eio_mock.Clock.set_time clock 1000.0;
1975
1976 (* Cookie without Domain attribute should have host_only=true *)
1977 let header = "session=abc123; Secure; HttpOnly" in
1978 let cookie_opt =
1979 of_set_cookie_header
1980 ~now:(fun () ->
1981 Ptime.of_float_s (Eio.Time.now clock)
1982 |> Option.value ~default:Ptime.epoch)
1983 ~domain:"example.com" ~path:"/" header
1984 in
1985 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
1986 let cookie = Result.get_ok cookie_opt in
1987 Alcotest.(check bool) "host_only is true" true (Cookeio.host_only cookie);
1988 Alcotest.(check string) "domain is request host" "example.com" (Cookeio.domain cookie)
1989
1990let test_host_only_with_domain_attribute () =
1991 Eio_mock.Backend.run @@ fun () ->
1992 let clock = Eio_mock.Clock.make () in
1993 Eio_mock.Clock.set_time clock 1000.0;
1994
1995 (* Cookie with Domain attribute should have host_only=false *)
1996 let header = "session=abc123; Domain=example.com; Secure" in
1997 let cookie_opt =
1998 of_set_cookie_header
1999 ~now:(fun () ->
2000 Ptime.of_float_s (Eio.Time.now clock)
2001 |> Option.value ~default:Ptime.epoch)
2002 ~domain:"example.com" ~path:"/" header
2003 in
2004 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
2005 let cookie = Result.get_ok cookie_opt in
2006 Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
2007 Alcotest.(check string) "domain is attribute value" "example.com" (Cookeio.domain cookie)
2008
2009let test_host_only_with_dotted_domain_attribute () =
2010 Eio_mock.Backend.run @@ fun () ->
2011 let clock = Eio_mock.Clock.make () in
2012 Eio_mock.Clock.set_time clock 1000.0;
2013
2014 (* Cookie with .domain should have host_only=false and normalized domain *)
2015 let header = "session=abc123; Domain=.example.com" in
2016 let cookie_opt =
2017 of_set_cookie_header
2018 ~now:(fun () ->
2019 Ptime.of_float_s (Eio.Time.now clock)
2020 |> Option.value ~default:Ptime.epoch)
2021 ~domain:"example.com" ~path:"/" header
2022 in
2023 Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
2024 let cookie = Result.get_ok cookie_opt in
2025 Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
2026 Alcotest.(check string) "domain normalized" "example.com" (Cookeio.domain cookie)
2027
2028let test_host_only_domain_matching () =
2029 Eio_mock.Backend.run @@ fun () ->
2030 let clock = Eio_mock.Clock.make () in
2031 Eio_mock.Clock.set_time clock 1000.0;
2032
2033 let jar = create () in
2034
2035 (* Add a host-only cookie (no Domain attribute) *)
2036 let host_only_cookie =
2037 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"host_only" ~value:"val1"
2038 ~secure:false ~http_only:false ~host_only:true
2039 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2040 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2041 in
2042 add_cookie jar host_only_cookie;
2043
2044 (* Add a domain cookie (with Domain attribute) *)
2045 let domain_cookie =
2046 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"domain" ~value:"val2"
2047 ~secure:false ~http_only:false ~host_only:false
2048 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2049 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2050 in
2051 add_cookie jar domain_cookie;
2052
2053 (* Both cookies should match exact domain *)
2054 let cookies_exact =
2055 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2056 in
2057 Alcotest.(check int) "both match exact domain" 2 (List.length cookies_exact);
2058
2059 (* Only domain cookie should match subdomain *)
2060 let cookies_sub =
2061 get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false
2062 in
2063 Alcotest.(check int) "only domain cookie matches subdomain" 1 (List.length cookies_sub);
2064 let sub_cookie = List.hd cookies_sub in
2065 Alcotest.(check string) "subdomain match is domain cookie" "domain" (Cookeio.name sub_cookie)
2066
2067let test_host_only_cookie_header_parsing () =
2068 Eio_mock.Backend.run @@ fun () ->
2069 let clock = Eio_mock.Clock.make () in
2070 Eio_mock.Clock.set_time clock 1000.0;
2071
2072 (* Cookies from Cookie header should have host_only=true *)
2073 let result =
2074 of_cookie_header
2075 ~now:(fun () ->
2076 Ptime.of_float_s (Eio.Time.now clock)
2077 |> Option.value ~default:Ptime.epoch)
2078 ~domain:"example.com" ~path:"/" "session=abc; theme=dark"
2079 in
2080 match result with
2081 | Error msg -> Alcotest.fail ("Parse failed: " ^ msg)
2082 | Ok cookies ->
2083 Alcotest.(check int) "parsed 2 cookies" 2 (List.length cookies);
2084 List.iter (fun c ->
2085 Alcotest.(check bool)
2086 ("host_only is true for " ^ Cookeio.name c)
2087 true (Cookeio.host_only c)
2088 ) cookies
2089
2090let test_host_only_mozilla_format_round_trip () =
2091 Eio_mock.Backend.run @@ fun () ->
2092 let clock = Eio_mock.Clock.make () in
2093 Eio_mock.Clock.set_time clock 1000.0;
2094
2095 let jar = create () in
2096
2097 (* Add host-only cookie *)
2098 let host_only =
2099 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"hostonly" ~value:"v1"
2100 ~secure:false ~http_only:false ~host_only:true
2101 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2102 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2103 in
2104 add_cookie jar host_only;
2105
2106 (* Add domain cookie *)
2107 let domain_cookie =
2108 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"domain" ~value:"v2"
2109 ~secure:false ~http_only:false ~host_only:false
2110 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2111 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2112 in
2113 add_cookie jar domain_cookie;
2114
2115 (* Round trip through Mozilla format *)
2116 let mozilla = to_mozilla_format jar in
2117 let jar2 = from_mozilla_format ~clock mozilla in
2118 let cookies = get_all_cookies jar2 in
2119
2120 Alcotest.(check int) "2 cookies after round trip" 2 (List.length cookies);
2121
2122 let find name_val = List.find (fun c -> Cookeio.name c = name_val) cookies in
2123 Alcotest.(check bool) "hostonly preserved" true (Cookeio.host_only (find "hostonly"));
2124 Alcotest.(check bool) "domain preserved" false (Cookeio.host_only (find "domain"))
2125
2126(* ============================================================================ *)
2127(* Path Matching Tests (RFC 6265 Section 5.1.4) *)
2128(* ============================================================================ *)
2129
2130let test_path_matching_identical () =
2131 Eio_mock.Backend.run @@ fun () ->
2132 let clock = Eio_mock.Clock.make () in
2133 Eio_mock.Clock.set_time clock 1000.0;
2134
2135 let jar = create () in
2136 let cookie =
2137 Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"test" ~value:"val"
2138 ~secure:false ~http_only:false
2139 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2140 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2141 in
2142 add_cookie jar cookie;
2143
2144 (* Identical path should match *)
2145 let cookies =
2146 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo" ~is_secure:false
2147 in
2148 Alcotest.(check int) "identical path matches" 1 (List.length cookies)
2149
2150let test_path_matching_with_trailing_slash () =
2151 Eio_mock.Backend.run @@ fun () ->
2152 let clock = Eio_mock.Clock.make () in
2153 Eio_mock.Clock.set_time clock 1000.0;
2154
2155 let jar = create () in
2156 let cookie =
2157 Cookeio.make ~domain:"example.com" ~path:"/foo/" ~name:"test" ~value:"val"
2158 ~secure:false ~http_only:false
2159 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2160 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2161 in
2162 add_cookie jar cookie;
2163
2164 (* Cookie path /foo/ should match /foo/bar *)
2165 let cookies =
2166 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/bar" ~is_secure:false
2167 in
2168 Alcotest.(check int) "/foo/ matches /foo/bar" 1 (List.length cookies);
2169
2170 (* Cookie path /foo/ should match /foo/ *)
2171 let cookies2 =
2172 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/" ~is_secure:false
2173 in
2174 Alcotest.(check int) "/foo/ matches /foo/" 1 (List.length cookies2)
2175
2176let test_path_matching_prefix_with_slash () =
2177 Eio_mock.Backend.run @@ fun () ->
2178 let clock = Eio_mock.Clock.make () in
2179 Eio_mock.Clock.set_time clock 1000.0;
2180
2181 let jar = create () in
2182 let cookie =
2183 Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"test" ~value:"val"
2184 ~secure:false ~http_only:false
2185 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2186 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2187 in
2188 add_cookie jar cookie;
2189
2190 (* Cookie path /foo should match /foo/bar (next char is /) *)
2191 let cookies =
2192 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/bar" ~is_secure:false
2193 in
2194 Alcotest.(check int) "/foo matches /foo/bar" 1 (List.length cookies);
2195
2196 (* Cookie path /foo should match /foo/ *)
2197 let cookies2 =
2198 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/" ~is_secure:false
2199 in
2200 Alcotest.(check int) "/foo matches /foo/" 1 (List.length cookies2)
2201
2202let test_path_matching_no_false_prefix () =
2203 Eio_mock.Backend.run @@ fun () ->
2204 let clock = Eio_mock.Clock.make () in
2205 Eio_mock.Clock.set_time clock 1000.0;
2206
2207 let jar = create () in
2208 let cookie =
2209 Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"test" ~value:"val"
2210 ~secure:false ~http_only:false
2211 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2212 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2213 in
2214 add_cookie jar cookie;
2215
2216 (* Cookie path /foo should NOT match /foobar (no / separator) *)
2217 let cookies =
2218 get_cookies jar ~clock ~domain:"example.com" ~path:"/foobar" ~is_secure:false
2219 in
2220 Alcotest.(check int) "/foo does NOT match /foobar" 0 (List.length cookies);
2221
2222 (* Cookie path /foo should NOT match /foob *)
2223 let cookies2 =
2224 get_cookies jar ~clock ~domain:"example.com" ~path:"/foob" ~is_secure:false
2225 in
2226 Alcotest.(check int) "/foo does NOT match /foob" 0 (List.length cookies2)
2227
2228let test_path_matching_root () =
2229 Eio_mock.Backend.run @@ fun () ->
2230 let clock = Eio_mock.Clock.make () in
2231 Eio_mock.Clock.set_time clock 1000.0;
2232
2233 let jar = create () in
2234 let cookie =
2235 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"val"
2236 ~secure:false ~http_only:false
2237 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2238 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2239 in
2240 add_cookie jar cookie;
2241
2242 (* Root path should match everything *)
2243 let cookies1 =
2244 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2245 in
2246 Alcotest.(check int) "/ matches /" 1 (List.length cookies1);
2247
2248 let cookies2 =
2249 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo" ~is_secure:false
2250 in
2251 Alcotest.(check int) "/ matches /foo" 1 (List.length cookies2);
2252
2253 let cookies3 =
2254 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/bar/baz" ~is_secure:false
2255 in
2256 Alcotest.(check int) "/ matches /foo/bar/baz" 1 (List.length cookies3)
2257
2258let test_path_matching_no_match () =
2259 Eio_mock.Backend.run @@ fun () ->
2260 let clock = Eio_mock.Clock.make () in
2261 Eio_mock.Clock.set_time clock 1000.0;
2262
2263 let jar = create () in
2264 let cookie =
2265 Cookeio.make ~domain:"example.com" ~path:"/foo/bar" ~name:"test" ~value:"val"
2266 ~secure:false ~http_only:false
2267 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2268 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2269 in
2270 add_cookie jar cookie;
2271
2272 (* Cookie path /foo/bar should NOT match /foo *)
2273 let cookies =
2274 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo" ~is_secure:false
2275 in
2276 Alcotest.(check int) "/foo/bar does NOT match /foo" 0 (List.length cookies);
2277
2278 (* Cookie path /foo/bar should NOT match / *)
2279 let cookies2 =
2280 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2281 in
2282 Alcotest.(check int) "/foo/bar does NOT match /" 0 (List.length cookies2);
2283
2284 (* Cookie path /foo/bar should NOT match /baz *)
2285 let cookies3 =
2286 get_cookies jar ~clock ~domain:"example.com" ~path:"/baz" ~is_secure:false
2287 in
2288 Alcotest.(check int) "/foo/bar does NOT match /baz" 0 (List.length cookies3)
2289
2290(* ============================================================================ *)
2291(* Cookie Ordering Tests (RFC 6265 Section 5.4, Step 2) *)
2292(* ============================================================================ *)
2293
2294let test_cookie_ordering_by_path_length () =
2295 Eio_mock.Backend.run @@ fun () ->
2296 let clock = Eio_mock.Clock.make () in
2297 Eio_mock.Clock.set_time clock 1000.0;
2298
2299 let jar = create () in
2300
2301 (* Add cookies with different path lengths, but same creation time *)
2302 let cookie_short =
2303 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"short" ~value:"v1"
2304 ~secure:false ~http_only:false
2305 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2306 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2307 in
2308 let cookie_medium =
2309 Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"medium" ~value:"v2"
2310 ~secure:false ~http_only:false
2311 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2312 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2313 in
2314 let cookie_long =
2315 Cookeio.make ~domain:"example.com" ~path:"/foo/bar" ~name:"long" ~value:"v3"
2316 ~secure:false ~http_only:false
2317 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2318 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2319 in
2320
2321 (* Add in random order *)
2322 add_cookie jar cookie_short;
2323 add_cookie jar cookie_long;
2324 add_cookie jar cookie_medium;
2325
2326 (* Get cookies for path /foo/bar/baz - all three should match *)
2327 let cookies =
2328 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/bar/baz" ~is_secure:false
2329 in
2330
2331 Alcotest.(check int) "all 3 cookies match" 3 (List.length cookies);
2332
2333 (* Verify order: longest path first *)
2334 let names = List.map Cookeio.name cookies in
2335 Alcotest.(check (list string))
2336 "cookies ordered by path length (longest first)"
2337 [ "long"; "medium"; "short" ]
2338 names
2339
2340let test_cookie_ordering_by_creation_time () =
2341 Eio_mock.Backend.run @@ fun () ->
2342 let clock = Eio_mock.Clock.make () in
2343 Eio_mock.Clock.set_time clock 2000.0;
2344
2345 let jar = create () in
2346
2347 (* Add cookies with same path but different creation times *)
2348 let cookie_new =
2349 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"new" ~value:"v1"
2350 ~secure:false ~http_only:false
2351 ~creation_time:(Ptime.of_float_s 1500.0 |> Option.get)
2352 ~last_access:(Ptime.of_float_s 1500.0 |> Option.get) ()
2353 in
2354 let cookie_old =
2355 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"old" ~value:"v2"
2356 ~secure:false ~http_only:false
2357 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2358 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2359 in
2360 let cookie_middle =
2361 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"middle" ~value:"v3"
2362 ~secure:false ~http_only:false
2363 ~creation_time:(Ptime.of_float_s 1200.0 |> Option.get)
2364 ~last_access:(Ptime.of_float_s 1200.0 |> Option.get) ()
2365 in
2366
2367 (* Add in random order *)
2368 add_cookie jar cookie_new;
2369 add_cookie jar cookie_old;
2370 add_cookie jar cookie_middle;
2371
2372 let cookies =
2373 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2374 in
2375
2376 Alcotest.(check int) "all 3 cookies match" 3 (List.length cookies);
2377
2378 (* Verify order: earlier creation time first (for same path length) *)
2379 let names = List.map Cookeio.name cookies in
2380 Alcotest.(check (list string))
2381 "cookies ordered by creation time (earliest first)"
2382 [ "old"; "middle"; "new" ]
2383 names
2384
2385let test_cookie_ordering_combined () =
2386 Eio_mock.Backend.run @@ fun () ->
2387 let clock = Eio_mock.Clock.make () in
2388 Eio_mock.Clock.set_time clock 2000.0;
2389
2390 let jar = create () in
2391
2392 (* Mix of different paths and creation times *)
2393 let cookie_a =
2394 Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"a" ~value:"v1"
2395 ~secure:false ~http_only:false
2396 ~creation_time:(Ptime.of_float_s 1500.0 |> Option.get)
2397 ~last_access:(Ptime.of_float_s 1500.0 |> Option.get) ()
2398 in
2399 let cookie_b =
2400 Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"b" ~value:"v2"
2401 ~secure:false ~http_only:false
2402 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2403 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2404 in
2405 let cookie_c =
2406 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"c" ~value:"v3"
2407 ~secure:false ~http_only:false
2408 ~creation_time:(Ptime.of_float_s 500.0 |> Option.get)
2409 ~last_access:(Ptime.of_float_s 500.0 |> Option.get) ()
2410 in
2411
2412 add_cookie jar cookie_a;
2413 add_cookie jar cookie_c;
2414 add_cookie jar cookie_b;
2415
2416 let cookies =
2417 get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/bar" ~is_secure:false
2418 in
2419
2420 Alcotest.(check int) "all 3 cookies match" 3 (List.length cookies);
2421
2422 (* /foo cookies (length 4) should come before / cookie (length 1)
2423 Within /foo, earlier creation time (b=1000) should come before (a=1500) *)
2424 let names = List.map Cookeio.name cookies in
2425 Alcotest.(check (list string))
2426 "cookies ordered by path length then creation time"
2427 [ "b"; "a"; "c" ]
2428 names
2429
2430(* ============================================================================ *)
2431(* Creation Time Preservation Tests (RFC 6265 Section 5.3, Step 11.3) *)
2432(* ============================================================================ *)
2433
2434let test_creation_time_preserved_on_update () =
2435 Eio_mock.Backend.run @@ fun () ->
2436 let clock = Eio_mock.Clock.make () in
2437 Eio_mock.Clock.set_time clock 1000.0;
2438
2439 let jar = create () in
2440
2441 (* Add initial cookie with creation_time=500 *)
2442 let original_creation = Ptime.of_float_s 500.0 |> Option.get in
2443 let cookie_v1 =
2444 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"v1"
2445 ~secure:false ~http_only:false
2446 ~creation_time:original_creation
2447 ~last_access:(Ptime.of_float_s 500.0 |> Option.get) ()
2448 in
2449 add_cookie jar cookie_v1;
2450
2451 (* Update the cookie with a new value (creation_time=1000) *)
2452 Eio_mock.Clock.set_time clock 1500.0;
2453 let cookie_v2 =
2454 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"v2"
2455 ~secure:false ~http_only:false
2456 ~creation_time:(Ptime.of_float_s 1500.0 |> Option.get)
2457 ~last_access:(Ptime.of_float_s 1500.0 |> Option.get) ()
2458 in
2459 add_cookie jar cookie_v2;
2460
2461 (* Get the cookie and verify creation_time was preserved *)
2462 let cookies =
2463 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2464 in
2465 Alcotest.(check int) "still one cookie" 1 (List.length cookies);
2466
2467 let cookie = List.hd cookies in
2468 Alcotest.(check string) "value was updated" "v2" (Cookeio.value cookie);
2469
2470 (* Creation time should be preserved from original cookie *)
2471 let creation_float =
2472 Ptime.to_float_s (Cookeio.creation_time cookie)
2473 in
2474 Alcotest.(check (float 0.001))
2475 "creation_time preserved from original"
2476 500.0 creation_float
2477
2478let test_creation_time_preserved_add_original () =
2479 Eio_mock.Backend.run @@ fun () ->
2480 let clock = Eio_mock.Clock.make () in
2481 Eio_mock.Clock.set_time clock 1000.0;
2482
2483 let jar = create () in
2484
2485 (* Add initial original cookie *)
2486 let original_creation = Ptime.of_float_s 100.0 |> Option.get in
2487 let cookie_v1 =
2488 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"v1"
2489 ~secure:false ~http_only:false
2490 ~creation_time:original_creation
2491 ~last_access:(Ptime.of_float_s 100.0 |> Option.get) ()
2492 in
2493 add_original jar cookie_v1;
2494
2495 (* Replace with new original cookie *)
2496 let cookie_v2 =
2497 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"v2"
2498 ~secure:false ~http_only:false
2499 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2500 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2501 in
2502 add_original jar cookie_v2;
2503
2504 let cookies = get_all_cookies jar in
2505 Alcotest.(check int) "still one cookie" 1 (List.length cookies);
2506
2507 let cookie = List.hd cookies in
2508 Alcotest.(check string) "value was updated" "v2" (Cookeio.value cookie);
2509
2510 (* Creation time should be preserved *)
2511 let creation_float =
2512 Ptime.to_float_s (Cookeio.creation_time cookie)
2513 in
2514 Alcotest.(check (float 0.001))
2515 "creation_time preserved in add_original"
2516 100.0 creation_float
2517
2518let test_creation_time_new_cookie () =
2519 Eio_mock.Backend.run @@ fun () ->
2520 let clock = Eio_mock.Clock.make () in
2521 Eio_mock.Clock.set_time clock 1000.0;
2522
2523 let jar = create () in
2524
2525 (* Add a new cookie (no existing cookie to preserve from) *)
2526 let cookie =
2527 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"new" ~value:"v1"
2528 ~secure:false ~http_only:false
2529 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2530 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2531 in
2532 add_cookie jar cookie;
2533
2534 let cookies =
2535 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2536 in
2537 let cookie = List.hd cookies in
2538
2539 (* New cookie should keep its own creation time *)
2540 let creation_float =
2541 Ptime.to_float_s (Cookeio.creation_time cookie)
2542 in
2543 Alcotest.(check (float 0.001))
2544 "new cookie keeps its creation_time"
2545 1000.0 creation_float
2546
2547(* ============================================================================ *)
2548(* IP Address Domain Matching Tests (RFC 6265 Section 5.1.3) *)
2549(* ============================================================================ *)
2550
2551let test_ipv4_exact_match () =
2552 Eio_mock.Backend.run @@ fun () ->
2553 let clock = Eio_mock.Clock.make () in
2554 Eio_mock.Clock.set_time clock 1000.0;
2555
2556 let jar = create () in
2557 let cookie =
2558 Cookeio.make ~domain:"192.168.1.1" ~path:"/" ~name:"test" ~value:"val"
2559 ~secure:false ~http_only:false ~host_only:false
2560 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2561 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2562 in
2563 add_cookie jar cookie;
2564
2565 (* IPv4 cookie should match exact IP *)
2566 let cookies =
2567 get_cookies jar ~clock ~domain:"192.168.1.1" ~path:"/" ~is_secure:false
2568 in
2569 Alcotest.(check int) "IPv4 exact match" 1 (List.length cookies)
2570
2571let test_ipv4_no_suffix_match () =
2572 Eio_mock.Backend.run @@ fun () ->
2573 let clock = Eio_mock.Clock.make () in
2574 Eio_mock.Clock.set_time clock 1000.0;
2575
2576 let jar = create () in
2577 (* Cookie for 168.1.1 - this should NOT match requests to 192.168.1.1
2578 even though "192.168.1.1" ends with ".168.1.1" *)
2579 let cookie =
2580 Cookeio.make ~domain:"168.1.1" ~path:"/" ~name:"test" ~value:"val"
2581 ~secure:false ~http_only:false ~host_only:false
2582 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2583 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2584 in
2585 add_cookie jar cookie;
2586
2587 (* Should NOT match - IP addresses don't do suffix matching *)
2588 let cookies =
2589 get_cookies jar ~clock ~domain:"192.168.1.1" ~path:"/" ~is_secure:false
2590 in
2591 Alcotest.(check int) "IPv4 no suffix match" 0 (List.length cookies)
2592
2593let test_ipv4_different_ip () =
2594 Eio_mock.Backend.run @@ fun () ->
2595 let clock = Eio_mock.Clock.make () in
2596 Eio_mock.Clock.set_time clock 1000.0;
2597
2598 let jar = create () in
2599 let cookie =
2600 Cookeio.make ~domain:"192.168.1.1" ~path:"/" ~name:"test" ~value:"val"
2601 ~secure:false ~http_only:false ~host_only:false
2602 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2603 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2604 in
2605 add_cookie jar cookie;
2606
2607 (* Different IP should not match *)
2608 let cookies =
2609 get_cookies jar ~clock ~domain:"192.168.1.2" ~path:"/" ~is_secure:false
2610 in
2611 Alcotest.(check int) "different IPv4 no match" 0 (List.length cookies)
2612
2613let test_ipv6_exact_match () =
2614 Eio_mock.Backend.run @@ fun () ->
2615 let clock = Eio_mock.Clock.make () in
2616 Eio_mock.Clock.set_time clock 1000.0;
2617
2618 let jar = create () in
2619 let cookie =
2620 Cookeio.make ~domain:"::1" ~path:"/" ~name:"test" ~value:"val"
2621 ~secure:false ~http_only:false ~host_only:false
2622 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2623 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2624 in
2625 add_cookie jar cookie;
2626
2627 (* IPv6 loopback should match exactly *)
2628 let cookies =
2629 get_cookies jar ~clock ~domain:"::1" ~path:"/" ~is_secure:false
2630 in
2631 Alcotest.(check int) "IPv6 exact match" 1 (List.length cookies)
2632
2633let test_ipv6_full_format () =
2634 Eio_mock.Backend.run @@ fun () ->
2635 let clock = Eio_mock.Clock.make () in
2636 Eio_mock.Clock.set_time clock 1000.0;
2637
2638 let jar = create () in
2639 let cookie =
2640 Cookeio.make ~domain:"2001:db8::1" ~path:"/" ~name:"test" ~value:"val"
2641 ~secure:false ~http_only:false ~host_only:false
2642 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2643 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2644 in
2645 add_cookie jar cookie;
2646
2647 (* IPv6 should match exactly *)
2648 let cookies =
2649 get_cookies jar ~clock ~domain:"2001:db8::1" ~path:"/" ~is_secure:false
2650 in
2651 Alcotest.(check int) "IPv6 full format match" 1 (List.length cookies);
2652
2653 (* Different IPv6 should not match *)
2654 let cookies2 =
2655 get_cookies jar ~clock ~domain:"2001:db8::2" ~path:"/" ~is_secure:false
2656 in
2657 Alcotest.(check int) "different IPv6 no match" 0 (List.length cookies2)
2658
2659let test_ip_vs_hostname () =
2660 Eio_mock.Backend.run @@ fun () ->
2661 let clock = Eio_mock.Clock.make () in
2662 Eio_mock.Clock.set_time clock 1000.0;
2663
2664 let jar = create () in
2665
2666 (* Add a hostname cookie with host_only=false (domain cookie) *)
2667 let hostname_cookie =
2668 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"hostname" ~value:"h1"
2669 ~secure:false ~http_only:false ~host_only:false
2670 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2671 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2672 in
2673 add_cookie jar hostname_cookie;
2674
2675 (* Add an IP cookie with host_only=false *)
2676 let ip_cookie =
2677 Cookeio.make ~domain:"192.168.1.1" ~path:"/" ~name:"ip" ~value:"i1"
2678 ~secure:false ~http_only:false ~host_only:false
2679 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2680 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2681 in
2682 add_cookie jar ip_cookie;
2683
2684 (* Hostname request should match hostname cookie and subdomains *)
2685 let cookies1 =
2686 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2687 in
2688 Alcotest.(check int) "hostname matches hostname cookie" 1 (List.length cookies1);
2689
2690 let cookies2 =
2691 get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false
2692 in
2693 Alcotest.(check int) "subdomain matches hostname cookie" 1 (List.length cookies2);
2694
2695 (* IP request should only match IP cookie exactly *)
2696 let cookies3 =
2697 get_cookies jar ~clock ~domain:"192.168.1.1" ~path:"/" ~is_secure:false
2698 in
2699 Alcotest.(check int) "IP matches IP cookie" 1 (List.length cookies3);
2700 Alcotest.(check string) "IP cookie is returned" "ip" (Cookeio.name (List.hd cookies3))
2701
2702(* ============================================================================ *)
2703(* RFC 6265 Validation Tests *)
2704(* ============================================================================ *)
2705
2706let test_validate_cookie_name_valid () =
2707 (* Valid token characters per RFC 2616 *)
2708 let valid_names = ["session"; "SID"; "my-cookie"; "COOKIE_123"; "abc.def"] in
2709 List.iter (fun name ->
2710 match Cookeio.Validate.cookie_name name with
2711 | Ok _ -> ()
2712 | Error msg ->
2713 Alcotest.fail (Printf.sprintf "Name %S should be valid: %s" name msg))
2714 valid_names
2715
2716let test_validate_cookie_name_invalid () =
2717 (* Invalid: control chars, separators, spaces *)
2718 let invalid_names =
2719 [
2720 ("", "empty");
2721 ("my cookie", "space");
2722 ("cookie=value", "equals");
2723 ("my;cookie", "semicolon");
2724 ("name\t", "tab");
2725 ("(cookie)", "parens");
2726 ("name,val", "comma");
2727 ]
2728 in
2729 List.iter (fun (name, reason) ->
2730 match Cookeio.Validate.cookie_name name with
2731 | Error _ -> () (* Expected *)
2732 | Ok _ ->
2733 Alcotest.fail
2734 (Printf.sprintf "Name %S (%s) should be invalid" name reason))
2735 invalid_names
2736
2737let test_validate_cookie_value_valid () =
2738 (* Valid cookie-octets or quoted values *)
2739 let valid_values = ["abc123"; "value!#$%&'()*+-./"; "\"quoted\""; ""] in
2740 List.iter (fun value ->
2741 match Cookeio.Validate.cookie_value value with
2742 | Ok _ -> ()
2743 | Error msg ->
2744 Alcotest.fail (Printf.sprintf "Value %S should be valid: %s" value msg))
2745 valid_values
2746
2747let test_validate_cookie_value_invalid () =
2748 (* Invalid: space, comma, semicolon, backslash, unmatched quotes *)
2749 let invalid_values =
2750 [
2751 ("with space", "space");
2752 ("with,comma", "comma");
2753 ("with;semi", "semicolon");
2754 ("back\\slash", "backslash");
2755 ("\"unmatched", "unmatched opening quote");
2756 ("unmatched\"", "unmatched closing quote");
2757 ]
2758 in
2759 List.iter (fun (value, reason) ->
2760 match Cookeio.Validate.cookie_value value with
2761 | Error _ -> () (* Expected *)
2762 | Ok _ ->
2763 Alcotest.fail
2764 (Printf.sprintf "Value %S (%s) should be invalid" value reason))
2765 invalid_values
2766
2767let test_validate_domain_valid () =
2768 (* Valid domain names and IP addresses *)
2769 let valid_domains =
2770 ["example.com"; "sub.example.com"; ".example.com"; "192.168.1.1"; "::1"]
2771 in
2772 List.iter (fun domain ->
2773 match Cookeio.Validate.domain_value domain with
2774 | Ok _ -> ()
2775 | Error msg ->
2776 Alcotest.fail (Printf.sprintf "Domain %S should be valid: %s" domain msg))
2777 valid_domains
2778
2779let test_validate_domain_invalid () =
2780 (* Invalid domain names - only test cases that domain-name library rejects.
2781 Note: domain-name library has specific rules that may differ from what
2782 we might expect from the RFC. *)
2783 let invalid_domains =
2784 [
2785 ("", "empty");
2786 (* Note: "-invalid.com" and "invalid-.com" are valid per domain-name library *)
2787 ]
2788 in
2789 List.iter (fun (domain, reason) ->
2790 match Cookeio.Validate.domain_value domain with
2791 | Error _ -> () (* Expected *)
2792 | Ok _ ->
2793 Alcotest.fail
2794 (Printf.sprintf "Domain %S (%s) should be invalid" domain reason))
2795 invalid_domains
2796
2797let test_validate_path_valid () =
2798 let valid_paths = ["/"; "/path"; "/path/to/resource"; "/path?query"] in
2799 List.iter (fun path ->
2800 match Cookeio.Validate.path_value path with
2801 | Ok _ -> ()
2802 | Error msg ->
2803 Alcotest.fail (Printf.sprintf "Path %S should be valid: %s" path msg))
2804 valid_paths
2805
2806let test_validate_path_invalid () =
2807 let invalid_paths =
2808 [
2809 ("/path;bad", "semicolon");
2810 ("/path\x00bad", "control char");
2811 ]
2812 in
2813 List.iter (fun (path, reason) ->
2814 match Cookeio.Validate.path_value path with
2815 | Error _ -> () (* Expected *)
2816 | Ok _ ->
2817 Alcotest.fail
2818 (Printf.sprintf "Path %S (%s) should be invalid" path reason))
2819 invalid_paths
2820
2821let test_duplicate_cookie_detection () =
2822 Eio_mock.Backend.run @@ fun () ->
2823 let clock = Eio_mock.Clock.make () in
2824 Eio_mock.Clock.set_time clock 1000.0;
2825
2826 (* Duplicate cookie names should be rejected *)
2827 let result =
2828 of_cookie_header
2829 ~now:(fun () ->
2830 Ptime.of_float_s (Eio.Time.now clock)
2831 |> Option.value ~default:Ptime.epoch)
2832 ~domain:"example.com" ~path:"/" "session=abc; theme=dark; session=xyz"
2833 in
2834 match result with
2835 | Error msg ->
2836 (* Should mention duplicate *)
2837 let contains_dup = String.lowercase_ascii msg |> fun s ->
2838 try let _ = Str.search_forward (Str.regexp_string "duplicate") s 0 in true
2839 with Not_found -> false
2840 in
2841 Alcotest.(check bool) "error mentions duplicate" true contains_dup
2842 | Ok _ -> Alcotest.fail "Should reject duplicate cookie names"
2843
2844let test_validation_error_messages () =
2845 Eio_mock.Backend.run @@ fun () ->
2846 let clock = Eio_mock.Clock.make () in
2847 Eio_mock.Clock.set_time clock 1000.0;
2848
2849 (* Test that error messages are descriptive *)
2850 let test_cases =
2851 [
2852 ("=noname", "Cookie name is empty");
2853 ("bad cookie=value", "invalid characters");
2854 ("name=val ue", "invalid characters");
2855 ]
2856 in
2857 List.iter (fun (header, expected_substring) ->
2858 match
2859 of_set_cookie_header
2860 ~now:(fun () ->
2861 Ptime.of_float_s (Eio.Time.now clock)
2862 |> Option.value ~default:Ptime.epoch)
2863 ~domain:"example.com" ~path:"/" header
2864 with
2865 | Error msg ->
2866 let has_substring =
2867 try
2868 let _ = Str.search_forward
2869 (Str.regexp_string expected_substring) msg 0 in
2870 true
2871 with Not_found -> false
2872 in
2873 Alcotest.(check bool)
2874 (Printf.sprintf "error for %S mentions %S" header expected_substring)
2875 true has_substring
2876 | Ok _ ->
2877 Alcotest.fail (Printf.sprintf "Should reject %S" header))
2878 test_cases
2879
2880(* ============================================================================ *)
2881(* Public Suffix Validation Tests (RFC 6265 Section 5.3, Step 5) *)
2882(* ============================================================================ *)
2883
2884let test_public_suffix_rejection () =
2885 Eio_mock.Backend.run @@ fun () ->
2886 let clock = Eio_mock.Clock.make () in
2887 Eio_mock.Clock.set_time clock 1000.0;
2888
2889 (* Setting a cookie for a public suffix (TLD) should be rejected *)
2890 let test_cases =
2891 [
2892 (* (request_domain, cookie_domain, description) *)
2893 ("www.example.com", "com", "TLD .com");
2894 ("www.example.co.uk", "co.uk", "ccTLD .co.uk");
2895 ("foo.bar.github.io", "github.io", "private domain github.io");
2896 ]
2897 in
2898
2899 List.iter
2900 (fun (request_domain, cookie_domain, description) ->
2901 let header = Printf.sprintf "session=abc; Domain=.%s" cookie_domain in
2902 let result =
2903 of_set_cookie_header
2904 ~now:(fun () ->
2905 Ptime.of_float_s (Eio.Time.now clock)
2906 |> Option.value ~default:Ptime.epoch)
2907 ~domain:request_domain ~path:"/" header
2908 in
2909 match result with
2910 | Error msg ->
2911 (* Should mention public suffix *)
2912 let has_psl =
2913 String.lowercase_ascii msg |> fun s ->
2914 try
2915 let _ = Str.search_forward (Str.regexp_string "public suffix") s 0 in
2916 true
2917 with Not_found -> false
2918 in
2919 Alcotest.(check bool)
2920 (Printf.sprintf "%s: error mentions public suffix" description)
2921 true has_psl
2922 | Ok _ ->
2923 Alcotest.fail
2924 (Printf.sprintf "Should reject cookie for %s" description))
2925 test_cases
2926
2927let test_public_suffix_allowed_when_exact_match () =
2928 Eio_mock.Backend.run @@ fun () ->
2929 let clock = Eio_mock.Clock.make () in
2930 Eio_mock.Clock.set_time clock 1000.0;
2931
2932 (* If request host exactly matches the public suffix domain, allow it.
2933 This is rare but possible for private domains like blogspot.com *)
2934 let header = "session=abc; Domain=.blogspot.com" in
2935 let result =
2936 of_set_cookie_header
2937 ~now:(fun () ->
2938 Ptime.of_float_s (Eio.Time.now clock)
2939 |> Option.value ~default:Ptime.epoch)
2940 ~domain:"blogspot.com" ~path:"/" header
2941 in
2942 Alcotest.(check bool)
2943 "exact match allows public suffix" true
2944 (Result.is_ok result)
2945
2946let test_non_public_suffix_allowed () =
2947 Eio_mock.Backend.run @@ fun () ->
2948 let clock = Eio_mock.Clock.make () in
2949 Eio_mock.Clock.set_time clock 1000.0;
2950
2951 (* Normal domain (not a public suffix) should be allowed *)
2952 let test_cases =
2953 [
2954 ("www.example.com", "example.com", "registrable domain");
2955 ("sub.example.com", "example.com", "parent of subdomain");
2956 ("www.example.co.uk", "example.co.uk", "registrable domain under ccTLD");
2957 ]
2958 in
2959
2960 List.iter
2961 (fun (request_domain, cookie_domain, description) ->
2962 let header = Printf.sprintf "session=abc; Domain=.%s" cookie_domain in
2963 let result =
2964 of_set_cookie_header
2965 ~now:(fun () ->
2966 Ptime.of_float_s (Eio.Time.now clock)
2967 |> Option.value ~default:Ptime.epoch)
2968 ~domain:request_domain ~path:"/" header
2969 in
2970 match result with
2971 | Ok cookie ->
2972 Alcotest.(check string)
2973 (Printf.sprintf "%s: domain correct" description)
2974 cookie_domain (Cookeio.domain cookie)
2975 | Error msg ->
2976 Alcotest.fail
2977 (Printf.sprintf "%s should be allowed: %s" description msg))
2978 test_cases
2979
2980let test_public_suffix_no_domain_attribute () =
2981 Eio_mock.Backend.run @@ fun () ->
2982 let clock = Eio_mock.Clock.make () in
2983 Eio_mock.Clock.set_time clock 1000.0;
2984
2985 (* Cookie without Domain attribute should always be allowed (host-only) *)
2986 let header = "session=abc; Secure; HttpOnly" in
2987 let result =
2988 of_set_cookie_header
2989 ~now:(fun () ->
2990 Ptime.of_float_s (Eio.Time.now clock)
2991 |> Option.value ~default:Ptime.epoch)
2992 ~domain:"www.example.com" ~path:"/" header
2993 in
2994 match result with
2995 | Ok cookie ->
2996 Alcotest.(check bool) "host_only is true" true (Cookeio.host_only cookie);
2997 Alcotest.(check string)
2998 "domain is request domain" "www.example.com"
2999 (Cookeio.domain cookie)
3000 | Error msg -> Alcotest.fail ("Should allow host-only cookie: " ^ msg)
3001
3002let test_public_suffix_ip_address_bypass () =
3003 Eio_mock.Backend.run @@ fun () ->
3004 let clock = Eio_mock.Clock.make () in
3005 Eio_mock.Clock.set_time clock 1000.0;
3006
3007 (* IP addresses should bypass PSL check *)
3008 let header = "session=abc; Domain=192.168.1.1" in
3009 let result =
3010 of_set_cookie_header
3011 ~now:(fun () ->
3012 Ptime.of_float_s (Eio.Time.now clock)
3013 |> Option.value ~default:Ptime.epoch)
3014 ~domain:"192.168.1.1" ~path:"/" header
3015 in
3016 Alcotest.(check bool)
3017 "IP address bypasses PSL" true
3018 (Result.is_ok result)
3019
3020let test_public_suffix_case_insensitive () =
3021 Eio_mock.Backend.run @@ fun () ->
3022 let clock = Eio_mock.Clock.make () in
3023 Eio_mock.Clock.set_time clock 1000.0;
3024
3025 (* Public suffix check should be case-insensitive *)
3026 let header = "session=abc; Domain=.COM" in
3027 let result =
3028 of_set_cookie_header
3029 ~now:(fun () ->
3030 Ptime.of_float_s (Eio.Time.now clock)
3031 |> Option.value ~default:Ptime.epoch)
3032 ~domain:"www.example.COM" ~path:"/" header
3033 in
3034 Alcotest.(check bool)
3035 "uppercase TLD still rejected" true
3036 (Result.is_error result)
3037
3038let () =
3039 Eio_main.run @@ fun env ->
3040 let open Alcotest in
3041 run "Cookeio Tests"
3042 [
3043 ( "mozilla_format",
3044 [
3045 test_case "Load Mozilla format from string" `Quick (fun () ->
3046 test_load_mozilla_cookies env);
3047 test_case "Load Mozilla format from file" `Quick (fun () ->
3048 test_load_from_file env);
3049 test_case "Round trip Mozilla format" `Quick (fun () ->
3050 test_round_trip_mozilla_format env);
3051 ] );
3052 ( "cookie_matching",
3053 [
3054 test_case "Domain and security matching" `Quick (fun () ->
3055 test_cookie_matching env);
3056 ] );
3057 ( "basic_operations",
3058 [
3059 test_case "Empty jar operations" `Quick (fun () -> test_empty_jar env);
3060 ] );
3061 ( "time_handling",
3062 [
3063 test_case "Cookie expiry with mock clock" `Quick
3064 test_cookie_expiry_with_mock_clock;
3065 test_case "get_cookies filters expired cookies" `Quick
3066 test_get_cookies_filters_expired;
3067 test_case "Max-Age parsing with mock clock" `Quick
3068 test_max_age_parsing_with_mock_clock;
3069 test_case "Last access time with mock clock" `Quick
3070 test_last_access_time_with_mock_clock;
3071 test_case "Parse Set-Cookie with Expires" `Quick
3072 test_of_set_cookie_header_with_expires;
3073 test_case "SameSite=None validation" `Quick
3074 test_samesite_none_validation;
3075 ] );
3076 ( "domain_normalization",
3077 [
3078 test_case "Domain normalization" `Quick test_domain_normalization;
3079 test_case "Domain matching with normalized domains" `Quick
3080 test_domain_matching;
3081 ] );
3082 ( "max_age_tracking",
3083 [
3084 test_case "Max-Age stored separately from Expires" `Quick
3085 test_max_age_stored_separately;
3086 test_case "Negative Max-Age becomes 0" `Quick
3087 test_max_age_negative_becomes_zero;
3088 test_case "make_set_cookie_header includes Max-Age" `Quick
3089 test_make_set_cookie_header_includes_max_age;
3090 test_case "Max-Age round-trip parsing" `Quick test_max_age_round_trip;
3091 ] );
3092 ( "delta_tracking",
3093 [
3094 test_case "add_original doesn't affect delta" `Quick
3095 test_add_original_not_in_delta;
3096 test_case "add_cookie appears in delta" `Quick
3097 test_add_cookie_appears_in_delta;
3098 test_case "remove original creates removal cookie" `Quick
3099 test_remove_original_creates_removal_cookie;
3100 test_case "remove delta cookie just removes it" `Quick
3101 test_remove_delta_cookie_removes_it;
3102 test_case "get_cookies combines original and delta" `Quick
3103 test_get_cookies_combines_original_and_delta;
3104 test_case "get_cookies delta takes precedence" `Quick
3105 test_get_cookies_delta_takes_precedence;
3106 test_case "get_cookies excludes removal cookies" `Quick
3107 test_get_cookies_excludes_removal_cookies;
3108 test_case "delta returns only changed cookies" `Quick
3109 test_delta_returns_only_changed_cookies;
3110 test_case "removal cookie format" `Quick test_removal_cookie_format;
3111 ] );
3112 ( "http_date_parsing",
3113 [
3114 test_case "HTTP date FMT1 (RFC 1123)" `Quick test_http_date_fmt1;
3115 test_case "HTTP date FMT2 (RFC 850)" `Quick test_http_date_fmt2;
3116 test_case "HTTP date FMT3 (asctime)" `Quick test_http_date_fmt3;
3117 test_case "HTTP date FMT4 (variant)" `Quick test_http_date_fmt4;
3118 test_case "Abbreviated year 69-99 becomes 1900+" `Quick
3119 test_abbreviated_year_69_to_99;
3120 test_case "Abbreviated year 0-68 becomes 2000+" `Quick
3121 test_abbreviated_year_0_to_68;
3122 test_case "RFC 3339 backward compatibility" `Quick
3123 test_rfc3339_still_works;
3124 test_case "Invalid date format logs warning" `Quick
3125 test_invalid_date_format_logs_warning;
3126 test_case "Case-insensitive month parsing" `Quick
3127 test_case_insensitive_month_parsing;
3128 test_case "Case-insensitive GMT parsing" `Quick
3129 test_case_insensitive_gmt_parsing;
3130 ] );
3131 ( "partitioned",
3132 [
3133 test_case "parse partitioned cookie" `Quick (fun () ->
3134 test_partitioned_parsing env);
3135 test_case "serialize partitioned cookie" `Quick (fun () ->
3136 test_partitioned_serialization env);
3137 test_case "partitioned requires secure" `Quick (fun () ->
3138 test_partitioned_requires_secure env);
3139 ] );
3140 ( "expiration",
3141 [
3142 test_case "expiration variants" `Quick (fun () ->
3143 test_expiration_variants env);
3144 test_case "parse session expiration" `Quick (fun () ->
3145 test_parse_session_expiration env);
3146 test_case "serialize expiration variants" `Quick (fun () ->
3147 test_serialize_expiration_variants env);
3148 ] );
3149 ( "value_trimming",
3150 [
3151 test_case "quoted values" `Quick (fun () ->
3152 test_quoted_cookie_values env);
3153 test_case "trimmed not used for equality" `Quick (fun () ->
3154 test_trimmed_value_not_used_for_equality env);
3155 ] );
3156 ( "cookie_header",
3157 [
3158 test_case "parse basic" `Quick (fun () ->
3159 test_cookie_header_parsing_basic env);
3160 test_case "default values" `Quick (fun () ->
3161 test_cookie_header_defaults env);
3162 test_case "edge cases" `Quick (fun () ->
3163 test_cookie_header_edge_cases env);
3164 test_case "multiple with errors" `Quick (fun () ->
3165 test_cookie_header_with_errors env);
3166 ] );
3167 ( "max_age_expires_interaction",
3168 [
3169 test_case "both present" `Quick (fun () ->
3170 test_max_age_and_expires_both_present env);
3171 test_case "parse both" `Quick (fun () ->
3172 test_parse_max_age_and_expires env);
3173 ] );
3174 ( "host_only_flag",
3175 [
3176 test_case "host_only without Domain attribute" `Quick
3177 test_host_only_without_domain_attribute;
3178 test_case "host_only with Domain attribute" `Quick
3179 test_host_only_with_domain_attribute;
3180 test_case "host_only with dotted Domain attribute" `Quick
3181 test_host_only_with_dotted_domain_attribute;
3182 test_case "host_only domain matching" `Quick
3183 test_host_only_domain_matching;
3184 test_case "host_only Cookie header parsing" `Quick
3185 test_host_only_cookie_header_parsing;
3186 test_case "host_only Mozilla format round trip" `Quick
3187 test_host_only_mozilla_format_round_trip;
3188 ] );
3189 ( "path_matching",
3190 [
3191 test_case "identical path" `Quick test_path_matching_identical;
3192 test_case "path with trailing slash" `Quick
3193 test_path_matching_with_trailing_slash;
3194 test_case "prefix with slash separator" `Quick
3195 test_path_matching_prefix_with_slash;
3196 test_case "no false prefix match" `Quick
3197 test_path_matching_no_false_prefix;
3198 test_case "root path matches all" `Quick test_path_matching_root;
3199 test_case "path no match" `Quick test_path_matching_no_match;
3200 ] );
3201 ( "ip_address_matching",
3202 [
3203 test_case "IPv4 exact match" `Quick test_ipv4_exact_match;
3204 test_case "IPv4 no suffix match" `Quick test_ipv4_no_suffix_match;
3205 test_case "IPv4 different IP no match" `Quick test_ipv4_different_ip;
3206 test_case "IPv6 exact match" `Quick test_ipv6_exact_match;
3207 test_case "IPv6 full format" `Quick test_ipv6_full_format;
3208 test_case "IP vs hostname behavior" `Quick test_ip_vs_hostname;
3209 ] );
3210 ( "rfc6265_validation",
3211 [
3212 test_case "valid cookie names" `Quick test_validate_cookie_name_valid;
3213 test_case "invalid cookie names" `Quick test_validate_cookie_name_invalid;
3214 test_case "valid cookie values" `Quick test_validate_cookie_value_valid;
3215 test_case "invalid cookie values" `Quick test_validate_cookie_value_invalid;
3216 test_case "valid domain values" `Quick test_validate_domain_valid;
3217 test_case "invalid domain values" `Quick test_validate_domain_invalid;
3218 test_case "valid path values" `Quick test_validate_path_valid;
3219 test_case "invalid path values" `Quick test_validate_path_invalid;
3220 test_case "duplicate cookie detection" `Quick test_duplicate_cookie_detection;
3221 test_case "validation error messages" `Quick test_validation_error_messages;
3222 ] );
3223 ( "cookie_ordering",
3224 [
3225 test_case "ordering by path length" `Quick
3226 test_cookie_ordering_by_path_length;
3227 test_case "ordering by creation time" `Quick
3228 test_cookie_ordering_by_creation_time;
3229 test_case "ordering combined" `Quick test_cookie_ordering_combined;
3230 ] );
3231 ( "creation_time_preservation",
3232 [
3233 test_case "preserved on update" `Quick
3234 test_creation_time_preserved_on_update;
3235 test_case "preserved in add_original" `Quick
3236 test_creation_time_preserved_add_original;
3237 test_case "new cookie keeps time" `Quick test_creation_time_new_cookie;
3238 ] );
3239 ( "public_suffix_validation",
3240 [
3241 test_case "reject public suffix domains" `Quick
3242 test_public_suffix_rejection;
3243 test_case "allow exact match on public suffix" `Quick
3244 test_public_suffix_allowed_when_exact_match;
3245 test_case "allow non-public-suffix domains" `Quick
3246 test_non_public_suffix_allowed;
3247 test_case "no Domain attribute bypasses PSL" `Quick
3248 test_public_suffix_no_domain_attribute;
3249 test_case "IP address bypasses PSL" `Quick
3250 test_public_suffix_ip_address_bypass;
3251 test_case "case insensitive check" `Quick
3252 test_public_suffix_case_insensitive;
3253 ] );
3254 ]