TCP/TLS connection pooling for Eio
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Configuration for connection pools *)
7
8let src = Logs.Src.create "conpool.config" ~doc:"Connection pool configuration"
9
10module Log = (val Logs.src_log src : Logs.LOG)
11
12type t = {
13 max_connections_per_endpoint : int;
14 max_idle_time : float;
15 max_connection_lifetime : float;
16 max_connection_uses : int option;
17 health_check :
18 ([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> bool) option;
19 connect_timeout : float option;
20 connect_retry_count : int;
21 connect_retry_delay : float;
22 on_connection_created : (Endpoint.t -> unit) option;
23 on_connection_closed : (Endpoint.t -> unit) option;
24 on_connection_reused : (Endpoint.t -> unit) option;
25}
26
27let make ?(max_connections_per_endpoint = 10) ?(max_idle_time = 60.0)
28 ?(max_connection_lifetime = 300.0) ?max_connection_uses ?health_check
29 ?(connect_timeout = 10.0) ?(connect_retry_count = 3)
30 ?(connect_retry_delay = 0.1) ?on_connection_created ?on_connection_closed
31 ?on_connection_reused () =
32 (* Validate parameters *)
33 if max_connections_per_endpoint <= 0 then
34 invalid_arg
35 (Printf.sprintf "max_connections_per_endpoint must be positive, got %d"
36 max_connections_per_endpoint);
37
38 if max_idle_time <= 0.0 then
39 invalid_arg
40 (Printf.sprintf "max_idle_time must be positive, got %.2f" max_idle_time);
41
42 if max_connection_lifetime <= 0.0 then
43 invalid_arg
44 (Printf.sprintf "max_connection_lifetime must be positive, got %.2f"
45 max_connection_lifetime);
46
47 (match max_connection_uses with
48 | Some n when n <= 0 ->
49 invalid_arg
50 (Printf.sprintf "max_connection_uses must be positive, got %d" n)
51 | _ -> ());
52
53 if connect_timeout <= 0.0 then
54 invalid_arg
55 (Printf.sprintf "connect_timeout must be positive, got %.2f"
56 connect_timeout);
57
58 if connect_retry_count < 0 then
59 invalid_arg
60 (Printf.sprintf "connect_retry_count must be non-negative, got %d"
61 connect_retry_count);
62
63 if connect_retry_delay <= 0.0 then
64 invalid_arg
65 (Printf.sprintf "connect_retry_delay must be positive, got %.2f"
66 connect_retry_delay);
67
68 Log.debug (fun m ->
69 m
70 "Creating config: max_connections=%d, max_idle=%.1fs, \
71 max_lifetime=%.1fs"
72 max_connections_per_endpoint max_idle_time max_connection_lifetime);
73 {
74 max_connections_per_endpoint;
75 max_idle_time;
76 max_connection_lifetime;
77 max_connection_uses;
78 health_check;
79 connect_timeout = Some connect_timeout;
80 connect_retry_count;
81 connect_retry_delay;
82 on_connection_created;
83 on_connection_closed;
84 on_connection_reused;
85 }
86
87let default = make ()
88let max_connections_per_endpoint t = t.max_connections_per_endpoint
89let max_idle_time t = t.max_idle_time
90let max_connection_lifetime t = t.max_connection_lifetime
91let max_connection_uses t = t.max_connection_uses
92let health_check t = t.health_check
93let connect_timeout t = t.connect_timeout
94let connect_retry_count t = t.connect_retry_count
95let connect_retry_delay t = t.connect_retry_delay
96let on_connection_created t = t.on_connection_created
97let on_connection_closed t = t.on_connection_closed
98let on_connection_reused t = t.on_connection_reused
99
100let pp ppf t =
101 Fmt.pf ppf
102 "@[<v>Config:@,\
103 - max_connections_per_endpoint: %d@,\
104 - max_idle_time: %.1fs@,\
105 - max_connection_lifetime: %.1fs@,\
106 - max_connection_uses: %s@,\
107 - connect_timeout: %s@,\
108 - connect_retry_count: %d@,\
109 - connect_retry_delay: %.2fs@]"
110 t.max_connections_per_endpoint t.max_idle_time t.max_connection_lifetime
111 (match t.max_connection_uses with
112 | Some n -> string_of_int n
113 | None -> "unlimited")
114 (match t.connect_timeout with
115 | Some f -> Fmt.str "%.1fs" f
116 | None -> "none")
117 t.connect_retry_count t.connect_retry_delay