···11+(** Cmdliner terms for connection pool configuration *)
22+33+open Cmdliner
44+55+let max_connections_per_endpoint =
66+ let doc = "Maximum concurrent connections per endpoint." in
77+ Arg.(value & opt int 10 & info ["max-connections-per-endpoint"] ~doc ~docv:"NUM")
88+99+let max_idle_time =
1010+ let doc = "Maximum time a connection can sit idle in seconds." in
1111+ Arg.(value & opt float 60.0 & info ["max-idle-time"] ~doc ~docv:"SECONDS")
1212+1313+let max_connection_lifetime =
1414+ let doc = "Maximum connection age in seconds." in
1515+ Arg.(value & opt float 300.0 & info ["max-connection-lifetime"] ~doc ~docv:"SECONDS")
1616+1717+let max_connection_uses =
1818+ let doc = "Maximum times a connection can be reused (omit for unlimited)." in
1919+ Arg.(value & opt (some int) None & info ["max-connection-uses"] ~doc ~docv:"NUM")
2020+2121+let connect_timeout =
2222+ let doc = "Connection timeout in seconds." in
2323+ Arg.(value & opt float 10.0 & info ["connect-timeout"] ~doc ~docv:"SECONDS")
2424+2525+let connect_retry_count =
2626+ let doc = "Number of connection retry attempts." in
2727+ Arg.(value & opt int 3 & info ["connect-retry-count"] ~doc ~docv:"NUM")
2828+2929+let connect_retry_delay =
3030+ let doc = "Initial retry delay in seconds (with exponential backoff)." in
3131+ Arg.(value & opt float 0.1 & info ["connect-retry-delay"] ~doc ~docv:"SECONDS")
3232+3333+let config =
3434+ let make max_conn max_idle max_lifetime max_uses timeout retry_count retry_delay =
3535+ Config.make
3636+ ~max_connections_per_endpoint:max_conn
3737+ ~max_idle_time:max_idle
3838+ ~max_connection_lifetime:max_lifetime
3939+ ?max_connection_uses:max_uses
4040+ ~connect_timeout:timeout
4141+ ~connect_retry_count:retry_count
4242+ ~connect_retry_delay:retry_delay
4343+ ()
4444+ in
4545+ Term.(const make
4646+ $ max_connections_per_endpoint
4747+ $ max_idle_time
4848+ $ max_connection_lifetime
4949+ $ max_connection_uses
5050+ $ connect_timeout
5151+ $ connect_retry_count
5252+ $ connect_retry_delay)
+45
lib/cmd.mli
···11+(** Cmdliner terms for connection pool configuration *)
22+33+(** {1 Configuration Terms} *)
44+55+val max_connections_per_endpoint : int Cmdliner.Term.t
66+(** Cmdliner term for maximum connections per endpoint.
77+ Default: 10
88+ Flag: [--max-connections-per-endpoint] *)
99+1010+val max_idle_time : float Cmdliner.Term.t
1111+(** Cmdliner term for maximum idle time in seconds.
1212+ Default: 60.0
1313+ Flag: [--max-idle-time] *)
1414+1515+val max_connection_lifetime : float Cmdliner.Term.t
1616+(** Cmdliner term for maximum connection lifetime in seconds.
1717+ Default: 300.0
1818+ Flag: [--max-connection-lifetime] *)
1919+2020+val max_connection_uses : int option Cmdliner.Term.t
2121+(** Cmdliner term for maximum connection uses.
2222+ Default: None (unlimited)
2323+ Flag: [--max-connection-uses] *)
2424+2525+val connect_timeout : float Cmdliner.Term.t
2626+(** Cmdliner term for connection timeout in seconds.
2727+ Default: 10.0
2828+ Flag: [--connect-timeout] *)
2929+3030+val connect_retry_count : int Cmdliner.Term.t
3131+(** Cmdliner term for number of connection retry attempts.
3232+ Default: 3
3333+ Flag: [--connect-retry-count] *)
3434+3535+val connect_retry_delay : float Cmdliner.Term.t
3636+(** Cmdliner term for initial retry delay in seconds.
3737+ Default: 0.1
3838+ Flag: [--connect-retry-delay] *)
3939+4040+(** {1 Combined Terms} *)
4141+4242+val config : Config.t Cmdliner.Term.t
4343+(** Cmdliner term that combines all configuration options into a {!Config.t}.
4444+ This term can be used in your application's main command to accept
4545+ all connection pool configuration options from the command line. *)
···11+(** Configuration for connection pools *)
22+33+(** {1 Logging} *)
44+55+val src : Logs.Src.t
66+(** Logs source for configuration operations. Configure logging with:
77+ {[
88+ Logs.Src.set_level Conpool.Config.src (Some Logs.Debug);
99+ ]}
1010+*)
1111+1212+(** {1 Type} *)
1313+1414+type t
1515+(** Pool configuration *)
1616+1717+(** {1 Construction} *)
1818+1919+val make :
2020+ ?max_connections_per_endpoint:int ->
2121+ ?max_idle_time:float ->
2222+ ?max_connection_lifetime:float ->
2323+ ?max_connection_uses:int ->
2424+ ?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->
2525+ ?connect_timeout:float ->
2626+ ?connect_retry_count:int ->
2727+ ?connect_retry_delay:float ->
2828+ ?on_connection_created:(Endpoint.t -> unit) ->
2929+ ?on_connection_closed:(Endpoint.t -> unit) ->
3030+ ?on_connection_reused:(Endpoint.t -> unit) ->
3131+ unit -> t
3232+(** Create pool configuration with optional parameters.
3333+3434+ @param max_connections_per_endpoint Maximum concurrent connections per endpoint (default: 10)
3535+ @param max_idle_time Maximum time a connection can sit idle in seconds (default: 60.0)
3636+ @param max_connection_lifetime Maximum connection age in seconds (default: 300.0)
3737+ @param max_connection_uses Maximum times a connection can be reused (default: unlimited)
3838+ @param health_check Custom health check function (default: none)
3939+ @param connect_timeout Connection timeout in seconds (default: 10.0)
4040+ @param connect_retry_count Number of connection retry attempts (default: 3)
4141+ @param connect_retry_delay Initial retry delay in seconds, with exponential backoff (default: 0.1)
4242+ @param on_connection_created Hook called when a connection is created
4343+ @param on_connection_closed Hook called when a connection is closed
4444+ @param on_connection_reused Hook called when a connection is reused
4545+*)
4646+4747+val default : t
4848+(** Sensible defaults for most use cases:
4949+ - max_connections_per_endpoint: 10
5050+ - max_idle_time: 60.0s
5151+ - max_connection_lifetime: 300.0s
5252+ - max_connection_uses: unlimited
5353+ - health_check: none
5454+ - connect_timeout: 10.0s
5555+ - connect_retry_count: 3
5656+ - connect_retry_delay: 0.1s
5757+ - hooks: none
5858+*)
5959+6060+(** {1 Accessors} *)
6161+6262+val max_connections_per_endpoint : t -> int
6363+(** Get maximum connections per endpoint. *)
6464+6565+val max_idle_time : t -> float
6666+(** Get maximum idle time in seconds. *)
6767+6868+val max_connection_lifetime : t -> float
6969+(** Get maximum connection lifetime in seconds. *)
7070+7171+val max_connection_uses : t -> int option
7272+(** Get maximum connection uses, if any. *)
7373+7474+val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option
7575+(** Get custom health check function, if any. *)
7676+7777+val connect_timeout : t -> float option
7878+(** Get connection timeout in seconds, if any. *)
7979+8080+val connect_retry_count : t -> int
8181+(** Get number of connection retry attempts. *)
8282+8383+val connect_retry_delay : t -> float
8484+(** Get initial retry delay in seconds. *)
8585+8686+val on_connection_created : t -> (Endpoint.t -> unit) option
8787+(** Get connection created hook, if any. *)
8888+8989+val on_connection_closed : t -> (Endpoint.t -> unit) option
9090+(** Get connection closed hook, if any. *)
9191+9292+val on_connection_reused : t -> (Endpoint.t -> unit) option
9393+(** Get connection reused hook, if any. *)
9494+9595+(** {1 Pretty-printing} *)
9696+9797+val pp : t Fmt.t
9898+(** Pretty-printer for configuration. *)
+24
lib/connection.ml
···11+(** Internal connection representation - not exposed in public API *)
22+33+let src = Logs.Src.create "conpool.connection" ~doc:"Connection pool internal connection management"
44+module Log = (val Logs.src_log src : Logs.LOG)
55+66+type t = {
77+ flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;
88+ created_at : float;
99+ mutable last_used : float;
1010+ mutable use_count : int;
1111+ endpoint : Endpoint.t;
1212+}
1313+1414+let flow t = t.flow
1515+let endpoint t = t.endpoint
1616+let created_at t = t.created_at
1717+let last_used t = t.last_used
1818+let use_count t = t.use_count
1919+2020+let pp ppf t =
2121+ Fmt.pf ppf "Connection(endpoint=%a, age=%.2fs, uses=%d)"
2222+ Endpoint.pp t.endpoint
2323+ (Unix.gettimeofday () -. t.created_at)
2424+ t.use_count
+104-251
lib/conpool.ml
···33let src = Logs.Src.create "conpool" ~doc:"Connection pooling library"
44module Log = (val Logs.src_log src : Logs.LOG)
5566-module Endpoint = struct
77- type t = {
88- host : string;
99- port : int;
1010- }
1111-1212- let make ~host ~port = { host; port }
1313-1414- let host t = t.host
1515- let port t = t.port
1616-1717- let pp fmt t =
1818- Format.fprintf fmt "%s:%d" t.host t.port
1919-2020- let equal t1 t2 =
2121- String.equal t1.host t2.host && t1.port = t2.port
2222-2323- let hash t =
2424- Hashtbl.hash (t.host, t.port)
2525-end
2626-2727-module Tls_config = struct
2828- type t = {
2929- config : Tls.Config.client;
3030- servername : string option;
3131- }
3232-3333- let make ~config ?servername () = { config; servername }
3434-3535- let config t = t.config
3636- let servername t = t.servername
3737-3838- let pp fmt t =
3939- Format.fprintf fmt "TLS(servername=%s)"
4040- (match t.servername with Some s -> s | None -> "<default>")
4141-end
4242-4343-(* Internal connection type - not exposed in public API *)
4444-module Connection = struct
4545- type t = {
4646- flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;
4747- created_at : float;
4848- mutable last_used : float;
4949- mutable use_count : int;
5050- endpoint : Endpoint.t;
5151- }
5252-5353- let flow t = t.flow
5454- let endpoint t = t.endpoint
5555- let created_at t = t.created_at
5656- let last_used t = t.last_used
5757- let use_count t = t.use_count
5858-end
5959-6060-module Config = struct
6161- type t = {
6262- max_connections_per_endpoint : int;
6363- max_idle_time : float;
6464- max_connection_lifetime : float;
6565- max_connection_uses : int option;
6666- health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option;
6767- connect_timeout : float option;
6868- connect_retry_count : int;
6969- connect_retry_delay : float;
7070- on_connection_created : (Endpoint.t -> unit) option;
7171- on_connection_closed : (Endpoint.t -> unit) option;
7272- on_connection_reused : (Endpoint.t -> unit) option;
7373- }
7474-7575- let make
7676- ?(max_connections_per_endpoint = 10)
7777- ?(max_idle_time = 60.0)
7878- ?(max_connection_lifetime = 300.0)
7979- ?max_connection_uses
8080- ?health_check
8181- ?(connect_timeout = 10.0)
8282- ?(connect_retry_count = 3)
8383- ?(connect_retry_delay = 0.1)
8484- ?on_connection_created
8585- ?on_connection_closed
8686- ?on_connection_reused
8787- () =
8888- {
8989- max_connections_per_endpoint;
9090- max_idle_time;
9191- max_connection_lifetime;
9292- max_connection_uses;
9393- health_check;
9494- connect_timeout = Some connect_timeout;
9595- connect_retry_count;
9696- connect_retry_delay;
9797- on_connection_created;
9898- on_connection_closed;
9999- on_connection_reused;
100100- }
101101-102102- let default = make ()
103103-104104- let max_connections_per_endpoint t = t.max_connections_per_endpoint
105105- let max_idle_time t = t.max_idle_time
106106- let max_connection_lifetime t = t.max_connection_lifetime
107107- let max_connection_uses t = t.max_connection_uses
108108- let health_check t = t.health_check
109109- let connect_timeout t = t.connect_timeout
110110- let connect_retry_count t = t.connect_retry_count
111111- let connect_retry_delay t = t.connect_retry_delay
112112-113113- let pp fmt t =
114114- Format.fprintf fmt
115115- "@[<v>Config:@,\
116116- - max_connections_per_endpoint: %d@,\
117117- - max_idle_time: %.1fs@,\
118118- - max_connection_lifetime: %.1fs@,\
119119- - max_connection_uses: %s@,\
120120- - connect_timeout: %s@,\
121121- - connect_retry_count: %d@,\
122122- - connect_retry_delay: %.2fs@]"
123123- t.max_connections_per_endpoint
124124- t.max_idle_time
125125- t.max_connection_lifetime
126126- (match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited")
127127- (match t.connect_timeout with Some f -> Printf.sprintf "%.1fs" f | None -> "none")
128128- t.connect_retry_count
129129- t.connect_retry_delay
130130-end
131131-132132-module Stats = struct
133133- type t = {
134134- active : int;
135135- idle : int;
136136- total_created : int;
137137- total_reused : int;
138138- total_closed : int;
139139- errors : int;
140140- }
141141-142142- let active t = t.active
143143- let idle t = t.idle
144144- let total_created t = t.total_created
145145- let total_reused t = t.total_reused
146146- let total_closed t = t.total_closed
147147- let errors t = t.errors
148148-149149- let pp fmt t =
150150- Format.fprintf fmt
151151- "@[<v>Stats:@,\
152152- - Active: %d@,\
153153- - Idle: %d@,\
154154- - Created: %d@,\
155155- - Reused: %d@,\
156156- - Closed: %d@,\
157157- - Errors: %d@]"
158158- t.active
159159- t.idle
160160- t.total_created
161161- t.total_reused
162162- t.total_closed
163163- t.errors
164164-end
66+(* Re-export submodules *)
77+module Endpoint = Endpoint
88+module Tls_config = Tls_config
99+module Config = Config
1010+module Stats = Stats
1111+module Cmd = Cmd
1651216613type endp_stats = {
16714 mutable active : int;
···17825 mutex : Eio.Mutex.t;
17926}
18027181181-type ('clock, 'net) t = {
2828+type ('clock, 'net) internal = {
18229 sw : Eio.Switch.t;
18330 net : 'net;
18431 clock : 'clock;
···18835 endpoints_mutex : Eio.Mutex.t;
18936}
190373838+type t = T : ('clock Eio.Time.clock, 'net Eio.Net.t) internal -> t
3939+19140module EndpointTbl = Hashtbl.Make(struct
19241 type t = Endpoint.t
19342 let equal = Endpoint.equal
19443 let hash = Endpoint.hash
19544end)
19645197197-let get_time pool =
4646+let get_time (pool : ('clock, 'net) internal) =
19847 Eio.Time.now pool.clock
1994820049let create_endp_stats () = {
···20655 errors = 0;
20756}
20857209209-let snapshot_stats (stats : endp_stats) : Stats.t = {
210210- active = stats.active;
211211- idle = stats.idle;
212212- total_created = stats.total_created;
213213- total_reused = stats.total_reused;
214214- total_closed = stats.total_closed;
215215- errors = stats.errors;
216216-}
5858+let snapshot_stats (stats : endp_stats) : Stats.t =
5959+ Stats.make
6060+ ~active:stats.active
6161+ ~idle:stats.idle
6262+ ~total_created:stats.total_created
6363+ ~total_reused:stats.total_reused
6464+ ~total_closed:stats.total_closed
6565+ ~errors:stats.errors
2176621867(** {1 DNS Resolution} *)
21968220220-let resolve_endpoint pool endpoint =
6969+let resolve_endpoint (pool : ('clock, 'net) internal) endpoint =
22170 Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint);
22271 let addrs = Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint) ~service:(string_of_int (Endpoint.port endpoint)) in
22372 Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);
···2328123382(** {1 Connection Creation with Retry} *)
23483235235-let rec create_connection_with_retry pool endpoint attempt =
236236- if attempt > pool.config.connect_retry_count then begin
8484+let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint attempt =
8585+ let retry_count = Config.connect_retry_count pool.config in
8686+ if attempt > retry_count then begin
23787 Log.err (fun m -> m "Failed to connect to %a after %d attempts"
238238- Endpoint.pp endpoint pool.config.connect_retry_count);
8888+ Endpoint.pp endpoint retry_count);
23989 failwith (Printf.sprintf "Failed to connect to %s:%d after %d attempts"
240240- (Endpoint.host endpoint) (Endpoint.port endpoint) pool.config.connect_retry_count)
9090+ (Endpoint.host endpoint) (Endpoint.port endpoint) retry_count)
24191 end;
2429224393 Log.debug (fun m -> m "Connecting to %a (attempt %d/%d)"
244244- Endpoint.pp endpoint attempt pool.config.connect_retry_count);
9494+ Endpoint.pp endpoint attempt retry_count);
2459524696 try
24797 let addr = resolve_endpoint pool endpoint in
···24999250100 (* Connect with optional timeout *)
251101 let socket =
252252- match pool.config.connect_timeout with
102102+ match Config.connect_timeout pool.config with
253103 | Some timeout ->
254104 Eio.Time.with_timeout_exn pool.clock timeout
255105 (fun () -> Eio.Net.connect ~sw:pool.sw pool.net addr)
···286136 | Eio.Time.Timeout ->
287137 Log.warn (fun m -> m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);
288138 (* Exponential backoff *)
289289- let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in
139139+ let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in
290140 Eio.Time.sleep pool.clock delay;
291141 create_connection_with_retry pool endpoint (attempt + 1)
292142 | e ->
293143 (* Other errors - retry with backoff *)
294144 Log.warn (fun m -> m "Connection attempt %d to %a failed: %s"
295145 attempt Endpoint.pp endpoint (Printexc.to_string e));
296296- if attempt < pool.config.connect_retry_count then (
297297- let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in
146146+ if attempt < Config.connect_retry_count pool.config then (
147147+ let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in
298148 Eio.Time.sleep pool.clock delay;
299149 create_connection_with_retry pool endpoint (attempt + 1)
300150 ) else
301151 raise e
302152303303-let create_connection pool endpoint =
153153+let create_connection (pool : ('clock, 'net) internal) endpoint =
304154 create_connection_with_retry pool endpoint 1
305155306156(** {1 Connection Validation} *)
307157308308-let is_healthy pool ?(check_readable = false) conn =
158158+let is_healthy (pool : ('clock, 'net) internal) ?(check_readable = false) conn =
309159 let now = get_time pool in
310160311161 (* Check age *)
312162 let age = now -. Connection.created_at conn in
313313- if age > pool.config.max_connection_lifetime then begin
163163+ let max_lifetime = Config.max_connection_lifetime pool.config in
164164+ if age > max_lifetime then begin
314165 Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"
315315- Endpoint.pp (Connection.endpoint conn) age pool.config.max_connection_lifetime);
166166+ Endpoint.pp (Connection.endpoint conn) age max_lifetime);
316167 false
317168 end
318169319170 (* Check idle time *)
320320- else if (now -. Connection.last_used conn) > pool.config.max_idle_time then begin
321321- let idle_time = now -. Connection.last_used conn in
322322- Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"
323323- Endpoint.pp (Connection.endpoint conn) idle_time pool.config.max_idle_time);
324324- false
325325- end
171171+ else begin
172172+ let max_idle = Config.max_idle_time pool.config in
173173+ if (now -. Connection.last_used conn) > max_idle then begin
174174+ let idle_time = now -. Connection.last_used conn in
175175+ Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"
176176+ Endpoint.pp (Connection.endpoint conn) idle_time max_idle);
177177+ false
178178+ end
326179327327- (* Check use count *)
328328- else if (match pool.config.max_connection_uses with
329329- | Some max -> Connection.use_count conn >= max
330330- | None -> false) then begin
331331- Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"
332332- Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));
333333- false
334334- end
180180+ (* Check use count *)
181181+ else if (match Config.max_connection_uses pool.config with
182182+ | Some max -> Connection.use_count conn >= max
183183+ | None -> false) then begin
184184+ Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"
185185+ Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));
186186+ false
187187+ end
335188336336- (* Optional: custom health check *)
337337- else if (match pool.config.health_check with
338338- | Some check ->
339339- (try
340340- let healthy = check (Connection.flow conn) in
341341- if not healthy then
342342- Log.debug (fun m -> m "Connection to %a failed custom health check"
343343- Endpoint.pp (Connection.endpoint conn));
344344- not healthy
345345- with e ->
346346- Log.debug (fun m -> m "Connection to %a health check raised exception: %s"
347347- Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));
348348- true) (* Exception in health check = unhealthy *)
349349- | None -> false) then
350350- false
189189+ (* Optional: custom health check *)
190190+ else if (match Config.health_check pool.config with
191191+ | Some check ->
192192+ (try
193193+ let healthy = check (Connection.flow conn) in
194194+ if not healthy then
195195+ Log.debug (fun m -> m "Connection to %a failed custom health check"
196196+ Endpoint.pp (Connection.endpoint conn));
197197+ not healthy
198198+ with e ->
199199+ Log.debug (fun m -> m "Connection to %a health check raised exception: %s"
200200+ Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));
201201+ true) (* Exception in health check = unhealthy *)
202202+ | None -> false) then
203203+ false
204204+205205+ (* Optional: check if socket still connected *)
206206+ else if check_readable then
207207+ try
208208+ (* TODO avsm: a sockopt for this? *)
209209+ true
210210+ with
211211+ | _ -> false
351212352352- (* Optional: check if socket still connected *)
353353- else if check_readable then
354354- try
355355- (* TODO avsm: a sockopt for this? *)
213213+ else begin
214214+ Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"
215215+ Endpoint.pp (Connection.endpoint conn)
216216+ age
217217+ (now -. Connection.last_used conn)
218218+ (Connection.use_count conn));
356219 true
357357- with
358358- | _ -> false
359359-360360- else begin
361361- Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"
362362- Endpoint.pp (Connection.endpoint conn)
363363- age
364364- (now -. Connection.last_used conn)
365365- (Connection.use_count conn));
366366- true
220220+ end
367221 end
368222369223(** {1 Internal Pool Operations} *)
370224371371-let close_internal pool conn =
225225+let close_internal (pool : ('clock, 'net) internal) conn =
372226 Log.debug (fun m -> m "Closing connection to %a (age=%.2fs, uses=%d)"
373227 Endpoint.pp (Connection.endpoint conn)
374228 (get_time pool -. Connection.created_at conn)
···381235 );
382236383237 (* Call hook if configured *)
384384- Option.iter (fun f -> f (Connection.endpoint conn)) pool.config.on_connection_closed
238238+ Option.iter (fun f -> f (Connection.endpoint conn)) (Config.on_connection_closed pool.config)
385239386386-let get_or_create_endpoint_pool pool endpoint =
240240+let get_or_create_endpoint_pool (pool : ('clock, 'net) internal) endpoint =
387241 Log.debug (fun m -> m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);
388242389243 (* First try with read lock *)
···408262 let mutex = Eio.Mutex.create () in
409263410264 Log.info (fun m -> m "Creating new endpoint pool for %a (max_connections=%d)"
411411- Endpoint.pp endpoint pool.config.max_connections_per_endpoint);
265265+ Endpoint.pp endpoint (Config.max_connections_per_endpoint pool.config));
412266413267 Log.debug (fun m -> m "About to create Eio.Pool for %a" Endpoint.pp endpoint);
414268415269 let eio_pool = Eio.Pool.create
416416- pool.config.max_connections_per_endpoint
270270+ (Config.max_connections_per_endpoint pool.config)
417271 ~validate:(fun conn ->
418272 Log.debug (fun m -> m "Validate called for connection to %a" Endpoint.pp endpoint);
419273 (* Called before reusing from pool *)
···428282 );
429283430284 (* Call hook if configured *)
431431- Option.iter (fun f -> f endpoint) pool.config.on_connection_reused;
285285+ Option.iter (fun f -> f endpoint) (Config.on_connection_reused pool.config);
432286433287 (* Run health check if configured *)
434434- match pool.config.health_check with
288288+ match Config.health_check pool.config with
435289 | Some check ->
436290 (try check (Connection.flow conn)
437291 with _ -> false)
···465319 );
466320467321 (* Call hook if configured *)
468468- Option.iter (fun f -> f endpoint) pool.config.on_connection_created;
322322+ Option.iter (fun f -> f endpoint) (Config.on_connection_created pool.config);
469323470324 conn
471325 with e ->
···494348495349(** {1 Public API - Pool Creation} *)
496350497497-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 =
351351+let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls ?(config = Config.default) () : t =
498352 Log.info (fun m -> m "Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, max_lifetime=%.1fs)"
499499- config.max_connections_per_endpoint
500500- config.max_idle_time
501501- config.max_connection_lifetime);
353353+ (Config.max_connections_per_endpoint config)
354354+ (Config.max_idle_time config)
355355+ (Config.max_connection_lifetime config));
502356503357 let pool = {
504358 sw;
···524378 )
525379 );
526380527527- pool
381381+ T pool
528382529383(** {1 Public API - Connection Management} *)
530384531531-let with_connection (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint f =
385385+let with_connection (T pool) endpoint f =
532386 Log.debug (fun m -> m "Acquiring connection to %a" Endpoint.pp endpoint);
533387 let ep_pool = get_or_create_endpoint_pool pool endpoint in
534388···587441588442(** {1 Public API - Statistics} *)
589443590590-let stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =
444444+let stats (T pool) endpoint =
591445 match Hashtbl.find_opt pool.endpoints endpoint with
592446 | Some ep_pool ->
593447 Eio.Mutex.use_ro ep_pool.mutex (fun () ->
···595449 )
596450 | None ->
597451 (* No pool for this endpoint yet *)
598598- {
599599- Stats.active = 0;
600600- idle = 0;
601601- total_created = 0;
602602- total_reused = 0;
603603- total_closed = 0;
604604- errors = 0;
605605- }
452452+ Stats.make
453453+ ~active:0
454454+ ~idle:0
455455+ ~total_created:0
456456+ ~total_reused:0
457457+ ~total_closed:0
458458+ ~errors:0
606459607607-let all_stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) =
460460+let all_stats (T pool) =
608461 Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
609462 Hashtbl.fold (fun endpoint ep_pool acc ->
610463 let stats = Eio.Mutex.use_ro ep_pool.mutex (fun () ->
···616469617470(** {1 Public API - Pool Management} *)
618471619619-let clear_endpoint (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =
472472+let clear_endpoint (T pool) endpoint =
620473 Log.info (fun m -> m "Clearing endpoint %a from pool" Endpoint.pp endpoint);
621474 match Hashtbl.find_opt pool.endpoints endpoint with
622475 | Some _ep_pool ->
+23-121
lib/conpool.mli
···33(** {1 Logging} *)
4455val src : Logs.Src.t
66-(** Logs source for conpool. Configure logging with:
66+(** Logs source for the main connection pool. Configure logging with:
77 {[
88 Logs.Src.set_level Conpool.src (Some Logs.Debug);
99 Logs.set_reporter (Logs_fmt.reporter ());
1010 ]}
1111+1212+ Each submodule also exposes its own log source for fine-grained control:
1313+ - {!Endpoint.src} - endpoint operations
1414+ - {!Tls_config.src} - TLS configuration
1515+ - {!Config.src} - pool configuration
1116*)
12171318(** {1 Core Types} *)
14191515-(** Network endpoint *)
1616-module Endpoint : sig
1717- type t
1818- (** Network endpoint identified by host and port *)
1919-2020- val make : host:string -> port:int -> t
2121- (** Create an endpoint *)
2222-2323- val host : t -> string
2424- (** Get the hostname *)
2525-2626- val port : t -> int
2727- (** Get the port number *)
2828-2929- val pp : Format.formatter -> t -> unit
3030- (** Pretty-print an endpoint *)
3131-3232- val equal : t -> t -> bool
3333- (** Compare two endpoints for equality *)
3434-3535- val hash : t -> int
3636- (** Hash an endpoint *)
3737-end
3838-3939-(** TLS configuration *)
4040-module Tls_config : sig
4141- type t
4242- (** TLS configuration applied to all connections in a pool *)
4343-4444- val make : config:Tls.Config.client -> ?servername:string -> unit -> t
4545- (** Create TLS configuration.
4646- @param config TLS client configuration
4747- @param servername Optional SNI server name override. If None, uses endpoint host *)
4848-4949- val config : t -> Tls.Config.client
5050- (** Get the TLS client configuration *)
5151-5252- val servername : t -> string option
5353- (** Get the SNI server name override *)
5454-5555- val pp : Format.formatter -> t -> unit
5656- (** Pretty-print TLS configuration *)
5757-end
5858-5959-6060-(** Pool configuration *)
6161-module Config : sig
6262- type t
6363- (** Pool configuration *)
6464-6565- val make :
6666- ?max_connections_per_endpoint:int ->
6767- ?max_idle_time:float ->
6868- ?max_connection_lifetime:float ->
6969- ?max_connection_uses:int ->
7070- ?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->
7171- ?connect_timeout:float ->
7272- ?connect_retry_count:int ->
7373- ?connect_retry_delay:float ->
7474- ?on_connection_created:(Endpoint.t -> unit) ->
7575- ?on_connection_closed:(Endpoint.t -> unit) ->
7676- ?on_connection_reused:(Endpoint.t -> unit) ->
7777- unit -> t
7878- (** Create pool configuration with optional parameters.
7979- See field descriptions for defaults. *)
8080-8181- val default : t
8282- (** Sensible defaults for most use cases:
8383- - max_connections_per_endpoint: 10
8484- - max_idle_time: 60.0s
8585- - max_connection_lifetime: 300.0s
8686- - max_connection_uses: None (unlimited)
8787- - health_check: None
8888- - connect_timeout: 10.0s
8989- - connect_retry_count: 3
9090- - connect_retry_delay: 0.1s
9191- - hooks: None *)
9292-9393- val max_connections_per_endpoint : t -> int
9494- val max_idle_time : t -> float
9595- val max_connection_lifetime : t -> float
9696- val max_connection_uses : t -> int option
9797- val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option
9898- val connect_timeout : t -> float option
9999- val connect_retry_count : t -> int
100100- val connect_retry_delay : t -> float
101101-102102- val pp : Format.formatter -> t -> unit
103103- (** Pretty-print configuration *)
104104-end
105105-106106-(** Statistics for an endpoint *)
107107-module Stats : sig
108108- type t
109109- (** Statistics for a specific endpoint *)
110110-111111- val active : t -> int
112112- (** Connections currently in use *)
113113-114114- val idle : t -> int
115115- (** Connections in pool waiting to be reused *)
2020+(** Network endpoint representation *)
2121+module Endpoint : module type of Endpoint
11622117117- val total_created : t -> int
118118- (** Total connections created (lifetime) *)
119119-120120- val total_reused : t -> int
121121- (** Total times connections were reused *)
2323+(** TLS configuration for connection pools *)
2424+module Tls_config : module type of Tls_config
12225123123- val total_closed : t -> int
124124- (** Total connections closed *)
2626+(** Configuration for connection pools *)
2727+module Config : module type of Config
12528126126- val errors : t -> int
127127- (** Total connection errors *)
2929+(** Statistics for connection pool endpoints *)
3030+module Stats : module type of Stats
12831129129- val pp : Format.formatter -> t -> unit
130130- (** Pretty-print endpoint statistics *)
131131-end
3232+(** Cmdliner terms for connection pool configuration *)
3333+module Cmd : module type of Cmd
1323413335(** {1 Connection Pool} *)
13436135135-type ('clock, 'net) t
136136-(** Connection pool managing multiple endpoints, parameterized by clock and network types *)
3737+type t
3838+(** Connection pool managing multiple endpoints *)
1373913840val create :
13941 sw:Eio.Switch.t ->
···14143 clock:'clock Eio.Time.clock ->
14244 ?tls:Tls_config.t ->
14345 ?config:Config.t ->
144144- unit -> ('clock Eio.Time.clock, 'net Eio.Net.t) t
4646+ unit -> t
14547(** Create connection pool bound to switch.
14648 All connections will be closed when switch is released.
14749···15456(** {1 Connection Usage} *)
1555715658val with_connection :
157157- ('clock Eio.Time.clock, 'net Eio.Net.t) t ->
5959+ t ->
15860 Endpoint.t ->
15961 ([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> 'a) ->
16062 'a
···18688(** {1 Statistics & Monitoring} *)
1878918890val stats :
189189- ('clock Eio.Time.clock, 'net Eio.Net.t) t ->
9191+ t ->
19092 Endpoint.t ->
19193 Stats.t
19294(** Get statistics for specific endpoint *)
1939519496val all_stats :
195195- ('clock Eio.Time.clock, 'net Eio.Net.t) t ->
9797+ t ->
19698 (Endpoint.t * Stats.t) list
19799(** Get statistics for all endpoints in pool *)
198100199101(** {1 Pool Management} *)
200102201103val clear_endpoint :
202202- ('clock Eio.Time.clock, 'net Eio.Net.t) t ->
104104+ t ->
203105 Endpoint.t ->
204106 unit
205107(** Clear all cached connections for a specific endpoint.
···11+(** Network endpoint representation *)
22+33+let src = Logs.Src.create "conpool.endpoint" ~doc:"Connection pool endpoint operations"
44+module Log = (val Logs.src_log src : Logs.LOG)
55+66+type t = {
77+ host : string;
88+ port : int;
99+}
1010+1111+let make ~host ~port =
1212+ Log.debug (fun m -> m "Creating endpoint: %s:%d" host port);
1313+ { host; port }
1414+1515+let host t = t.host
1616+let port t = t.port
1717+1818+let equal t1 t2 =
1919+ String.equal t1.host t2.host && t1.port = t2.port
2020+2121+let hash t =
2222+ Hashtbl.hash (t.host, t.port)
2323+2424+let pp = Fmt.of_to_string (fun t -> Printf.sprintf "%s:%d" t.host t.port)
+41
lib/endpoint.mli
···11+(** Network endpoint representation *)
22+33+(** {1 Logging} *)
44+55+val src : Logs.Src.t
66+(** Logs source for endpoint operations. Configure logging with:
77+ {[
88+ Logs.Src.set_level Conpool.Endpoint.src (Some Logs.Debug);
99+ ]}
1010+*)
1111+1212+(** {1 Type} *)
1313+1414+type t
1515+(** Network endpoint identified by host and port *)
1616+1717+(** {1 Construction} *)
1818+1919+val make : host:string -> port:int -> t
2020+(** Create an endpoint from a hostname and port. *)
2121+2222+(** {1 Accessors} *)
2323+2424+val host : t -> string
2525+(** Get the hostname from an endpoint. *)
2626+2727+val port : t -> int
2828+(** Get the port number from an endpoint. *)
2929+3030+(** {1 Comparison and Hashing} *)
3131+3232+val equal : t -> t -> bool
3333+(** Compare two endpoints for equality. *)
3434+3535+val hash : t -> int
3636+(** Hash an endpoint for use in hash tables. *)
3737+3838+(** {1 Pretty-printing} *)
3939+4040+val pp : t Fmt.t
4141+(** Pretty-printer for endpoints. Formats as "host:port". *)
+36
lib/stats.ml
···11+(** Statistics for connection pool endpoints *)
22+33+type t = {
44+ active : int;
55+ idle : int;
66+ total_created : int;
77+ total_reused : int;
88+ total_closed : int;
99+ errors : int;
1010+}
1111+1212+let make ~active ~idle ~total_created ~total_reused ~total_closed ~errors =
1313+ { active; idle; total_created; total_reused; total_closed; errors }
1414+1515+let active t = t.active
1616+let idle t = t.idle
1717+let total_created t = t.total_created
1818+let total_reused t = t.total_reused
1919+let total_closed t = t.total_closed
2020+let errors t = t.errors
2121+2222+let pp ppf t =
2323+ Fmt.pf ppf
2424+ "@[<v>Stats:@,\
2525+ - Active: %d@,\
2626+ - Idle: %d@,\
2727+ - Created: %d@,\
2828+ - Reused: %d@,\
2929+ - Closed: %d@,\
3030+ - Errors: %d@]"
3131+ t.active
3232+ t.idle
3333+ t.total_created
3434+ t.total_reused
3535+ t.total_closed
3636+ t.errors
+43
lib/stats.mli
···11+(** Statistics for connection pool endpoints *)
22+33+(** {1 Type} *)
44+55+type t
66+(** Statistics snapshot for a specific endpoint *)
77+88+(** {1 Construction} *)
99+1010+val make :
1111+ active:int ->
1212+ idle:int ->
1313+ total_created:int ->
1414+ total_reused:int ->
1515+ total_closed:int ->
1616+ errors:int ->
1717+ t
1818+(** Create a statistics snapshot. *)
1919+2020+(** {1 Accessors} *)
2121+2222+val active : t -> int
2323+(** Number of connections currently in use. *)
2424+2525+val idle : t -> int
2626+(** Number of connections in pool waiting to be reused. *)
2727+2828+val total_created : t -> int
2929+(** Total connections created over the endpoint's lifetime. *)
3030+3131+val total_reused : t -> int
3232+(** Total number of times connections were reused from the pool. *)
3333+3434+val total_closed : t -> int
3535+(** Total connections that have been closed. *)
3636+3737+val errors : t -> int
3838+(** Total connection errors encountered. *)
3939+4040+(** {1 Pretty-printing} *)
4141+4242+val pp : t Fmt.t
4343+(** Pretty-printer for statistics. *)
+22
lib/tls_config.ml
···11+(** TLS configuration for connection pools *)
22+33+let src = Logs.Src.create "conpool.tls" ~doc:"Connection pool TLS configuration"
44+module Log = (val Logs.src_log src : Logs.LOG)
55+66+type t = {
77+ config : Tls.Config.client;
88+ servername : string option;
99+}
1010+1111+let make ~config ?servername () =
1212+ Log.debug (fun m ->
1313+ m "Creating TLS config with servername: %s"
1414+ (match servername with Some s -> s | None -> "<default>"));
1515+ { config; servername }
1616+1717+let config t = t.config
1818+let servername t = t.servername
1919+2020+let pp ppf t =
2121+ Fmt.pf ppf "TLS(servername=%s)"
2222+ (match t.servername with Some s -> s | None -> "<default>")
+37
lib/tls_config.mli
···11+(** TLS configuration for connection pools *)
22+33+(** {1 Logging} *)
44+55+val src : Logs.Src.t
66+(** Logs source for TLS configuration operations. Configure logging with:
77+ {[
88+ Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug);
99+ ]}
1010+*)
1111+1212+(** {1 Type} *)
1313+1414+type t
1515+(** TLS configuration applied to all connections in a pool *)
1616+1717+(** {1 Construction} *)
1818+1919+val make : config:Tls.Config.client -> ?servername:string -> unit -> t
2020+(** Create TLS configuration.
2121+2222+ @param config TLS client configuration for all connections
2323+ @param servername Optional SNI server name override. If [None], uses the endpoint's hostname
2424+*)
2525+2626+(** {1 Accessors} *)
2727+2828+val config : t -> Tls.Config.client
2929+(** Get the TLS client configuration. *)
3030+3131+val servername : t -> string option
3232+(** Get the SNI server name override, if any. *)
3333+3434+(** {1 Pretty-printing} *)
3535+3636+val pp : t Fmt.t
3737+(** Pretty-printer for TLS configuration. *)