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
27let request_line w ~method_ ~uri =
28 let path = Uri.path uri in
29 let path = if path = "" then "/" else path in
30 let query = Uri.query uri in
31 let path_with_query =
32 if query = [] then path
33 else path ^ "?" ^ (Uri.encoded_of_query query)
34 in
35 Write.string w method_;
36 sp w;
37 Write.string w path_with_query;
38 Write.string w " HTTP/1.1";
39 crlf w
40
41(** {1 Header Writing} *)
42
43let header w ~name ~value =
44 Write.string w name;
45 Write.string w ": ";
46 Write.string w value;
47 crlf w
48
49let headers w hdrs =
50 Headers.to_list hdrs
51 |> List.iter (fun (name, value) -> header w ~name ~value);
52 crlf w
53
54(** Build Host header value from URI *)
55let host_value uri =
56 let host = match Uri.host uri with
57 | Some h -> h
58 | None -> raise (Error.err (Error.Invalid_url {
59 url = Uri.to_string uri;
60 reason = "URI must have a host"
61 }))
62 in
63 (* RFC 7230: default ports should be omitted from Host header *)
64 match Uri.port uri, Uri.scheme uri with
65 | Some p, Some "https" when p <> 443 -> host ^ ":" ^ string_of_int p
66 | Some p, Some "http" when p <> 80 -> host ^ ":" ^ string_of_int p
67 | Some p, _ -> host ^ ":" ^ string_of_int p
68 | None, _ -> host
69
70let request_headers w ~method_ ~uri ~headers:hdrs ~content_length =
71 (* Write request line *)
72 request_line w ~method_ ~uri;
73
74 (* Ensure Host header is present *)
75 let hdrs = if not (Headers.mem "host" hdrs) then
76 Headers.add "host" (host_value uri) hdrs
77 else hdrs in
78
79 (* Ensure Connection header for keep-alive *)
80 let hdrs = if not (Headers.mem "connection" hdrs) then
81 Headers.add "connection" "keep-alive" hdrs
82 else hdrs in
83
84 (* Add Content-Length if we have a body length *)
85 let hdrs = match content_length with
86 | Some len when len > 0L && not (Headers.mem "content-length" hdrs) ->
87 Headers.add "content-length" (Int64.to_string len) hdrs
88 | _ -> hdrs
89 in
90
91 (* Write all headers *)
92 headers w hdrs
93
94(** {1 Body Writing} *)
95
96let body_string w s =
97 if s <> "" then
98 Write.string w s
99
100(** Copy from a flow source to the writer, chunk by chunk *)
101let body_stream w source =
102 let buf = Cstruct.create 8192 in
103 let rec copy () =
104 match Eio.Flow.single_read source buf with
105 | n ->
106 Write.cstruct w (Cstruct.sub buf 0 n);
107 copy ()
108 | exception End_of_file -> ()
109 in
110 copy ()
111
112(** Write body using chunked transfer encoding *)
113let body_chunked w source =
114 let buf = Cstruct.create 8192 in
115 let rec copy () =
116 match Eio.Flow.single_read source buf with
117 | n ->
118 (* Write chunk size in hex *)
119 Write.printf w "%x" n;
120 crlf w;
121 (* Write chunk data *)
122 Write.cstruct w (Cstruct.sub buf 0 n);
123 crlf w;
124 copy ()
125 | exception End_of_file ->
126 (* Write final chunk *)
127 Write.string w "0";
128 crlf w;
129 crlf w
130 in
131 copy ()
132
133(** {1 High-level Request Writing} *)
134
135let request w ~sw ~method_ ~uri ~headers:hdrs ~body =
136 let method_str = Method.to_string method_ in
137
138 (* Get content type and length from body *)
139 let content_type = Body.content_type body in
140 let content_length = Body.content_length body in
141
142 (* Add Content-Type header if body has one *)
143 let hdrs = match content_type with
144 | Some mime when not (Headers.mem "content-type" hdrs) ->
145 Headers.add "content-type" (Mime.to_string mime) hdrs
146 | _ -> hdrs
147 in
148
149 (* Determine if we need chunked encoding *)
150 let use_chunked = Body.Private.is_chunked body in
151
152 let hdrs = if use_chunked && not (Headers.mem "transfer-encoding" hdrs) then
153 Headers.add "transfer-encoding" "chunked" hdrs
154 else hdrs in
155
156 (* Write request line and headers *)
157 request_headers w ~method_:method_str ~uri ~headers:hdrs ~content_length;
158
159 (* Write body *)
160 if Body.Private.is_empty body then
161 ()
162 else if use_chunked then
163 Body.Private.write_chunked ~sw w body
164 else
165 Body.Private.write ~sw w body
166
167(** {1 Headers-Only Writing (for 100-continue)} *)
168
169let request_headers_only w ~method_ ~uri ~headers:hdrs ~content_length =
170 let method_str = Method.to_string method_ in
171 request_headers w ~method_:method_str ~uri ~headers:hdrs ~content_length
172
173(** {1 Convenience Wrappers} *)
174
175let with_flow ?initial_size flow fn =
176 Write.with_flow ?initial_size flow fn
177
178(** Write and flush directly to flow without creating a nested switch.
179 This is a simpler alternative to [with_flow] that avoids potential
180 issues with nested switches in the Eio fiber system. *)
181let write_and_flush ?(initial_size=0x1000) flow fn =
182 (* Create a writer without attaching to a switch *)
183 let w = Write.create initial_size in
184 (* Execute the writing function *)
185 fn w;
186 (* Serialize to string and copy to flow *)
187 let data = Write.serialize_to_string w in
188 if String.length data > 0 then
189 Eio.Flow.copy_string data flow
190
191(** {1 Proxy Request Writing} *)
192
193(** Write request line using absolute-URI form for proxy requests.
194 Per RFC 9112 Section 3.2.2 *)
195let request_line_absolute w ~method_ ~uri =
196 Write.string w method_;
197 sp w;
198 (* Use full absolute URI *)
199 Write.string w (Uri.to_string uri);
200 Write.string w " HTTP/1.1";
201 crlf w
202
203(** Write request headers for proxy request with absolute-URI *)
204let request_headers_proxy w ~method_ ~uri ~headers:hdrs ~content_length ~proxy_auth =
205 (* Write request line with absolute URI *)
206 request_line_absolute w ~method_ ~uri;
207
208 (* Ensure Host header is present *)
209 let hdrs = if not (Headers.mem "host" hdrs) then
210 Headers.add "host" (host_value uri) hdrs
211 else hdrs in
212
213 (* Ensure Connection header for keep-alive *)
214 let hdrs = if not (Headers.mem "connection" hdrs) then
215 Headers.add "connection" "keep-alive" hdrs
216 else hdrs in
217
218 (* Add Content-Length if we have a body length *)
219 let hdrs = match content_length with
220 | Some len when len > 0L && not (Headers.mem "content-length" hdrs) ->
221 Headers.add "content-length" (Int64.to_string len) hdrs
222 | _ -> hdrs
223 in
224
225 (* Add Proxy-Authorization if configured *)
226 let hdrs = match proxy_auth with
227 | Some auth ->
228 let auth_headers = Auth.apply auth Headers.empty in
229 (match Headers.get "authorization" auth_headers with
230 | Some value -> Headers.add "proxy-authorization" value hdrs
231 | None -> hdrs)
232 | None -> hdrs
233 in
234
235 (* Write all headers *)
236 headers w hdrs
237
238(** Write complete HTTP request via proxy using absolute-URI form *)
239let request_via_proxy w ~sw ~method_ ~uri ~headers:hdrs ~body ~proxy_auth =
240 let method_str = Method.to_string method_ in
241
242 (* Get content type and length from body *)
243 let content_type = Body.content_type body in
244 let content_length = Body.content_length body in
245
246 (* Add Content-Type header if body has one *)
247 let hdrs = match content_type with
248 | Some mime when not (Headers.mem "content-type" hdrs) ->
249 Headers.add "content-type" (Mime.to_string mime) hdrs
250 | _ -> hdrs
251 in
252
253 (* Determine if we need chunked encoding *)
254 let use_chunked = Body.Private.is_chunked body in
255
256 let hdrs = if use_chunked && not (Headers.mem "transfer-encoding" hdrs) then
257 Headers.add "transfer-encoding" "chunked" hdrs
258 else hdrs in
259
260 (* Write request line and headers *)
261 request_headers_proxy w ~method_:method_str ~uri ~headers:hdrs
262 ~content_length ~proxy_auth;
263
264 (* Write body *)
265 if Body.Private.is_empty body then
266 ()
267 else if use_chunked then
268 Body.Private.write_chunked ~sw w body
269 else
270 Body.Private.write ~sw w body