anil.recoil.org
A batteries included HTTP/1.1 client in OCaml
Add format string constructors for Error module
Add printf-style format string variants of error constructors to reduce
boilerplate when error messages need interpolation:
- invalid_requestf, invalid_redirectf, invalid_urlf
- proxy_errorf, tls_handshake_failedf, tcp_connect_failedf
Also add non-format convenience constructors:
- tls_handshake_failed, tcp_connect_failed
Update callers in http_read.ml, proxy_tunnel.ml, retry.ml, and
redirect.ml to use the new format functions, reducing verbosity from:
raise (Error.err (Error.Invalid_request {
reason = Printf.sprintf "Invalid: %s" x
}))
To:
raise (Error.invalid_requestf "Invalid: %s" x)
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+92
-54
+29
lib/error.ml
+29
lib/error.ml
···
298
298
299
299
let proxy_error ~host ~reason =
300
300
err (Proxy_error { host; reason })
301
+
302
+
let tls_handshake_failed ~host ~reason =
303
+
err (Tls_handshake_failed { host; reason })
304
+
305
+
let tcp_connect_failed ~host ~port ~reason =
306
+
err (Tcp_connect_failed { host; port; reason })
307
+
308
+
(** {1 Format String Constructors}
309
+
310
+
These functions accept printf-style format strings for the reason field,
311
+
making error construction more concise when messages need interpolation. *)
312
+
313
+
let invalid_requestf fmt =
314
+
Printf.ksprintf (fun reason -> err (Invalid_request { reason })) fmt
315
+
316
+
let invalid_redirectf ~url fmt =
317
+
Printf.ksprintf (fun reason -> err (Invalid_redirect { url; reason })) fmt
318
+
319
+
let invalid_urlf ~url fmt =
320
+
Printf.ksprintf (fun reason -> err (Invalid_url { url; reason })) fmt
321
+
322
+
let proxy_errorf ~host fmt =
323
+
Printf.ksprintf (fun reason -> err (Proxy_error { host; reason })) fmt
324
+
325
+
let tls_handshake_failedf ~host fmt =
326
+
Printf.ksprintf (fun reason -> err (Tls_handshake_failed { host; reason })) fmt
327
+
328
+
let tcp_connect_failedf ~host ~port fmt =
329
+
Printf.ksprintf (fun reason -> err (Tcp_connect_failed { host; port; reason })) fmt
+40
lib/error.mli
+40
lib/error.mli
···
199
199
200
200
val proxy_error : host:string -> reason:string -> exn
201
201
(** Create a [Proxy_error] exception *)
202
+
203
+
val tls_handshake_failed : host:string -> reason:string -> exn
204
+
(** Create a [Tls_handshake_failed] exception *)
205
+
206
+
val tcp_connect_failed : host:string -> port:int -> reason:string -> exn
207
+
(** Create a [Tcp_connect_failed] exception *)
208
+
209
+
(** {1 Format String Constructors}
210
+
211
+
These functions accept printf-style format strings for the reason field,
212
+
making error construction more concise when messages need interpolation.
213
+
214
+
Example:
215
+
{[
216
+
(* Instead of: *)
217
+
raise (Error.err (Error.Invalid_request {
218
+
reason = Printf.sprintf "Invalid status code: %s" code_str
219
+
}))
220
+
221
+
(* Use: *)
222
+
raise (Error.invalid_requestf "Invalid status code: %s" code_str)
223
+
]} *)
224
+
225
+
val invalid_requestf : ('a, unit, string, exn) format4 -> 'a
226
+
(** Create an [Invalid_request] exception with a format string *)
227
+
228
+
val invalid_redirectf : url:string -> ('a, unit, string, exn) format4 -> 'a
229
+
(** Create an [Invalid_redirect] exception with a format string *)
230
+
231
+
val invalid_urlf : url:string -> ('a, unit, string, exn) format4 -> 'a
232
+
(** Create an [Invalid_url] exception with a format string *)
233
+
234
+
val proxy_errorf : host:string -> ('a, unit, string, exn) format4 -> 'a
235
+
(** Create a [Proxy_error] exception with a format string *)
236
+
237
+
val tls_handshake_failedf : host:string -> ('a, unit, string, exn) format4 -> 'a
238
+
(** Create a [Tls_handshake_failed] exception with a format string *)
239
+
240
+
val tcp_connect_failedf : host:string -> port:int -> ('a, unit, string, exn) format4 -> 'a
241
+
(** Create a [Tcp_connect_failed] exception with a format string *)
+9
-25
lib/http_read.ml
+9
-25
lib/http_read.ml
···
62
62
for i = 0 to len - 1 do
63
63
if s.[i] = '\r' then begin
64
64
if i + 1 >= len || s.[i + 1] <> '\n' then
65
-
raise (Error.err (Error.Invalid_request {
66
-
reason = Printf.sprintf "Bare CR in %s (potential HTTP smuggling attack)" context
67
-
}))
65
+
raise (Error.invalid_requestf "Bare CR in %s (potential HTTP smuggling attack)" context)
68
66
end
69
67
done
70
68
···
78
76
let status_code r =
79
77
let code_str = Read.take_while is_digit r in
80
78
if String.length code_str <> 3 then
81
-
raise (Error.err (Error.Invalid_request {
82
-
reason = "Invalid status code: " ^ code_str
83
-
}));
79
+
raise (Error.invalid_requestf "Invalid status code: %s" code_str);
84
80
try int_of_string code_str
85
81
with _ ->
86
-
raise (Error.err (Error.Invalid_request {
87
-
reason = "Invalid status code: " ^ code_str
88
-
}))
82
+
raise (Error.invalid_requestf "Invalid status code: %s" code_str)
89
83
90
84
let reason_phrase r =
91
85
Read.line r
···
101
95
let http_version_of_string = function
102
96
| "HTTP/1.0" -> HTTP_1_0
103
97
| "HTTP/1.1" -> HTTP_1_1
104
-
| v -> raise (Error.err (Error.Invalid_request {
105
-
reason = "Invalid HTTP version: " ^ v
106
-
}))
98
+
| v -> raise (Error.invalid_requestf "Invalid HTTP version: %s" v)
107
99
108
100
let http_version_to_string = function
109
101
| HTTP_1_0 -> "HTTP/1.0"
···
285
277
(* Protect against overflow: limit hex digits to prevent parsing huge numbers.
286
278
16 hex digits = 64-bit max, which is way more than any reasonable chunk. *)
287
279
if String.length hex_str > max_chunk_size_hex_digits then
288
-
raise (Error.err (Error.Invalid_request {
289
-
reason = Printf.sprintf "Chunk size too large (%d hex digits, max %d)"
290
-
(String.length hex_str) max_chunk_size_hex_digits
291
-
}));
280
+
raise (Error.invalid_requestf "Chunk size too large (%d hex digits, max %d)"
281
+
(String.length hex_str) max_chunk_size_hex_digits);
292
282
(* Skip any chunk extensions (after semicolon) - validate for bare CR *)
293
283
let extensions = Read.take_while (fun c -> c <> '\r' && c <> '\n') r in
294
284
validate_no_bare_cr ~context:"chunk extension" extensions;
295
285
let _ = Read.line r in (* Consume CRLF *)
296
286
try int_of_string ("0x" ^ hex_str)
297
287
with _ ->
298
-
raise (Error.err (Error.Invalid_request {
299
-
reason = "Invalid chunk size: " ^ hex_str
300
-
}))
288
+
raise (Error.invalid_requestf "Invalid chunk size: %s" hex_str)
301
289
302
290
(** {1 Trailer Header Parsing}
303
291
···
694
682
(* Per RFC 9110 Section 8.6: Content-Length MUST be >= 0 *)
695
683
if len < 0L then begin
696
684
Log.warn (fun m -> m "Negative Content-Length rejected: %s" s);
697
-
raise (Error.err (Error.Invalid_request {
698
-
reason = Printf.sprintf "Content-Length cannot be negative: %s" s
699
-
}))
685
+
raise (Error.invalid_requestf "Content-Length cannot be negative: %s" s)
700
686
end;
701
687
Some len
702
688
with Failure _ ->
703
689
Log.warn (fun m -> m "Invalid Content-Length header value: %s" s);
704
-
raise (Error.err (Error.Invalid_request {
705
-
reason = "Invalid Content-Length header: " ^ s
706
-
}))
690
+
raise (Error.invalid_requestf "Invalid Content-Length header: %s" s)
707
691
708
692
(** Parse complete response (status + headers + body) to string.
709
693
Per {{:https://datatracker.ietf.org/doc/html/rfc9112#section-6}RFC 9112 Section 6}}. *)
+9
-20
lib/proxy_tunnel.ml
+9
-20
lib/proxy_tunnel.ml
···
67
67
let status =
68
68
try int_of_string status_str
69
69
with _ ->
70
-
raise (Error.err (Error.Proxy_error {
71
-
host = proxy.Proxy.host;
72
-
reason = Printf.sprintf "Invalid status code in CONNECT response: %s" status_str
73
-
}))
70
+
raise (Error.proxy_errorf ~host:proxy.Proxy.host
71
+
"Invalid status code in CONNECT response: %s" status_str)
74
72
in
75
73
76
74
Log.debug (fun m -> m "CONNECT response: %s %d %s" version_str status reason);
···
84
82
85
83
(* Check for success (2xx) *)
86
84
if status < 200 || status >= 300 then
87
-
raise (Error.err (Error.Proxy_error {
88
-
host = proxy.Proxy.host;
89
-
reason = Printf.sprintf "CONNECT to %s failed: %d %s" target status reason
90
-
}));
85
+
raise (Error.proxy_errorf ~host:proxy.Proxy.host
86
+
"CONNECT to %s failed: %d %s" target status reason);
91
87
92
88
Log.info (fun m -> m "CONNECT tunnel established to %s via proxy %s:%d"
93
89
target proxy.Proxy.host proxy.Proxy.port)
···
171
167
(match Domain_name.host domain with
172
168
| Ok host -> host
173
169
| Error (`Msg msg) ->
174
-
raise (Error.err (Error.Tls_handshake_failed {
175
-
host = target_host;
176
-
reason = Printf.sprintf "Invalid hostname for SNI: %s" msg
177
-
})))
170
+
raise (Error.tls_handshake_failedf ~host:target_host
171
+
"Invalid hostname for SNI: %s" msg))
178
172
| Error (`Msg msg) ->
179
-
raise (Error.err (Error.Tls_handshake_failed {
180
-
host = target_host;
181
-
reason = Printf.sprintf "Invalid domain name: %s" msg
182
-
}))
173
+
raise (Error.tls_handshake_failedf ~host:target_host
174
+
"Invalid domain name: %s" msg)
183
175
in
184
176
185
177
Log.debug (fun m -> m "Starting TLS handshake with %s through tunnel" target_host);
···
190
182
target_host proxy.Proxy.host proxy.Proxy.port);
191
183
(tls_flow :> Eio.Flow.two_way_ty Eio.Resource.t)
192
184
with exn ->
193
-
raise (Error.err (Error.Tls_handshake_failed {
194
-
host = target_host;
195
-
reason = Printexc.to_string exn
196
-
}))
185
+
raise (Error.tls_handshake_failedf ~host:target_host "%s" (Printexc.to_string exn))
+1
-4
lib/redirect.ml
+1
-4
lib/redirect.ml
···
57
57
| Some scheme when List.mem (String.lowercase_ascii scheme) allowed_schemes ->
58
58
uri
59
59
| Some scheme ->
60
-
raise (Error.err (Error.Invalid_redirect {
61
-
url = location;
62
-
reason = Printf.sprintf "Disallowed redirect scheme: %s" scheme
63
-
}))
60
+
raise (Error.invalid_redirectf ~url:location "Disallowed redirect scheme: %s" scheme)
64
61
| None ->
65
62
uri (* Relative URLs are OK - they will be resolved against current URL *)
+4
-5
lib/retry.ml
+4
-5
lib/retry.ml
···
84
84
(* Per RFC 9110 Section 9.2.2: Only idempotent methods should be retried automatically *)
85
85
if status_retryable && not method_allowed then begin
86
86
if config.strict_method_semantics then
87
-
raise (Error.err (Error.Invalid_request {
88
-
reason = Printf.sprintf "Cannot retry %s request: method is not idempotent \
89
-
(RFC 9110 Section 9.2.2). Disable strict_method_semantics to allow."
90
-
(Method.to_string method_)
91
-
}))
87
+
raise (Error.invalid_requestf
88
+
"Cannot retry %s request: method is not idempotent \
89
+
(RFC 9110 Section 9.2.2). Disable strict_method_semantics to allow."
90
+
(Method.to_string method_))
92
91
else
93
92
Log.debug (fun m -> m "Not retrying %s request (status %d): method is not idempotent \
94
93
(RFC 9110 Section 9.2.2)" (Method.to_string method_) status)