commit b0b7f031d227b64bb703394522c79f5d5ed06b46 · anil.recoil.org/ocaml-conpool

conpool.opam

···

       14
       14
        
         "eio"

     

       15
       15
        
         "tls-eio" {>= "1.0"}

     

       16
       16
        
         "logs"

     

       17
       17
       +
         "fmt"

     

       18
       18
       +
         "cmdliner"

     

       17
       19
        
         "odoc" {with-doc}

     

       18
       20
        
       ]

     

       19
       21
        
       build: [

+3 -1

dune-project

···

       21
       21
        
         (dune (>= 3.0))

     

       22
       22
        
         eio

     

       23
       23
        
         (tls-eio (>= 1.0))

     

       24
       24
       -
         logs))

     

       24
       24
       +
         logs

     

       25
       25
       +
         fmt

     

       26
       26
       +
         cmdliner))

+52

lib/cmd.ml

···

       1
       1
       +
       (** Cmdliner terms for connection pool configuration *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Cmdliner

     

       4
       4
       +
       

     

       5
       5
       +
       let max_connections_per_endpoint =

     

       6
       6
       +
         let doc = "Maximum concurrent connections per endpoint." in

     

       7
       7
       +
         Arg.(value & opt int 10 & info ["max-connections-per-endpoint"] ~doc ~docv:"NUM")

     

       8
       8
       +
       

     

       9
       9
       +
       let max_idle_time =

     

       10
       10
       +
         let doc = "Maximum time a connection can sit idle in seconds." in

     

       11
       11
       +
         Arg.(value & opt float 60.0 & info ["max-idle-time"] ~doc ~docv:"SECONDS")

     

       12
       12
       +
       

     

       13
       13
       +
       let max_connection_lifetime =

     

       14
       14
       +
         let doc = "Maximum connection age in seconds." in

     

       15
       15
       +
         Arg.(value & opt float 300.0 & info ["max-connection-lifetime"] ~doc ~docv:"SECONDS")

     

       16
       16
       +
       

     

       17
       17
       +
       let max_connection_uses =

     

       18
       18
       +
         let doc = "Maximum times a connection can be reused (omit for unlimited)." in

     

       19
       19
       +
         Arg.(value & opt (some int) None & info ["max-connection-uses"] ~doc ~docv:"NUM")

     

       20
       20
       +
       

     

       21
       21
       +
       let connect_timeout =

     

       22
       22
       +
         let doc = "Connection timeout in seconds." in

     

       23
       23
       +
         Arg.(value & opt float 10.0 & info ["connect-timeout"] ~doc ~docv:"SECONDS")

     

       24
       24
       +
       

     

       25
       25
       +
       let connect_retry_count =

     

       26
       26
       +
         let doc = "Number of connection retry attempts." in

     

       27
       27
       +
         Arg.(value & opt int 3 & info ["connect-retry-count"] ~doc ~docv:"NUM")

     

       28
       28
       +
       

     

       29
       29
       +
       let connect_retry_delay =

     

       30
       30
       +
         let doc = "Initial retry delay in seconds (with exponential backoff)." in

     

       31
       31
       +
         Arg.(value & opt float 0.1 & info ["connect-retry-delay"] ~doc ~docv:"SECONDS")

     

       32
       32
       +
       

     

       33
       33
       +
       let config =

     

       34
       34
       +
         let make max_conn max_idle max_lifetime max_uses timeout retry_count retry_delay =

     

       35
       35
       +
           Config.make

     

       36
       36
       +
             ~max_connections_per_endpoint:max_conn

     

       37
       37
       +
             ~max_idle_time:max_idle

     

       38
       38
       +
             ~max_connection_lifetime:max_lifetime

     

       39
       39
       +
             ?max_connection_uses:max_uses

     

       40
       40
       +
             ~connect_timeout:timeout

     

       41
       41
       +
             ~connect_retry_count:retry_count

     

       42
       42
       +
             ~connect_retry_delay:retry_delay

     

       43
       43
       +
             ()

     

       44
       44
       +
         in

     

       45
       45
       +
         Term.(const make

     

       46
       46
       +
               $ max_connections_per_endpoint

     

       47
       47
       +
               $ max_idle_time

     

       48
       48
       +
               $ max_connection_lifetime

     

       49
       49
       +
               $ max_connection_uses

     

       50
       50
       +
               $ connect_timeout

     

       51
       51
       +
               $ connect_retry_count

     

       52
       52
       +
               $ connect_retry_delay)

+45

lib/cmd.mli

···

       1
       1
       +
       (** Cmdliner terms for connection pool configuration *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** {1 Configuration Terms} *)

     

       4
       4
       +
       

     

       5
       5
       +
       val max_connections_per_endpoint : int Cmdliner.Term.t

     

       6
       6
       +
       (** Cmdliner term for maximum connections per endpoint.

     

       7
       7
       +
           Default: 10

     

       8
       8
       +
           Flag: [--max-connections-per-endpoint] *)

     

       9
       9
       +
       

     

       10
       10
       +
       val max_idle_time : float Cmdliner.Term.t

     

       11
       11
       +
       (** Cmdliner term for maximum idle time in seconds.

     

       12
       12
       +
           Default: 60.0

     

       13
       13
       +
           Flag: [--max-idle-time] *)

     

       14
       14
       +
       

     

       15
       15
       +
       val max_connection_lifetime : float Cmdliner.Term.t

     

       16
       16
       +
       (** Cmdliner term for maximum connection lifetime in seconds.

     

       17
       17
       +
           Default: 300.0

     

       18
       18
       +
           Flag: [--max-connection-lifetime] *)

     

       19
       19
       +
       

     

       20
       20
       +
       val max_connection_uses : int option Cmdliner.Term.t

     

       21
       21
       +
       (** Cmdliner term for maximum connection uses.

     

       22
       22
       +
           Default: None (unlimited)

     

       23
       23
       +
           Flag: [--max-connection-uses] *)

     

       24
       24
       +
       

     

       25
       25
       +
       val connect_timeout : float Cmdliner.Term.t

     

       26
       26
       +
       (** Cmdliner term for connection timeout in seconds.

     

       27
       27
       +
           Default: 10.0

     

       28
       28
       +
           Flag: [--connect-timeout] *)

     

       29
       29
       +
       

     

       30
       30
       +
       val connect_retry_count : int Cmdliner.Term.t

     

       31
       31
       +
       (** Cmdliner term for number of connection retry attempts.

     

       32
       32
       +
           Default: 3

     

       33
       33
       +
           Flag: [--connect-retry-count] *)

     

       34
       34
       +
       

     

       35
       35
       +
       val connect_retry_delay : float Cmdliner.Term.t

     

       36
       36
       +
       (** Cmdliner term for initial retry delay in seconds.

     

       37
       37
       +
           Default: 0.1

     

       38
       38
       +
           Flag: [--connect-retry-delay] *)

     

       39
       39
       +
       

     

       40
       40
       +
       (** {1 Combined Terms} *)

     

       41
       41
       +
       

     

       42
       42
       +
       val config : Config.t Cmdliner.Term.t

     

       43
       43
       +
       (** Cmdliner term that combines all configuration options into a {!Config.t}.

     

       44
       44
       +
           This term can be used in your application's main command to accept

     

       45
       45
       +
           all connection pool configuration options from the command line. *)

+80

lib/config.ml

···

       1
       1
       +
       (** Configuration for connection pools *)

     

       2
       2
       +
       

     

       3
       3
       +
       let src = Logs.Src.create "conpool.config" ~doc:"Connection pool configuration"

     

       4
       4
       +
       module Log = (val Logs.src_log src : Logs.LOG)

     

       5
       5
       +
       

     

       6
       6
       +
       type t = {

     

       7
       7
       +
         max_connections_per_endpoint : int;

     

       8
       8
       +
         max_idle_time : float;

     

       9
       9
       +
         max_connection_lifetime : float;

     

       10
       10
       +
         max_connection_uses : int option;

     

       11
       11
       +
         health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option;

     

       12
       12
       +
         connect_timeout : float option;

     

       13
       13
       +
         connect_retry_count : int;

     

       14
       14
       +
         connect_retry_delay : float;

     

       15
       15
       +
         on_connection_created : (Endpoint.t -> unit) option;

     

       16
       16
       +
         on_connection_closed : (Endpoint.t -> unit) option;

     

       17
       17
       +
         on_connection_reused : (Endpoint.t -> unit) option;

     

       18
       18
       +
       }

     

       19
       19
       +
       

     

       20
       20
       +
       let make

     

       21
       21
       +
           ?(max_connections_per_endpoint = 10)

     

       22
       22
       +
           ?(max_idle_time = 60.0)

     

       23
       23
       +
           ?(max_connection_lifetime = 300.0)

     

       24
       24
       +
           ?max_connection_uses

     

       25
       25
       +
           ?health_check

     

       26
       26
       +
           ?(connect_timeout = 10.0)

     

       27
       27
       +
           ?(connect_retry_count = 3)

     

       28
       28
       +
           ?(connect_retry_delay = 0.1)

     

       29
       29
       +
           ?on_connection_created

     

       30
       30
       +
           ?on_connection_closed

     

       31
       31
       +
           ?on_connection_reused

     

       32
       32
       +
           () =

     

       33
       33
       +
         Log.debug (fun m ->

     

       34
       34
       +
           m "Creating config: max_connections=%d, max_idle=%.1fs, max_lifetime=%.1fs"

     

       35
       35
       +
             max_connections_per_endpoint max_idle_time max_connection_lifetime);

     

       36
       36
       +
         {

     

       37
       37
       +
           max_connections_per_endpoint;

     

       38
       38
       +
           max_idle_time;

     

       39
       39
       +
           max_connection_lifetime;

     

       40
       40
       +
           max_connection_uses;

     

       41
       41
       +
           health_check;

     

       42
       42
       +
           connect_timeout = Some connect_timeout;

     

       43
       43
       +
           connect_retry_count;

     

       44
       44
       +
           connect_retry_delay;

     

       45
       45
       +
           on_connection_created;

     

       46
       46
       +
           on_connection_closed;

     

       47
       47
       +
           on_connection_reused;

     

       48
       48
       +
         }

     

       49
       49
       +
       

     

       50
       50
       +
       let default = make ()

     

       51
       51
       +
       

     

       52
       52
       +
       let max_connections_per_endpoint t = t.max_connections_per_endpoint

     

       53
       53
       +
       let max_idle_time t = t.max_idle_time

     

       54
       54
       +
       let max_connection_lifetime t = t.max_connection_lifetime

     

       55
       55
       +
       let max_connection_uses t = t.max_connection_uses

     

       56
       56
       +
       let health_check t = t.health_check

     

       57
       57
       +
       let connect_timeout t = t.connect_timeout

     

       58
       58
       +
       let connect_retry_count t = t.connect_retry_count

     

       59
       59
       +
       let connect_retry_delay t = t.connect_retry_delay

     

       60
       60
       +
       let on_connection_created t = t.on_connection_created

     

       61
       61
       +
       let on_connection_closed t = t.on_connection_closed

     

       62
       62
       +
       let on_connection_reused t = t.on_connection_reused

     

       63
       63
       +
       

     

       64
       64
       +
       let pp ppf t =

     

       65
       65
       +
         Fmt.pf ppf

     

       66
       66
       +
           "@[<v>Config:@,\

     

       67
       67
       +
            - max_connections_per_endpoint: %d@,\

     

       68
       68
       +
            - max_idle_time: %.1fs@,\

     

       69
       69
       +
            - max_connection_lifetime: %.1fs@,\

     

       70
       70
       +
            - max_connection_uses: %s@,\

     

       71
       71
       +
            - connect_timeout: %s@,\

     

       72
       72
       +
            - connect_retry_count: %d@,\

     

       73
       73
       +
            - connect_retry_delay: %.2fs@]"

     

       74
       74
       +
           t.max_connections_per_endpoint

     

       75
       75
       +
           t.max_idle_time

     

       76
       76
       +
           t.max_connection_lifetime

     

       77
       77
       +
           (match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited")

     

       78
       78
       +
           (match t.connect_timeout with Some f -> Fmt.str "%.1fs" f | None -> "none")

     

       79
       79
       +
           t.connect_retry_count

     

       80
       80
       +
           t.connect_retry_delay

+98

lib/config.mli

···

       1
       1
       +
       (** Configuration for connection pools *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** {1 Logging} *)

     

       4
       4
       +
       

     

       5
       5
       +
       val src : Logs.Src.t

     

       6
       6
       +
       (** Logs source for configuration operations. Configure logging with:

     

       7
       7
       +
           {[

     

       8
       8
       +
             Logs.Src.set_level Conpool.Config.src (Some Logs.Debug);

     

       9
       9
       +
           ]}

     

       10
       10
       +
       *)

     

       11
       11
       +
       

     

       12
       12
       +
       (** {1 Type} *)

     

       13
       13
       +
       

     

       14
       14
       +
       type t

     

       15
       15
       +
       (** Pool configuration *)

     

       16
       16
       +
       

     

       17
       17
       +
       (** {1 Construction} *)

     

       18
       18
       +
       

     

       19
       19
       +
       val make :

     

       20
       20
       +
         ?max_connections_per_endpoint:int ->

     

       21
       21
       +
         ?max_idle_time:float ->

     

       22
       22
       +
         ?max_connection_lifetime:float ->

     

       23
       23
       +
         ?max_connection_uses:int ->

     

       24
       24
       +
         ?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->

     

       25
       25
       +
         ?connect_timeout:float ->

     

       26
       26
       +
         ?connect_retry_count:int ->

     

       27
       27
       +
         ?connect_retry_delay:float ->

     

       28
       28
       +
         ?on_connection_created:(Endpoint.t -> unit) ->

     

       29
       29
       +
         ?on_connection_closed:(Endpoint.t -> unit) ->

     

       30
       30
       +
         ?on_connection_reused:(Endpoint.t -> unit) ->

     

       31
       31
       +
         unit -> t

     

       32
       32
       +
       (** Create pool configuration with optional parameters.

     

       33
       33
       +
       

     

       34
       34
       +
           @param max_connections_per_endpoint Maximum concurrent connections per endpoint (default: 10)

     

       35
       35
       +
           @param max_idle_time Maximum time a connection can sit idle in seconds (default: 60.0)

     

       36
       36
       +
           @param max_connection_lifetime Maximum connection age in seconds (default: 300.0)

     

       37
       37
       +
           @param max_connection_uses Maximum times a connection can be reused (default: unlimited)

     

       38
       38
       +
           @param health_check Custom health check function (default: none)

     

       39
       39
       +
           @param connect_timeout Connection timeout in seconds (default: 10.0)

     

       40
       40
       +
           @param connect_retry_count Number of connection retry attempts (default: 3)

     

       41
       41
       +
           @param connect_retry_delay Initial retry delay in seconds, with exponential backoff (default: 0.1)

     

       42
       42
       +
           @param on_connection_created Hook called when a connection is created

     

       43
       43
       +
           @param on_connection_closed Hook called when a connection is closed

     

       44
       44
       +
           @param on_connection_reused Hook called when a connection is reused

     

       45
       45
       +
       *)

     

       46
       46
       +
       

     

       47
       47
       +
       val default : t

     

       48
       48
       +
       (** Sensible defaults for most use cases:

     

       49
       49
       +
           - max_connections_per_endpoint: 10

     

       50
       50
       +
           - max_idle_time: 60.0s

     

       51
       51
       +
           - max_connection_lifetime: 300.0s

     

       52
       52
       +
           - max_connection_uses: unlimited

     

       53
       53
       +
           - health_check: none

     

       54
       54
       +
           - connect_timeout: 10.0s

     

       55
       55
       +
           - connect_retry_count: 3

     

       56
       56
       +
           - connect_retry_delay: 0.1s

     

       57
       57
       +
           - hooks: none

     

       58
       58
       +
       *)

     

       59
       59
       +
       

     

       60
       60
       +
       (** {1 Accessors} *)

     

       61
       61
       +
       

     

       62
       62
       +
       val max_connections_per_endpoint : t -> int

     

       63
       63
       +
       (** Get maximum connections per endpoint. *)

     

       64
       64
       +
       

     

       65
       65
       +
       val max_idle_time : t -> float

     

       66
       66
       +
       (** Get maximum idle time in seconds. *)

     

       67
       67
       +
       

     

       68
       68
       +
       val max_connection_lifetime : t -> float

     

       69
       69
       +
       (** Get maximum connection lifetime in seconds. *)

     

       70
       70
       +
       

     

       71
       71
       +
       val max_connection_uses : t -> int option

     

       72
       72
       +
       (** Get maximum connection uses, if any. *)

     

       73
       73
       +
       

     

       74
       74
       +
       val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option

     

       75
       75
       +
       (** Get custom health check function, if any. *)

     

       76
       76
       +
       

     

       77
       77
       +
       val connect_timeout : t -> float option

     

       78
       78
       +
       (** Get connection timeout in seconds, if any. *)

     

       79
       79
       +
       

     

       80
       80
       +
       val connect_retry_count : t -> int

     

       81
       81
       +
       (** Get number of connection retry attempts. *)

     

       82
       82
       +
       

     

       83
       83
       +
       val connect_retry_delay : t -> float

     

       84
       84
       +
       (** Get initial retry delay in seconds. *)

     

       85
       85
       +
       

     

       86
       86
       +
       val on_connection_created : t -> (Endpoint.t -> unit) option

     

       87
       87
       +
       (** Get connection created hook, if any. *)

     

       88
       88
       +
       

     

       89
       89
       +
       val on_connection_closed : t -> (Endpoint.t -> unit) option

     

       90
       90
       +
       (** Get connection closed hook, if any. *)

     

       91
       91
       +
       

     

       92
       92
       +
       val on_connection_reused : t -> (Endpoint.t -> unit) option

     

       93
       93
       +
       (** Get connection reused hook, if any. *)

     

       94
       94
       +
       

     

       95
       95
       +
       (** {1 Pretty-printing} *)

     

       96
       96
       +
       

     

       97
       97
       +
       val pp : t Fmt.t

     

       98
       98
       +
       (** Pretty-printer for configuration. *)

+24

lib/connection.ml

···

       1
       1
       +
       (** Internal connection representation - not exposed in public API *)

     

       2
       2
       +
       

     

       3
       3
       +
       let src = Logs.Src.create "conpool.connection" ~doc:"Connection pool internal connection management"

     

       4
       4
       +
       module Log = (val Logs.src_log src : Logs.LOG)

     

       5
       5
       +
       

     

       6
       6
       +
       type t = {

     

       7
       7
       +
         flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;

     

       8
       8
       +
         created_at : float;

     

       9
       9
       +
         mutable last_used : float;

     

       10
       10
       +
         mutable use_count : int;

     

       11
       11
       +
         endpoint : Endpoint.t;

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       let flow t = t.flow

     

       15
       15
       +
       let endpoint t = t.endpoint

     

       16
       16
       +
       let created_at t = t.created_at

     

       17
       17
       +
       let last_used t = t.last_used

     

       18
       18
       +
       let use_count t = t.use_count

     

       19
       19
       +
       

     

       20
       20
       +
       let pp ppf t =

     

       21
       21
       +
         Fmt.pf ppf "Connection(endpoint=%a, age=%.2fs, uses=%d)"

     

       22
       22
       +
           Endpoint.pp t.endpoint

     

       23
       23
       +
           (Unix.gettimeofday () -. t.created_at)

     

       24
       24
       +
           t.use_count

+104 -251

lib/conpool.ml

···

       3
       3
        
       let src = Logs.Src.create "conpool" ~doc:"Connection pooling library"

     

       4
       4
        
       module Log = (val Logs.src_log src : Logs.LOG)

     

       5
       5
        
       

     

       6
       6
       -
       module Endpoint = struct

     

       7
       7
       -
         type t = {

     

       8
       8
       -
           host : string;

     

       9
       9
       -
           port : int;

     

       10
       10
       -
         }

     

       11
       11
       -
       

     

       12
       12
       -
         let make ~host ~port = { host; port }

     

       13
       13
       -
       

     

       14
       14
       -
         let host t = t.host

     

       15
       15
       -
         let port t = t.port

     

       16
       16
       -
       

     

       17
       17
       -
         let pp fmt t =

     

       18
       18
       -
           Format.fprintf fmt "%s:%d" t.host t.port

     

       19
       19
       -
       

     

       20
       20
       -
         let equal t1 t2 =

     

       21
       21
       -
           String.equal t1.host t2.host && t1.port = t2.port

     

       22
       22
       -
       

     

       23
       23
       -
         let hash t =

     

       24
       24
       -
           Hashtbl.hash (t.host, t.port)

     

       25
       25
       -
       end

     

       26
       26
       -
       

     

       27
       27
       -
       module Tls_config = struct

     

       28
       28
       -
         type t = {

     

       29
       29
       -
           config : Tls.Config.client;

     

       30
       30
       -
           servername : string option;

     

       31
       31
       -
         }

     

       32
       32
       -
       

     

       33
       33
       -
         let make ~config ?servername () = { config; servername }

     

       34
       34
       -
       

     

       35
       35
       -
         let config t = t.config

     

       36
       36
       -
         let servername t = t.servername

     

       37
       37
       -
       

     

       38
       38
       -
         let pp fmt t =

     

       39
       39
       -
           Format.fprintf fmt "TLS(servername=%s)"

     

       40
       40
       -
             (match t.servername with Some s -> s | None -> "<default>")

     

       41
       41
       -
       end

     

       42
       42
       -
       

     

       43
       43
       -
       (* Internal connection type - not exposed in public API *)

     

       44
       44
       -
       module Connection = struct

     

       45
       45
       -
         type t = {

     

       46
       46
       -
           flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;

     

       47
       47
       -
           created_at : float;

     

       48
       48
       -
           mutable last_used : float;

     

       49
       49
       -
           mutable use_count : int;

     

       50
       50
       -
           endpoint : Endpoint.t;

     

       51
       51
       -
         }

     

       52
       52
       -
       

     

       53
       53
       -
         let flow t = t.flow

     

       54
       54
       -
         let endpoint t = t.endpoint

     

       55
       55
       -
         let created_at t = t.created_at

     

       56
       56
       -
         let last_used t = t.last_used

     

       57
       57
       -
         let use_count t = t.use_count

     

       58
       58
       -
       end

     

       59
       59
       -
       

     

       60
       60
       -
       module Config = struct

     

       61
       61
       -
         type t = {

     

       62
       62
       -
           max_connections_per_endpoint : int;

     

       63
       63
       -
           max_idle_time : float;

     

       64
       64
       -
           max_connection_lifetime : float;

     

       65
       65
       -
           max_connection_uses : int option;

     

       66
       66
       -
           health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option;

     

       67
       67
       -
           connect_timeout : float option;

     

       68
       68
       -
           connect_retry_count : int;

     

       69
       69
       -
           connect_retry_delay : float;

     

       70
       70
       -
           on_connection_created : (Endpoint.t -> unit) option;

     

       71
       71
       -
           on_connection_closed : (Endpoint.t -> unit) option;

     

       72
       72
       -
           on_connection_reused : (Endpoint.t -> unit) option;

     

       73
       73
       -
         }

     

       74
       74
       -
       

     

       75
       75
       -
         let make

     

       76
       76
       -
             ?(max_connections_per_endpoint = 10)

     

       77
       77
       -
             ?(max_idle_time = 60.0)

     

       78
       78
       -
             ?(max_connection_lifetime = 300.0)

     

       79
       79
       -
             ?max_connection_uses

     

       80
       80
       -
             ?health_check

     

       81
       81
       -
             ?(connect_timeout = 10.0)

     

       82
       82
       -
             ?(connect_retry_count = 3)

     

       83
       83
       -
             ?(connect_retry_delay = 0.1)

     

       84
       84
       -
             ?on_connection_created

     

       85
       85
       -
             ?on_connection_closed

     

       86
       86
       -
             ?on_connection_reused

     

       87
       87
       -
             () =

     

       88
       88
       -
           {

     

       89
       89
       -
             max_connections_per_endpoint;

     

       90
       90
       -
             max_idle_time;

     

       91
       91
       -
             max_connection_lifetime;

     

       92
       92
       -
             max_connection_uses;

     

       93
       93
       -
             health_check;

     

       94
       94
       -
             connect_timeout = Some connect_timeout;

     

       95
       95
       -
             connect_retry_count;

     

       96
       96
       -
             connect_retry_delay;

     

       97
       97
       -
             on_connection_created;

     

       98
       98
       -
             on_connection_closed;

     

       99
       99
       -
             on_connection_reused;

     

       100
       100
       -
           }

     

       101
       101
       -
       

     

       102
       102
       -
         let default = make ()

     

       103
       103
       -
       

     

       104
       104
       -
         let max_connections_per_endpoint t = t.max_connections_per_endpoint

     

       105
       105
       -
         let max_idle_time t = t.max_idle_time

     

       106
       106
       -
         let max_connection_lifetime t = t.max_connection_lifetime

     

       107
       107
       -
         let max_connection_uses t = t.max_connection_uses

     

       108
       108
       -
         let health_check t = t.health_check

     

       109
       109
       -
         let connect_timeout t = t.connect_timeout

     

       110
       110
       -
         let connect_retry_count t = t.connect_retry_count

     

       111
       111
       -
         let connect_retry_delay t = t.connect_retry_delay

     

       112
       112
       -
       

     

       113
       113
       -
         let pp fmt t =

     

       114
       114
       -
           Format.fprintf fmt

     

       115
       115
       -
             "@[<v>Config:@,\

     

       116
       116
       -
              - max_connections_per_endpoint: %d@,\

     

       117
       117
       -
              - max_idle_time: %.1fs@,\

     

       118
       118
       -
              - max_connection_lifetime: %.1fs@,\

     

       119
       119
       -
              - max_connection_uses: %s@,\

     

       120
       120
       -
              - connect_timeout: %s@,\

     

       121
       121
       -
              - connect_retry_count: %d@,\

     

       122
       122
       -
              - connect_retry_delay: %.2fs@]"

     

       123
       123
       -
             t.max_connections_per_endpoint

     

       124
       124
       -
             t.max_idle_time

     

       125
       125
       -
             t.max_connection_lifetime

     

       126
       126
       -
             (match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited")

     

       127
       127
       -
             (match t.connect_timeout with Some f -> Printf.sprintf "%.1fs" f | None -> "none")

     

       128
       128
       -
             t.connect_retry_count

     

       129
       129
       -
             t.connect_retry_delay

     

       130
       130
       -
       end

     

       131
       131
       -
       

     

       132
       132
       -
       module Stats = struct

     

       133
       133
       -
         type t = {

     

       134
       134
       -
           active : int;

     

       135
       135
       -
           idle : int;

     

       136
       136
       -
           total_created : int;

     

       137
       137
       -
           total_reused : int;

     

       138
       138
       -
           total_closed : int;

     

       139
       139
       -
           errors : int;

     

       140
       140
       -
         }

     

       141
       141
       -
       

     

       142
       142
       -
         let active t = t.active

     

       143
       143
       -
         let idle t = t.idle

     

       144
       144
       -
         let total_created t = t.total_created

     

       145
       145
       -
         let total_reused t = t.total_reused

     

       146
       146
       -
         let total_closed t = t.total_closed

     

       147
       147
       -
         let errors t = t.errors

     

       148
       148
       -
       

     

       149
       149
       -
         let pp fmt t =

     

       150
       150
       -
           Format.fprintf fmt

     

       151
       151
       -
             "@[<v>Stats:@,\

     

       152
       152
       -
              - Active: %d@,\

     

       153
       153
       -
              - Idle: %d@,\

     

       154
       154
       -
              - Created: %d@,\

     

       155
       155
       -
              - Reused: %d@,\

     

       156
       156
       -
              - Closed: %d@,\

     

       157
       157
       -
              - Errors: %d@]"

     

       158
       158
       -
             t.active

     

       159
       159
       -
             t.idle

     

       160
       160
       -
             t.total_created

     

       161
       161
       -
             t.total_reused

     

       162
       162
       -
             t.total_closed

     

       163
       163
       -
             t.errors

     

       164
       164
       -
       end

     

       6
       6
       +
       (* Re-export submodules *)

     

       7
       7
       +
       module Endpoint = Endpoint

     

       8
       8
       +
       module Tls_config = Tls_config

     

       9
       9
       +
       module Config = Config

     

       10
       10
       +
       module Stats = Stats

     

       11
       11
       +
       module Cmd = Cmd

     

       165
       12
        
       

     

       166
       13
        
       type endp_stats = {

     

       167
       14
        
         mutable active : int;

     
···

       178
       25
        
         mutex : Eio.Mutex.t;

     

       179
       26
        
       }

     

       180
       27
        
       

     

       181
       181
       -
       type ('clock, 'net) t = {

     

       28
       28
       +
       type ('clock, 'net) internal = {

     

       182
       29
        
         sw : Eio.Switch.t;

     

       183
       30
        
         net : 'net;

     

       184
       31
        
         clock : 'clock;

     
···

       188
       35
        
         endpoints_mutex : Eio.Mutex.t;

     

       189
       36
        
       }

     

       190
       37
        
       

     

       38
       38
       +
       type t = T : ('clock Eio.Time.clock, 'net Eio.Net.t) internal -> t

     

       39
       39
       +
       

     

       191
       40
        
       module EndpointTbl = Hashtbl.Make(struct

     

       192
       41
        
         type t = Endpoint.t

     

       193
       42
        
         let equal = Endpoint.equal

     

       194
       43
        
         let hash = Endpoint.hash

     

       195
       44
        
       end)

     

       196
       45
        
       

     

       197
       197
       -
       let get_time pool =

     

       46
       46
       +
       let get_time (pool : ('clock, 'net) internal) =

     

       198
       47
        
         Eio.Time.now pool.clock

     

       199
       48
        
       

     

       200
       49
        
       let create_endp_stats () = {

     
···

       206
       55
        
         errors = 0;

     

       207
       56
        
       }

     

       208
       57
        
       

     

       209
       209
       -
       let snapshot_stats (stats : endp_stats) : Stats.t = {

     

       210
       210
       -
         active = stats.active;

     

       211
       211
       -
         idle = stats.idle;

     

       212
       212
       -
         total_created = stats.total_created;

     

       213
       213
       -
         total_reused = stats.total_reused;

     

       214
       214
       -
         total_closed = stats.total_closed;

     

       215
       215
       -
         errors = stats.errors;

     

       216
       216
       -
       }

     

       58
       58
       +
       let snapshot_stats (stats : endp_stats) : Stats.t =

     

       59
       59
       +
         Stats.make

     

       60
       60
       +
           ~active:stats.active

     

       61
       61
       +
           ~idle:stats.idle

     

       62
       62
       +
           ~total_created:stats.total_created

     

       63
       63
       +
           ~total_reused:stats.total_reused

     

       64
       64
       +
           ~total_closed:stats.total_closed

     

       65
       65
       +
           ~errors:stats.errors

     

       217
       66
        
       

     

       218
       67
        
       (** {1 DNS Resolution} *)

     

       219
       68
        
       

     

       220
       220
       -
       let resolve_endpoint pool endpoint =

     

       69
       69
       +
       let resolve_endpoint (pool : ('clock, 'net) internal) endpoint =

     

       221
       70
        
         Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint);

     

       222
       71
        
         let addrs = Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint) ~service:(string_of_int (Endpoint.port endpoint)) in

     

       223
       72
        
         Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);

     
