My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1let src = Logs.Src.create "requests.one" ~doc:"One-shot HTTP Requests"
2module Log = (val Logs.src_log src : Logs.LOG)
3
4(* Helper to create TCP connection to host:port *)
5let connect_tcp ~sw ~net ~host ~port =
6 Log.debug (fun m -> m "Connecting to %s:%d" host port);
7 (* Resolve hostname to IP address *)
8 let addrs = Eio.Net.getaddrinfo_stream net host ~service:(string_of_int port) in
9 match addrs with
10 | addr :: _ ->
11 Log.debug (fun m -> m "Resolved %s, connecting..." host);
12 Eio.Net.connect ~sw net addr
13 | [] ->
14 let msg = Printf.sprintf "Failed to resolve hostname: %s" host in
15 Log.err (fun m -> m "%s" msg);
16 failwith msg
17
18(* Helper to wrap connection with TLS if needed *)
19let wrap_tls flow ~host ~verify_tls ~tls_config =
20 Log.debug (fun m -> m "Wrapping connection with TLS for %s (verify=%b)" host verify_tls);
21
22 (* Get or create TLS config *)
23 let tls_cfg = match tls_config, verify_tls with
24 | Some cfg, _ -> cfg
25 | None, true ->
26 (* Use CA certificates for verification *)
27 (match Ca_certs.authenticator () with
28 | Ok authenticator ->
29 (match Tls.Config.client ~authenticator () with
30 | Ok cfg -> cfg
31 | Error (`Msg msg) ->
32 Log.err (fun m -> m "Failed to create TLS config: %s" msg);
33 failwith ("TLS config error: " ^ msg))
34 | Error (`Msg msg) ->
35 Log.err (fun m -> m "Failed to load CA certificates: %s" msg);
36 failwith ("CA certificates error: " ^ msg))
37 | None, false ->
38 (* No verification *)
39 match Tls.Config.client ~authenticator:(fun ?ip:_ ~host:_ _ -> Ok None) () with
40 | Ok cfg -> cfg
41 | Error (`Msg msg) -> failwith ("TLS config error: " ^ msg)
42 in
43
44 (* Get domain name for SNI *)
45 let domain = match Domain_name.of_string host with
46 | Ok dn -> (match Domain_name.host dn with
47 | Ok d -> d
48 | Error (`Msg msg) ->
49 Log.err (fun m -> m "Invalid hostname for TLS: %s (%s)" host msg);
50 failwith ("Invalid hostname: " ^ msg))
51 | Error (`Msg msg) ->
52 Log.err (fun m -> m "Invalid hostname for TLS: %s (%s)" host msg);
53 failwith ("Invalid hostname: " ^ msg)
54 in
55
56 (Tls_eio.client_of_flow ~host:domain tls_cfg flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
57
58(* Parse URL and connect directly (no pooling) *)
59let connect_to_url ~sw ~clock ~net ~url ~timeout ~verify_tls ~tls_config =
60 let uri = Uri.of_string url in
61
62 (* Extract host and port *)
63 let host = match Uri.host uri with
64 | Some h -> h
65 | None -> failwith ("URL must contain a host: " ^ url)
66 in
67
68 let is_https = Uri.scheme uri = Some "https" in
69 let default_port = if is_https then 443 else 80 in
70 let port = Option.value (Uri.port uri) ~default:default_port in
71
72 (* Apply connection timeout if specified *)
73 let connect_fn () =
74 let tcp_flow = connect_tcp ~sw ~net ~host ~port in
75 if is_https then
76 wrap_tls tcp_flow ~host ~verify_tls ~tls_config
77 else
78 (tcp_flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
79 in
80
81 match timeout with
82 | Some t ->
83 let timeout_seconds = Timeout.total t in
84 (match timeout_seconds with
85 | Some seconds ->
86 Log.debug (fun m -> m "Setting connection timeout: %.2f seconds" seconds);
87 Eio.Time.with_timeout_exn clock seconds connect_fn
88 | None -> connect_fn ())
89 | None -> connect_fn ()
90
91(* Main request implementation - completely stateless *)
92let request ~sw ~clock ~net ?headers ?body ?auth ?timeout
93 ?(follow_redirects = true) ?(max_redirects = 10)
94 ?(verify_tls = true) ?tls_config ~method_ url =
95
96 let start_time = Unix.gettimeofday () in
97 let method_str = Method.to_string method_ in
98 Log.debug (fun m -> m "[One] Executing %s request to %s" method_str url);
99
100 (* Prepare headers *)
101 let headers = Option.value headers ~default:Headers.empty in
102
103 (* Apply auth *)
104 let headers = match auth with
105 | Some a ->
106 Log.debug (fun m -> m "Applying authentication");
107 Auth.apply a headers
108 | None -> headers
109 in
110
111 (* Add content type from body *)
112 let headers = match body with
113 | Some b -> (match Body.content_type b with
114 | Some mime -> Headers.content_type mime headers
115 | None -> headers)
116 | None -> headers
117 in
118
119 (* Convert body to string for sending *)
120 let request_body_str = match body with
121 | None -> ""
122 | Some b -> Body.Private.to_string b
123 in
124
125 (* Execute request with redirects *)
126 let rec make_with_redirects url_to_fetch redirects_left =
127 let uri_to_fetch = Uri.of_string url_to_fetch in
128
129 (* Connect to URL (opens new TCP connection) *)
130 let flow = connect_to_url ~sw ~clock ~net ~url:url_to_fetch
131 ~timeout ~verify_tls ~tls_config in
132
133 (* Make HTTP request using low-level client *)
134 let status, resp_headers, response_body_str =
135 Http_client.make_request ~method_:method_str ~uri:uri_to_fetch
136 ~headers ~body_str:request_body_str flow
137 in
138
139 Log.info (fun m -> m "Received response: status=%d" status);
140
141 (* Handle redirects if enabled *)
142 if follow_redirects && (status >= 300 && status < 400) then begin
143 if redirects_left <= 0 then begin
144 Log.err (fun m -> m "Too many redirects (%d) for %s" max_redirects url);
145 raise (Error.TooManyRedirects { url; count = max_redirects; max = max_redirects })
146 end;
147
148 match Headers.get "location" resp_headers with
149 | None ->
150 Log.debug (fun m -> m "Redirect response missing Location header");
151 (status, resp_headers, response_body_str, url_to_fetch)
152 | Some location ->
153 Log.info (fun m -> m "Following redirect to %s (%d remaining)" location redirects_left);
154 make_with_redirects location (redirects_left - 1)
155 end else
156 (status, resp_headers, response_body_str, url_to_fetch)
157 in
158
159 let final_status, final_headers, final_body_str, final_url =
160 make_with_redirects url max_redirects
161 in
162
163 let elapsed = Unix.gettimeofday () -. start_time in
164 Log.info (fun m -> m "Request completed in %.3f seconds" elapsed);
165
166 (* Create a flow from the body string *)
167 let body_flow = Eio.Flow.string_source final_body_str in
168
169 Response.Private.make
170 ~sw
171 ~status:final_status
172 ~headers:final_headers
173 ~body:body_flow
174 ~url:final_url
175 ~elapsed
176
177(* Convenience methods *)
178let get ~sw ~clock ~net ?headers ?auth ?timeout
179 ?follow_redirects ?max_redirects ?verify_tls ?tls_config url =
180 request ~sw ~clock ~net ?headers ?auth ?timeout
181 ?follow_redirects ?max_redirects ?verify_tls ?tls_config
182 ~method_:`GET url
183
184let post ~sw ~clock ~net ?headers ?body ?auth ?timeout
185 ?verify_tls ?tls_config url =
186 request ~sw ~clock ~net ?headers ?body ?auth ?timeout
187 ?verify_tls ?tls_config ~method_:`POST url
188
189let put ~sw ~clock ~net ?headers ?body ?auth ?timeout
190 ?verify_tls ?tls_config url =
191 request ~sw ~clock ~net ?headers ?body ?auth ?timeout
192 ?verify_tls ?tls_config ~method_:`PUT url
193
194let delete ~sw ~clock ~net ?headers ?auth ?timeout
195 ?verify_tls ?tls_config url =
196 request ~sw ~clock ~net ?headers ?auth ?timeout
197 ?verify_tls ?tls_config ~method_:`DELETE url
198
199let head ~sw ~clock ~net ?headers ?auth ?timeout
200 ?verify_tls ?tls_config url =
201 request ~sw ~clock ~net ?headers ?auth ?timeout
202 ?verify_tls ?tls_config ~method_:`HEAD url
203
204let patch ~sw ~clock ~net ?headers ?body ?auth ?timeout
205 ?verify_tls ?tls_config url =
206 request ~sw ~clock ~net ?headers ?body ?auth ?timeout
207 ?verify_tls ?tls_config ~method_:`PATCH url
208
209let upload ~sw ~clock ~net ?headers ?auth ?timeout ?method_ ?mime ?length
210 ?on_progress ?verify_tls ?tls_config ~source url =
211 let method_ = Option.value method_ ~default:`POST in
212 let mime = Option.value mime ~default:Mime.octet_stream in
213
214 (* Wrap source with progress tracking if callback provided *)
215 let tracked_source = match on_progress with
216 | None -> source
217 | Some callback ->
218 (* For now, progress tracking is not implemented for uploads
219 due to complexity of wrapping Eio.Flow.source.
220 This would require creating a custom flow wrapper. *)
221 let _ = callback in
222 source
223 in
224
225 let body = Body.of_stream ?length mime tracked_source in
226 request ~sw ~clock ~net ?headers ~body ?auth ?timeout
227 ?verify_tls ?tls_config ~method_ url
228
229let download ~sw ~clock ~net ?headers ?auth ?timeout ?on_progress
230 ?verify_tls ?tls_config url ~sink =
231 let response = get ~sw ~clock ~net ?headers ?auth ?timeout
232 ?verify_tls ?tls_config url in
233
234 try
235 (* Get content length for progress tracking *)
236 let total = Response.content_length response in
237
238 let body = Response.body response in
239
240 (* Stream data to sink with optional progress *)
241 match on_progress with
242 | None ->
243 (* No progress tracking, just copy directly *)
244 Eio.Flow.copy body sink
245 | Some progress_fn ->
246 (* Copy with progress tracking *)
247 (* We need to intercept the flow to track bytes *)
248 (* For now, just do a simple copy - proper progress tracking needs flow wrapper *)
249 progress_fn ~received:0L ~total;
250 Eio.Flow.copy body sink;
251 progress_fn ~received:(Option.value total ~default:0L) ~total;
252
253 (* Response auto-closes with switch *)
254 ()
255 with e ->
256 (* Response auto-closes with switch *)
257 raise e