anil.recoil.org
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 request serialization using Eio.Buf_write
7
8 This module provides efficient HTTP/1.1 request serialization using Eio's
9 buffered write API. It avoids intermediate string allocations by writing
10 directly to the output buffer. *)
11
12let src = Logs.Src.create "requests.http_write" ~doc:"HTTP request serialization"
13module Log = (val Logs.src_log src : Logs.LOG)
14
15module Write = Eio.Buf_write
16
17(** {1 Low-level Writers} *)
18
19let crlf w =
20 Write.string w "\r\n"
21
22let sp w =
23 Write.char w ' '
24
25(** {1 Request Line} *)
26
27(** Build authority value (host:port) for CONNECT requests.
28 Per RFC 9110 Section 9.3.6: CONNECT uses authority-form as request-target.
29 The port is always included for CONNECT since it's establishing a tunnel. *)
30let authority_value uri =
31 let host = match Uri.host uri with
32 | Some h -> h
33 | None -> raise (Error.err (Error.Invalid_url {
34 url = Uri.to_string uri;
35 reason = "URI must have a host for CONNECT"
36 }))
37 in
38 let port = match Uri.port uri with
39 | Some p -> p
40 | None ->
41 (* Default to 443 for CONNECT (typically used for HTTPS tunneling) *)
42 match Uri.scheme uri with
43 | Some "https" -> 443
44 | Some "http" -> 80
45 | _ -> 443 (* Default to 443 for tunneling *)
46 in
47 host ^ ":" ^ string_of_int port
48
49let request_line w ~method_ ~uri =
50 (* RFC 9112 Section 3.2: Request target forms depend on method *)
51 let request_target =
52 if method_ = "CONNECT" then
53 (* RFC 9112 Section 3.2.3: CONNECT uses authority-form (host:port) *)
54 authority_value uri
55 else
56 let path = Uri.path uri in
57 (* RFC 9112 Section 3.2.4: asterisk-form for server-wide OPTIONS requests.
58 When path is "*", use asterisk-form instead of origin-form.
59 Example: OPTIONS * HTTP/1.1 *)
60 if path = "*" && method_ = "OPTIONS" then
61 "*"
62 else begin
63 let path = if path = "" then "/" else path in
64 let query = Uri.query uri in
65 if query = [] then path
66 else path ^ "?" ^ (Uri.encoded_of_query query)
67 end
68 in
69 Write.string w method_;
70 sp w;
71 Write.string w request_target;
72 Write.string w " HTTP/1.1";
73 crlf w
74
75(** {1 Header Writing} *)
76
77let header w ~name ~value =
78 Write.string w name;
79 Write.string w ": ";
80 Write.string w value;
81 crlf w
82
83let headers w hdrs =
84 Headers.to_list hdrs
85 |> List.iter (fun (name, value) -> header w ~name ~value);
86 crlf w
87
88(** Build Host header value from URI *)
89let host_value uri =
90 let host = match Uri.host uri with
91 | Some h -> h
92 | None -> raise (Error.err (Error.Invalid_url {
93 url = Uri.to_string uri;
94 reason = "URI must have a host"
95 }))
96 in
97 (* RFC 7230: default ports should be omitted from Host header *)
98 match Uri.port uri, Uri.scheme uri with
99 | Some p, Some "https" when p <> 443 -> host ^ ":" ^ string_of_int p
100 | Some p, Some "http" when p <> 80 -> host ^ ":" ^ string_of_int p
101 | Some p, _ -> host ^ ":" ^ string_of_int p
102 | None, _ -> host
103
104let request_headers w ~method_ ~uri ~headers:hdrs ~content_length =
105 (* Write request line *)
106 request_line w ~method_ ~uri;
107
108 (* Per RFC 9110 Section 7.2: Host header handling.
109 For CONNECT requests (RFC 9110 Section 9.3.6), Host should be the authority (host:port).
110 For other requests, Host should match the URI authority. *)
111 let expected_host =
112 if method_ = "CONNECT" then authority_value uri
113 else host_value uri
114 in
115 let hdrs = match Headers.get `Host hdrs with
116 | None ->
117 (* Auto-add Host header from URI *)
118 Headers.add `Host expected_host hdrs
119 | Some provided_host ->
120 (* Validate provided Host matches expected value *)
121 if provided_host <> expected_host then
122 Log.warn (fun m -> m "Host header '%s' does not match expected '%s' \
123 (RFC 9110 Section 7.2)" provided_host expected_host);
124 hdrs
125 in
126
127 (* Ensure Connection header for keep-alive *)
128 let hdrs = if not (Headers.mem `Connection hdrs) then
129 Headers.add `Connection "keep-alive" hdrs
130 else hdrs in
131
132 (* Add Content-Length if we have a body length *)
133 let hdrs = match content_length with
134 | Some len when len > 0L && not (Headers.mem `Content_length hdrs) ->
135 Headers.add `Content_length (Int64.to_string len) hdrs
136 | _ -> hdrs
137 in
138
139 (* Write all headers *)
140 headers w hdrs
141
142(** {1 Body Writing} *)
143
144let body_string w s =
145 if s <> "" then
146 Write.string w s
147
148(** Copy from a flow source to the writer, chunk by chunk *)
149let body_stream w source =
150 let buf = Cstruct.create 8192 in
151 let rec copy () =
152 match Eio.Flow.single_read source buf with
153 | n ->
154 Write.cstruct w (Cstruct.sub buf 0 n);
155 copy ()
156 | exception End_of_file -> ()
157 in
158 copy ()
159
160(** Write body using chunked transfer encoding *)
161let body_chunked w source =
162 let buf = Cstruct.create 8192 in
163 let rec copy () =
164 match Eio.Flow.single_read source buf with
165 | n ->
166 (* Write chunk size in hex *)
167 Write.printf w "%x" n;
168 crlf w;
169 (* Write chunk data *)
170 Write.cstruct w (Cstruct.sub buf 0 n);
171 crlf w;
172 copy ()
173 | exception End_of_file ->
174 (* Write final chunk *)
175 Write.string w "0";
176 crlf w;
177 crlf w
178 in
179 copy ()
180
181(** {1 High-level Request Writing} *)
182
183let request w ~sw ~method_ ~uri ~headers:hdrs ~body =
184 let method_str = Method.to_string method_ in
185
186 (* Get content type and length from body *)
187 let content_type = Body.content_type body in
188 let content_length = Body.content_length body in
189
190 (* Add Content-Type header if body has one *)
191 let hdrs = match content_type with
192 | Some mime when not (Headers.mem `Content_type hdrs) ->
193 Headers.add `Content_type (Mime.to_string mime) hdrs
194 | _ -> hdrs
195 in
196
197 (* Determine if we need chunked encoding *)
198 let use_chunked = Body.Private.is_chunked body in
199
200 let hdrs = if use_chunked && not (Headers.mem `Transfer_encoding hdrs) then
201 Headers.add `Transfer_encoding "chunked" hdrs
202 else hdrs in
203
204 (* Write request line and headers *)
205 request_headers w ~method_:method_str ~uri ~headers:hdrs ~content_length;
206
207 (* Write body *)
208 if Body.Private.is_empty body then
209 ()
210 else if use_chunked then
211 Body.Private.write_chunked ~sw w body
212 else
213 Body.Private.write ~sw w body
214
215(** {1 Headers-Only Writing (for 100-continue)} *)
216
217let request_headers_only w ~method_ ~uri ~headers:hdrs ~content_length =
218 let method_str = Method.to_string method_ in
219 request_headers w ~method_:method_str ~uri ~headers:hdrs ~content_length
220
221(** {1 Convenience Wrappers} *)
222
223let with_flow ?initial_size flow fn =
224 Write.with_flow ?initial_size flow fn
225
226(** Write and flush directly to flow without creating a nested switch.
227 This is a simpler alternative to [with_flow] that avoids potential
228 issues with nested switches in the Eio fiber system. *)
229let write_and_flush ?(initial_size=0x1000) flow fn =
230 (* Create a writer without attaching to a switch *)
231 let w = Write.create initial_size in
232 (* Execute the writing function *)
233 fn w;
234 (* Serialize to string and copy to flow *)
235 let data = Write.serialize_to_string w in
236 if String.length data > 0 then
237 Eio.Flow.copy_string data flow
238
239(** {1 Proxy Request Writing} *)
240
241(** Write request line using absolute-URI form for proxy requests.
242 Per RFC 9112 Section 3.2.2 *)
243let request_line_absolute w ~method_ ~uri =
244 Write.string w method_;
245 sp w;
246 (* Use full absolute URI - write directly to buffer for efficiency *)
247 Huri.write w uri;
248 Write.string w " HTTP/1.1";
249 crlf w
250
251(** Write request headers for proxy request with absolute-URI *)
252let request_headers_proxy w ~method_ ~uri ~headers:hdrs ~content_length ~proxy_auth =
253 (* Write request line with absolute URI *)
254 request_line_absolute w ~method_ ~uri;
255
256 (* Ensure Host header is present *)
257 let hdrs = if not (Headers.mem `Host hdrs) then
258 Headers.add `Host (host_value uri) hdrs
259 else hdrs in
260
261 (* Ensure Connection header for keep-alive *)
262 let hdrs = if not (Headers.mem `Connection hdrs) then
263 Headers.add `Connection "keep-alive" hdrs
264 else hdrs in
265
266 (* Add Content-Length if we have a body length *)
267 let hdrs = match content_length with
268 | Some len when len > 0L && not (Headers.mem `Content_length hdrs) ->
269 Headers.add `Content_length (Int64.to_string len) hdrs
270 | _ -> hdrs
271 in
272
273 (* Add Proxy-Authorization if configured *)
274 let hdrs = match proxy_auth with
275 | Some value -> Headers.add `Proxy_authorization value hdrs
276 | None -> hdrs
277 in
278
279 (* Write all headers *)
280 headers w hdrs
281
282(** Write complete HTTP request via proxy using absolute-URI form *)
283let request_via_proxy w ~sw ~method_ ~uri ~headers:hdrs ~body ~proxy_auth =
284 let method_str = Method.to_string method_ in
285
286 (* Get content type and length from body *)
287 let content_type = Body.content_type body in
288 let content_length = Body.content_length body in
289
290 (* Add Content-Type header if body has one *)
291 let hdrs = match content_type with
292 | Some mime when not (Headers.mem `Content_type hdrs) ->
293 Headers.add `Content_type (Mime.to_string mime) hdrs
294 | _ -> hdrs
295 in
296
297 (* Determine if we need chunked encoding *)
298 let use_chunked = Body.Private.is_chunked body in
299
300 let hdrs = if use_chunked && not (Headers.mem `Transfer_encoding hdrs) then
301 Headers.add `Transfer_encoding "chunked" hdrs
302 else hdrs in
303
304 (* Write request line and headers *)
305 request_headers_proxy w ~method_:method_str ~uri ~headers:hdrs
306 ~content_length ~proxy_auth;
307
308 (* Write body *)
309 if Body.Private.is_empty body then
310 ()
311 else if use_chunked then
312 Body.Private.write_chunked ~sw w body
313 else
314 Body.Private.write ~sw w body