···

       232
       81
        
       

     

       233
       82
        
       (** {1 Connection Creation with Retry} *)

     

       234
       83
        
       

     

       235
       235
       -
       let rec create_connection_with_retry pool endpoint attempt =

     

       236
       236
       -
         if attempt > pool.config.connect_retry_count then begin

     

       84
       84
       +
       let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint attempt =

     

       85
       85
       +
         let retry_count = Config.connect_retry_count pool.config in

     

       86
       86
       +
         if attempt > retry_count then begin

     

       237
       87
        
           Log.err (fun m -> m "Failed to connect to %a after %d attempts"

     

       238
       238
       -
             Endpoint.pp endpoint pool.config.connect_retry_count);

     

       88
       88
       +
             Endpoint.pp endpoint retry_count);

     

       239
       89
        
           failwith (Printf.sprintf "Failed to connect to %s:%d after %d attempts"

     

       240
       240
       -
             (Endpoint.host endpoint) (Endpoint.port endpoint) pool.config.connect_retry_count)

     

       90
       90
       +
             (Endpoint.host endpoint) (Endpoint.port endpoint) retry_count)

     

       241
       91
        
         end;

     

       242
       92
        
       

     

       243
       93
        
         Log.debug (fun m -> m "Connecting to %a (attempt %d/%d)"

     

       244
       244
       -
           Endpoint.pp endpoint attempt pool.config.connect_retry_count);

     

       94
       94
       +
           Endpoint.pp endpoint attempt retry_count);

     

       245
       95
        
       

     

       246
       96
        
         try

     

       247
       97
        
           let addr = resolve_endpoint pool endpoint in

     
