anil.recoil.org
A batteries included HTTP/1.1 client in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2019 Antonio Nuno Monteiro.
3 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>.
4
5 All rights reserved.
6
7 Redistribution and use in source and binary forms, with or without
8 modification, are permitted provided that the following conditions are met:
9
10 1. Redistributions of source code must retain the above copyright notice,
11 this list of conditions and the following disclaimer.
12
13 2. Redistributions in binary form must reproduce the above copyright notice,
14 this list of conditions and the following disclaimer in the documentation
15 and/or other materials provided with the distribution.
16
17 3. Neither the name of the copyright holder nor the names of its contributors
18 may be used to endorse or promote products derived from this software
19 without specific prior written permission.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
22 AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24 ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
25 LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
26 CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
27 SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28 INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29 CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30 ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 POSSIBILITY OF SUCH DAMAGE.
32 SPDX-License-Identifier: BSD-3-Clause
33 ---------------------------------------------------------------------------*)
34
35(** HTTP/2 Stream State Machine per RFC 9113 Section 5.1.
36
37 Implements the stream lifecycle:
38 - idle -> open -> half-closed -> closed
39 - With reserved states for server push (PUSH_PROMISE)
40
41 See {{:https://datatracker.ietf.org/doc/html/rfc9113#section-5.1}RFC 9113 Section 5.1}. *)
42
43(* ============================================================
44 Stream States
45 ============================================================ *)
46
47(** Why a stream was closed. *)
48type closed_reason =
49 | Finished
50 (** Both endpoints sent END_STREAM. *)
51 | ResetByUs of H2_frame.error_code
52 (** We sent RST_STREAM. *)
53 | ResetByThem of H2_frame.error_code
54 (** Peer sent RST_STREAM. *)
55
56(** Stream state per RFC 9113 Section 5.1. *)
57type state =
58 | Idle
59 (** Initial state. Transitions to open on send/recv HEADERS,
60 or to reserved on PUSH_PROMISE. *)
61 | Reserved_local
62 (** We sent PUSH_PROMISE. Can only send HEADERS (-> half_closed_remote)
63 or RST_STREAM (-> closed). *)
64 | Reserved_remote
65 (** Peer sent PUSH_PROMISE. Can only receive HEADERS (-> half_closed_local)
66 or send/recv RST_STREAM (-> closed). *)
67 | Open
68 (** Both sides can send frames. Transitions to half_closed on END_STREAM,
69 or closed on RST_STREAM. *)
70 | Half_closed_local
71 (** We sent END_STREAM. We can only receive frames.
72 Transitions to closed on recv END_STREAM or RST_STREAM. *)
73 | Half_closed_remote
74 (** Peer sent END_STREAM. We can only send frames.
75 Transitions to closed on send END_STREAM or RST_STREAM. *)
76 | Closed of closed_reason
77 (** Terminal state. *)
78
79(** Events that cause state transitions. *)
80type event =
81 | Send_headers of { end_stream : bool }
82 | Recv_headers of { end_stream : bool }
83 | Send_data of { end_stream : bool }
84 | Recv_data of { end_stream : bool }
85 | Send_push_promise
86 | Recv_push_promise
87 | Send_rst_stream of H2_frame.error_code
88 | Recv_rst_stream of H2_frame.error_code
89 | Send_end_stream
90 | Recv_end_stream
91
92(** Result of applying an event to a state. *)
93type transition_result =
94 | Transition_ok of state
95 | Transition_error of H2_frame.error_code * string
96
97(* ============================================================
98 State Transition Logic
99 ============================================================ *)
100
101(** [transition state event] applies [event] to [state] and returns
102 the new state or an error.
103
104 Implements RFC 9113 Section 5.1 state machine. *)
105let transition state event =
106 match state, event with
107 (* === Idle state transitions === *)
108 | Idle, Send_headers { end_stream = false } ->
109 Transition_ok Open
110 | Idle, Send_headers { end_stream = true } ->
111 Transition_ok Half_closed_local
112 | Idle, Recv_headers { end_stream = false } ->
113 Transition_ok Open
114 | Idle, Recv_headers { end_stream = true } ->
115 Transition_ok Half_closed_remote
116 | Idle, Send_push_promise ->
117 Transition_ok Reserved_local
118 | Idle, Recv_push_promise ->
119 Transition_ok Reserved_remote
120 | Idle, _ ->
121 Transition_error (H2_frame.Protocol_error,
122 "Invalid frame on idle stream")
123
124 (* === Reserved (local) state transitions === *)
125 | Reserved_local, Send_headers { end_stream = false } ->
126 Transition_ok Half_closed_remote
127 | Reserved_local, Send_headers { end_stream = true } ->
128 (* Send HEADERS with END_STREAM on reserved -> closed *)
129 Transition_ok (Closed Finished)
130 | Reserved_local, Send_rst_stream code ->
131 Transition_ok (Closed (ResetByUs code))
132 | Reserved_local, Recv_rst_stream code ->
133 Transition_ok (Closed (ResetByThem code))
134 | Reserved_local, _ ->
135 Transition_error (H2_frame.Protocol_error,
136 "Invalid frame on reserved (local) stream")
137
138 (* === Reserved (remote) state transitions === *)
139 | Reserved_remote, Recv_headers { end_stream = false } ->
140 Transition_ok Half_closed_local
141 | Reserved_remote, Recv_headers { end_stream = true } ->
142 (* Recv HEADERS with END_STREAM on reserved -> closed *)
143 Transition_ok (Closed Finished)
144 | Reserved_remote, Send_rst_stream code ->
145 Transition_ok (Closed (ResetByUs code))
146 | Reserved_remote, Recv_rst_stream code ->
147 Transition_ok (Closed (ResetByThem code))
148 | Reserved_remote, _ ->
149 Transition_error (H2_frame.Protocol_error,
150 "Invalid frame on reserved (remote) stream")
151
152 (* === Open state transitions === *)
153 | Open, Send_headers { end_stream = true } ->
154 Transition_ok Half_closed_local
155 | Open, Send_headers { end_stream = false } ->
156 Transition_ok Open (* Trailers without END_STREAM, unusual but valid *)
157 | Open, Recv_headers { end_stream = true } ->
158 Transition_ok Half_closed_remote
159 | Open, Recv_headers { end_stream = false } ->
160 Transition_ok Open (* Trailers without END_STREAM *)
161 | Open, Send_data { end_stream = true } ->
162 Transition_ok Half_closed_local
163 | Open, Send_data { end_stream = false } ->
164 Transition_ok Open
165 | Open, Recv_data { end_stream = true } ->
166 Transition_ok Half_closed_remote
167 | Open, Recv_data { end_stream = false } ->
168 Transition_ok Open
169 | Open, Send_end_stream ->
170 Transition_ok Half_closed_local
171 | Open, Recv_end_stream ->
172 Transition_ok Half_closed_remote
173 | Open, Send_rst_stream code ->
174 Transition_ok (Closed (ResetByUs code))
175 | Open, Recv_rst_stream code ->
176 Transition_ok (Closed (ResetByThem code))
177 | Open, Send_push_promise | Open, Recv_push_promise ->
178 (* PUSH_PROMISE is sent on an existing stream but creates a new reserved stream *)
179 Transition_ok Open
180
181 (* === Half-closed (local) state transitions === *)
182 | Half_closed_local, Recv_headers { end_stream = true } ->
183 Transition_ok (Closed Finished)
184 | Half_closed_local, Recv_headers { end_stream = false } ->
185 Transition_ok Half_closed_local
186 | Half_closed_local, Recv_data { end_stream = true } ->
187 Transition_ok (Closed Finished)
188 | Half_closed_local, Recv_data { end_stream = false } ->
189 Transition_ok Half_closed_local
190 | Half_closed_local, Recv_end_stream ->
191 Transition_ok (Closed Finished)
192 | Half_closed_local, Send_rst_stream code ->
193 Transition_ok (Closed (ResetByUs code))
194 | Half_closed_local, Recv_rst_stream code ->
195 Transition_ok (Closed (ResetByThem code))
196 | Half_closed_local, (Send_headers _ | Send_data _ | Send_end_stream) ->
197 Transition_error (H2_frame.Stream_closed,
198 "Cannot send on half-closed (local) stream")
199 | Half_closed_local, _ ->
200 Transition_ok Half_closed_local (* WINDOW_UPDATE, PRIORITY allowed *)
201
202 (* === Half-closed (remote) state transitions === *)
203 | Half_closed_remote, Send_headers { end_stream = true } ->
204 Transition_ok (Closed Finished)
205 | Half_closed_remote, Send_headers { end_stream = false } ->
206 Transition_ok Half_closed_remote
207 | Half_closed_remote, Send_data { end_stream = true } ->
208 Transition_ok (Closed Finished)
209 | Half_closed_remote, Send_data { end_stream = false } ->
210 Transition_ok Half_closed_remote
211 | Half_closed_remote, Send_end_stream ->
212 Transition_ok (Closed Finished)
213 | Half_closed_remote, Send_rst_stream code ->
214 Transition_ok (Closed (ResetByUs code))
215 | Half_closed_remote, Recv_rst_stream code ->
216 Transition_ok (Closed (ResetByThem code))
217 | Half_closed_remote, (Recv_headers _ | Recv_data _ | Recv_end_stream) ->
218 Transition_error (H2_frame.Stream_closed,
219 "Received data on half-closed (remote) stream")
220 | Half_closed_remote, _ ->
221 Transition_ok Half_closed_remote (* WINDOW_UPDATE, PRIORITY allowed *)
222
223 (* === Closed state - terminal === *)
224 | Closed reason, Recv_rst_stream _ ->
225 (* Can receive RST_STREAM on closed stream (race condition) *)
226 Transition_ok (Closed reason)
227 | Closed _, _ ->
228 Transition_error (H2_frame.Stream_closed,
229 "Stream is closed")
230
231(* ============================================================
232 Stream Type
233 ============================================================ *)
234
235(** Flow control state for a stream. *)
236type flow_control = {
237 mutable send_window : int;
238 (** Bytes we're allowed to send. *)
239 mutable recv_window : int;
240 (** Bytes we've advertised we can receive. *)
241 initial_send_window : int;
242 (** Initial send window from SETTINGS. *)
243 initial_recv_window : int;
244 (** Initial receive window from SETTINGS. *)
245}
246
247(** A single HTTP/2 stream. *)
248type t = {
249 id : int32;
250 (** Stream identifier (odd = client-initiated, even = server-initiated). *)
251 mutable state : state;
252 (** Current stream state. *)
253 flow : flow_control;
254 (** Flow control windows. *)
255 mutable request_headers : H2_hpack.header list option;
256 (** Request headers once received/sent. *)
257 mutable response_headers : H2_hpack.header list option;
258 (** Response headers once received/sent. *)
259 mutable trailers : H2_hpack.header list option;
260 (** Trailing headers. *)
261}
262
263(** Default initial flow control window size per RFC 9113. *)
264let default_initial_window_size = 65535
265
266(** Create a new stream with the given ID. *)
267let create ?(initial_send_window = default_initial_window_size)
268 ?(initial_recv_window = default_initial_window_size)
269 id =
270 { id;
271 state = Idle;
272 flow = {
273 send_window = initial_send_window;
274 recv_window = initial_recv_window;
275 initial_send_window;
276 initial_recv_window;
277 };
278 request_headers = None;
279 response_headers = None;
280 trailers = None;
281 }
282
283(** Get the stream ID. *)
284let id t = t.id
285
286(** Get the current state. *)
287let state t = t.state
288
289(** Helper for state predicate checks. *)
290let state_matches pred t = pred t.state
291
292(** Check if stream is in idle state. *)
293let is_idle = state_matches (function Idle -> true | _ -> false)
294
295(** Check if stream is open (including half-closed). *)
296let is_active = state_matches (function
297 | Open | Half_closed_local | Half_closed_remote -> true
298 | _ -> false)
299
300(** Check if stream is fully open (both directions). *)
301let is_open = state_matches (function Open -> true | _ -> false)
302
303(** Check if stream is closed. *)
304let is_closed = state_matches (function Closed _ -> true | _ -> false)
305
306(** Check if we can send on this stream. *)
307let can_send = state_matches (function
308 | Open | Half_closed_remote | Reserved_local -> true
309 | _ -> false)
310
311(** Check if we can receive on this stream. *)
312let can_recv = state_matches (function
313 | Open | Half_closed_local | Reserved_remote -> true
314 | _ -> false)
315
316(** Apply an event to the stream, updating its state.
317 Returns Ok () on success, or Error with an error code and message. *)
318let apply_event t event =
319 match transition t.state event with
320 | Transition_ok new_state ->
321 t.state <- new_state;
322 Ok ()
323 | Transition_error (code, msg) ->
324 Error (code, msg)
325
326(* ============================================================
327 Flow Control
328 ============================================================ *)
329
330(** Consume bytes from the send window.
331 Returns the number of bytes actually consumed (may be less if window exhausted). *)
332let consume_send_window t bytes =
333 let available = min bytes t.flow.send_window in
334 t.flow.send_window <- t.flow.send_window - available;
335 available
336
337(** Add bytes to the send window (from WINDOW_UPDATE). *)
338let credit_send_window t increment =
339 let new_window = t.flow.send_window + increment in
340 if new_window > 0x7FFFFFFF then
341 Error (H2_frame.Flow_control_error,
342 "Flow control window overflow")
343 else begin
344 t.flow.send_window <- new_window;
345 Ok ()
346 end
347
348(** Consume bytes from the receive window.
349 Call this when receiving DATA frames. *)
350let consume_recv_window t bytes =
351 t.flow.recv_window <- t.flow.recv_window - bytes
352
353(** Credit the receive window (we're sending WINDOW_UPDATE). *)
354let credit_recv_window t increment =
355 t.flow.recv_window <- t.flow.recv_window + increment
356
357(** Get available send window. *)
358let send_window t = t.flow.send_window
359
360(** Get available receive window. *)
361let recv_window t = t.flow.recv_window
362
363(** Get initial receive window size. *)
364let initial_recv_window t = t.flow.initial_recv_window
365
366(** Update initial window size (from SETTINGS).
367 Adjusts the current window by the delta. *)
368let update_initial_window_size t new_initial_size =
369 let delta = new_initial_size - t.flow.initial_send_window in
370 let new_window = t.flow.send_window + delta in
371 if new_window > 0x7FFFFFFF || new_window < 0 then
372 Error (H2_frame.Flow_control_error,
373 "Flow control window overflow after SETTINGS update")
374 else begin
375 t.flow.send_window <- new_window;
376 Ok ()
377 end
378
379(* ============================================================
380 Stream Identifier Management
381 ============================================================ *)
382
383(** Check if stream ID is client-initiated (odd). *)
384let is_client_initiated id = Int32.(logand id 1l = 1l)
385
386(** Check if stream ID is server-initiated (even, non-zero). *)
387let is_server_initiated id = Int32.(id > 0l && logand id 1l = 0l)
388
389(** Check if stream ID is valid (non-zero). *)
390let is_valid_id id = Int32.compare id 0l > 0
391
392(** Connection-level stream ID is 0. *)
393let connection_stream_id = 0l
394
395(** Check if this is the connection-level stream. *)
396let is_connection_stream id = Int32.equal id 0l
397
398(* ============================================================
399 Pretty Printing
400 ============================================================ *)
401
402let pp_closed_reason fmt = function
403 | Finished -> Format.fprintf fmt "Finished"
404 | ResetByUs code ->
405 Format.fprintf fmt "ResetByUs(%a)" H2_frame.pp_error_code code
406 | ResetByThem code ->
407 Format.fprintf fmt "ResetByThem(%a)" H2_frame.pp_error_code code
408
409let pp_state fmt = function
410 | Idle -> Format.fprintf fmt "Idle"
411 | Reserved_local -> Format.fprintf fmt "Reserved(local)"
412 | Reserved_remote -> Format.fprintf fmt "Reserved(remote)"
413 | Open -> Format.fprintf fmt "Open"
414 | Half_closed_local -> Format.fprintf fmt "HalfClosed(local)"
415 | Half_closed_remote -> Format.fprintf fmt "HalfClosed(remote)"
416 | Closed reason -> Format.fprintf fmt "Closed(%a)" pp_closed_reason reason
417
418let state_to_string state =
419 Format.asprintf "%a" pp_state state
420
421let pp fmt t =
422 Format.fprintf fmt "Stream{id=%ld; state=%a; send_window=%d; recv_window=%d}"
423 t.id pp_state t.state t.flow.send_window t.flow.recv_window
424
425(* ============================================================
426 Headers Management
427 ============================================================ *)
428
429(** Set request headers. *)
430let set_request_headers t headers = t.request_headers <- Some headers
431
432(** Get request headers. *)
433let request_headers t = t.request_headers
434
435(** Set response headers. *)
436let set_response_headers t headers = t.response_headers <- Some headers
437
438(** Get response headers. *)
439let response_headers t = t.response_headers
440
441(** Set trailers. *)
442let set_trailers t headers = t.trailers <- Some headers
443
444(** Get trailers. *)
445let trailers t = t.trailers
446
447(** Reset the stream with an error code. *)
448let reset t code =
449 ignore (apply_event t (Send_rst_stream code))