+156 -49

lib/cookeio.ml

··· 2 2 3 3 module Log = (val Logs.src_log src : Logs.LOG) 4 4 5 5 - type same_site = [ `Strict | `Lax | `None ] 6 6 - (** Cookie same-site policy *) 5 5 + module SameSite = struct 6 6 + type t = [ `Strict | `Lax | `None ] 7 7 + 8 8 + let equal = ( = ) 9 9 + 10 10 + let pp ppf = function 11 11 + | `Strict -> Format.pp_print_string ppf "Strict" 12 12 + | `Lax -> Format.pp_print_string ppf "Lax" 13 13 + | `None -> Format.pp_print_string ppf "None" 14 14 + end 15 15 + 16 16 + module Expiration = struct 17 17 + type t = [ `Session | `DateTime of Ptime.t ] 18 18 + 19 19 + let equal e1 e2 = 20 20 + match (e1, e2) with 21 21 + | `Session, `Session -> true 22 22 + | `DateTime t1, `DateTime t2 -> Ptime.equal t1 t2 23 23 + | _ -> false 24 24 + 25 25 + let pp ppf = function 26 26 + | `Session -> Format.pp_print_string ppf "Session" 27 27 + | `DateTime t -> Format.fprintf ppf "DateTime(%a)" Ptime.pp t 28 28 + end 7 29 8 30 type t = { 9 31 domain : string; ··· 12 34 value : string; 13 35 secure : bool; 14 36 http_only : bool; 15 15 - expires : Ptime.t option; 37 37 + partitioned : bool; 38 38 + expires : Expiration.t option; 16 39 max_age : Ptime.Span.t option; 17 17 - same_site : same_site option; 40 40 + same_site : SameSite.t option; 18 41 creation_time : Ptime.t; 19 42 last_access : Ptime.t; 20 43 } ··· 33 56 let path cookie = cookie.path 34 57 let name cookie = cookie.name 35 58 let value cookie = cookie.value 59 59 + 60 60 + let value_trimmed cookie = 61 61 + let v = cookie.value in 62 62 + let len = String.length v in 63 63 + if len < 2 then v 64 64 + else 65 65 + match (v.[0], v.[len - 1]) with 66 66 + | '"', '"' -> String.sub v 1 (len - 2) 67 67 + | _ -> v 68 68 + 36 69 let secure cookie = cookie.secure 37 70 let http_only cookie = cookie.http_only 71 71 + let partitioned cookie = cookie.partitioned 38 72 let expires cookie = cookie.expires 39 73 let max_age cookie = cookie.max_age 40 74 let same_site cookie = cookie.same_site ··· 42 76 let last_access cookie = cookie.last_access 43 77 44 78 let make ~domain ~path ~name ~value ?(secure = false) ?(http_only = false) 45 45 - ?expires ?max_age ?same_site ~creation_time ~last_access () = 79 79 + ?expires ?max_age ?same_site ?(partitioned = false) ~creation_time 80 80 + ~last_access () = 46 81 { 47 82 domain; 48 83 path; ··· 50 85 value; 51 86 secure; 52 87 http_only; 88 88 + partitioned; 53 89 expires; 54 90 max_age; 55 91 same_site; ··· 89 125 (** {1 HTTP Date Parsing} *) 90 126 let is_expired cookie clock = 91 127 match cookie.expires with 92 92 - | None -> false (* Session cookie *) 93 93 - | Some exp_time -> 128 128 + | None -> false (* No expiration *) 129 129 + | Some `Session -> false (* Session cookie - not expired until browser closes *) 130 130 + | Some (`DateTime exp_time) -> 94 131 let now = 95 132 Ptime.of_float_s (Eio.Time.now clock) 96 133 |> Option.value ~default:Ptime.epoch ··· 199 236 mutable path : string option; 200 237 mutable secure : bool; 201 238 mutable http_only : bool; 202 202 - mutable expires : Ptime.t option; 239 239 + mutable partitioned : bool; 240 240 + mutable expires : Expiration.t option; 203 241 mutable max_age : Ptime.Span.t option; 204 204 - mutable same_site : same_site option; 242 242 + mutable same_site : SameSite.t option; 205 243 } 206 244 (** Accumulated attributes from parsing Set-Cookie header *) 207 245 ··· 212 250 path = None; 213 251 secure = false; 214 252 http_only = false; 253 253 + partitioned = false; 215 254 expires = None; 216 255 max_age = None; 217 256 same_site = None; ··· 224 263 | "domain" -> attrs.domain <- Some (normalize_domain attr_value) 225 264 | "path" -> attrs.path <- Some attr_value 226 265 | "expires" -> ( 227 227 - match Ptime.of_rfc3339 attr_value with 228 228 - | Ok (time, _, _) -> attrs.expires <- Some time 229 229 - | Error (`RFC3339 (_, err)) -> ( 230 230 - (* Try HTTP date format as fallback *) 231 231 - match DateParser.parse_http_date attr_value with 232 232 - | Some time -> attrs.expires <- Some time 233 233 - | None -> 234 234 - Log.warn (fun m -> 235 235 - m "Failed to parse expires attribute '%s': %a" attr_value 236 236 - Ptime.pp_rfc3339_error err))) 266 266 + (* Special case: Expires=0 means session cookie *) 267 267 + if attr_value = "0" then attrs.expires <- Some `Session 268 268 + else 269 269 + match Ptime.of_rfc3339 attr_value with 270 270 + | Ok (time, _, _) -> attrs.expires <- Some (`DateTime time) 271 271 + | Error (`RFC3339 (_, err)) -> ( 272 272 + (* Try HTTP date format as fallback *) 273 273 + match DateParser.parse_http_date attr_value with 274 274 + | Some time -> attrs.expires <- Some (`DateTime time) 275 275 + | None -> 276 276 + Log.warn (fun m -> 277 277 + m "Failed to parse expires attribute '%s': %a" attr_value 278 278 + Ptime.pp_rfc3339_error err))) 237 279 | "max-age" -> ( 238 280 match int_of_string_opt attr_value with 239 281 | Some seconds -> ··· 242 284 let now = Eio.Time.now clock in 243 285 (* Store the max-age as a Ptime.Span *) 244 286 attrs.max_age <- Some (Ptime.Span.of_int_s seconds); 245 245 - (* Also compute and store expires *) 287 287 + (* Also compute and store expires as DateTime *) 246 288 let expires = Ptime.of_float_s (now +. float_of_int seconds) in 247 247 - attrs.expires <- expires; 289 289 + (match expires with 290 290 + | Some time -> attrs.expires <- Some (`DateTime time) 291 291 + | None -> ()); 248 292 Log.debug (fun m -> m "Parsed Max-Age: %d seconds" seconds) 249 293 | None -> 250 294 Log.warn (fun m -> 251 295 m "Failed to parse max-age attribute '%s'" attr_value)) 252 296 | "secure" -> attrs.secure <- true 253 297 | "httponly" -> attrs.http_only <- true 298 298 + | "partitioned" -> attrs.partitioned <- true 254 299 | "samesite" -> ( 255 300 match String.lowercase_ascii attr_value with 256 301 | "strict" -> attrs.same_site <- Some `Strict ··· 265 310 (** Validate cookie attributes and log warnings for invalid combinations *) 266 311 let validate_attributes attrs = 267 312 (* SameSite=None requires Secure flag *) 268 268 - match attrs.same_site with 269 269 - | Some `None when not attrs.secure -> 313 313 + let samesite_valid = 314 314 + match attrs.same_site with 315 315 + | Some `None when not attrs.secure -> 316 316 + Log.warn (fun m -> 317 317 + m 318 318 + "Cookie has SameSite=None but Secure flag is not set; this \ 319 319 + violates RFC requirements"); 320 320 + false 321 321 + | _ -> true 322 322 + in 323 323 + (* Partitioned requires Secure flag *) 324 324 + let partitioned_valid = 325 325 + if attrs.partitioned && not attrs.secure then ( 270 326 Log.warn (fun m -> 271 327 m 272 272 - "Cookie has SameSite=None but Secure flag is not set; this \ 273 273 - violates RFC requirements"); 274 274 - false 275 275 - | _ -> true 328 328 + "Cookie has Partitioned attribute but Secure flag is not set; \ 329 329 + this violates CHIPS requirements"); 330 330 + false) 331 331 + else true 332 332 + in 333 333 + samesite_valid && partitioned_valid 276 334 277 335 (** Build final cookie from name/value and accumulated attributes *) 278 336 let build_cookie ~request_domain ~request_path ~name ~value attrs ~now = ··· 282 340 let path = Option.value attrs.path ~default:request_path in 283 341 make ~domain ~path ~name ~value ~secure:attrs.secure 284 342 ~http_only:attrs.http_only ?expires:attrs.expires ?max_age:attrs.max_age 285 285 - ?same_site:attrs.same_site ~creation_time:now ~last_access:now () 343 343 + ?same_site:attrs.same_site ~partitioned:attrs.partitioned 344 344 + ~creation_time:now ~last_access:now () 286 345 287 346 let rec parse_set_cookie ~clock ~domain:request_domain ~path:request_path 288 347 header_value = ··· 339 398 Log.debug (fun m -> m "Parsed cookie: %a" pp cookie); 340 399 Some cookie) 341 400 401 401 + and of_cookie_header ~clock ~domain ~path header_value = 402 402 + Log.debug (fun m -> m "Parsing Cookie header: %s" header_value); 403 403 + 404 404 + (* Split on semicolons *) 405 405 + let parts = String.split_on_char ';' header_value |> List.map String.trim in 406 406 + 407 407 + (* Filter out empty parts *) 408 408 + let parts = List.filter (fun s -> String.length s > 0) parts in 409 409 + 410 410 + (* Parse each name=value pair *) 411 411 + List.map 412 412 + (fun name_value -> 413 413 + match String.index_opt name_value '=' with 414 414 + | None -> 415 415 + Error (Printf.sprintf "Cookie missing '=' separator: %s" name_value) 416 416 + | Some eq_pos -> 417 417 + let cookie_name = String.sub name_value 0 eq_pos |> String.trim in 418 418 + if String.length cookie_name = 0 then 419 419 + Error "Cookie has empty name" 420 420 + else 421 421 + let cookie_value = 422 422 + String.sub name_value (eq_pos + 1) 423 423 + (String.length name_value - eq_pos - 1) 424 424 + |> String.trim 425 425 + in 426 426 + let now = 427 427 + Ptime.of_float_s (Eio.Time.now clock) 428 428 + |> Option.value ~default:Ptime.epoch 429 429 + in 430 430 + (* Create cookie with defaults from Cookie header context *) 431 431 + let cookie = 432 432 + make ~domain ~path ~name:cookie_name ~value:cookie_value 433 433 + ~secure:false ~http_only:false ~partitioned:false ~creation_time:now 434 434 + ~last_access:now () 435 435 + in 436 436 + Ok cookie) 437 437 + parts 438 438 + 342 439 and make_cookie_header cookies = 343 440 cookies 344 441 |> List.map (fun c -> Printf.sprintf "%s=%s" (name c) (value c)) ··· 359 456 360 457 (* Add Expires if present *) 361 458 (match expires cookie with 362 362 - | Some exp_time -> 459 459 + | Some `Session -> 460 460 + (* Session cookies can be indicated with Expires=0 or a past date *) 461 461 + Buffer.add_string buffer "; Expires=0" 462 462 + | Some (`DateTime exp_time) -> 363 463 (* Format as HTTP date *) 364 464 let exp_str = Ptime.to_rfc3339 ~tz_offset_s:0 exp_time in 365 465 Buffer.add_string buffer (Printf.sprintf "; Expires=%s" exp_str) ··· 377 477 (* Add HttpOnly flag *) 378 478 if http_only cookie then Buffer.add_string buffer "; HttpOnly"; 379 479 480 480 + (* Add Partitioned flag *) 481 481 + if partitioned cookie then Buffer.add_string buffer "; Partitioned"; 482 482 + 380 483 (* Add SameSite *) 381 484 (match same_site cookie with 382 485 | Some `Strict -> Buffer.add_string buffer "; SameSite=Strict" ··· 388 491 389 492 (** {1 Pretty Printing} *) 390 493 391 391 - and pp_same_site ppf = function 392 392 - | `Strict -> Format.pp_print_string ppf "Strict" 393 393 - | `Lax -> Format.pp_print_string ppf "Lax" 394 394 - | `None -> Format.pp_print_string ppf "None" 395 395 - 396 494 and pp ppf cookie = 397 495 Format.fprintf ppf 398 496 "@[<hov 2>{ name=%S;@ value=%S;@ domain=%S;@ path=%S;@ secure=%b;@ \ 399 399 - http_only=%b;@ expires=%a;@ max_age=%a;@ same_site=%a }@]" 497 497 + http_only=%b;@ partitioned=%b;@ expires=%a;@ max_age=%a;@ same_site=%a }@]" 400 498 (name cookie) (value cookie) (domain cookie) (path cookie) (secure cookie) 401 401 - (http_only cookie) 402 402 - (Format.pp_print_option Ptime.pp) 499 499 + (http_only cookie) (partitioned cookie) 500 500 + (Format.pp_print_option Expiration.pp) 403 501 (expires cookie) 404 502 (Format.pp_print_option Ptime.Span.pp) 405 503 (max_age cookie) 406 406 - (Format.pp_print_option pp_same_site) 504 504 + (Format.pp_print_option SameSite.pp) 407 505 (same_site cookie) 408 506 409 507 let pp_jar ppf jar = ··· 465 563 |> Option.value ~default:Ptime.epoch 466 564 in 467 565 make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) ~value:"" 468 468 - ~secure:(secure cookie) ~http_only:(http_only cookie) ~expires:past_expiry 469 469 - ~max_age:(Ptime.Span.of_int_s 0) ?same_site:(same_site cookie) 566 566 + ~secure:(secure cookie) ~http_only:(http_only cookie) 567 567 + ~expires:(`DateTime past_expiry) ~max_age:(Ptime.Span.of_int_s 0) 568 568 + ?same_site:(same_site cookie) ~partitioned:(partitioned cookie) 470 569 ~creation_time:now ~last_access:now () 471 570 472 571 let remove jar ~clock cookie = ··· 585 684 let before_count = 586 685 List.length jar.original_cookies + List.length jar.delta_cookies 587 686 in 588 588 - jar.original_cookies <- 589 589 - List.filter (fun c -> expires c <> None) jar.original_cookies; 590 590 - jar.delta_cookies <- 591 591 - List.filter (fun c -> expires c <> None) jar.delta_cookies; 687 687 + (* Keep only cookies that are NOT session cookies *) 688 688 + let is_not_session c = 689 689 + match expires c with 690 690 + | Some `Session -> false (* This is a session cookie, remove it *) 691 691 + | None | Some (`DateTime _) -> true (* Keep these *) 692 692 + in 693 693 + jar.original_cookies <- List.filter is_not_session jar.original_cookies; 694 694 + jar.delta_cookies <- List.filter is_not_session jar.delta_cookies; 592 695 let removed = 593 696 before_count 594 697 - (List.length jar.original_cookies + List.length jar.delta_cookies) ··· 663 766 let secure_flag = if secure cookie then "TRUE" else "FALSE" in 664 767 let expires_str = 665 768 match expires cookie with 666 666 - | None -> "0" (* Session cookie *) 667 667 - | Some t -> 769 769 + | None -> "0" (* No expiration *) 770 770 + | Some `Session -> "0" (* Session cookie *) 771 771 + | Some (`DateTime t) -> 668 772 let epoch = Ptime.to_float_s t |> int_of_float |> string_of_int in 669 773 epoch 670 774 in ··· 701 805 let expires = 702 806 let exp_int = try int_of_string expires with _ -> 0 in 703 807 if exp_int = 0 then None 704 704 - else Ptime.of_float_s (float_of_int exp_int) 808 808 + else 809 809 + match Ptime.of_float_s (float_of_int exp_int) with 810 810 + | Some t -> Some (`DateTime t) 811 811 + | None -> None 705 812 in 706 813 707 814 let cookie = 708 815 make ~domain:(normalize_domain domain) ~path ~name ~value 709 709 - ~secure:(secure = "TRUE") ~http_only:false ?expires 710 710 - ?max_age:None ?same_site:None ~creation_time:now 816 816 + ~secure:(secure = "TRUE") ~http_only:false ?expires ?max_age:None 817 817 + ?same_site:None ~partitioned:false ~creation_time:now 711 818 ~last_access:now () 712 819 in 713 820 add_original jar cookie;