···

       249
       99
        
       

     

       250
       100
        
           (* Connect with optional timeout *)

     

       251
       101
        
           let socket =

     

       252
       252
       -
             match pool.config.connect_timeout with

     

       102
       102
       +
             match Config.connect_timeout pool.config with

     

       253
       103
        
             | Some timeout ->

     

       254
       104
        
                 Eio.Time.with_timeout_exn pool.clock timeout

     

       255
       105
        
                   (fun () -> Eio.Net.connect ~sw:pool.sw pool.net addr)

     
···

       286
       136
        
         | Eio.Time.Timeout ->

     

       287
       137
        
             Log.warn (fun m -> m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);

     

       288
       138
        
             (* Exponential backoff *)

     

       289
       289
       -
             let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in

     

       139
       139
       +
             let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in

     

       290
       140
        
             Eio.Time.sleep pool.clock delay;

     

       291
       141
        
             create_connection_with_retry pool endpoint (attempt + 1)

     

       292
       142
        
         | e ->

     

       293
       143
        
             (* Other errors - retry with backoff *)

     

       294
       144
        
             Log.warn (fun m -> m "Connection attempt %d to %a failed: %s"

     

       295
       145
        
               attempt Endpoint.pp endpoint (Printexc.to_string e));

     

       296
       296
       -
             if attempt < pool.config.connect_retry_count then (

     

       297
       297
       -
               let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in

     

       146
       146
       +
             if attempt < Config.connect_retry_count pool.config then (

     

       147
       147
       +
               let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in

     

       298
       148
        
               Eio.Time.sleep pool.clock delay;

     

       299
       149
        
               create_connection_with_retry pool endpoint (attempt + 1)

     

       300
       150
        
             ) else

     

       301
       151
        
               raise e

     

       302
       152
        
       

     

       303
       303
       -
       let create_connection pool endpoint =

     

       153
       153
       +
       let create_connection (pool : ('clock, 'net) internal) endpoint =

     

       304
       154
        
         create_connection_with_retry pool endpoint 1

     

       305
       155
        
       

     

       306
       156
        
       (** {1 Connection Validation} *)

     

       307
       157
        
       

     

       308
       308
       -
       let is_healthy pool ?(check_readable = false) conn =

     

       158
       158
       +
       let is_healthy (pool : ('clock, 'net) internal) ?(check_readable = false) conn =

     

       309
       159
        
         let now = get_time pool in

     

       310
       160
        
       

     

       311
       161
        
         (* Check age *)

     

       312
       162
        
         let age = now -. Connection.created_at conn in

     

       313
       313
       -
         if age > pool.config.max_connection_lifetime then begin

     

       163
       163
       +
         let max_lifetime = Config.max_connection_lifetime pool.config in

     

       164
       164
       +
         if age > max_lifetime then begin

     

       314
       165
        
           Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"

     

       315
       315
       -
             Endpoint.pp (Connection.endpoint conn) age pool.config.max_connection_lifetime);

     

       166
       166
       +
             Endpoint.pp (Connection.endpoint conn) age max_lifetime);

     

       316
       167
        
           false

     

       317
       168
        
         end

     

       318
       169
        
       

     

       319
       170
        
         (* Check idle time *)

     

       320
       320
       -
         else if (now -. Connection.last_used conn) > pool.config.max_idle_time then begin

     

       321
       321
       -
           let idle_time = now -. Connection.last_used conn in

     

       322
       322
       -
           Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"

     

       323
       323
       -
             Endpoint.pp (Connection.endpoint conn) idle_time pool.config.max_idle_time);

     

       324
       324
       -
           false

     

       325
       325
       -
         end

     

       171
       171
       +
         else begin

     

       172
       172
       +
           let max_idle = Config.max_idle_time pool.config in

     

       173
       173
       +
           if (now -. Connection.last_used conn) > max_idle then begin

     

       174
       174
       +
             let idle_time = now -. Connection.last_used conn in

     

       175
       175
       +
             Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"

     

       176
       176
       +
               Endpoint.pp (Connection.endpoint conn) idle_time max_idle);

     

       177
       177
       +
             false

     

       178
       178
       +
           end

     

       326
       179
        
       

     

       327
       327
       -
         (* Check use count *)

     

       328
       328
       -
         else if (match pool.config.max_connection_uses with

     

       329
       329
       -
                  | Some max -> Connection.use_count conn >= max

     

       330
       330
       -
                  | None -> false) then begin

     

       331
       331
       -
           Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"

     

       332
       332
       -
             Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));

     

       333
       333
       -
           false

     

       334
       334
       -
         end

     

       180
       180
       +
           (* Check use count *)

     

       181
       181
       +
           else if (match Config.max_connection_uses pool.config with

     

       182
       182
       +
                    | Some max -> Connection.use_count conn >= max

     

       183
       183
       +
                    | None -> false) then begin

     

       184
       184
       +
             Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"

     

       185
       185
       +
               Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));

     

       186
       186
       +
             false

     

       187
       187
       +
           end

     

       335
       188
        
       

     

       336
       336
       -
         (* Optional: custom health check *)

     

       337
       337
       -
         else if (match pool.config.health_check with

     

       338
       338
       -
                  | Some check ->

     

       339
       339
       -
                      (try

     

       340
       340
       -
                        let healthy = check (Connection.flow conn) in

     

       341
       341
       -
                        if not healthy then

     

       342
       342
       -
                          Log.debug (fun m -> m "Connection to %a failed custom health check"

     

       343
       343
       -
                            Endpoint.pp (Connection.endpoint conn));

     

       344
       344
       -
                        not healthy

     

       345
       345
       -
                       with e ->

     

       346
       346
       -
                         Log.debug (fun m -> m "Connection to %a health check raised exception: %s"

     

       347
       347
       -
                           Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));

     

       348
       348
       -
                         true)  (* Exception in health check = unhealthy *)

     

       349
       349
       -
                  | None -> false) then

     

       350
       350
       -
           false

     

       189
       189
       +
           (* Optional: custom health check *)

     

       190
       190
       +
           else if (match Config.health_check pool.config with

     

       191
       191
       +
                    | Some check ->

     

       192
       192
       +
                        (try

     

       193
       193
       +
                          let healthy = check (Connection.flow conn) in

     

       194
       194
       +
                          if not healthy then

     

       195
       195
       +
                            Log.debug (fun m -> m "Connection to %a failed custom health check"

     

       196
       196
       +
                              Endpoint.pp (Connection.endpoint conn));

     

       197
       197
       +
                          not healthy

     

       198
       198
       +
                         with e ->

     

       199
       199
       +
                           Log.debug (fun m -> m "Connection to %a health check raised exception: %s"

     

       200
       200
       +
                             Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));

     

       201
       201
       +
                           true)  (* Exception in health check = unhealthy *)

     

       202
       202
       +
                    | None -> false) then

     

       203
       203
       +
             false

     

       204
       204
       +
       

     

       205
       205
       +
           (* Optional: check if socket still connected *)

     

       206
       206
       +
           else if check_readable then

     

       207
       207
       +
             try

     

       208
       208
       +
               (* TODO avsm: a sockopt for this? *)

     

       209
       209
       +
               true

     

       210
       210
       +
             with

     

       211
       211
       +
             | _ -> false

     

       351
       212
        
       

     

       352
       352
       -
         (* Optional: check if socket still connected *)

     

       353
       353
       -
         else if check_readable then

     

       354
       354
       -
           try

     

       355
       355
       -
             (* TODO avsm: a sockopt for this? *)

     

       213
       213
       +
           else begin

     

       214
       214
       +
             Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"

     

       215
       215
       +
               Endpoint.pp (Connection.endpoint conn)

     

       216
       216
       +
               age

     

       217
       217
       +
               (now -. Connection.last_used conn)

     

       218
       218
       +
               (Connection.use_count conn));

     

       356
       219
        
             true

     

       357
       357
       -
           with

     

       358
       358
       -
           | _ -> false

     

       359
       359
       -
       

     

       360
       360
       -
         else begin

     

       361
       361
       -
           Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"

     

       362
       362
       -
             Endpoint.pp (Connection.endpoint conn)

     

       363
       363
       -
             age

     

       364
       364
       -
             (now -. Connection.last_used conn)

     

       365
       365
       -
             (Connection.use_count conn));

     

       366
       366
       -
           true

     

       220
       220
       +
           end

     

       367
       221
        
         end

     

       368
       222
        
       

     

       369
       223
        
       (** {1 Internal Pool Operations} *)

     

       370
       224
        
       

     

       371
       371
       -
       let close_internal pool conn =

     

       225
       225
       +
       let close_internal (pool : ('clock, 'net) internal) conn =

     

       372
       226
        
         Log.debug (fun m -> m "Closing connection to %a (age=%.2fs, uses=%d)"

     

       373
       227
        
           Endpoint.pp (Connection.endpoint conn)

     

       374
       228
        
           (get_time pool -. Connection.created_at conn)

     
···

       381
       235
        
         );

     

       382
       236
        
       

     

       383
       237
        
         (* Call hook if configured *)

     

       384
       384
       -
         Option.iter (fun f -> f (Connection.endpoint conn)) pool.config.on_connection_closed

     

       238
       238
       +
         Option.iter (fun f -> f (Connection.endpoint conn)) (Config.on_connection_closed pool.config)

     

       385
       239
        
       

     

       386
       386
       -
       let get_or_create_endpoint_pool pool endpoint =

     

       240
       240
       +
       let get_or_create_endpoint_pool (pool : ('clock, 'net) internal) endpoint =

     

       387
       241
        
         Log.debug (fun m -> m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);

     

       388
       242
        
       

     

       389
       243
        
         (* First try with read lock *)

     
