anil.recoil.org
TCP/TLS connection pooling for Eio
split out modules
+2
conpool.opam
+2
conpool.opam
+3
-1
dune-project
+3
-1
dune-project
+52
lib/cmd.ml
+52
lib/cmd.ml
···
···
1
+
(** Cmdliner terms for connection pool configuration *)
2
+
3
+
open Cmdliner
4
+
5
+
let max_connections_per_endpoint =
6
+
let doc = "Maximum concurrent connections per endpoint." in
7
+
Arg.(value & opt int 10 & info ["max-connections-per-endpoint"] ~doc ~docv:"NUM")
8
+
9
+
let max_idle_time =
10
+
let doc = "Maximum time a connection can sit idle in seconds." in
11
+
Arg.(value & opt float 60.0 & info ["max-idle-time"] ~doc ~docv:"SECONDS")
12
+
13
+
let max_connection_lifetime =
14
+
let doc = "Maximum connection age in seconds." in
15
+
Arg.(value & opt float 300.0 & info ["max-connection-lifetime"] ~doc ~docv:"SECONDS")
16
+
17
+
let max_connection_uses =
18
+
let doc = "Maximum times a connection can be reused (omit for unlimited)." in
19
+
Arg.(value & opt (some int) None & info ["max-connection-uses"] ~doc ~docv:"NUM")
20
+
21
+
let connect_timeout =
22
+
let doc = "Connection timeout in seconds." in
23
+
Arg.(value & opt float 10.0 & info ["connect-timeout"] ~doc ~docv:"SECONDS")
24
+
25
+
let connect_retry_count =
26
+
let doc = "Number of connection retry attempts." in
27
+
Arg.(value & opt int 3 & info ["connect-retry-count"] ~doc ~docv:"NUM")
28
+
29
+
let connect_retry_delay =
30
+
let doc = "Initial retry delay in seconds (with exponential backoff)." in
31
+
Arg.(value & opt float 0.1 & info ["connect-retry-delay"] ~doc ~docv:"SECONDS")
32
+
33
+
let config =
34
+
let make max_conn max_idle max_lifetime max_uses timeout retry_count retry_delay =
35
+
Config.make
36
+
~max_connections_per_endpoint:max_conn
37
+
~max_idle_time:max_idle
38
+
~max_connection_lifetime:max_lifetime
39
+
?max_connection_uses:max_uses
40
+
~connect_timeout:timeout
41
+
~connect_retry_count:retry_count
42
+
~connect_retry_delay:retry_delay
43
+
()
44
+
in
45
+
Term.(const make
46
+
$ max_connections_per_endpoint
47
+
$ max_idle_time
48
+
$ max_connection_lifetime
49
+
$ max_connection_uses
50
+
$ connect_timeout
51
+
$ connect_retry_count
52
+
$ connect_retry_delay)
+45
lib/cmd.mli
+45
lib/cmd.mli
···
···
1
+
(** Cmdliner terms for connection pool configuration *)
2
+
3
+
(** {1 Configuration Terms} *)
4
+
5
+
val max_connections_per_endpoint : int Cmdliner.Term.t
6
+
(** Cmdliner term for maximum connections per endpoint.
7
+
Default: 10
8
+
Flag: [--max-connections-per-endpoint] *)
9
+
10
+
val max_idle_time : float Cmdliner.Term.t
11
+
(** Cmdliner term for maximum idle time in seconds.
12
+
Default: 60.0
13
+
Flag: [--max-idle-time] *)
14
+
15
+
val max_connection_lifetime : float Cmdliner.Term.t
16
+
(** Cmdliner term for maximum connection lifetime in seconds.
17
+
Default: 300.0
18
+
Flag: [--max-connection-lifetime] *)
19
+
20
+
val max_connection_uses : int option Cmdliner.Term.t
21
+
(** Cmdliner term for maximum connection uses.
22
+
Default: None (unlimited)
23
+
Flag: [--max-connection-uses] *)
24
+
25
+
val connect_timeout : float Cmdliner.Term.t
26
+
(** Cmdliner term for connection timeout in seconds.
27
+
Default: 10.0
28
+
Flag: [--connect-timeout] *)
29
+
30
+
val connect_retry_count : int Cmdliner.Term.t
31
+
(** Cmdliner term for number of connection retry attempts.
32
+
Default: 3
33
+
Flag: [--connect-retry-count] *)
34
+
35
+
val connect_retry_delay : float Cmdliner.Term.t
36
+
(** Cmdliner term for initial retry delay in seconds.
37
+
Default: 0.1
38
+
Flag: [--connect-retry-delay] *)
39
+
40
+
(** {1 Combined Terms} *)
41
+
42
+
val config : Config.t Cmdliner.Term.t
43
+
(** Cmdliner term that combines all configuration options into a {!Config.t}.
44
+
This term can be used in your application's main command to accept
45
+
all connection pool configuration options from the command line. *)
+80
lib/config.ml
+80
lib/config.ml
···
···
1
+
(** Configuration for connection pools *)
2
+
3
+
let src = Logs.Src.create "conpool.config" ~doc:"Connection pool configuration"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
type t = {
7
+
max_connections_per_endpoint : int;
8
+
max_idle_time : float;
9
+
max_connection_lifetime : float;
10
+
max_connection_uses : int option;
11
+
health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option;
12
+
connect_timeout : float option;
13
+
connect_retry_count : int;
14
+
connect_retry_delay : float;
15
+
on_connection_created : (Endpoint.t -> unit) option;
16
+
on_connection_closed : (Endpoint.t -> unit) option;
17
+
on_connection_reused : (Endpoint.t -> unit) option;
18
+
}
19
+
20
+
let make
21
+
?(max_connections_per_endpoint = 10)
22
+
?(max_idle_time = 60.0)
23
+
?(max_connection_lifetime = 300.0)
24
+
?max_connection_uses
25
+
?health_check
26
+
?(connect_timeout = 10.0)
27
+
?(connect_retry_count = 3)
28
+
?(connect_retry_delay = 0.1)
29
+
?on_connection_created
30
+
?on_connection_closed
31
+
?on_connection_reused
32
+
() =
33
+
Log.debug (fun m ->
34
+
m "Creating config: max_connections=%d, max_idle=%.1fs, max_lifetime=%.1fs"
35
+
max_connections_per_endpoint max_idle_time max_connection_lifetime);
36
+
{
37
+
max_connections_per_endpoint;
38
+
max_idle_time;
39
+
max_connection_lifetime;
40
+
max_connection_uses;
41
+
health_check;
42
+
connect_timeout = Some connect_timeout;
43
+
connect_retry_count;
44
+
connect_retry_delay;
45
+
on_connection_created;
46
+
on_connection_closed;
47
+
on_connection_reused;
48
+
}
49
+
50
+
let default = make ()
51
+
52
+
let max_connections_per_endpoint t = t.max_connections_per_endpoint
53
+
let max_idle_time t = t.max_idle_time
54
+
let max_connection_lifetime t = t.max_connection_lifetime
55
+
let max_connection_uses t = t.max_connection_uses
56
+
let health_check t = t.health_check
57
+
let connect_timeout t = t.connect_timeout
58
+
let connect_retry_count t = t.connect_retry_count
59
+
let connect_retry_delay t = t.connect_retry_delay
60
+
let on_connection_created t = t.on_connection_created
61
+
let on_connection_closed t = t.on_connection_closed
62
+
let on_connection_reused t = t.on_connection_reused
63
+
64
+
let pp ppf t =
65
+
Fmt.pf ppf
66
+
"@[<v>Config:@,\
67
+
- max_connections_per_endpoint: %d@,\
68
+
- max_idle_time: %.1fs@,\
69
+
- max_connection_lifetime: %.1fs@,\
70
+
- max_connection_uses: %s@,\
71
+
- connect_timeout: %s@,\
72
+
- connect_retry_count: %d@,\
73
+
- connect_retry_delay: %.2fs@]"
74
+
t.max_connections_per_endpoint
75
+
t.max_idle_time
76
+
t.max_connection_lifetime
77
+
(match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited")
78
+
(match t.connect_timeout with Some f -> Fmt.str "%.1fs" f | None -> "none")
79
+
t.connect_retry_count
80
+
t.connect_retry_delay
+98
lib/config.mli
+98
lib/config.mli
···
···
1
+
(** Configuration for connection pools *)
2
+
3
+
(** {1 Logging} *)
4
+
5
+
val src : Logs.Src.t
6
+
(** Logs source for configuration operations. Configure logging with:
7
+
{[
8
+
Logs.Src.set_level Conpool.Config.src (Some Logs.Debug);
9
+
]}
10
+
*)
11
+
12
+
(** {1 Type} *)
13
+
14
+
type t
15
+
(** Pool configuration *)
16
+
17
+
(** {1 Construction} *)
18
+
19
+
val make :
20
+
?max_connections_per_endpoint:int ->
21
+
?max_idle_time:float ->
22
+
?max_connection_lifetime:float ->
23
+
?max_connection_uses:int ->
24
+
?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->
25
+
?connect_timeout:float ->
26
+
?connect_retry_count:int ->
27
+
?connect_retry_delay:float ->
28
+
?on_connection_created:(Endpoint.t -> unit) ->
29
+
?on_connection_closed:(Endpoint.t -> unit) ->
30
+
?on_connection_reused:(Endpoint.t -> unit) ->
31
+
unit -> t
32
+
(** Create pool configuration with optional parameters.
33
+
34
+
@param max_connections_per_endpoint Maximum concurrent connections per endpoint (default: 10)
35
+
@param max_idle_time Maximum time a connection can sit idle in seconds (default: 60.0)
36
+
@param max_connection_lifetime Maximum connection age in seconds (default: 300.0)
37
+
@param max_connection_uses Maximum times a connection can be reused (default: unlimited)
38
+
@param health_check Custom health check function (default: none)
39
+
@param connect_timeout Connection timeout in seconds (default: 10.0)
40
+
@param connect_retry_count Number of connection retry attempts (default: 3)
41
+
@param connect_retry_delay Initial retry delay in seconds, with exponential backoff (default: 0.1)
42
+
@param on_connection_created Hook called when a connection is created
43
+
@param on_connection_closed Hook called when a connection is closed
44
+
@param on_connection_reused Hook called when a connection is reused
45
+
*)
46
+
47
+
val default : t
48
+
(** Sensible defaults for most use cases:
49
+
- max_connections_per_endpoint: 10
50
+
- max_idle_time: 60.0s
51
+
- max_connection_lifetime: 300.0s
52
+
- max_connection_uses: unlimited
53
+
- health_check: none
54
+
- connect_timeout: 10.0s
55
+
- connect_retry_count: 3
56
+
- connect_retry_delay: 0.1s
57
+
- hooks: none
58
+
*)
59
+
60
+
(** {1 Accessors} *)
61
+
62
+
val max_connections_per_endpoint : t -> int
63
+
(** Get maximum connections per endpoint. *)
64
+
65
+
val max_idle_time : t -> float
66
+
(** Get maximum idle time in seconds. *)
67
+
68
+
val max_connection_lifetime : t -> float
69
+
(** Get maximum connection lifetime in seconds. *)
70
+
71
+
val max_connection_uses : t -> int option
72
+
(** Get maximum connection uses, if any. *)
73
+
74
+
val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option
75
+
(** Get custom health check function, if any. *)
76
+
77
+
val connect_timeout : t -> float option
78
+
(** Get connection timeout in seconds, if any. *)
79
+
80
+
val connect_retry_count : t -> int
81
+
(** Get number of connection retry attempts. *)
82
+
83
+
val connect_retry_delay : t -> float
84
+
(** Get initial retry delay in seconds. *)
85
+
86
+
val on_connection_created : t -> (Endpoint.t -> unit) option
87
+
(** Get connection created hook, if any. *)
88
+
89
+
val on_connection_closed : t -> (Endpoint.t -> unit) option
90
+
(** Get connection closed hook, if any. *)
91
+
92
+
val on_connection_reused : t -> (Endpoint.t -> unit) option
93
+
(** Get connection reused hook, if any. *)
94
+
95
+
(** {1 Pretty-printing} *)
96
+
97
+
val pp : t Fmt.t
98
+
(** Pretty-printer for configuration. *)
+24
lib/connection.ml
+24
lib/connection.ml
···
···
1
+
(** Internal connection representation - not exposed in public API *)
2
+
3
+
let src = Logs.Src.create "conpool.connection" ~doc:"Connection pool internal connection management"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
type t = {
7
+
flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;
8
+
created_at : float;
9
+
mutable last_used : float;
10
+
mutable use_count : int;
11
+
endpoint : Endpoint.t;
12
+
}
13
+
14
+
let flow t = t.flow
15
+
let endpoint t = t.endpoint
16
+
let created_at t = t.created_at
17
+
let last_used t = t.last_used
18
+
let use_count t = t.use_count
19
+
20
+
let pp ppf t =
21
+
Fmt.pf ppf "Connection(endpoint=%a, age=%.2fs, uses=%d)"
22
+
Endpoint.pp t.endpoint
23
+
(Unix.gettimeofday () -. t.created_at)
24
+
t.use_count
+104
-251
lib/conpool.ml
+104
-251
lib/conpool.ml
···
3
let src = Logs.Src.create "conpool" ~doc:"Connection pooling library"
4
module Log = (val Logs.src_log src : Logs.LOG)
5
6
-
module Endpoint = struct
7
-
type t = {
8
-
host : string;
9
-
port : int;
10
-
}
11
-
12
-
let make ~host ~port = { host; port }
13
-
14
-
let host t = t.host
15
-
let port t = t.port
16
-
17
-
let pp fmt t =
18
-
Format.fprintf fmt "%s:%d" t.host t.port
19
-
20
-
let equal t1 t2 =
21
-
String.equal t1.host t2.host && t1.port = t2.port
22
-
23
-
let hash t =
24
-
Hashtbl.hash (t.host, t.port)
25
-
end
26
-
27
-
module Tls_config = struct
28
-
type t = {
29
-
config : Tls.Config.client;
30
-
servername : string option;
31
-
}
32
-
33
-
let make ~config ?servername () = { config; servername }
34
-
35
-
let config t = t.config
36
-
let servername t = t.servername
37
-
38
-
let pp fmt t =
39
-
Format.fprintf fmt "TLS(servername=%s)"
40
-
(match t.servername with Some s -> s | None -> "<default>")
41
-
end
42
-
43
-
(* Internal connection type - not exposed in public API *)
44
-
module Connection = struct
45
-
type t = {
46
-
flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;
47
-
created_at : float;
48
-
mutable last_used : float;
49
-
mutable use_count : int;
50
-
endpoint : Endpoint.t;
51
-
}
52
-
53
-
let flow t = t.flow
54
-
let endpoint t = t.endpoint
55
-
let created_at t = t.created_at
56
-
let last_used t = t.last_used
57
-
let use_count t = t.use_count
58
-
end
59
-
60
-
module Config = struct
61
-
type t = {
62
-
max_connections_per_endpoint : int;
63
-
max_idle_time : float;
64
-
max_connection_lifetime : float;
65
-
max_connection_uses : int option;
66
-
health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option;
67
-
connect_timeout : float option;
68
-
connect_retry_count : int;
69
-
connect_retry_delay : float;
70
-
on_connection_created : (Endpoint.t -> unit) option;
71
-
on_connection_closed : (Endpoint.t -> unit) option;
72
-
on_connection_reused : (Endpoint.t -> unit) option;
73
-
}
74
-
75
-
let make
76
-
?(max_connections_per_endpoint = 10)
77
-
?(max_idle_time = 60.0)
78
-
?(max_connection_lifetime = 300.0)
79
-
?max_connection_uses
80
-
?health_check
81
-
?(connect_timeout = 10.0)
82
-
?(connect_retry_count = 3)
83
-
?(connect_retry_delay = 0.1)
84
-
?on_connection_created
85
-
?on_connection_closed
86
-
?on_connection_reused
87
-
() =
88
-
{
89
-
max_connections_per_endpoint;
90
-
max_idle_time;
91
-
max_connection_lifetime;
92
-
max_connection_uses;
93
-
health_check;
94
-
connect_timeout = Some connect_timeout;
95
-
connect_retry_count;
96
-
connect_retry_delay;
97
-
on_connection_created;
98
-
on_connection_closed;
99
-
on_connection_reused;
100
-
}
101
-
102
-
let default = make ()
103
-
104
-
let max_connections_per_endpoint t = t.max_connections_per_endpoint
105
-
let max_idle_time t = t.max_idle_time
106
-
let max_connection_lifetime t = t.max_connection_lifetime
107
-
let max_connection_uses t = t.max_connection_uses
108
-
let health_check t = t.health_check
109
-
let connect_timeout t = t.connect_timeout
110
-
let connect_retry_count t = t.connect_retry_count
111
-
let connect_retry_delay t = t.connect_retry_delay
112
-
113
-
let pp fmt t =
114
-
Format.fprintf fmt
115
-
"@[<v>Config:@,\
116
-
- max_connections_per_endpoint: %d@,\
117
-
- max_idle_time: %.1fs@,\
118
-
- max_connection_lifetime: %.1fs@,\
119
-
- max_connection_uses: %s@,\
120
-
- connect_timeout: %s@,\
121
-
- connect_retry_count: %d@,\
122
-
- connect_retry_delay: %.2fs@]"
123
-
t.max_connections_per_endpoint
124
-
t.max_idle_time
125
-
t.max_connection_lifetime
126
-
(match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited")
127
-
(match t.connect_timeout with Some f -> Printf.sprintf "%.1fs" f | None -> "none")
128
-
t.connect_retry_count
129
-
t.connect_retry_delay
130
-
end
131
-
132
-
module Stats = struct
133
-
type t = {
134
-
active : int;
135
-
idle : int;
136
-
total_created : int;
137
-
total_reused : int;
138
-
total_closed : int;
139
-
errors : int;
140
-
}
141
-
142
-
let active t = t.active
143
-
let idle t = t.idle
144
-
let total_created t = t.total_created
145
-
let total_reused t = t.total_reused
146
-
let total_closed t = t.total_closed
147
-
let errors t = t.errors
148
-
149
-
let pp fmt t =
150
-
Format.fprintf fmt
151
-
"@[<v>Stats:@,\
152
-
- Active: %d@,\
153
-
- Idle: %d@,\
154
-
- Created: %d@,\
155
-
- Reused: %d@,\
156
-
- Closed: %d@,\
157
-
- Errors: %d@]"
158
-
t.active
159
-
t.idle
160
-
t.total_created
161
-
t.total_reused
162
-
t.total_closed
163
-
t.errors
164
-
end
165
166
type endp_stats = {
167
mutable active : int;
···
178
mutex : Eio.Mutex.t;
179
}
180
181
-
type ('clock, 'net) t = {
182
sw : Eio.Switch.t;
183
net : 'net;
184
clock : 'clock;
···
188
endpoints_mutex : Eio.Mutex.t;
189
}
190
191
module EndpointTbl = Hashtbl.Make(struct
192
type t = Endpoint.t
193
let equal = Endpoint.equal
194
let hash = Endpoint.hash
195
end)
196
197
-
let get_time pool =
198
Eio.Time.now pool.clock
199
200
let create_endp_stats () = {
···
206
errors = 0;
207
}
208
209
-
let snapshot_stats (stats : endp_stats) : Stats.t = {
210
-
active = stats.active;
211
-
idle = stats.idle;
212
-
total_created = stats.total_created;
213
-
total_reused = stats.total_reused;
214
-
total_closed = stats.total_closed;
215
-
errors = stats.errors;
216
-
}
217
218
(** {1 DNS Resolution} *)
219
220
-
let resolve_endpoint pool endpoint =
221
Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint);
222
let addrs = Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint) ~service:(string_of_int (Endpoint.port endpoint)) in
223
Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);
···
232
233
(** {1 Connection Creation with Retry} *)
234
235
-
let rec create_connection_with_retry pool endpoint attempt =
236
-
if attempt > pool.config.connect_retry_count then begin
237
Log.err (fun m -> m "Failed to connect to %a after %d attempts"
238
-
Endpoint.pp endpoint pool.config.connect_retry_count);
239
failwith (Printf.sprintf "Failed to connect to %s:%d after %d attempts"
240
-
(Endpoint.host endpoint) (Endpoint.port endpoint) pool.config.connect_retry_count)
241
end;
242
243
Log.debug (fun m -> m "Connecting to %a (attempt %d/%d)"
244
-
Endpoint.pp endpoint attempt pool.config.connect_retry_count);
245
246
try
247
let addr = resolve_endpoint pool endpoint in
···
249
250
(* Connect with optional timeout *)
251
let socket =
252
-
match pool.config.connect_timeout with
253
| Some timeout ->
254
Eio.Time.with_timeout_exn pool.clock timeout
255
(fun () -> Eio.Net.connect ~sw:pool.sw pool.net addr)
···
286
| Eio.Time.Timeout ->
287
Log.warn (fun m -> m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);
288
(* Exponential backoff *)
289
-
let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in
290
Eio.Time.sleep pool.clock delay;
291
create_connection_with_retry pool endpoint (attempt + 1)
292
| e ->
293
(* Other errors - retry with backoff *)
294
Log.warn (fun m -> m "Connection attempt %d to %a failed: %s"
295
attempt Endpoint.pp endpoint (Printexc.to_string e));
296
-
if attempt < pool.config.connect_retry_count then (
297
-
let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in
298
Eio.Time.sleep pool.clock delay;
299
create_connection_with_retry pool endpoint (attempt + 1)
300
) else
301
raise e
302
303
-
let create_connection pool endpoint =
304
create_connection_with_retry pool endpoint 1
305
306
(** {1 Connection Validation} *)
307
308
-
let is_healthy pool ?(check_readable = false) conn =
309
let now = get_time pool in
310
311
(* Check age *)
312
let age = now -. Connection.created_at conn in
313
-
if age > pool.config.max_connection_lifetime then begin
314
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"
315
-
Endpoint.pp (Connection.endpoint conn) age pool.config.max_connection_lifetime);
316
false
317
end
318
319
(* Check idle time *)
320
-
else if (now -. Connection.last_used conn) > pool.config.max_idle_time then begin
321
-
let idle_time = now -. Connection.last_used conn in
322
-
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"
323
-
Endpoint.pp (Connection.endpoint conn) idle_time pool.config.max_idle_time);
324
-
false
325
-
end
326
327
-
(* Check use count *)
328
-
else if (match pool.config.max_connection_uses with
329
-
| Some max -> Connection.use_count conn >= max
330
-
| None -> false) then begin
331
-
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"
332
-
Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));
333
-
false
334
-
end
335
336
-
(* Optional: custom health check *)
337
-
else if (match pool.config.health_check with
338
-
| Some check ->
339
-
(try
340
-
let healthy = check (Connection.flow conn) in
341
-
if not healthy then
342
-
Log.debug (fun m -> m "Connection to %a failed custom health check"
343
-
Endpoint.pp (Connection.endpoint conn));
344
-
not healthy
345
-
with e ->
346
-
Log.debug (fun m -> m "Connection to %a health check raised exception: %s"
347
-
Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));
348
-
true) (* Exception in health check = unhealthy *)
349
-
| None -> false) then
350
-
false
351
352
-
(* Optional: check if socket still connected *)
353
-
else if check_readable then
354
-
try
355
-
(* TODO avsm: a sockopt for this? *)
356
true
357
-
with
358
-
| _ -> false
359
-
360
-
else begin
361
-
Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"
362
-
Endpoint.pp (Connection.endpoint conn)
363
-
age
364
-
(now -. Connection.last_used conn)
365
-
(Connection.use_count conn));
366
-
true
367
end
368
369
(** {1 Internal Pool Operations} *)
370
371
-
let close_internal pool conn =
372
Log.debug (fun m -> m "Closing connection to %a (age=%.2fs, uses=%d)"
373
Endpoint.pp (Connection.endpoint conn)
374
(get_time pool -. Connection.created_at conn)
···
381
);
382
383
(* Call hook if configured *)
384
-
Option.iter (fun f -> f (Connection.endpoint conn)) pool.config.on_connection_closed
385
386
-
let get_or_create_endpoint_pool pool endpoint =
387
Log.debug (fun m -> m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);
388
389
(* First try with read lock *)
···
408
let mutex = Eio.Mutex.create () in
409
410
Log.info (fun m -> m "Creating new endpoint pool for %a (max_connections=%d)"
411
-
Endpoint.pp endpoint pool.config.max_connections_per_endpoint);
412
413
Log.debug (fun m -> m "About to create Eio.Pool for %a" Endpoint.pp endpoint);
414
415
let eio_pool = Eio.Pool.create
416
-
pool.config.max_connections_per_endpoint
417
~validate:(fun conn ->
418
Log.debug (fun m -> m "Validate called for connection to %a" Endpoint.pp endpoint);
419
(* Called before reusing from pool *)
···
428
);
429
430
(* Call hook if configured *)
431
-
Option.iter (fun f -> f endpoint) pool.config.on_connection_reused;
432
433
(* Run health check if configured *)
434
-
match pool.config.health_check with
435
| Some check ->
436
(try check (Connection.flow conn)
437
with _ -> false)
···
465
);
466
467
(* Call hook if configured *)
468
-
Option.iter (fun f -> f endpoint) pool.config.on_connection_created;
469
470
conn
471
with e ->
···
494
495
(** {1 Public API - Pool Creation} *)
496
497
-
let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls ?(config = Config.default) () : ('clock Eio.Time.clock, 'net Eio.Net.t) t =
498
Log.info (fun m -> m "Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, max_lifetime=%.1fs)"
499
-
config.max_connections_per_endpoint
500
-
config.max_idle_time
501
-
config.max_connection_lifetime);
502
503
let pool = {
504
sw;
···
524
)
525
);
526
527
-
pool
528
529
(** {1 Public API - Connection Management} *)
530
531
-
let with_connection (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint f =
532
Log.debug (fun m -> m "Acquiring connection to %a" Endpoint.pp endpoint);
533
let ep_pool = get_or_create_endpoint_pool pool endpoint in
534
···
587
588
(** {1 Public API - Statistics} *)
589
590
-
let stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =
591
match Hashtbl.find_opt pool.endpoints endpoint with
592
| Some ep_pool ->
593
Eio.Mutex.use_ro ep_pool.mutex (fun () ->
···
595
)
596
| None ->
597
(* No pool for this endpoint yet *)
598
-
{
599
-
Stats.active = 0;
600
-
idle = 0;
601
-
total_created = 0;
602
-
total_reused = 0;
603
-
total_closed = 0;
604
-
errors = 0;
605
-
}
606
607
-
let all_stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) =
608
Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
609
Hashtbl.fold (fun endpoint ep_pool acc ->
610
let stats = Eio.Mutex.use_ro ep_pool.mutex (fun () ->
···
616
617
(** {1 Public API - Pool Management} *)
618
619
-
let clear_endpoint (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =
620
Log.info (fun m -> m "Clearing endpoint %a from pool" Endpoint.pp endpoint);
621
match Hashtbl.find_opt pool.endpoints endpoint with
622
| Some _ep_pool ->
···
3
let src = Logs.Src.create "conpool" ~doc:"Connection pooling library"
4
module Log = (val Logs.src_log src : Logs.LOG)
5
6
+
(* Re-export submodules *)
7
+
module Endpoint = Endpoint
8
+
module Tls_config = Tls_config
9
+
module Config = Config
10
+
module Stats = Stats
11
+
module Cmd = Cmd
12
13
type endp_stats = {
14
mutable active : int;
···
25
mutex : Eio.Mutex.t;
26
}
27
28
+
type ('clock, 'net) internal = {
29
sw : Eio.Switch.t;
30
net : 'net;
31
clock : 'clock;
···
35
endpoints_mutex : Eio.Mutex.t;
36
}
37
38
+
type t = T : ('clock Eio.Time.clock, 'net Eio.Net.t) internal -> t
39
+
40
module EndpointTbl = Hashtbl.Make(struct
41
type t = Endpoint.t
42
let equal = Endpoint.equal
43
let hash = Endpoint.hash
44
end)
45
46
+
let get_time (pool : ('clock, 'net) internal) =
47
Eio.Time.now pool.clock
48
49
let create_endp_stats () = {
···
55
errors = 0;
56
}
57
58
+
let snapshot_stats (stats : endp_stats) : Stats.t =
59
+
Stats.make
60
+
~active:stats.active
61
+
~idle:stats.idle
62
+
~total_created:stats.total_created
63
+
~total_reused:stats.total_reused
64
+
~total_closed:stats.total_closed
65
+
~errors:stats.errors
66
67
(** {1 DNS Resolution} *)
68
69
+
let resolve_endpoint (pool : ('clock, 'net) internal) endpoint =
70
Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint);
71
let addrs = Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint) ~service:(string_of_int (Endpoint.port endpoint)) in
72
Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);
···
81
82
(** {1 Connection Creation with Retry} *)
83
84
+
let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint attempt =
85
+
let retry_count = Config.connect_retry_count pool.config in
86
+
if attempt > retry_count then begin
87
Log.err (fun m -> m "Failed to connect to %a after %d attempts"
88
+
Endpoint.pp endpoint retry_count);
89
failwith (Printf.sprintf "Failed to connect to %s:%d after %d attempts"
90
+
(Endpoint.host endpoint) (Endpoint.port endpoint) retry_count)
91
end;
92
93
Log.debug (fun m -> m "Connecting to %a (attempt %d/%d)"
94
+
Endpoint.pp endpoint attempt retry_count);
95
96
try
97
let addr = resolve_endpoint pool endpoint in
···
99
100
(* Connect with optional timeout *)
101
let socket =
102
+
match Config.connect_timeout pool.config with
103
| Some timeout ->
104
Eio.Time.with_timeout_exn pool.clock timeout
105
(fun () -> Eio.Net.connect ~sw:pool.sw pool.net addr)
···
136
| Eio.Time.Timeout ->
137
Log.warn (fun m -> m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);
138
(* Exponential backoff *)
139
+
let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in
140
Eio.Time.sleep pool.clock delay;
141
create_connection_with_retry pool endpoint (attempt + 1)
142
| e ->
143
(* Other errors - retry with backoff *)
144
Log.warn (fun m -> m "Connection attempt %d to %a failed: %s"
145
attempt Endpoint.pp endpoint (Printexc.to_string e));
146
+
if attempt < Config.connect_retry_count pool.config then (
147
+
let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in
148
Eio.Time.sleep pool.clock delay;
149
create_connection_with_retry pool endpoint (attempt + 1)
150
) else
151
raise e
152
153
+
let create_connection (pool : ('clock, 'net) internal) endpoint =
154
create_connection_with_retry pool endpoint 1
155
156
(** {1 Connection Validation} *)
157
158
+
let is_healthy (pool : ('clock, 'net) internal) ?(check_readable = false) conn =
159
let now = get_time pool in
160
161
(* Check age *)
162
let age = now -. Connection.created_at conn in
163
+
let max_lifetime = Config.max_connection_lifetime pool.config in
164
+
if age > max_lifetime then begin
165
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"
166
+
Endpoint.pp (Connection.endpoint conn) age max_lifetime);
167
false
168
end
169
170
(* Check idle time *)
171
+
else begin
172
+
let max_idle = Config.max_idle_time pool.config in
173
+
if (now -. Connection.last_used conn) > max_idle then begin
174
+
let idle_time = now -. Connection.last_used conn in
175
+
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"
176
+
Endpoint.pp (Connection.endpoint conn) idle_time max_idle);
177
+
false
178
+
end
179
180
+
(* Check use count *)
181
+
else if (match Config.max_connection_uses pool.config with
182
+
| Some max -> Connection.use_count conn >= max
183
+
| None -> false) then begin
184
+
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"
185
+
Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));
186
+
false
187
+
end
188
189
+
(* Optional: custom health check *)
190
+
else if (match Config.health_check pool.config with
191
+
| Some check ->
192
+
(try
193
+
let healthy = check (Connection.flow conn) in
194
+
if not healthy then
195
+
Log.debug (fun m -> m "Connection to %a failed custom health check"
196
+
Endpoint.pp (Connection.endpoint conn));
197
+
not healthy
198
+
with e ->
199
+
Log.debug (fun m -> m "Connection to %a health check raised exception: %s"
200
+
Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));
201
+
true) (* Exception in health check = unhealthy *)
202
+
| None -> false) then
203
+
false
204
+
205
+
(* Optional: check if socket still connected *)
206
+
else if check_readable then
207
+
try
208
+
(* TODO avsm: a sockopt for this? *)
209
+
true
210
+
with
211
+
| _ -> false
212
213
+
else begin
214
+
Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"
215
+
Endpoint.pp (Connection.endpoint conn)
216
+
age
217
+
(now -. Connection.last_used conn)
218
+
(Connection.use_count conn));
219
true
220
+
end
221
end
222
223
(** {1 Internal Pool Operations} *)
224
225
+
let close_internal (pool : ('clock, 'net) internal) conn =
226
Log.debug (fun m -> m "Closing connection to %a (age=%.2fs, uses=%d)"
227
Endpoint.pp (Connection.endpoint conn)
228
(get_time pool -. Connection.created_at conn)
···
235
);
236
237
(* Call hook if configured *)
238
+
Option.iter (fun f -> f (Connection.endpoint conn)) (Config.on_connection_closed pool.config)
239
240
+
let get_or_create_endpoint_pool (pool : ('clock, 'net) internal) endpoint =
241
Log.debug (fun m -> m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);
242
243
(* First try with read lock *)
···
262
let mutex = Eio.Mutex.create () in
263
264
Log.info (fun m -> m "Creating new endpoint pool for %a (max_connections=%d)"
265
+
Endpoint.pp endpoint (Config.max_connections_per_endpoint pool.config));
266
267
Log.debug (fun m -> m "About to create Eio.Pool for %a" Endpoint.pp endpoint);
268
269
let eio_pool = Eio.Pool.create
270
+
(Config.max_connections_per_endpoint pool.config)
271
~validate:(fun conn ->
272
Log.debug (fun m -> m "Validate called for connection to %a" Endpoint.pp endpoint);
273
(* Called before reusing from pool *)
···
282
);
283
284
(* Call hook if configured *)
285
+
Option.iter (fun f -> f endpoint) (Config.on_connection_reused pool.config);
286
287
(* Run health check if configured *)
288
+
match Config.health_check pool.config with
289
| Some check ->
290
(try check (Connection.flow conn)
291
with _ -> false)
···
319
);
320
321
(* Call hook if configured *)
322
+
Option.iter (fun f -> f endpoint) (Config.on_connection_created pool.config);
323
324
conn
325
with e ->
···
348
349
(** {1 Public API - Pool Creation} *)
350
351
+
let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls ?(config = Config.default) () : t =
352
Log.info (fun m -> m "Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, max_lifetime=%.1fs)"
353
+
(Config.max_connections_per_endpoint config)
354
+
(Config.max_idle_time config)
355
+
(Config.max_connection_lifetime config));
356
357
let pool = {
358
sw;
···
378
)
379
);
380
381
+
T pool
382
383
(** {1 Public API - Connection Management} *)
384
385
+
let with_connection (T pool) endpoint f =
386
Log.debug (fun m -> m "Acquiring connection to %a" Endpoint.pp endpoint);
387
let ep_pool = get_or_create_endpoint_pool pool endpoint in
388
···
441
442
(** {1 Public API - Statistics} *)
443
444
+
let stats (T pool) endpoint =
445
match Hashtbl.find_opt pool.endpoints endpoint with
446
| Some ep_pool ->
447
Eio.Mutex.use_ro ep_pool.mutex (fun () ->
···
449
)
450
| None ->
451
(* No pool for this endpoint yet *)
452
+
Stats.make
453
+
~active:0
454
+
~idle:0
455
+
~total_created:0
456
+
~total_reused:0
457
+
~total_closed:0
458
+
~errors:0
459
460
+
let all_stats (T pool) =
461
Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
462
Hashtbl.fold (fun endpoint ep_pool acc ->
463
let stats = Eio.Mutex.use_ro ep_pool.mutex (fun () ->
···
469
470
(** {1 Public API - Pool Management} *)
471
472
+
let clear_endpoint (T pool) endpoint =
473
Log.info (fun m -> m "Clearing endpoint %a from pool" Endpoint.pp endpoint);
474
match Hashtbl.find_opt pool.endpoints endpoint with
475
| Some _ep_pool ->
+23
-121
lib/conpool.mli
+23
-121
lib/conpool.mli
···
3
(** {1 Logging} *)
4
5
val src : Logs.Src.t
6
-
(** Logs source for conpool. Configure logging with:
7
{[
8
Logs.Src.set_level Conpool.src (Some Logs.Debug);
9
Logs.set_reporter (Logs_fmt.reporter ());
10
]}
11
*)
12
13
(** {1 Core Types} *)
14
15
-
(** Network endpoint *)
16
-
module Endpoint : sig
17
-
type t
18
-
(** Network endpoint identified by host and port *)
19
-
20
-
val make : host:string -> port:int -> t
21
-
(** Create an endpoint *)
22
-
23
-
val host : t -> string
24
-
(** Get the hostname *)
25
-
26
-
val port : t -> int
27
-
(** Get the port number *)
28
-
29
-
val pp : Format.formatter -> t -> unit
30
-
(** Pretty-print an endpoint *)
31
-
32
-
val equal : t -> t -> bool
33
-
(** Compare two endpoints for equality *)
34
-
35
-
val hash : t -> int
36
-
(** Hash an endpoint *)
37
-
end
38
-
39
-
(** TLS configuration *)
40
-
module Tls_config : sig
41
-
type t
42
-
(** TLS configuration applied to all connections in a pool *)
43
-
44
-
val make : config:Tls.Config.client -> ?servername:string -> unit -> t
45
-
(** Create TLS configuration.
46
-
@param config TLS client configuration
47
-
@param servername Optional SNI server name override. If None, uses endpoint host *)
48
-
49
-
val config : t -> Tls.Config.client
50
-
(** Get the TLS client configuration *)
51
-
52
-
val servername : t -> string option
53
-
(** Get the SNI server name override *)
54
-
55
-
val pp : Format.formatter -> t -> unit
56
-
(** Pretty-print TLS configuration *)
57
-
end
58
-
59
-
60
-
(** Pool configuration *)
61
-
module Config : sig
62
-
type t
63
-
(** Pool configuration *)
64
-
65
-
val make :
66
-
?max_connections_per_endpoint:int ->
67
-
?max_idle_time:float ->
68
-
?max_connection_lifetime:float ->
69
-
?max_connection_uses:int ->
70
-
?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->
71
-
?connect_timeout:float ->
72
-
?connect_retry_count:int ->
73
-
?connect_retry_delay:float ->
74
-
?on_connection_created:(Endpoint.t -> unit) ->
75
-
?on_connection_closed:(Endpoint.t -> unit) ->
76
-
?on_connection_reused:(Endpoint.t -> unit) ->
77
-
unit -> t
78
-
(** Create pool configuration with optional parameters.
79
-
See field descriptions for defaults. *)
80
-
81
-
val default : t
82
-
(** Sensible defaults for most use cases:
83
-
- max_connections_per_endpoint: 10
84
-
- max_idle_time: 60.0s
85
-
- max_connection_lifetime: 300.0s
86
-
- max_connection_uses: None (unlimited)
87
-
- health_check: None
88
-
- connect_timeout: 10.0s
89
-
- connect_retry_count: 3
90
-
- connect_retry_delay: 0.1s
91
-
- hooks: None *)
92
-
93
-
val max_connections_per_endpoint : t -> int
94
-
val max_idle_time : t -> float
95
-
val max_connection_lifetime : t -> float
96
-
val max_connection_uses : t -> int option
97
-
val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option
98
-
val connect_timeout : t -> float option
99
-
val connect_retry_count : t -> int
100
-
val connect_retry_delay : t -> float
101
-
102
-
val pp : Format.formatter -> t -> unit
103
-
(** Pretty-print configuration *)
104
-
end
105
-
106
-
(** Statistics for an endpoint *)
107
-
module Stats : sig
108
-
type t
109
-
(** Statistics for a specific endpoint *)
110
-
111
-
val active : t -> int
112
-
(** Connections currently in use *)
113
-
114
-
val idle : t -> int
115
-
(** Connections in pool waiting to be reused *)
116
117
-
val total_created : t -> int
118
-
(** Total connections created (lifetime) *)
119
-
120
-
val total_reused : t -> int
121
-
(** Total times connections were reused *)
122
123
-
val total_closed : t -> int
124
-
(** Total connections closed *)
125
126
-
val errors : t -> int
127
-
(** Total connection errors *)
128
129
-
val pp : Format.formatter -> t -> unit
130
-
(** Pretty-print endpoint statistics *)
131
-
end
132
133
(** {1 Connection Pool} *)
134
135
-
type ('clock, 'net) t
136
-
(** Connection pool managing multiple endpoints, parameterized by clock and network types *)
137
138
val create :
139
sw:Eio.Switch.t ->
···
141
clock:'clock Eio.Time.clock ->
142
?tls:Tls_config.t ->
143
?config:Config.t ->
144
-
unit -> ('clock Eio.Time.clock, 'net Eio.Net.t) t
145
(** Create connection pool bound to switch.
146
All connections will be closed when switch is released.
147
···
154
(** {1 Connection Usage} *)
155
156
val with_connection :
157
-
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
158
Endpoint.t ->
159
([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> 'a) ->
160
'a
···
186
(** {1 Statistics & Monitoring} *)
187
188
val stats :
189
-
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
190
Endpoint.t ->
191
Stats.t
192
(** Get statistics for specific endpoint *)
193
194
val all_stats :
195
-
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
196
(Endpoint.t * Stats.t) list
197
(** Get statistics for all endpoints in pool *)
198
199
(** {1 Pool Management} *)
200
201
val clear_endpoint :
202
-
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
203
Endpoint.t ->
204
unit
205
(** Clear all cached connections for a specific endpoint.
···
3
(** {1 Logging} *)
4
5
val src : Logs.Src.t
6
+
(** Logs source for the main connection pool. Configure logging with:
7
{[
8
Logs.Src.set_level Conpool.src (Some Logs.Debug);
9
Logs.set_reporter (Logs_fmt.reporter ());
10
]}
11
+
12
+
Each submodule also exposes its own log source for fine-grained control:
13
+
- {!Endpoint.src} - endpoint operations
14
+
- {!Tls_config.src} - TLS configuration
15
+
- {!Config.src} - pool configuration
16
*)
17
18
(** {1 Core Types} *)
19
20
+
(** Network endpoint representation *)
21
+
module Endpoint : module type of Endpoint
22
23
+
(** TLS configuration for connection pools *)
24
+
module Tls_config : module type of Tls_config
25
26
+
(** Configuration for connection pools *)
27
+
module Config : module type of Config
28
29
+
(** Statistics for connection pool endpoints *)
30
+
module Stats : module type of Stats
31
32
+
(** Cmdliner terms for connection pool configuration *)
33
+
module Cmd : module type of Cmd
34
35
(** {1 Connection Pool} *)
36
37
+
type t
38
+
(** Connection pool managing multiple endpoints *)
39
40
val create :
41
sw:Eio.Switch.t ->
···
43
clock:'clock Eio.Time.clock ->
44
?tls:Tls_config.t ->
45
?config:Config.t ->
46
+
unit -> t
47
(** Create connection pool bound to switch.
48
All connections will be closed when switch is released.
49
···
56
(** {1 Connection Usage} *)
57
58
val with_connection :
59
+
t ->
60
Endpoint.t ->
61
([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> 'a) ->
62
'a
···
88
(** {1 Statistics & Monitoring} *)
89
90
val stats :
91
+
t ->
92
Endpoint.t ->
93
Stats.t
94
(** Get statistics for specific endpoint *)
95
96
val all_stats :
97
+
t ->
98
(Endpoint.t * Stats.t) list
99
(** Get statistics for all endpoints in pool *)
100
101
(** {1 Pool Management} *)
102
103
val clear_endpoint :
104
+
t ->
105
Endpoint.t ->
106
unit
107
(** Clear all cached connections for a specific endpoint.
+1
-1
lib/dune
+1
-1
lib/dune
+24
lib/endpoint.ml
+24
lib/endpoint.ml
···
···
1
+
(** Network endpoint representation *)
2
+
3
+
let src = Logs.Src.create "conpool.endpoint" ~doc:"Connection pool endpoint operations"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
type t = {
7
+
host : string;
8
+
port : int;
9
+
}
10
+
11
+
let make ~host ~port =
12
+
Log.debug (fun m -> m "Creating endpoint: %s:%d" host port);
13
+
{ host; port }
14
+
15
+
let host t = t.host
16
+
let port t = t.port
17
+
18
+
let equal t1 t2 =
19
+
String.equal t1.host t2.host && t1.port = t2.port
20
+
21
+
let hash t =
22
+
Hashtbl.hash (t.host, t.port)
23
+
24
+
let pp = Fmt.of_to_string (fun t -> Printf.sprintf "%s:%d" t.host t.port)
+41
lib/endpoint.mli
+41
lib/endpoint.mli
···
···
1
+
(** Network endpoint representation *)
2
+
3
+
(** {1 Logging} *)
4
+
5
+
val src : Logs.Src.t
6
+
(** Logs source for endpoint operations. Configure logging with:
7
+
{[
8
+
Logs.Src.set_level Conpool.Endpoint.src (Some Logs.Debug);
9
+
]}
10
+
*)
11
+
12
+
(** {1 Type} *)
13
+
14
+
type t
15
+
(** Network endpoint identified by host and port *)
16
+
17
+
(** {1 Construction} *)
18
+
19
+
val make : host:string -> port:int -> t
20
+
(** Create an endpoint from a hostname and port. *)
21
+
22
+
(** {1 Accessors} *)
23
+
24
+
val host : t -> string
25
+
(** Get the hostname from an endpoint. *)
26
+
27
+
val port : t -> int
28
+
(** Get the port number from an endpoint. *)
29
+
30
+
(** {1 Comparison and Hashing} *)
31
+
32
+
val equal : t -> t -> bool
33
+
(** Compare two endpoints for equality. *)
34
+
35
+
val hash : t -> int
36
+
(** Hash an endpoint for use in hash tables. *)
37
+
38
+
(** {1 Pretty-printing} *)
39
+
40
+
val pp : t Fmt.t
41
+
(** Pretty-printer for endpoints. Formats as "host:port". *)
+36
lib/stats.ml
+36
lib/stats.ml
···
···
1
+
(** Statistics for connection pool endpoints *)
2
+
3
+
type t = {
4
+
active : int;
5
+
idle : int;
6
+
total_created : int;
7
+
total_reused : int;
8
+
total_closed : int;
9
+
errors : int;
10
+
}
11
+
12
+
let make ~active ~idle ~total_created ~total_reused ~total_closed ~errors =
13
+
{ active; idle; total_created; total_reused; total_closed; errors }
14
+
15
+
let active t = t.active
16
+
let idle t = t.idle
17
+
let total_created t = t.total_created
18
+
let total_reused t = t.total_reused
19
+
let total_closed t = t.total_closed
20
+
let errors t = t.errors
21
+
22
+
let pp ppf t =
23
+
Fmt.pf ppf
24
+
"@[<v>Stats:@,\
25
+
- Active: %d@,\
26
+
- Idle: %d@,\
27
+
- Created: %d@,\
28
+
- Reused: %d@,\
29
+
- Closed: %d@,\
30
+
- Errors: %d@]"
31
+
t.active
32
+
t.idle
33
+
t.total_created
34
+
t.total_reused
35
+
t.total_closed
36
+
t.errors
+43
lib/stats.mli
+43
lib/stats.mli
···
···
1
+
(** Statistics for connection pool endpoints *)
2
+
3
+
(** {1 Type} *)
4
+
5
+
type t
6
+
(** Statistics snapshot for a specific endpoint *)
7
+
8
+
(** {1 Construction} *)
9
+
10
+
val make :
11
+
active:int ->
12
+
idle:int ->
13
+
total_created:int ->
14
+
total_reused:int ->
15
+
total_closed:int ->
16
+
errors:int ->
17
+
t
18
+
(** Create a statistics snapshot. *)
19
+
20
+
(** {1 Accessors} *)
21
+
22
+
val active : t -> int
23
+
(** Number of connections currently in use. *)
24
+
25
+
val idle : t -> int
26
+
(** Number of connections in pool waiting to be reused. *)
27
+
28
+
val total_created : t -> int
29
+
(** Total connections created over the endpoint's lifetime. *)
30
+
31
+
val total_reused : t -> int
32
+
(** Total number of times connections were reused from the pool. *)
33
+
34
+
val total_closed : t -> int
35
+
(** Total connections that have been closed. *)
36
+
37
+
val errors : t -> int
38
+
(** Total connection errors encountered. *)
39
+
40
+
(** {1 Pretty-printing} *)
41
+
42
+
val pp : t Fmt.t
43
+
(** Pretty-printer for statistics. *)
+22
lib/tls_config.ml
+22
lib/tls_config.ml
···
···
1
+
(** TLS configuration for connection pools *)
2
+
3
+
let src = Logs.Src.create "conpool.tls" ~doc:"Connection pool TLS configuration"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
type t = {
7
+
config : Tls.Config.client;
8
+
servername : string option;
9
+
}
10
+
11
+
let make ~config ?servername () =
12
+
Log.debug (fun m ->
13
+
m "Creating TLS config with servername: %s"
14
+
(match servername with Some s -> s | None -> "<default>"));
15
+
{ config; servername }
16
+
17
+
let config t = t.config
18
+
let servername t = t.servername
19
+
20
+
let pp ppf t =
21
+
Fmt.pf ppf "TLS(servername=%s)"
22
+
(match t.servername with Some s -> s | None -> "<default>")
+37
lib/tls_config.mli
+37
lib/tls_config.mli
···
···
1
+
(** TLS configuration for connection pools *)
2
+
3
+
(** {1 Logging} *)
4
+
5
+
val src : Logs.Src.t
6
+
(** Logs source for TLS configuration operations. Configure logging with:
7
+
{[
8
+
Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug);
9
+
]}
10
+
*)
11
+
12
+
(** {1 Type} *)
13
+
14
+
type t
15
+
(** TLS configuration applied to all connections in a pool *)
16
+
17
+
(** {1 Construction} *)
18
+
19
+
val make : config:Tls.Config.client -> ?servername:string -> unit -> t
20
+
(** Create TLS configuration.
21
+
22
+
@param config TLS client configuration for all connections
23
+
@param servername Optional SNI server name override. If [None], uses the endpoint's hostname
24
+
*)
25
+
26
+
(** {1 Accessors} *)
27
+
28
+
val config : t -> Tls.Config.client
29
+
(** Get the TLS client configuration. *)
30
+
31
+
val servername : t -> string option
32
+
(** Get the SNI server name override, if any. *)
33
+
34
+
(** {1 Pretty-printing} *)
35
+
36
+
val pp : t Fmt.t
37
+
(** Pretty-printer for TLS configuration. *)