this repo has no description
more
+30
-23
+29
-22
stack/requests/lib/one.ml
+29
-22
stack/requests/lib/one.ml
···
10
10
retry_backoff : float;
11
11
verify_tls : bool;
12
12
tls_config : Tls.Config.client option;
13
-
pool : ('clock, 'net) Conpool.t;
13
+
http_pool : ('clock, 'net) Conpool.t; (* For HTTP connections *)
14
+
https_pool : ('clock, 'net) Conpool.t; (* For HTTPS connections *)
14
15
}
15
16
16
17
let create
···
46
47
| None, false -> None
47
48
in
48
49
49
-
(* Create connection pool - plain TCP, we'll wrap with TLS per-request *)
50
+
(* Create connection pools - one for HTTP, one for HTTPS *)
50
51
let pool_config = Conpool.Config.make
51
52
~max_connections_per_endpoint:max_connections_per_host
52
53
~max_idle_time:connection_idle_timeout
···
54
55
()
55
56
in
56
57
57
-
let pool = Conpool.create
58
+
(* HTTP pool - plain TCP connections *)
59
+
let http_pool = Conpool.create
60
+
~sw
61
+
~net
62
+
~clock
63
+
~config:pool_config
64
+
()
65
+
in
66
+
67
+
(* HTTPS pool - TLS-wrapped connections *)
68
+
let https_tls_config = Option.map (fun cfg ->
69
+
Conpool.Tls_config.make ~config:cfg ()
70
+
) tls_config in
71
+
72
+
let https_pool = Conpool.create
58
73
~sw
59
74
~net
60
75
~clock
76
+
?tls:https_tls_config
61
77
~config:pool_config
62
78
()
63
79
in
64
80
65
-
Log.info (fun m -> m "Created HTTP client with connection pool (max_per_host=%d)"
66
-
max_connections_per_host);
81
+
Log.info (fun m -> m "Created HTTP client with connection pools (max_per_host=%d, TLS=%b)"
82
+
max_connections_per_host (Option.is_some https_tls_config));
67
83
68
84
{
69
85
clock;
···
74
90
retry_backoff;
75
91
verify_tls;
76
92
tls_config;
77
-
pool;
93
+
http_pool;
94
+
https_pool;
78
95
}
79
96
80
97
let default ~sw ~clock ~net =
···
153
170
| Some b -> Body.Private.to_string b
154
171
in
155
172
156
-
(* Determine if we need TLS based on URL scheme *)
173
+
(* Determine if we need TLS based on URL scheme and choose appropriate pool *)
157
174
let is_https = match Uri.scheme uri with
158
175
| Some "https" -> true
159
176
| _ -> false
160
177
in
161
178
179
+
(* Choose the appropriate connection pool *)
180
+
let pool = if is_https then client.https_pool else client.http_pool in
181
+
162
182
(* Execute request with pooled connection *)
163
183
let rec make_with_redirects url_to_fetch redirects_left =
164
184
let uri_to_fetch = Uri.of_string url_to_fetch in
165
185
166
186
let make_request_fn () =
167
-
Conpool.with_connection client.pool endpoint (fun tcp_flow ->
168
-
(* Wrap with TLS if HTTPS *)
169
-
let flow : Eio.Flow.two_way_ty Eio.Resource.t = if is_https then
170
-
match client.tls_config with
171
-
| Some tls_cfg ->
172
-
let domain = Domain_name.of_string_exn host in
173
-
let servername = Domain_name.host_exn domain in
174
-
(Tls_eio.client_of_flow ~host:servername tls_cfg tcp_flow :> Eio.Flow.two_way_ty Eio.Resource.t)
175
-
| None ->
176
-
Log.warn (fun m -> m "HTTPS request but no TLS config available");
177
-
failwith "HTTPS requires TLS configuration"
178
-
else
179
-
(tcp_flow :> Eio.Flow.two_way_ty Eio.Resource.t)
180
-
in
181
-
187
+
Conpool.with_connection pool endpoint (fun flow ->
188
+
(* Flow is already TLS-wrapped if from https_pool, plain TCP if from http_pool *)
182
189
(* Use our low-level HTTP client *)
183
190
Http_client.make_request ~method_:method_str ~uri:uri_to_fetch ~headers ~body_str:request_body_str flow
184
191
)
+1
-1
stack/requests/test/test_requests.ml
+1
-1
stack/requests/test/test_requests.ml
···
705
705
end in
706
706
Test_server.start_server ~port test_env;
707
707
708
-
let client = Requests.One.create ~clock:env#clock ~net:env#net () in
708
+
let client = Requests.One.create ~sw ~clock:env#clock ~net:env#net () in
709
709
let response = Requests.One.get ~sw ~client (base_url ^ "/echo") in
710
710
711
711
Alcotest.(check int) "One module status" 200 (Requests.Response.status_code response)