···

       408
       262
        
                     let mutex = Eio.Mutex.create () in

     

       409
       263
        
       

     

       410
       264
        
                     Log.info (fun m -> m "Creating new endpoint pool for %a (max_connections=%d)"

     

       411
       411
       -
                       Endpoint.pp endpoint pool.config.max_connections_per_endpoint);

     

       265
       265
       +
                       Endpoint.pp endpoint (Config.max_connections_per_endpoint pool.config));

     

       412
       266
        
       

     

       413
       267
        
                     Log.debug (fun m -> m "About to create Eio.Pool for %a" Endpoint.pp endpoint);

     

       414
       268
        
       

     

       415
       269
        
                     let eio_pool = Eio.Pool.create

     

       416
       416
       -
                       pool.config.max_connections_per_endpoint

     

       270
       270
       +
                       (Config.max_connections_per_endpoint pool.config)

     

       417
       271
        
                       ~validate:(fun conn ->

     

       418
       272
        
                         Log.debug (fun m -> m "Validate called for connection to %a" Endpoint.pp endpoint);

     

       419
       273
        
                         (* Called before reusing from pool *)

     
···

       428
       282
        
                           );

     

       429
       283
        
       

     

       430
       284
        
                           (* Call hook if configured *)

     

       431
       431
       -
                           Option.iter (fun f -> f endpoint) pool.config.on_connection_reused;

     

       285
       285
       +
                           Option.iter (fun f -> f endpoint) (Config.on_connection_reused pool.config);

     

       432
       286
        
       

     

       433
       287
        
                           (* Run health check if configured *)

     

       434
       434
       -
                           match pool.config.health_check with

     

       288
       288
       +
                           match Config.health_check pool.config with

     

       435
       289
        
                           | Some check ->

     

       436
       290
        
                               (try check (Connection.flow conn)

     

       437
       291
        
                                with _ -> false)

     
