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 ([Eio.Resource.close_ty | Eio.Flow.two_way_ty] 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 {
69 max_connections_per_endpoint;
70 max_idle_time;
71 max_connection_lifetime;
72 max_connection_uses;
73 health_check;
74 connect_timeout = Some connect_timeout;
75 connect_retry_count;
76 connect_retry_delay;
77 on_connection_created;
78 on_connection_closed;
79 on_connection_reused;
80 }
81
82let default = make ()
83let max_connections_per_endpoint t = t.max_connections_per_endpoint
84let max_idle_time t = t.max_idle_time
85let max_connection_lifetime t = t.max_connection_lifetime
86let max_connection_uses t = t.max_connection_uses
87let health_check t = t.health_check
88let connect_timeout t = t.connect_timeout
89let connect_retry_count t = t.connect_retry_count
90let connect_retry_delay t = t.connect_retry_delay
91let on_connection_created t = t.on_connection_created
92let on_connection_closed t = t.on_connection_closed
93let on_connection_reused t = t.on_connection_reused
94
95let pp ppf t =
96 Fmt.pf ppf
97 "@[<v>Config:@,\
98 - max_connections_per_endpoint: %d@,\
99 - max_idle_time: %.1fs@,\
100 - max_connection_lifetime: %.1fs@,\
101 - max_connection_uses: %s@,\
102 - connect_timeout: %s@,\
103 - connect_retry_count: %d@,\
104 - connect_retry_delay: %.2fs@]"
105 t.max_connections_per_endpoint t.max_idle_time t.max_connection_lifetime
106 (match t.max_connection_uses with
107 | Some n -> string_of_int n
108 | None -> "unlimited")
109 (match t.connect_timeout with
110 | Some f -> Fmt.str "%.1fs" f
111 | None -> "none")
112 t.connect_retry_count t.connect_retry_delay