gazagnaire.org
forked from
anil.recoil.org/ocaml-requests
A batteries included HTTP/1.1 client in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** HTTP Cache-Control header parsing per RFC 9111 (HTTP Caching)
7
8 This module provides parsing and representation of Cache-Control directives
9 for both requests and responses. It supports all standard directives from
10 RFC 9111 Section 5.2.
11
12 Per Recommendation #17: Response Caching with RFC 7234/9111 Compliance
13
14 {2 Examples}
15
16 {[
17 (* Parse response Cache-Control *)
18 let cc = Cache_control.parse_response "max-age=3600, public" in
19 Printf.printf "Max age: %d\n" (Option.get cc.max_age);
20
21 (* Check if cacheable *)
22 if Cache_control.is_cacheable ~response_cc:cc ~status:200 then
23 Printf.printf "Response is cacheable\n"
24 ]} *)
25
26val src : Logs.Src.t
27(** Log source for cache control operations. *)
28
29(** {1 Response Cache-Control Directives}
30
31 RFC 9111 Section 5.2.2: Cache-Control Response Directives *)
32
33type response_directive =
34 | Max_age of int (** max-age=N - response is fresh for N seconds *)
35 | S_maxage of int (** s-maxage=N - shared cache max-age *)
36 | No_cache of string list (** no-cache[=headers] - must revalidate *)
37 | No_store (** no-store - must not be stored *)
38 | No_transform (** no-transform - must not be transformed *)
39 | Must_revalidate (** must-revalidate - stale must be revalidated *)
40 | Proxy_revalidate (** proxy-revalidate - shared caches must revalidate *)
41 | Must_understand (** must-understand - RFC 9111 *)
42 | Private of string list (** private[=headers] - only private cache *)
43 | Public (** public - can be stored by any cache *)
44 | Immutable (** immutable - will not change during freshness *)
45 | Stale_while_revalidate of int (** stale-while-revalidate=N *)
46 | Stale_if_error of int (** stale-if-error=N *)
47 | Response_extension of string * string option (** Unknown directive *)
48
49(** {1 Request Cache-Control Directives}
50
51 RFC 9111 Section 5.2.1: Cache-Control Request Directives *)
52
53type request_directive =
54 | Req_max_age of int (** max-age=N *)
55 | Req_max_stale of int option (** max-stale[=N] *)
56 | Req_min_fresh of int (** min-fresh=N *)
57 | Req_no_cache (** no-cache *)
58 | Req_no_store (** no-store *)
59 | Req_no_transform (** no-transform *)
60 | Req_only_if_cached (** only-if-cached *)
61 | Request_extension of string * string option (** Unknown directive *)
62
63(** {1 Parsed Cache-Control Types} *)
64
65type response = {
66 max_age : int option; (** max-age directive value in seconds *)
67 s_maxage : int option; (** s-maxage directive value for shared caches *)
68 no_cache : string list option;
69 (** [None] = not present, [Some []] = present without headers,
70 [Some headers] = must revalidate for these headers *)
71 no_store : bool; (** If true, the response must not be stored *)
72 no_transform : bool;
73 (** If true, intermediaries must not transform the response *)
74 must_revalidate : bool; (** If true, stale responses must be revalidated *)
75 proxy_revalidate : bool;
76 (** Like must_revalidate but only for shared caches *)
77 must_understand : bool;
78 (** If true, cache must understand the caching rules *)
79 private_ : string list option;
80 (** [None] = not present, [Some []] = entirely private, [Some headers] =
81 these headers are private *)
82 public : bool; (** If true, response may be stored by any cache *)
83 immutable : bool;
84 (** If true, response will not change during freshness lifetime *)
85 stale_while_revalidate : int option;
86 (** Seconds stale responses may be served while revalidating *)
87 stale_if_error : int option;
88 (** Seconds stale responses may be served on error *)
89 extensions : (string * string option) list;
90 (** Unknown directives for forward compatibility *)
91}
92(** Parsed response Cache-Control header *)
93
94type request = {
95 req_max_age : int option;
96 (** max-age directive - maximum age client will accept *)
97 req_max_stale : int option option;
98 (** [None] = not present, [Some None] = accept any stale, [Some (Some n)]
99 = accept stale up to n seconds *)
100 req_min_fresh : int option;
101 (** min-fresh directive - response must be fresh for at least n more
102 seconds *)
103 req_no_cache : bool; (** If true, force revalidation with origin server *)
104 req_no_store : bool; (** If true, response must not be stored *)
105 req_no_transform : bool; (** If true, intermediaries must not transform *)
106 req_only_if_cached : bool;
107 (** If true, return cached response or 504 Gateway Timeout *)
108 req_extensions : (string * string option) list;
109 (** Unknown directives for forward compatibility *)
110}
111(** Parsed request Cache-Control header *)
112
113(** {1 Empty Values} *)
114
115val empty_response : response
116(** An empty response Cache-Control (no directives set). *)
117
118val empty_request : request
119(** An empty request Cache-Control (no directives set). *)
120
121(** {1 Parsing Functions} *)
122
123val parse_response : string -> response
124(** [parse_response header_value] parses a response Cache-Control header value.
125 Unknown directives are preserved in [extensions] for forward compatibility.
126*)
127
128val parse_request : string -> request
129(** [parse_request header_value] parses a request Cache-Control header value.
130 Unknown directives are preserved in [req_extensions] for forward
131 compatibility. *)
132
133(** {1 Freshness Calculation}
134
135 RFC 9111 Section 4.2: Freshness *)
136
137val freshness_lifetime :
138 response_cc:response -> ?expires:string -> ?date:string -> unit -> int option
139(** [freshness_lifetime ~response_cc ?expires ?date ()] calculates the freshness
140 lifetime of a response in seconds, based on Cache-Control directives and
141 optional Expires/Date headers.
142
143 Priority (per RFC 9111 Section 4.2.1): 1. max-age directive 2. Expires
144 header minus Date header 3. Returns [None] if no explicit freshness (caller
145 should use heuristics).
146
147 @param response_cc Parsed Cache-Control from response.
148 @param expires Optional Expires header value (HTTP-date format).
149 @param date Optional Date header value (HTTP-date format). *)
150
151(** {1 Age Calculation}
152
153 Per RFC 9111 Section 4.2.3: Calculating Age. *)
154
155type age_inputs = {
156 date_value : Ptime.t option;
157 (** Value of Date header (when response was generated) *)
158 age_value : int; (** Value of Age header in seconds (0 if not present) *)
159 request_time : Ptime.t; (** Time when the request was initiated *)
160 response_time : Ptime.t; (** Time when the response was received *)
161}
162(** Inputs required for age calculation per RFC 9111 Section 4.2.3. *)
163
164val calculate_age : inputs:age_inputs -> now:Ptime.t -> int
165(** [calculate_age ~inputs ~now] calculates the current age of a cached
166 response.
167
168 Per RFC 9111 Section 4.2.3:
169 {v
170 apparent_age = max(0, response_time - date_value)
171 response_delay = response_time - request_time
172 corrected_age_value = age_value + response_delay
173 corrected_initial_age = max(apparent_age, corrected_age_value)
174 resident_time = now - response_time
175 current_age = corrected_initial_age + resident_time
176 v}
177
178 @return Current age in seconds. *)
179
180(** {1 Heuristic Freshness}
181
182 Per RFC 9111 Section 4.2.2: Calculating Heuristic Freshness. *)
183
184val default_heuristic_fraction : float
185(** Default heuristic fraction: 10% of time since Last-Modified. RFC 9111
186 recommends this as a typical value. *)
187
188val default_max_heuristic_age : int
189(** Maximum heuristic freshness lifetime: 1 day (86400 seconds). *)
190
191val heuristic_freshness :
192 ?last_modified:string ->
193 response_time:Ptime.t ->
194 ?fraction:float ->
195 ?max_age:int ->
196 unit ->
197 int option
198(** [heuristic_freshness ?last_modified ~response_time ?fraction ?max_age ()]
199 calculates heuristic freshness lifetime when no explicit caching info
200 provided.
201
202 Per RFC 9111 Section 4.2.2, caches MAY use heuristics when explicit
203 freshness is not available. The typical heuristic is 10% of time since
204 Last-Modified.
205
206 @param last_modified Value of Last-Modified header
207 @param response_time When the response was received
208 @param fraction Fraction of (now - last_modified) to use (default 10%)
209 @param max_age Maximum heuristic age in seconds (default 1 day)
210 @return Heuristic freshness lifetime in seconds, or None. *)
211
212val is_fresh : current_age:int -> freshness_lifetime:int -> bool
213(** [is_fresh ~current_age ~freshness_lifetime] returns true if a cached
214 response is still fresh (current_age < freshness_lifetime). *)
215
216val can_serve_stale :
217 request_cc:request -> current_age:int -> freshness_lifetime:int -> bool
218(** [can_serve_stale ~request_cc ~current_age ~freshness_lifetime] returns true
219 if a stale response can still be served based on request Cache-Control
220 directives (specifically max-stale). *)
221
222(** {1 Cacheability Checks} *)
223
224val is_cacheable : response_cc:response -> status:int -> bool
225(** [is_cacheable ~response_cc ~status] returns true if the response may be
226 cached based on its Cache-Control directives and HTTP status code.
227
228 A response is cacheable if:
229 - no-store is NOT present
230 - Status is cacheable by default (200, 203, 204, 206, 300, 301, 308, 404,
231 405, 410, 414, 501) OR explicit caching directive is present. *)
232
233val must_revalidate : response_cc:response -> bool
234(** [must_revalidate ~response_cc] returns true if cached response must be
235 revalidated with the origin server before use.
236
237 True if any of: must-revalidate, proxy-revalidate, or no-cache is set. *)
238
239val is_public : response_cc:response -> bool
240(** [is_public ~response_cc] returns true if the response may be stored in
241 shared caches (CDNs, proxies). *)
242
243val is_private : response_cc:response -> bool
244(** [is_private ~response_cc] returns true if the response may only be stored in
245 private caches (browser cache). *)
246
247(** {1 Pretty Printers} *)
248
249val pp_response : Format.formatter -> response -> unit
250(** Pretty print a parsed response Cache-Control. *)
251
252val pp_request : Format.formatter -> request -> unit
253(** Pretty print a parsed request Cache-Control. *)