···

       465
       319
        
                           );

     

       466
       320
        
       

     

       467
       321
        
                           (* Call hook if configured *)

     

       468
       468
       -
                           Option.iter (fun f -> f endpoint) pool.config.on_connection_created;

     

       322
       322
       +
                           Option.iter (fun f -> f endpoint) (Config.on_connection_created pool.config);

     

       469
       323
        
       

     

       470
       324
        
                           conn

     

       471
       325
        
                         with e ->

     
···

       494
       348
        
       

     

       495
       349
        
       (** {1 Public API - Pool Creation} *)

     

       496
       350
        
       

     

       497
       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 =

     

       351
       351
       +
       let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls ?(config = Config.default) () : t =

     

       498
       352
        
         Log.info (fun m -> m "Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, max_lifetime=%.1fs)"

     

       499
       499
       -
           config.max_connections_per_endpoint

     

       500
       500
       -
           config.max_idle_time

     

       501
       501
       -
           config.max_connection_lifetime);

     

       353
       353
       +
           (Config.max_connections_per_endpoint config)

     

       354
       354
       +
           (Config.max_idle_time config)

     

       355
       355
       +
           (Config.max_connection_lifetime config));

     

       502
       356
        
       

     

       503
       357
        
         let pool = {

     

       504
       358
        
           sw;

     
···

       524
       378
        
           )

     

       525
       379
        
         );

     

       526
       380
        
       

     

       527
       527
       -
         pool

     

       381
       381
       +
         T pool

     

       528
       382
        
       

     

       529
       383
        
       (** {1 Public API - Connection Management} *)

     

       530
       384
        
       

     

       531
       531
       -
       let with_connection (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint f =

     

       385
       385
       +
       let with_connection (T pool) endpoint f =

     

       532
       386
        
         Log.debug (fun m -> m "Acquiring connection to %a" Endpoint.pp endpoint);

     

       533
       387
        
         let ep_pool = get_or_create_endpoint_pool pool endpoint in

     

       534
       388
        
       

     
···

       587
       441
        
       

     

       588
       442
        
       (** {1 Public API - Statistics} *)

     

       589
       443
        
       

     

       590
       590
       -
       let stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =

     

       444
       444
       +
       let stats (T pool) endpoint =

     

       591
       445
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       592
       446
        
         | Some ep_pool ->

     

       593
       447
        
             Eio.Mutex.use_ro ep_pool.mutex (fun () ->

     
···

       595
       449
        
             )

     

       596
       450
        
         | None ->

     

       597
       451
        
             (* No pool for this endpoint yet *)

     

       598
       598
       -
             {

     

       599
       599
       -
               Stats.active = 0;

     

       600
       600
       -
               idle = 0;

     

       601
       601
       -
               total_created = 0;

     

       602
       602
       -
               total_reused = 0;

     

       603
       603
       -
               total_closed = 0;

     

       604
       604
       -
               errors = 0;

     

       605
       605
       -
             }

     

       452
       452
       +
             Stats.make

     

       453
       453
       +
               ~active:0

     

       454
       454
       +
               ~idle:0

     

       455
       455
       +
               ~total_created:0

     

       456
       456
       +
               ~total_reused:0

     

       457
       457
       +
               ~total_closed:0

     

       458
       458
       +
               ~errors:0

     

       606
       459
        
       

     

       607
       607
       -
       let all_stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) =

     

       460
       460
       +
       let all_stats (T pool) =

     

       608
       461
        
         Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->

     

       609
       462
        
           Hashtbl.fold (fun endpoint ep_pool acc ->

     

       610
       463
        
             let stats = Eio.Mutex.use_ro ep_pool.mutex (fun () ->

     
···

       616
       469
        
       

     

       617
       470
        
       (** {1 Public API - Pool Management} *)

     

       618
       471
        
       

     

       619
       619
       -
       let clear_endpoint (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =

     

       472
       472
       +
       let clear_endpoint (T pool) endpoint =

     

       620
       473
        
         Log.info (fun m -> m "Clearing endpoint %a from pool" Endpoint.pp endpoint);

     

       621
       474
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       622
       475
        
         | Some _ep_pool ->

+23 -121

lib/conpool.mli

···

       3
       3
        
       (** {1 Logging} *)

     

       4
       4
        
       

     

       5
       5
        
       val src : Logs.Src.t

     

       6
       6
       -
       (** Logs source for conpool. Configure logging with:

     

       6
       6
       +
       (** Logs source for the main connection pool. Configure logging with:

     

       7
       7
        
           {[

     

       8
       8
        
             Logs.Src.set_level Conpool.src (Some Logs.Debug);

     

       9
       9
        
             Logs.set_reporter (Logs_fmt.reporter ());

     

       10
       10
        
           ]}

     

       11
       11
       +
       

     

       12
       12
       +
           Each submodule also exposes its own log source for fine-grained control:

     

       13
       13
       +
           - {!Endpoint.src} - endpoint operations

     

       14
       14
       +
           - {!Tls_config.src} - TLS configuration

     

       15
       15
       +
           - {!Config.src} - pool configuration

     

       11
       16
        
       *)

     

       12
       17
        
       

     

       13
       18
        
       (** {1 Core Types} *)

     

       14
       19
        
       

     

       15
       15
       -
       (** Network endpoint *)

     

       16
       16
       -
       module Endpoint : sig

     

       17
       17
       -
         type t

     

       18
       18
       -
         (** Network endpoint identified by host and port *)

     

       19
       19
       -
       

     

       20
       20
       -
         val make : host:string -> port:int -> t

     

       21
       21
       -
         (** Create an endpoint *)

     

       22
       22
       -
       

     

       23
       23
       -
         val host : t -> string

     

       24
       24
       -
         (** Get the hostname *)

     

       25
       25
       -
       

     

       26
       26
       -
         val port : t -> int

     

       27
       27
       -
         (** Get the port number *)

     

       28
       28
       -
       

     

       29
       29
       -
         val pp : Format.formatter -> t -> unit

     

       30
       30
       -
         (** Pretty-print an endpoint *)

     

       31
       31
       -
       

     

       32
       32
       -
         val equal : t -> t -> bool

     

       33
       33
       -
         (** Compare two endpoints for equality *)

     

       34
       34
       -
       

     

       35
       35
       -
         val hash : t -> int

     

       36
       36
       -
         (** Hash an endpoint *)

     

       37
       37
       -
       end

     

       38
       38
       -
       

     

       39
       39
       -
       (** TLS configuration *)

     

       40
       40
       -
       module Tls_config : sig

     

       41
       41
       -
         type t

     

       42
       42
       -
         (** TLS configuration applied to all connections in a pool *)

     

       43
       43
       -
       

     

       44
       44
       -
         val make : config:Tls.Config.client -> ?servername:string -> unit -> t

     

       45
       45
       -
         (** Create TLS configuration.

     

       46
       46
       -
             @param config TLS client configuration

     

       47
       47
       -
             @param servername Optional SNI server name override. If None, uses endpoint host *)

     

       48
       48
       -
       

     

       49
       49
       -
         val config : t -> Tls.Config.client

     

       50
       50
       -
         (** Get the TLS client configuration *)

     

       51
       51
       -
       

     

       52
       52
       -
         val servername : t -> string option

     

       53
       53
       -
         (** Get the SNI server name override *)

     

       54
       54
       -
       

     

       55
       55
       -
         val pp : Format.formatter -> t -> unit

     

       56
       56
       -
         (** Pretty-print TLS configuration *)

     

       57
       57
       -
       end

     

       58
       58
       -
       

     

       59
       59
       -
       

     

       60
       60
       -
       (** Pool configuration *)

     

       61
       61
       -
       module Config : sig

     

       62
       62
       -
         type t

     

       63
       63
       -
         (** Pool configuration *)

     

       64
       64
       -
       

     

       65
       65
       -
         val make :

     

       66
       66
       -
           ?max_connections_per_endpoint:int ->

     

       67
       67
       -
           ?max_idle_time:float ->

     

       68
       68
       -
           ?max_connection_lifetime:float ->

     

       69
       69
       -
           ?max_connection_uses:int ->

     

       70
       70
       -
           ?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->

     

       71
       71
       -
           ?connect_timeout:float ->

     

       72
       72
       -
           ?connect_retry_count:int ->

     

       73
       73
       -
           ?connect_retry_delay:float ->

     

       74
       74
       -
           ?on_connection_created:(Endpoint.t -> unit) ->

     

       75
       75
       -
           ?on_connection_closed:(Endpoint.t -> unit) ->

     

       76
       76
       -
           ?on_connection_reused:(Endpoint.t -> unit) ->

     

       77
       77
       -
           unit -> t

     

       78
       78
       -
         (** Create pool configuration with optional parameters.

     

       79
       79
       -
             See field descriptions for defaults. *)

     

       80
       80
       -
       

     

       81
       81
       -
         val default : t

     

       82
       82
       -
         (** Sensible defaults for most use cases:

     

       83
       83
       -
             - max_connections_per_endpoint: 10

     

       84
       84
       -
             - max_idle_time: 60.0s

     

       85
       85
       -
             - max_connection_lifetime: 300.0s

     

       86
       86
       -
             - max_connection_uses: None (unlimited)

     

       87
       87
       -
             - health_check: None

     

       88
       88
       -
             - connect_timeout: 10.0s

     

       89
       89
       -
             - connect_retry_count: 3

     

       90
       90
       -
             - connect_retry_delay: 0.1s

     

       91
       91
       -
             - hooks: None *)

     

       92
       92
       -
       

     

       93
       93
       -
         val max_connections_per_endpoint : t -> int

     

       94
       94
       -
         val max_idle_time : t -> float

     

       95
       95
       -
         val max_connection_lifetime : t -> float

     

       96
       96
       -
         val max_connection_uses : t -> int option

     

       97
       97
       -
         val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option

     

       98
       98
       -
         val connect_timeout : t -> float option

     

       99
       99
       -
         val connect_retry_count : t -> int

     

       100
       100
       -
         val connect_retry_delay : t -> float

     

       101
       101
       -
       

     

       102
       102
       -
         val pp : Format.formatter -> t -> unit

     

       103
       103
       -
         (** Pretty-print configuration *)

     

       104
       104
       -
       end

     

       105
       105
       -
       

     

       106
       106
       -
       (** Statistics for an endpoint *)

     

       107
       107
       -
       module Stats : sig

     

       108
       108
       -
         type t

     

       109
       109
       -
         (** Statistics for a specific endpoint *)

     

       110
       110
       -
       

     

       111
       111
       -
         val active : t -> int

     

       112
       112
       -
         (** Connections currently in use *)

     

       113
       113
       -
       

     

       114
       114
       -
         val idle : t -> int

     

       115
       115
       -
         (** Connections in pool waiting to be reused *)

     

       20
       20
       +
       (** Network endpoint representation *)

     

       21
       21
       +
       module Endpoint : module type of Endpoint

     

       116
       22
        
       

     

       117
       117
       -
         val total_created : t -> int

     

       118
       118
       -
         (** Total connections created (lifetime) *)

     

       119
       119
       -
       

     

       120
       120
       -
         val total_reused : t -> int

     

       121
       121
       -
         (** Total times connections were reused *)

     

       23
       23
       +
       (** TLS configuration for connection pools *)

     

       24
       24
       +
       module Tls_config : module type of Tls_config

     

       122
       25
        
       

     

       123
       123
       -
         val total_closed : t -> int

     

       124
       124
       -
         (** Total connections closed *)

     

       26
       26
       +
       (** Configuration for connection pools *)

     

       27
       27
       +
       module Config : module type of Config

     

       125
       28
        
       

     

       126
       126
       -
         val errors : t -> int

     

       127
       127
       -
         (** Total connection errors *)

     

       29
       29
       +
       (** Statistics for connection pool endpoints *)

     

       30
       30
       +
       module Stats : module type of Stats

     

       128
       31
        
       

     

       129
       129
       -
         val pp : Format.formatter -> t -> unit

     

       130
       130
       -
         (** Pretty-print endpoint statistics *)

     

       131
       131
       -
       end

     

       32
       32
       +
       (** Cmdliner terms for connection pool configuration *)

     

       33
       33
       +
       module Cmd : module type of Cmd

     

       132
       34
        
       

     

       133
       35
        
       (** {1 Connection Pool} *)

     

       134
       36
        
       

     

       135
       135
       -
       type ('clock, 'net) t

     

       136
       136
       -
       (** Connection pool managing multiple endpoints, parameterized by clock and network types *)

     

       37
       37
       +
       type t

     

       38
       38
       +
       (** Connection pool managing multiple endpoints *)

     

       137
       39
        
       

     

       138
       40
        
       val create :

     

       139
       41
        
         sw:Eio.Switch.t ->

     
···

       141
       43
        
         clock:'clock Eio.Time.clock ->

     

       142
       44
        
         ?tls:Tls_config.t ->

     

       143
       45
        
         ?config:Config.t ->

     

       144
       144
       -
         unit -> ('clock Eio.Time.clock, 'net Eio.Net.t) t

     

       46
       46
       +
         unit -> t

     

       145
       47
        
       (** Create connection pool bound to switch.

     

       146
       48
        
           All connections will be closed when switch is released.

     

       147
       49
        
       

     
···

       154
       56
        
       (** {1 Connection Usage} *)

     

       155
       57
        
       

     

       156
       58
        
       val with_connection :

     

       157
       157
       -
         ('clock Eio.Time.clock, 'net Eio.Net.t) t ->

     

       59
       59
       +
         t ->

     

       158
       60
        
         Endpoint.t ->

     

       159
       61
        
         ([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> 'a) ->

     

       160
       62
        
         'a

     
···

       186
       88
        
       (** {1 Statistics & Monitoring} *)

     

       187
       89
        
       

     

       188
       90
        
       val stats :

     

       189
       189
       -
         ('clock Eio.Time.clock, 'net Eio.Net.t) t ->

     

       91
       91
       +
         t ->

     

       190
       92
        
         Endpoint.t ->

     

       191
       93
        
         Stats.t

     

       192
       94
        
       (** Get statistics for specific endpoint *)

     

       193
       95
        
       

     

       194
       96
        
       val all_stats :

     

       195
       195
       -
         ('clock Eio.Time.clock, 'net Eio.Net.t) t ->

     

       97
       97
       +
         t ->

     

       196
       98
        
         (Endpoint.t * Stats.t) list

     

       197
       99
        
       (** Get statistics for all endpoints in pool *)

     

       198
       100
        
       

     

       199
       101
        
       (** {1 Pool Management} *)

     

       200
       102
        
       

     

       201
       103
        
       val clear_endpoint :

     

       202
       202
       -
         ('clock Eio.Time.clock, 'net Eio.Net.t) t ->

     

       104
       104
       +
         t ->

     

       203
       105
        
         Endpoint.t ->

     

       204
       106
        
         unit

     

       205
       107
        
       (** Clear all cached connections for a specific endpoint.

+1 -1

lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name conpool)

     

       3
       3
        
        (public_name conpool)

     

       4
       4
       -
        (libraries eio eio.unix tls-eio logs))

     

       4
       4
       +
        (libraries eio eio.unix tls-eio logs fmt cmdliner))

+24

lib/endpoint.ml

···

       1
       1
       +
       (** Network endpoint representation *)

     

       2
       2
       +
       

     

       3
       3
       +
       let src = Logs.Src.create "conpool.endpoint" ~doc:"Connection pool endpoint operations"

     

       4
       4
       +
       module Log = (val Logs.src_log src : Logs.LOG)

     

       5
       5
       +
       

     

       6
       6
       +
       type t = {

     

       7
       7
       +
         host : string;

     

       8
       8
       +
         port : int;

     

       9
       9
       +
       }

     

       10
       10
       +
       

     

       11
       11
       +
       let make ~host ~port =

     

       12
       12
       +
         Log.debug (fun m -> m "Creating endpoint: %s:%d" host port);

     

       13
       13
       +
         { host; port }

     

       14
       14
       +
       

     

       15
       15
       +
       let host t = t.host

     

       16
       16
       +
       let port t = t.port

     

       17
       17
       +
       

     

       18
       18
       +
       let equal t1 t2 =

     

       19
       19
       +
         String.equal t1.host t2.host && t1.port = t2.port

     

       20
       20
       +
       

     

       21
       21
       +
       let hash t =

     

       22
       22
       +
         Hashtbl.hash (t.host, t.port)

     

       23
       23
       +
       

     

       24
       24
       +
       let pp = Fmt.of_to_string (fun t -> Printf.sprintf "%s:%d" t.host t.port)

+41

lib/endpoint.mli

···

       1
       1
       +
       (** Network endpoint representation *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** {1 Logging} *)

     

       4
       4
       +
       

     

       5
       5
       +
       val src : Logs.Src.t

     

       6
       6
       +
       (** Logs source for endpoint operations. Configure logging with:

     

       7
       7
       +
           {[

     

       8
       8
       +
             Logs.Src.set_level Conpool.Endpoint.src (Some Logs.Debug);

     

       9
       9
       +
           ]}

     

       10
       10
       +
       *)

     

       11
       11
       +
       

     

       12
       12
       +
       (** {1 Type} *)

     

       13
       13
       +
       

     

       14
       14
       +
       type t

     

       15
       15
       +
       (** Network endpoint identified by host and port *)

     

       16
       16
       +
       

     

       17
       17
       +
       (** {1 Construction} *)

     

       18
       18
       +
       

     

       19
       19
       +
       val make : host:string -> port:int -> t

     

       20
       20
       +
       (** Create an endpoint from a hostname and port. *)

     

       21
       21
       +
       

     

       22
       22
       +
       (** {1 Accessors} *)

     

       23
       23
       +
       

     

       24
       24
       +
       val host : t -> string

     

       25
       25
       +
       (** Get the hostname from an endpoint. *)

     

       26
       26
       +
       

     

       27
       27
       +
       val port : t -> int

     

       28
       28
       +
       (** Get the port number from an endpoint. *)

     

       29
       29
       +
       

     

       30
       30
       +
       (** {1 Comparison and Hashing} *)

     

       31
       31
       +
       

     

       32
       32
       +
       val equal : t -> t -> bool

     

       33
       33
       +
       (** Compare two endpoints for equality. *)

     

       34
       34
       +
       

     

       35
       35
       +
       val hash : t -> int

     

       36
       36
       +
       (** Hash an endpoint for use in hash tables. *)

     

       37
       37
       +
       

     

       38
       38
       +
       (** {1 Pretty-printing} *)

     

       39
       39
       +
       

     

       40
       40
       +
       val pp : t Fmt.t

     

       41
       41
       +
       (** Pretty-printer for endpoints. Formats as "host:port". *)

+36

lib/stats.ml

···

       1
       1
       +
       (** Statistics for connection pool endpoints *)

     

       2
       2
       +
       

     

       3
       3
       +
       type t = {

     

       4
       4
       +
         active : int;

     

       5
       5
       +
         idle : int;

     

       6
       6
       +
         total_created : int;

     

       7
       7
       +
         total_reused : int;

     

       8
       8
       +
         total_closed : int;

     

       9
       9
       +
         errors : int;

     

       10
       10
       +
       }

     

       11
       11
       +
       

     

       12
       12
       +
       let make ~active ~idle ~total_created ~total_reused ~total_closed ~errors =

     

       13
       13
       +
         { active; idle; total_created; total_reused; total_closed; errors }

     

       14
       14
       +
       

     

       15
       15
       +
       let active t = t.active

     

       16
       16
       +
       let idle t = t.idle

     

       17
       17
       +
       let total_created t = t.total_created

     

       18
       18
       +
       let total_reused t = t.total_reused

     

       19
       19
       +
       let total_closed t = t.total_closed

     

       20
       20
       +
       let errors t = t.errors

     

       21
       21
       +
       

     

       22
       22
       +
       let pp ppf t =

     

       23
       23
       +
         Fmt.pf ppf

     

       24
       24
       +
           "@[<v>Stats:@,\

     

       25
       25
       +
            - Active: %d@,\

     

       26
       26
       +
            - Idle: %d@,\

     

       27
       27
       +
            - Created: %d@,\

     

       28
       28
       +
            - Reused: %d@,\

     

       29
       29
       +
            - Closed: %d@,\

     

       30
       30
       +
            - Errors: %d@]"

     

       31
       31
       +
           t.active

     

       32
       32
       +
           t.idle

     

       33
       33
       +
           t.total_created

     

       34
       34
       +
           t.total_reused

     

       35
       35
       +
           t.total_closed

     

       36
       36
       +
           t.errors

+43

lib/stats.mli

···

       1
       1
       +
       (** Statistics for connection pool endpoints *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** {1 Type} *)

     

       4
       4
       +
       

     

       5
       5
       +
       type t

     

       6
       6
       +
       (** Statistics snapshot for a specific endpoint *)

     

       7
       7
       +
       

     

       8
       8
       +
       (** {1 Construction} *)

     

       9
       9
       +
       

     

       10
       10
       +
       val make :

     

       11
       11
       +
         active:int ->

     

       12
       12
       +
         idle:int ->

     

       13
       13
       +
         total_created:int ->

     

       14
       14
       +
         total_reused:int ->

     

       15
       15
       +
         total_closed:int ->

     

       16
       16
       +
         errors:int ->

     

       17
       17
       +
         t

     

       18
       18
       +
       (** Create a statistics snapshot. *)

     

       19
       19
       +
       

     

       20
       20
       +
       (** {1 Accessors} *)

     

       21
       21
       +
       

     

       22
       22
       +
       val active : t -> int

     

       23
       23
       +
       (** Number of connections currently in use. *)

     

       24
       24
       +
       

     

       25
       25
       +
       val idle : t -> int

     

       26
       26
       +
       (** Number of connections in pool waiting to be reused. *)

     

       27
       27
       +
       

     

       28
       28
       +
       val total_created : t -> int

     

       29
       29
       +
       (** Total connections created over the endpoint's lifetime. *)

     

       30
       30
       +
       

     

       31
       31
       +
       val total_reused : t -> int

     

       32
       32
       +
       (** Total number of times connections were reused from the pool. *)

     

       33
       33
       +
       

     

       34
       34
       +
       val total_closed : t -> int

     

       35
       35
       +
       (** Total connections that have been closed. *)

     

       36
       36
       +
       

     

       37
       37
       +
       val errors : t -> int

     

       38
       38
       +
       (** Total connection errors encountered. *)

     

       39
       39
       +
       

     

       40
       40
       +
       (** {1 Pretty-printing} *)

     

       41
       41
       +
       

     

       42
       42
       +
       val pp : t Fmt.t

     

       43
       43
       +
       (** Pretty-printer for statistics. *)

+22

lib/tls_config.ml

···

       1
       1
       +
       (** TLS configuration for connection pools *)

     

       2
       2
       +
       

     

       3
       3
       +
       let src = Logs.Src.create "conpool.tls" ~doc:"Connection pool TLS configuration"

     

       4
       4
       +
       module Log = (val Logs.src_log src : Logs.LOG)

     

       5
       5
       +
       

     

       6
       6
       +
       type t = {

     

       7
       7
       +
         config : Tls.Config.client;

     

       8
       8
       +
         servername : string option;

     

       9
       9
       +
       }

     

       10
       10
       +
       

     

       11
       11
       +
       let make ~config ?servername () =

     

       12
       12
       +
         Log.debug (fun m ->

     

       13
       13
       +
           m "Creating TLS config with servername: %s"

     

       14
       14
       +
             (match servername with Some s -> s | None -> "<default>"));

     

       15
       15
       +
         { config; servername }

     

       16
       16
       +
       

     

       17
       17
       +
       let config t = t.config

     

       18
       18
       +
       let servername t = t.servername

     

       19
       19
       +
       

     

       20
       20
       +
       let pp ppf t =

     

       21
       21
       +
         Fmt.pf ppf "TLS(servername=%s)"

     

       22
       22
       +
           (match t.servername with Some s -> s | None -> "<default>")

+37

lib/tls_config.mli

···

       1
       1
       +
       (** TLS configuration for connection pools *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** {1 Logging} *)

     

       4
       4
       +
       

     

       5
       5
       +
       val src : Logs.Src.t

     

       6
       6
       +
       (** Logs source for TLS configuration operations. Configure logging with:

     

       7
       7
       +
           {[

     

       8
       8
       +
             Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug);

     

       9
       9
       +
           ]}

     

       10
       10
       +
       *)

     

       11
       11
       +
       

     

       12
       12
       +
       (** {1 Type} *)

     

       13
       13
       +
       

     

       14
       14
       +
       type t

     

       15
       15
       +
       (** TLS configuration applied to all connections in a pool *)

     

       16
       16
       +
       

     

       17
       17
       +
       (** {1 Construction} *)

     

       18
       18
       +
       

     

       19
       19
       +
       val make : config:Tls.Config.client -> ?servername:string -> unit -> t

     

       20
       20
       +
       (** Create TLS configuration.

     

       21
       21
       +
       

     

       22
       22
       +
           @param config TLS client configuration for all connections

     

       23
       23
       +
           @param servername Optional SNI server name override. If [None], uses the endpoint's hostname

     

       24
       24
       +
       *)

     

       25
       25
       +
       

     

       26
       26
       +
       (** {1 Accessors} *)

     

       27
       27
       +
       

     

       28
       28
       +
       val config : t -> Tls.Config.client

     

       29
       29
       +
       (** Get the TLS client configuration. *)

     

       30
       30
       +
       

     

       31
       31
       +
       val servername : t -> string option

     

       32
       32
       +
       (** Get the SNI server name override, if any. *)

     

       33
       33
       +
       

     

       34
       34
       +
       (** {1 Pretty-printing} *)

     

       35
       35
       +
       

     

       36
       36
       +
       val pp : t Fmt.t

     

       37
       37
       +
       (** Pretty-printer for TLS configuration. *)