+100 -16

lib/cookeio.mli

··· 29 29 - Path matching allows subset URL specification for fine-grained control 30 30 - More specific path mappings are sent first in Cookie headers *) 31 31 32 32 - type same_site = [ `Strict | `Lax | `None ] 33 33 - (** Cookie same-site policy for controlling cross-site request behavior. 32 32 + module SameSite : sig 33 33 + type t = [ `Strict | `Lax | `None ] 34 34 + (** Cookie same-site policy for controlling cross-site request behavior. 35 35 + 36 36 + - [`Strict]: Cookie only sent for same-site requests, providing maximum 37 37 + protection 38 38 + - [`Lax]: Cookie sent for same-site requests and top-level navigation 39 39 + (default for modern browsers) 40 40 + - [`None]: Cookie sent for all cross-site requests (requires [secure] flag) *) 41 41 + 42 42 + val equal : t -> t -> bool 43 43 + (** Equality function for same-site values *) 44 44 + 45 45 + val pp : Format.formatter -> t -> unit 46 46 + (** Pretty printer for same-site values *) 47 47 + end 34 48 35 35 - - [`Strict]: Cookie only sent for same-site requests, providing maximum 36 36 - protection 37 37 - - [`Lax]: Cookie sent for same-site requests and top-level navigation 38 38 - (default for modern browsers) 39 39 - - [`None]: Cookie sent for all cross-site requests (requires [secure] flag) 40 40 - *) 49 49 + module Expiration : sig 50 50 + type t = [ `Session | `DateTime of Ptime.t ] 51 51 + (** Cookie expiration strategy. 52 52 + 53 53 + - [`Session]: Session cookie that expires when browser session ends 54 54 + - [`DateTime time]: Persistent cookie that expires at specific time *) 55 55 + 56 56 + val equal : t -> t -> bool 57 57 + (** Equality function for expiration values *) 58 58 + 59 59 + val pp : Format.formatter -> t -> unit 60 60 + (** Pretty printer for expiration values *) 61 61 + end 41 62 42 63 type t 43 64 (** HTTP Cookie representation with all standard attributes. ··· 71 92 val value : t -> string 72 93 (** Get the value of a cookie *) 73 94 95 95 + val value_trimmed : t -> string 96 96 + (** Get cookie value with surrounding double-quotes removed if they form a 97 97 + matching pair. 98 98 + 99 99 + Only removes quotes when both opening and closing quotes are present. The 100 100 + raw value is always preserved in {!value}. This is useful for handling 101 101 + quoted cookie values per RFC 6265. 102 102 + 103 103 + Examples: 104 104 + - ["value"] → ["value"] 105 105 + - ["\"value\""] → ["value"] 106 106 + - ["\"value"] → ["\"value"] (no matching pair) 107 107 + - ["\"val\"\""] → ["val\""] (removes outer pair only) *) 108 108 + 74 109 val secure : t -> bool 75 110 (** Check if cookie is secure only *) 76 111 77 112 val http_only : t -> bool 78 113 (** Check if cookie is HTTP only *) 79 114 80 80 - val expires : t -> Ptime.t option 81 81 - (** Get the expiry time of a cookie *) 115 115 + val partitioned : t -> bool 116 116 + (** Check if cookie has the Partitioned attribute. 117 117 + 118 118 + Partitioned cookies are part of CHIPS (Cookies Having Independent 119 119 + Partitioned State) and are stored separately per top-level site, enabling 120 120 + privacy-preserving third-party cookie functionality. Partitioned cookies 121 121 + must always be Secure. *) 122 122 + 123 123 + val expires : t -> Expiration.t option 124 124 + (** Get the expiration attribute if set. 125 125 + 126 126 + - [None]: No expiration specified (browser decides lifetime) 127 127 + - [Some `Session]: Session cookie (expires when browser session ends) 128 128 + - [Some (`DateTime t)]: Expires at specific time [t] 129 129 + 130 130 + Both [max_age] and [expires] can be present simultaneously. This library 131 131 + stores both independently. *) 82 132 83 133 val max_age : t -> Ptime.Span.t option 84 84 - (** Get the max-age of a cookie *) 134 134 + (** Get the max-age attribute if set. 85 135 86 86 - val same_site : t -> same_site option 136 136 + Both [max_age] and [expires] can be present simultaneously. When both are 137 137 + present in a Set-Cookie header, browsers prioritize [max_age] per RFC 6265. 138 138 + This library stores both independently and serializes both when present. *) 139 139 + 140 140 + val same_site : t -> SameSite.t option 87 141 (** Get the same-site policy of a cookie *) 88 142 89 143 val creation_time : t -> Ptime.t ··· 99 153 value:string -> 100 154 ?secure:bool -> 101 155 ?http_only:bool -> 102 102 - ?expires:Ptime.t -> 156 156 + ?expires:Expiration.t -> 103 157 ?max_age:Ptime.Span.t -> 104 104 - ?same_site:same_site -> 158 158 + ?same_site:SameSite.t -> 159 159 + ?partitioned:bool -> 105 160 creation_time:Ptime.t -> 106 161 last_access:Ptime.t -> 107 162 unit -> 108 163 t 109 109 - (** Create a new cookie with the given attributes *) 164 164 + (** Create a new cookie with the given attributes. 165 165 + 166 166 + Note: If [partitioned] is [true], the cookie must also be [secure]. Invalid 167 167 + combinations will result in validation errors. *) 110 168 111 169 (** {1 Cookie Jar Creation and Loading} *) 112 170 ··· 194 252 Parses a Set-Cookie header value following RFC specifications: 195 253 - Basic format: [NAME=VALUE; attribute1; attribute2=value2] 196 254 - Supports all standard attributes: [expires], [max-age], [domain], [path], 197 197 - [secure], [httponly], [samesite] 255 255 + [secure], [httponly], [samesite], [partitioned] 198 256 - Returns [None] if parsing fails or cookie validation fails 199 257 - The [domain] and [path] parameters provide the request context for default 200 258 values ··· 203 261 204 262 Cookie validation rules: 205 263 - [SameSite=None] requires the [Secure] flag to be set 264 264 + - [Partitioned] requires the [Secure] flag to be set 206 265 207 266 Example: 208 267 [parse_set_cookie ~clock ~domain:"example.com" ~path:"/" "session=abc123; 209 268 Secure; HttpOnly"] *) 269 269 + 270 270 + val of_cookie_header : 271 271 + clock:_ Eio.Time.clock -> 272 272 + domain:string -> 273 273 + path:string -> 274 274 + string -> 275 275 + (t, string) result list 276 276 + (** Parse Cookie header containing semicolon-separated name=value pairs. 277 277 + 278 278 + Cookie headers (client→server) contain only name=value pairs without 279 279 + attributes: ["name1=value1; name2=value2; name3=value3"] 280 280 + 281 281 + Creates cookies with: 282 282 + - Provided [domain] and [path] from request context 283 283 + - All security flags set to [false] (defaults) 284 284 + - All optional attributes set to [None] 285 285 + - [creation_time] and [last_access] set to current time from [clock] 286 286 + 287 287 + Returns a list of parse results, one per cookie. Parse errors for individual 288 288 + cookies are returned as [Error msg] without failing the entire parse. Empty 289 289 + values and excess whitespace are ignored. 290 290 + 291 291 + Example: 292 292 + [of_cookie_header ~clock ~domain:"example.com" ~path:"/" 293 293 + "session=abc; theme=dark"] *) 210 294 211 295 val make_cookie_header : t list -> string 212 296 (** Create cookie header value from cookies.

+1 -1

test/dune

··· 1 1 (test 2 2 (name test_cookeio) 3 3 - (libraries cookeio alcotest eio eio.unix eio_main eio.mock ptime) 3 3 + (libraries cookeio alcotest eio eio.unix eio_main eio.mock ptime str) 4 4 (deps cookies.txt))

+528 -78

test/test_cookeio.ml

··· 1 1 open Cookeio 2 2 3 3 + (* Testable helpers for Priority 2 types *) 4 4 + let expiration_testable : Cookeio.Expiration.t Alcotest.testable = 5 5 + Alcotest.testable Cookeio.Expiration.pp Cookeio.Expiration.equal 6 6 + 7 7 + let span_testable : Ptime.Span.t Alcotest.testable = 8 8 + Alcotest.testable Ptime.Span.pp Ptime.Span.equal 9 9 + 10 10 + let same_site_testable : Cookeio.SameSite.t Alcotest.testable = 11 11 + Alcotest.testable Cookeio.SameSite.pp Cookeio.SameSite.equal 12 12 + 3 13 let cookie_testable : Cookeio.t Alcotest.testable = 4 14 Alcotest.testable 5 15 (fun ppf c -> 6 16 Format.fprintf ppf 7 17 "{ name=%S; value=%S; domain=%S; path=%S; secure=%b; http_only=%b; \ 8 8 - expires=%a; max_age=%a; same_site=%a }" 18 18 + partitioned=%b; expires=%a; max_age=%a; same_site=%a }" 9 19 (Cookeio.name c) (Cookeio.value c) (Cookeio.domain c) (Cookeio.path c) 10 10 - (Cookeio.secure c) (Cookeio.http_only c) 11 11 - (Format.pp_print_option Ptime.pp) 20 20 + (Cookeio.secure c) (Cookeio.http_only c) (Cookeio.partitioned c) 21 21 + (Format.pp_print_option 22 22 + (fun ppf e -> 23 23 + match e with 24 24 + | `Session -> Format.pp_print_string ppf "Session" 25 25 + | `DateTime t -> Format.fprintf ppf "DateTime(%a)" Ptime.pp t)) 12 26 (Cookeio.expires c) 13 27 (Format.pp_print_option Ptime.Span.pp) 14 28 (Cookeio.max_age c) 15 15 - (Format.pp_print_option (fun ppf -> function 16 16 - | `Strict -> Format.pp_print_string ppf "Strict" 17 17 - | `Lax -> Format.pp_print_string ppf "Lax" 18 18 - | `None -> Format.pp_print_string ppf "None")) 29 29 + (Format.pp_print_option 30 30 + (fun ppf -> function 31 31 + | `Strict -> Format.pp_print_string ppf "Strict" 32 32 + | `Lax -> Format.pp_print_string ppf "Lax" 33 33 + | `None -> Format.pp_print_string ppf "None")) 19 34 (Cookeio.same_site c)) 20 35 (fun c1 c2 -> 36 36 + let expires_equal e1 e2 = 37 37 + match (e1, e2) with 38 38 + | None, None -> true 39 39 + | Some `Session, Some `Session -> true 40 40 + | Some (`DateTime t1), Some (`DateTime t2) -> Ptime.equal t1 t2 41 41 + | _ -> false 42 42 + in 21 43 Cookeio.name c1 = Cookeio.name c2 22 44 && Cookeio.value c1 = Cookeio.value c2 23 45 && Cookeio.domain c1 = Cookeio.domain c2 24 46 && Cookeio.path c1 = Cookeio.path c2 25 47 && Cookeio.secure c1 = Cookeio.secure c2 26 48 && Cookeio.http_only c1 = Cookeio.http_only c2 27 27 - && Option.equal Ptime.equal (Cookeio.expires c1) (Cookeio.expires c2) 49 49 + && Cookeio.partitioned c1 = Cookeio.partitioned c2 50 50 + && expires_equal (Cookeio.expires c1) (Cookeio.expires c2) 28 51 && Option.equal Ptime.Span.equal (Cookeio.max_age c1) (Cookeio.max_age c2) 29 52 && Option.equal ( = ) (Cookeio.same_site c1) (Cookeio.same_site c2)) 30 53 ··· 63 86 Alcotest.(check string) "cookie-1 value" "v$1" (Cookeio.value cookie1); 64 87 Alcotest.(check bool) "cookie-1 secure" false (Cookeio.secure cookie1); 65 88 Alcotest.(check bool) "cookie-1 http_only" false (Cookeio.http_only cookie1); 66 66 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 89 89 + Alcotest.(check (option expiration_testable)) 67 90 "cookie-1 expires" None (Cookeio.expires cookie1); 68 91 Alcotest.( 69 92 check ··· 86 109 Alcotest.(check string) "cookie-2 value" "v$2" (Cookeio.value cookie2); 87 110 Alcotest.(check bool) "cookie-2 secure" false (Cookeio.secure cookie2); 88 111 Alcotest.(check bool) "cookie-2 http_only" false (Cookeio.http_only cookie2); 89 89 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 112 112 + Alcotest.(check (option expiration_testable)) 90 113 "cookie-2 expires" None (Cookeio.expires cookie2); 91 114 92 115 (* Test cookie-3: non-session cookie with expiry *) ··· 99 122 Alcotest.(check string) "cookie-3 value" "v$3" (Cookeio.value cookie3); 100 123 Alcotest.(check bool) "cookie-3 secure" false (Cookeio.secure cookie3); 101 124 Alcotest.(check bool) "cookie-3 http_only" false (Cookeio.http_only cookie3); 102 102 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 103 103 - "cookie-3 expires" expected_expiry (Cookeio.expires cookie3); 125 125 + begin match expected_expiry with 126 126 + | Some t -> 127 127 + Alcotest.(check (option expiration_testable)) 128 128 + "cookie-3 expires" (Some (`DateTime t)) (Cookeio.expires cookie3) 129 129 + | None -> Alcotest.fail "Expected expiry time for cookie-3" 130 130 + end; 104 131 105 132 (* Test cookie-4: another non-session cookie *) 106 133 let cookie4 = find_cookie "cookie-4" in ··· 111 138 Alcotest.(check string) "cookie-4 value" "v$4" (Cookeio.value cookie4); 112 139 Alcotest.(check bool) "cookie-4 secure" false (Cookeio.secure cookie4); 113 140 Alcotest.(check bool) "cookie-4 http_only" false (Cookeio.http_only cookie4); 114 114 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 115 115 - "cookie-4 expires" expected_expiry (Cookeio.expires cookie4); 141 141 + begin match expected_expiry with 142 142 + | Some t -> 143 143 + Alcotest.(check (option expiration_testable)) 144 144 + "cookie-4 expires" (Some (`DateTime t)) (Cookeio.expires cookie4) 145 145 + | None -> Alcotest.fail "Expected expiry time for cookie-4" 146 146 + end; 116 147 117 148 (* Test cookie-5: secure cookie *) 118 149 let cookie5 = find_cookie "cookie-5" in ··· 123 154 Alcotest.(check string) "cookie-5 value" "v$5" (Cookeio.value cookie5); 124 155 Alcotest.(check bool) "cookie-5 secure" true (Cookeio.secure cookie5); 125 156 Alcotest.(check bool) "cookie-5 http_only" false (Cookeio.http_only cookie5); 126 126 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 127 127 - "cookie-5 expires" expected_expiry (Cookeio.expires cookie5) 157 157 + begin match expected_expiry with 158 158 + | Some t -> 159 159 + Alcotest.(check (option expiration_testable)) 160 160 + "cookie-5 expires" (Some (`DateTime t)) (Cookeio.expires cookie5) 161 161 + | None -> Alcotest.fail "Expected expiry time for cookie-5" 162 162 + end 128 163 129 164 let test_load_from_file env = 130 165 (* This test loads from the actual test/cookies.txt file using the load function *) ··· 145 180 Alcotest.(check string) 146 181 "file cookie-1 domain" "example.com" (Cookeio.domain cookie1); 147 182 Alcotest.(check bool) "file cookie-1 secure" false (Cookeio.secure cookie1); 148 148 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 183 183 + Alcotest.(check (option expiration_testable)) 149 184 "file cookie-1 expires" None (Cookeio.expires cookie1); 150 185 151 186 let cookie5 = find_cookie "cookie-5" in 152 187 Alcotest.(check string) "file cookie-5 value" "v$5" (Cookeio.value cookie5); 153 188 Alcotest.(check bool) "file cookie-5 secure" true (Cookeio.secure cookie5); 154 189 let expected_expiry = Ptime.of_float_s 1257894000.0 in 155 155 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 156 156 - "file cookie-5 expires" expected_expiry (Cookeio.expires cookie5); 190 190 + begin match expected_expiry with 191 191 + | Some t -> 192 192 + Alcotest.(check (option expiration_testable)) 193 193 + "file cookie-5 expires" (Some (`DateTime t)) (Cookeio.expires cookie5) 194 194 + | None -> Alcotest.fail "Expected expiry time for cookie-5" 195 195 + end; 157 196 158 197 (* Verify subdomain cookie *) 159 198 let cookie2 = find_cookie "cookie-2" in 160 199 Alcotest.(check string) 161 200 "file cookie-2 domain" "example.com" (Cookeio.domain cookie2); 162 162 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 201 201 + Alcotest.(check (option expiration_testable)) 163 202 "file cookie-2 expires" None (Cookeio.expires cookie2) 164 203 165 204 let test_cookie_matching env = ··· 223 262 let jar = create () in 224 263 225 264 let test_cookie = 265 265 + let expires = 266 266 + match Ptime.of_float_s 1257894000.0 with 267 267 + | Some t -> Some (`DateTime t) 268 268 + | None -> None 269 269 + in 226 270 Cookeio.make ~domain:"example.com" ~path:"/test/" ~name:"test" 227 227 - ~value:"value" ~secure:true ~http_only:false 228 228 - ?expires:(Ptime.of_float_s 1257894000.0) 229 229 - ~same_site:`Strict ?max_age:None ~creation_time:Ptime.epoch 230 230 - ~last_access:Ptime.epoch () 271 271 + ~value:"value" ~secure:true ~http_only:false ?expires ~same_site:`Strict 272 272 + ?max_age:None ~creation_time:Ptime.epoch ~last_access:Ptime.epoch () 231 273 in 232 274 233 275 add_cookie jar test_cookie; ··· 246 288 Alcotest.(check string) "round trip path" "/test/" (Cookeio.path cookie2); 247 289 Alcotest.(check bool) "round trip secure" true (Cookeio.secure cookie2); 248 290 (* Note: http_only and same_site are lost in Mozilla format *) 249 249 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 250 250 - "round trip expires" 251 251 - (Ptime.of_float_s 1257894000.0) 252 252 - (Cookeio.expires cookie2) 291 291 + begin match Ptime.of_float_s 1257894000.0 with 292 292 + | Some t -> 293 293 + Alcotest.(check (option expiration_testable)) 294 294 + "round trip expires" (Some (`DateTime t)) (Cookeio.expires cookie2) 295 295 + | None -> Alcotest.fail "Expected expiry time" 296 296 + end 253 297 254 298 let test_cookie_expiry_with_mock_clock () = 255 299 Eio_mock.Backend.run @@ fun () -> ··· 264 308 let expires_soon = Ptime.of_float_s 1500.0 |> Option.get in 265 309 let cookie1 = 266 310 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_soon" 267 267 - ~value:"value1" ~secure:false ~http_only:false ~expires:expires_soon 268 268 - ?same_site:None ?max_age:None 311 311 + ~value:"value1" ~secure:false ~http_only:false 312 312 + ~expires:(`DateTime expires_soon) ?same_site:None ?max_age:None 269 313 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 270 314 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 271 315 () ··· 275 319 let expires_later = Ptime.of_float_s 2000.0 |> Option.get in 276 320 let cookie2 = 277 321 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_later" 278 278 - ~value:"value2" ~secure:false ~http_only:false ~expires:expires_later 279 279 - ?same_site:None ?max_age:None 322 322 + ~value:"value2" ~secure:false ~http_only:false 323 323 + ~expires:(`DateTime expires_later) ?same_site:None ?max_age:None 280 324 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 281 325 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 282 326 () ··· 344 388 345 389 (* Verify the expiry time is set correctly (5000.0 + 3600 = 8600.0) *) 346 390 let expected_expiry = Ptime.of_float_s 8600.0 in 347 347 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 348 348 - "expires set from max-age" expected_expiry (Cookeio.expires cookie); 391 391 + begin match expected_expiry with 392 392 + | Some t -> 393 393 + Alcotest.(check (option expiration_testable)) 394 394 + "expires set from max-age" (Some (`DateTime t)) (Cookeio.expires cookie) 395 395 + | None -> Alcotest.fail "Expected expiry time" 396 396 + end; 349 397 350 398 (* Verify creation time matches clock time *) 351 399 let expected_creation = Ptime.of_float_s 5000.0 in ··· 426 474 let expected_expiry = Ptime.of_rfc3339 "2025-10-21T07:28:00Z" in 427 475 match expected_expiry with 428 476 | Ok (time, _, _) -> 429 429 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 430 430 - "expires matches parsed value" (Some time) (Cookeio.expires cookie) 477 477 + Alcotest.(check (option expiration_testable)) 478 478 + "expires matches parsed value" (Some (`DateTime time)) 479 479 + (Cookeio.expires cookie) 431 480 | Error _ -> Alcotest.fail "Failed to parse expected expiry time" 432 481 433 482 let test_samesite_none_validation () = ··· 529 578 530 579 (* Verify expires is also computed correctly *) 531 580 let expected_expiry = Ptime.of_float_s 8600.0 in 532 532 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 533 533 - "expires computed from max-age" expected_expiry (Cookeio.expires cookie) 581 581 + begin match expected_expiry with 582 582 + | Some t -> 583 583 + Alcotest.(check (option expiration_testable)) 584 584 + "expires computed from max-age" (Some (`DateTime t)) 585 585 + (Cookeio.expires cookie) 586 586 + | None -> Alcotest.fail "Expected expiry time" 587 587 + end 534 588 535 589 let test_max_age_negative_becomes_zero () = 536 590 Eio_mock.Backend.run @@ fun () -> ··· 557 611 558 612 (* Verify expires is computed with 0 seconds *) 559 613 let expected_expiry = Ptime.of_float_s 5000.0 in 560 560 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 561 561 - "expires computed with 0 seconds" expected_expiry (Cookeio.expires cookie) 614 614 + begin match expected_expiry with 615 615 + | Some t -> 616 616 + Alcotest.(check (option expiration_testable)) 617 617 + "expires computed with 0 seconds" (Some (`DateTime t)) 618 618 + (Cookeio.expires cookie) 619 619 + | None -> Alcotest.fail "Expected expiry time" 620 620 + end 562 621 563 622 let string_contains_substring s sub = 564 623 try ··· 581 640 let expires_time = Ptime.of_float_s 8600.0 |> Option.get in 582 641 let cookie = 583 642 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"abc123" 584 584 - ~secure:true ~http_only:true ?expires:(Some expires_time) 643 643 + ~secure:true ~http_only:true ?expires:(Some (`DateTime expires_time)) 585 644 ?max_age:(Some max_age_span) ?same_site:(Some `Strict) 586 645 ~creation_time:(Ptime.of_float_s 5000.0 |> Option.get) 587 646 ~last_access:(Ptime.of_float_s 5000.0 |> Option.get) ··· 711 770 712 771 (* Verify the parsed time matches expected value *) 713 772 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 714 714 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 715 715 - "FMT1 expiry correct" expected (Cookeio.expires cookie) 773 773 + begin match expected with 774 774 + | Some t -> 775 775 + Alcotest.(check (option expiration_testable)) 776 776 + "FMT1 expiry correct" (Some (`DateTime t)) (Cookeio.expires cookie) 777 777 + | None -> Alcotest.fail "Expected expiry time for FMT1" 778 778 + end 716 779 717 780 let test_http_date_fmt2 () = 718 781 Eio_mock.Backend.run @@ fun () -> ··· 733 796 734 797 (* Year 15 should be normalized to 2015 *) 735 798 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 736 736 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 737 737 - "FMT2 expiry correct with year normalization" expected 738 738 - (Cookeio.expires cookie) 799 799 + begin match expected with 800 800 + | Some t -> 801 801 + Alcotest.(check (option expiration_testable)) 802 802 + "FMT2 expiry correct with year normalization" (Some (`DateTime t)) 803 803 + (Cookeio.expires cookie) 804 804 + | None -> Alcotest.fail "Expected expiry time for FMT2" 805 805 + end 739 806 740 807 let test_http_date_fmt3 () = 741 808 Eio_mock.Backend.run @@ fun () -> ··· 755 822 (Option.is_some (Cookeio.expires cookie)); 756 823 757 824 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 758 758 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 759 759 - "FMT3 expiry correct" expected (Cookeio.expires cookie) 825 825 + begin match expected with 826 826 + | Some t -> 827 827 + Alcotest.(check (option expiration_testable)) 828 828 + "FMT3 expiry correct" (Some (`DateTime t)) (Cookeio.expires cookie) 829 829 + | None -> Alcotest.fail "Expected expiry time for FMT3" 830 830 + end 760 831 761 832 let test_http_date_fmt4 () = 762 833 Eio_mock.Backend.run @@ fun () -> ··· 776 847 (Option.is_some (Cookeio.expires cookie)); 777 848 778 849 let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 779 779 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 780 780 - "FMT4 expiry correct" expected (Cookeio.expires cookie) 850 850 + begin match expected with 851 851 + | Some t -> 852 852 + Alcotest.(check (option expiration_testable)) 853 853 + "FMT4 expiry correct" (Some (`DateTime t)) (Cookeio.expires cookie) 854 854 + | None -> Alcotest.fail "Expected expiry time for FMT4" 855 855 + end 781 856 782 857 let test_abbreviated_year_69_to_99 () = 783 858 Eio_mock.Backend.run @@ fun () -> ··· 791 866 in 792 867 let cookie = Option.get cookie_opt in 793 868 let expected = Ptime.of_date_time ((1995, 10, 21), ((07, 28, 00), 0)) in 794 794 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 795 795 - "year 95 becomes 1995" expected (Cookeio.expires cookie); 869 869 + begin match expected with 870 870 + | Some t -> 871 871 + Alcotest.(check (option expiration_testable)) 872 872 + "year 95 becomes 1995" (Some (`DateTime t)) (Cookeio.expires cookie) 873 873 + | None -> Alcotest.fail "Expected expiry time for year 95" 874 874 + end; 796 875 797 876 (* Year 69 should become 1969 *) 798 877 let header2 = "session=abc; Expires=Wed, 10-Sep-69 20:00:00 GMT" in ··· 801 880 in 802 881 let cookie2 = Option.get cookie_opt2 in 803 882 let expected2 = Ptime.of_date_time ((1969, 9, 10), ((20, 0, 0), 0)) in 804 804 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 805 805 - "year 69 becomes 1969" expected2 (Cookeio.expires cookie2); 883 883 + begin match expected2 with 884 884 + | Some t -> 885 885 + Alcotest.(check (option expiration_testable)) 886 886 + "year 69 becomes 1969" (Some (`DateTime t)) (Cookeio.expires cookie2) 887 887 + | None -> Alcotest.fail "Expected expiry time for year 69" 888 888 + end; 806 889 807 890 (* Year 99 should become 1999 *) 808 891 let header3 = "session=abc; Expires=Thu, 10-Sep-99 20:00:00 GMT" in ··· 811 894 in 812 895 let cookie3 = Option.get cookie_opt3 in 813 896 let expected3 = Ptime.of_date_time ((1999, 9, 10), ((20, 0, 0), 0)) in 814 814 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 815 815 - "year 99 becomes 1999" expected3 (Cookeio.expires cookie3) 897 897 + begin match expected3 with 898 898 + | Some t -> 899 899 + Alcotest.(check (option expiration_testable)) 900 900 + "year 99 becomes 1999" (Some (`DateTime t)) (Cookeio.expires cookie3) 901 901 + | None -> Alcotest.fail "Expected expiry time for year 99" 902 902 + end 816 903 817 904 let test_abbreviated_year_0_to_68 () = 818 905 Eio_mock.Backend.run @@ fun () -> ··· 826 913 in 827 914 let cookie = Option.get cookie_opt in 828 915 let expected = Ptime.of_date_time ((2025, 10, 21), ((07, 28, 00), 0)) in 829 829 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 830 830 - "year 25 becomes 2025" expected (Cookeio.expires cookie); 916 916 + begin match expected with 917 917 + | Some t -> 918 918 + Alcotest.(check (option expiration_testable)) 919 919 + "year 25 becomes 2025" (Some (`DateTime t)) (Cookeio.expires cookie) 920 920 + | None -> Alcotest.fail "Expected expiry time for year 25" 921 921 + end; 831 922 832 923 (* Year 0 should become 2000 *) 833 924 let header2 = "session=abc; Expires=Fri, 01-Jan-00 00:00:00 GMT" in ··· 836 927 in 837 928 let cookie2 = Option.get cookie_opt2 in 838 929 let expected2 = Ptime.of_date_time ((2000, 1, 1), ((0, 0, 0), 0)) in 839 839 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 840 840 - "year 0 becomes 2000" expected2 (Cookeio.expires cookie2); 930 930 + begin match expected2 with 931 931 + | Some t -> 932 932 + Alcotest.(check (option expiration_testable)) 933 933 + "year 0 becomes 2000" (Some (`DateTime t)) (Cookeio.expires cookie2) 934 934 + | None -> Alcotest.fail "Expected expiry time for year 0" 935 935 + end; 841 936 842 937 (* Year 68 should become 2068 *) 843 938 let header3 = "session=abc; Expires=Thu, 10-Sep-68 20:00:00 GMT" in ··· 846 941 in 847 942 let cookie3 = Option.get cookie_opt3 in 848 943 let expected3 = Ptime.of_date_time ((2068, 9, 10), ((20, 0, 0), 0)) in 849 849 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 850 850 - "year 68 becomes 2068" expected3 (Cookeio.expires cookie3) 944 944 + begin match expected3 with 945 945 + | Some t -> 946 946 + Alcotest.(check (option expiration_testable)) 947 947 + "year 68 becomes 2068" (Some (`DateTime t)) (Cookeio.expires cookie3) 948 948 + | None -> Alcotest.fail "Expected expiry time for year 68" 949 949 + end 851 950 852 951 let test_rfc3339_still_works () = 853 952 Eio_mock.Backend.run @@ fun () -> ··· 872 971 let expected = Ptime.of_rfc3339 "2025-10-21T07:28:00Z" in 873 972 match expected with 874 973 | Ok (time, _, _) -> 875 875 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 876 876 - "RFC 3339 expiry correct" (Some time) (Cookeio.expires cookie) 974 974 + Alcotest.(check (option expiration_testable)) 975 975 + "RFC 3339 expiry correct" (Some (`DateTime time)) (Cookeio.expires cookie) 877 976 | Error _ -> Alcotest.fail "Failed to parse expected RFC 3339 time" 878 977 879 978 let test_invalid_date_format_logs_warning () = ··· 895 994 Alcotest.(check string) "cookie name correct" "session" (Cookeio.name cookie); 896 995 Alcotest.(check string) "cookie value correct" "abc" (Cookeio.value cookie); 897 996 (* expires should be None since date was invalid *) 898 898 - Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 997 997 + Alcotest.(check (option expiration_testable)) 899 998 "expires is None for invalid date" None (Cookeio.expires cookie) 900 999 901 1000 let test_case_insensitive_month_parsing () = ··· 930 1029 931 1030 (* Verify the date was parsed correctly regardless of case *) 932 1031 let expires = Option.get (Cookeio.expires cookie) in 933 933 - let year, month, _ = Ptime.to_date expires in 934 934 - Alcotest.(check int) (description ^ " year correct") 2015 year; 935 935 - Alcotest.(check int) 936 936 - (description ^ " month correct (October=10)") 937 937 - 10 month) 1032 1032 + match expires with 1033 1033 + | `DateTime ptime -> 1034 1034 + let year, month, _ = Ptime.to_date ptime in 1035 1035 + Alcotest.(check int) (description ^ " year correct") 2015 year; 1036 1036 + Alcotest.(check int) 1037 1037 + (description ^ " month correct (October=10)") 1038 1038 + 10 month 1039 1039 + | `Session -> Alcotest.fail (description ^ " should not be session cookie")) 938 1040 test_cases 939 1041 940 1042 let test_case_insensitive_gmt_parsing () = ··· 969 1071 970 1072 (* Verify the date was parsed correctly regardless of GMT case *) 971 1073 let expires = Option.get (Cookeio.expires cookie) in 972 972 - let year, month, day = Ptime.to_date expires in 973 973 - Alcotest.(check int) (description ^ " year correct") 2015 year; 974 974 - Alcotest.(check int) 975 975 - (description ^ " month correct (October=10)") 976 976 - 10 month; 977 977 - Alcotest.(check int) (description ^ " day correct") 21 day) 1074 1074 + match expires with 1075 1075 + | `DateTime ptime -> 1076 1076 + let year, month, day = Ptime.to_date ptime in 1077 1077 + Alcotest.(check int) (description ^ " year correct") 2015 year; 1078 1078 + Alcotest.(check int) 1079 1079 + (description ^ " month correct (October=10)") 1080 1080 + 10 month; 1081 1081 + Alcotest.(check int) (description ^ " day correct") 21 day 1082 1082 + | `Session -> Alcotest.fail (description ^ " should not be session cookie")) 978 1083 test_cases 979 1084 980 1085 (** {1 Delta Tracking Tests} *) ··· 1263 1368 (* Check expires is in the past *) 1264 1369 let now = Ptime.of_float_s 1000.0 |> Option.get in 1265 1370 match Cookeio.expires removal with 1266 1266 - | Some exp -> 1371 1371 + | Some (`DateTime exp) -> 1267 1372 Alcotest.(check bool) 1268 1373 "expires is in the past" true 1269 1374 (Ptime.compare exp now < 0) 1270 1270 - | None -> Alcotest.fail "removal cookie should have expires" 1375 1375 + | _ -> Alcotest.fail "removal cookie should have DateTime expires" 1376 1376 + 1377 1377 + (* ============================================================================ *) 1378 1378 + (* Priority 2 Tests *) 1379 1379 + (* ============================================================================ *) 1380 1380 + 1381 1381 + (* Priority 2.1: Partitioned Cookies *) 1382 1382 + 1383 1383 + let test_partitioned_parsing env = 1384 1384 + let clock = Eio.Stdenv.clock env in 1385 1385 + 1386 1386 + match parse_set_cookie ~clock ~domain:"widget.com" ~path:"/" 1387 1387 + "id=123; Partitioned; Secure" with 1388 1388 + | Some c -> 1389 1389 + Alcotest.(check bool) "partitioned flag" true (partitioned c); 1390 1390 + Alcotest.(check bool) "secure flag" true (secure c) 1391 1391 + | None -> Alcotest.fail "Should parse valid Partitioned cookie" 1392 1392 + 1393 1393 + let test_partitioned_serialization env = 1394 1394 + let clock = Eio.Stdenv.clock env in 1395 1395 + let now = Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch in 1396 1396 + 1397 1397 + let cookie = make ~domain:"widget.com" ~path:"/" ~name:"id" ~value:"123" 1398 1398 + ~secure:true ~partitioned:true 1399 1399 + ~creation_time:now ~last_access:now () in 1400 1400 + 1401 1401 + let header = make_set_cookie_header cookie in 1402 1402 + let contains_substring s sub = 1403 1403 + try 1404 1404 + let _ = Str.search_forward (Str.regexp_string sub) s 0 in 1405 1405 + true 1406 1406 + with Not_found -> false 1407 1407 + in 1408 1408 + let has_partitioned = contains_substring header "Partitioned" in 1409 1409 + let has_secure = contains_substring header "Secure" in 1410 1410 + Alcotest.(check bool) "contains Partitioned" true has_partitioned; 1411 1411 + Alcotest.(check bool) "contains Secure" true has_secure 1412 1412 + 1413 1413 + let test_partitioned_requires_secure env = 1414 1414 + let clock = Eio.Stdenv.clock env in 1415 1415 + 1416 1416 + (* Partitioned without Secure should be rejected *) 1417 1417 + match parse_set_cookie ~clock ~domain:"widget.com" ~path:"/" 1418 1418 + "id=123; Partitioned" with 1419 1419 + | None -> () (* Expected *) 1420 1420 + | Some _ -> Alcotest.fail "Should reject Partitioned without Secure" 1421 1421 + 1422 1422 + (* Priority 2.2: Expiration Variants *) 1423 1423 + 1424 1424 + let test_expiration_variants env = 1425 1425 + let clock = Eio.Stdenv.clock env in 1426 1426 + let now = Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch in 1427 1427 + let make_base ~name ?expires () = 1428 1428 + make ~domain:"ex.com" ~path:"/" ~name ~value:"v" 1429 1429 + ?expires ~creation_time:now ~last_access:now () 1430 1430 + in 1431 1431 + 1432 1432 + (* No expiration *) 1433 1433 + let c1 = make_base ~name:"no_expiry" () in 1434 1434 + Alcotest.(check (option expiration_testable)) "no expiration" 1435 1435 + None (expires c1); 1436 1436 + 1437 1437 + (* Session cookie *) 1438 1438 + let c2 = make_base ~name:"session" ~expires:`Session () in 1439 1439 + Alcotest.(check (option expiration_testable)) "session cookie" 1440 1440 + (Some `Session) (expires c2); 1441 1441 + 1442 1442 + (* Explicit expiration *) 1443 1443 + let future = Ptime.add_span now (Ptime.Span.of_int_s 3600) |> Option.get in 1444 1444 + let c3 = make_base ~name:"persistent" ~expires:(`DateTime future) () in 1445 1445 + match expires c3 with 1446 1446 + | Some (`DateTime t) when Ptime.equal t future -> () 1447 1447 + | _ -> Alcotest.fail "Expected DateTime expiration" 1448 1448 + 1449 1449 + let test_parse_session_expiration env = 1450 1450 + let clock = Eio.Stdenv.clock env in 1451 1451 + 1452 1452 + (* Expires=0 should parse as Session *) 1453 1453 + match parse_set_cookie ~clock ~domain:"ex.com" ~path:"/" 1454 1454 + "id=123; Expires=0" with 1455 1455 + | Some c -> 1456 1456 + Alcotest.(check (option expiration_testable)) "expires=0 is session" 1457 1457 + (Some `Session) (expires c) 1458 1458 + | None -> Alcotest.fail "Should parse Expires=0" 1459 1459 + 1460 1460 + let test_serialize_expiration_variants env = 1461 1461 + let clock = Eio.Stdenv.clock env in 1462 1462 + let now = Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch in 1463 1463 + let contains_substring s sub = 1464 1464 + try 1465 1465 + let _ = Str.search_forward (Str.regexp_string sub) s 0 in 1466 1466 + true 1467 1467 + with Not_found -> false 1468 1468 + in 1469 1469 + 1470 1470 + (* Session cookie serialization *) 1471 1471 + let c1 = make ~domain:"ex.com" ~path:"/" ~name:"s" ~value:"v" 1472 1472 + ~expires:`Session ~creation_time:now ~last_access:now () in 1473 1473 + let h1 = make_set_cookie_header c1 in 1474 1474 + let has_expires = contains_substring h1 "Expires=" in 1475 1475 + Alcotest.(check bool) "session has Expires" true has_expires; 1476 1476 + 1477 1477 + (* DateTime serialization *) 1478 1478 + let future = Ptime.add_span now (Ptime.Span.of_int_s 3600) |> Option.get in 1479 1479 + let c2 = make ~domain:"ex.com" ~path:"/" ~name:"p" ~value:"v" 1480 1480 + ~expires:(`DateTime future) ~creation_time:now ~last_access:now () in 1481 1481 + let h2 = make_set_cookie_header c2 in 1482 1482 + let has_expires2 = contains_substring h2 "Expires=" in 1483 1483 + Alcotest.(check bool) "datetime has Expires" true has_expires2 1484 1484 + 1485 1485 + (* Priority 2.3: Value Trimming *) 1486 1486 + 1487 1487 + let test_quoted_cookie_values env = 1488 1488 + let clock = Eio.Stdenv.clock env in 1489 1489 + let test_cases = [ 1490 1490 + ("name=value", "value", "value"); 1491 1491 + ("name=\"value\"", "\"value\"", "value"); 1492 1492 + ("name=\"partial", "\"partial", "\"partial"); 1493 1493 + ("name=\"val\"\"", "\"val\"\"", "val\""); 1494 1494 + ("name=val\"", "val\"", "val\""); 1495 1495 + ("name=\"\"", "\"\"", ""); 1496 1496 + ] in 1497 1497 + 1498 1498 + List.iter (fun (input, expected_raw, expected_trimmed) -> 1499 1499 + match parse_set_cookie ~clock ~domain:"ex.com" ~path:"/" input with 1500 1500 + | Some c -> 1501 1501 + Alcotest.(check string) 1502 1502 + (Printf.sprintf "raw value for %s" input) expected_raw (value c); 1503 1503 + Alcotest.(check string) 1504 1504 + (Printf.sprintf "trimmed value for %s" input) expected_trimmed 1505 1505 + (value_trimmed c) 1506 1506 + | None -> Alcotest.fail ("Parse failed: " ^ input) 1507 1507 + ) test_cases 1508 1508 + 1509 1509 + let test_trimmed_value_not_used_for_equality env = 1510 1510 + let clock = Eio.Stdenv.clock env in 1511 1511 + 1512 1512 + match parse_set_cookie ~clock ~domain:"ex.com" ~path:"/" 1513 1513 + "name=\"value\"" with 1514 1514 + | Some c1 -> 1515 1515 + begin match parse_set_cookie ~clock ~domain:"ex.com" ~path:"/" 1516 1516 + "name=value" with 1517 1517 + | Some c2 -> 1518 1518 + (* Different raw values *) 1519 1519 + Alcotest.(check bool) "different raw values" false 1520 1520 + (value c1 = value c2); 1521 1521 + (* Same trimmed values *) 1522 1522 + Alcotest.(check string) "same trimmed values" 1523 1523 + (value_trimmed c1) (value_trimmed c2) 1524 1524 + | None -> Alcotest.fail "Parse failed for unquoted" 1525 1525 + end 1526 1526 + | None -> Alcotest.fail "Parse failed for quoted" 1527 1527 + 1528 1528 + (* Priority 2.4: Cookie Header Parsing *) 1529 1529 + 1530 1530 + let test_cookie_header_parsing_basic env = 1531 1531 + let clock = Eio.Stdenv.clock env in 1532 1532 + let results = of_cookie_header ~clock ~domain:"ex.com" ~path:"/" 1533 1533 + "session=abc123; theme=dark; lang=en" in 1534 1534 + 1535 1535 + let cookies = List.filter_map Result.to_option results in 1536 1536 + Alcotest.(check int) "parsed 3 cookies" 3 (List.length cookies); 1537 1537 + 1538 1538 + let find name_val = List.find (fun c -> name c = name_val) cookies in 1539 1539 + Alcotest.(check string) "session value" "abc123" (value (find "session")); 1540 1540 + Alcotest.(check string) "theme value" "dark" (value (find "theme")); 1541 1541 + Alcotest.(check string) "lang value" "en" (value (find "lang")) 1542 1542 + 1543 1543 + let test_cookie_header_defaults env = 1544 1544 + let clock = Eio.Stdenv.clock env in 1545 1545 + 1546 1546 + match of_cookie_header ~clock ~domain:"example.com" ~path:"/app" 1547 1547 + "session=xyz" with 1548 1548 + | [Ok c] -> 1549 1549 + (* Domain and path from request context *) 1550 1550 + Alcotest.(check string) "domain from context" "example.com" (domain c); 1551 1551 + Alcotest.(check string) "path from context" "/app" (path c); 1552 1552 + 1553 1553 + (* Security flags default to false *) 1554 1554 + Alcotest.(check bool) "secure default" false (secure c); 1555 1555 + Alcotest.(check bool) "http_only default" false (http_only c); 1556 1556 + Alcotest.(check bool) "partitioned default" false (partitioned c); 1557 1557 + 1558 1558 + (* Optional attributes default to None *) 1559 1559 + Alcotest.(check (option expiration_testable)) "no expiration" 1560 1560 + None (expires c); 1561 1561 + Alcotest.(check (option span_testable)) "no max_age" 1562 1562 + None (max_age c); 1563 1563 + Alcotest.(check (option same_site_testable)) "no same_site" 1564 1564 + None (same_site c) 1565 1565 + | _ -> Alcotest.fail "Should parse single cookie" 1566 1566 + 1567 1567 + let test_cookie_header_edge_cases env = 1568 1568 + let clock = Eio.Stdenv.clock env in 1569 1569 + 1570 1570 + let test input expected_count description = 1571 1571 + let results = of_cookie_header ~clock ~domain:"ex.com" ~path:"/" input in 1572 1572 + let cookies = List.filter_map Result.to_option results in 1573 1573 + Alcotest.(check int) description expected_count (List.length cookies) 1574 1574 + in 1575 1575 + 1576 1576 + test "" 0 "empty string"; 1577 1577 + test ";;" 0 "only separators"; 1578 1578 + test "a=1;;b=2" 2 "double separator"; 1579 1579 + test " a=1 ; b=2 " 2 "excess whitespace"; 1580 1580 + test " " 0 "only whitespace" 1581 1581 + 1582 1582 + let test_cookie_header_with_errors env = 1583 1583 + let clock = Eio.Stdenv.clock env in 1584 1584 + 1585 1585 + (* Mix of valid and invalid cookies *) 1586 1586 + let results = of_cookie_header ~clock ~domain:"ex.com" ~path:"/" 1587 1587 + "valid=1;=noname;valid2=2" in 1588 1588 + 1589 1589 + Alcotest.(check int) "total results" 3 (List.length results); 1590 1590 + 1591 1591 + let successes = List.filter Result.is_ok results in 1592 1592 + let errors = List.filter Result.is_error results in 1593 1593 + 1594 1594 + Alcotest.(check int) "successful parses" 2 (List.length successes); 1595 1595 + Alcotest.(check int) "failed parses" 1 (List.length errors); 1596 1596 + 1597 1597 + (* Error should have descriptive message *) 1598 1598 + let contains_substring s sub = 1599 1599 + try 1600 1600 + let _ = Str.search_forward (Str.regexp_string sub) s 0 in 1601 1601 + true 1602 1602 + with Not_found -> false 1603 1603 + in 1604 1604 + begin match List.hd errors with 1605 1605 + | Error msg -> 1606 1606 + let has_name = contains_substring msg "name" in 1607 1607 + let has_empty = contains_substring msg "empty" in 1608 1608 + Alcotest.(check bool) "error mentions name or empty" true 1609 1609 + (has_name || has_empty) 1610 1610 + | Ok _ -> Alcotest.fail "Expected error" 1611 1611 + end 1612 1612 + 1613 1613 + (* Max-Age and Expires Interaction *) 1614 1614 + 1615 1615 + let test_max_age_and_expires_both_present env = 1616 1616 + let clock = Eio.Stdenv.clock env in 1617 1617 + let now = Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch in 1618 1618 + let future = Ptime.add_span now (Ptime.Span.of_int_s 7200) |> Option.get in 1619 1619 + 1620 1620 + (* Create cookie with both *) 1621 1621 + let cookie = make ~domain:"ex.com" ~path:"/" ~name:"dual" ~value:"val" 1622 1622 + ~max_age:(Ptime.Span.of_int_s 3600) 1623 1623 + ~expires:(`DateTime future) 1624 1624 + ~creation_time:now ~last_access:now () in 1625 1625 + 1626 1626 + (* Both should be present *) 1627 1627 + begin match max_age cookie with 1628 1628 + | Some span -> 1629 1629 + begin match Ptime.Span.to_int_s span with 1630 1630 + | Some s -> 1631 1631 + Alcotest.(check int64) "max_age present" 3600L (Int64.of_int s) 1632 1632 + | None -> Alcotest.fail "max_age span could not be converted to int" 1633 1633 + end 1634 1634 + | None -> Alcotest.fail "max_age should be present" 1635 1635 + end; 1636 1636 + 1637 1637 + begin match expires cookie with 1638 1638 + | Some (`DateTime t) when Ptime.equal t future -> () 1639 1639 + | _ -> Alcotest.fail "expires should be present" 1640 1640 + end; 1641 1641 + 1642 1642 + (* Both should appear in serialization *) 1643 1643 + let header = make_set_cookie_header cookie in 1644 1644 + let contains_substring s sub = 1645 1645 + try 1646 1646 + let _ = Str.search_forward (Str.regexp_string sub) s 0 in 1647 1647 + true 1648 1648 + with Not_found -> false 1649 1649 + in 1650 1650 + let has_max_age = contains_substring header "Max-Age=3600" in 1651 1651 + let has_expires = contains_substring header "Expires=" in 1652 1652 + Alcotest.(check bool) "contains Max-Age" true has_max_age; 1653 1653 + Alcotest.(check bool) "contains Expires" true has_expires 1654 1654 + 1655 1655 + let test_parse_max_age_and_expires env = 1656 1656 + let clock = Eio.Stdenv.clock env in 1657 1657 + 1658 1658 + (* Parse Set-Cookie with both attributes *) 1659 1659 + match parse_set_cookie ~clock ~domain:"ex.com" ~path:"/" 1660 1660 + "id=123; Max-Age=3600; Expires=Wed, 21 Oct 2025 07:28:00 GMT" with 1661 1661 + | Some c -> 1662 1662 + (* Both should be stored *) 1663 1663 + begin match max_age c with 1664 1664 + | Some span -> 1665 1665 + begin match Ptime.Span.to_int_s span with 1666 1666 + | Some s -> 1667 1667 + Alcotest.(check int64) "max_age parsed" 3600L (Int64.of_int s) 1668 1668 + | None -> Alcotest.fail "max_age span could not be converted to int" 1669 1669 + end 1670 1670 + | None -> Alcotest.fail "max_age should be parsed" 1671 1671 + end; 1672 1672 + 1673 1673 + begin match expires c with 1674 1674 + | Some (`DateTime _) -> () 1675 1675 + | _ -> Alcotest.fail "expires should be parsed" 1676 1676 + end 1677 1677 + | None -> Alcotest.fail "Should parse cookie with both attributes" 1271 1678 1272 1679 let () = 1273 1680 Eio_main.run @@ fun env -> ··· 1359 1766 test_case_insensitive_month_parsing; 1360 1767 test_case "Case-insensitive GMT parsing" `Quick 1361 1768 test_case_insensitive_gmt_parsing; 1769 1769 + ] ); 1770 1770 + ( "partitioned", 1771 1771 + [ 1772 1772 + test_case "parse partitioned cookie" `Quick (fun () -> 1773 1773 + test_partitioned_parsing env); 1774 1774 + test_case "serialize partitioned cookie" `Quick (fun () -> 1775 1775 + test_partitioned_serialization env); 1776 1776 + test_case "partitioned requires secure" `Quick (fun () -> 1777 1777 + test_partitioned_requires_secure env); 1778 1778 + ] ); 1779 1779 + ( "expiration", 1780 1780 + [ 1781 1781 + test_case "expiration variants" `Quick (fun () -> 1782 1782 + test_expiration_variants env); 1783 1783 + test_case "parse session expiration" `Quick (fun () -> 1784 1784 + test_parse_session_expiration env); 1785 1785 + test_case "serialize expiration variants" `Quick (fun () -> 1786 1786 + test_serialize_expiration_variants env); 1787 1787 + ] ); 1788 1788 + ( "value_trimming", 1789 1789 + [ 1790 1790 + test_case "quoted values" `Quick (fun () -> 1791 1791 + test_quoted_cookie_values env); 1792 1792 + test_case "trimmed not used for equality" `Quick (fun () -> 1793 1793 + test_trimmed_value_not_used_for_equality env); 1794 1794 + ] ); 1795 1795 + ( "cookie_header", 1796 1796 + [ 1797 1797 + test_case "parse basic" `Quick (fun () -> 1798 1798 + test_cookie_header_parsing_basic env); 1799 1799 + test_case "default values" `Quick (fun () -> 1800 1800 + test_cookie_header_defaults env); 1801 1801 + test_case "edge cases" `Quick (fun () -> 1802 1802 + test_cookie_header_edge_cases env); 1803 1803 + test_case "multiple with errors" `Quick (fun () -> 1804 1804 + test_cookie_header_with_errors env); 1805 1805 + ] ); 1806 1806 + ( "max_age_expires_interaction", 1807 1807 + [ 1808 1808 + test_case "both present" `Quick (fun () -> 1809 1809 + test_max_age_and_expires_both_present env); 1810 1810 + test_case "parse both" `Quick (fun () -> 1811 1811 + test_parse_max_age_and_expires env); 1362 1812 ] ); 1363 1813 ]