commit 4bf43974776e17140cef15b557220bebe6baae95 · anil.recoil.org/ocaml-conpool

+17 -1

.gitignore

···

       1
       +
       # OCaml build artifacts

     

       2
       +
       _build/

     

       3
       +
       *.install

     

       4
       +
       *.merlin

     

       5
       +
       

     

       6
       +
       # Third-party sources (fetch locally with opam source)

     

       7
       +
       third_party/

     

       8
       +
       

     

       9
       +
       # Editor and OS files

     

       10
       +
       .DS_Store

     

       11
       +
       *.swp

     

       12
       +
       *~

     

       13
       +
       .vscode/

     

       14
       +
       .idea/

     

       15
       +
       

     

       16
       +
       # Opam local switch

     

       17
       +
       _opam/

.ocamlformat

···

       0

···

       1
       +
       version=0.28.1

+53

.tangled/workflows/build.yml

···

       1
       +
       when:

     

       2
       +
         - event: ["push", "pull_request"]

     

       3
       +
           branch: ["main"]

     

       4
       +
       

     

       5
       +
       engine: nixery

     

       6
       +
       

     

       7
       +
       dependencies:

     

       8
       +
         nixpkgs:

     

       9
       +
           - shell

     

       10
       +
           - stdenv

     

       11
       +
           - findutils

     

       12
       +
           - binutils

     

       13
       +
           - libunwind

     

       14
       +
           - ncurses

     

       15
       +
           - opam

     

       16
       +
           - git

     

       17
       +
           - gawk

     

       18
       +
           - gnupatch

     

       19
       +
           - gnum4

     

       20
       +
           - gnumake

     

       21
       +
           - gnutar

     

       22
       +
           - gnused

     

       23
       +
           - gnugrep

     

       24
       +
           - diffutils

     

       25
       +
           - gzip

     

       26
       +
           - bzip2

     

       27
       +
           - gcc

     

       28
       +
           - ocaml

     

       29
       +
           - pkg-config

     

       30
       +
       

     

       31
       +
       steps:

     

       32
       +
         - name: opam

     

       33
       +
           command: |

     

       34
       +
              opam init --disable-sandboxing -a -y

     

       35
       +
         - name: repo

     

       36
       +
           command: |

     

       37
       +
              opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git

     

       38
       +
         - name: switch

     

       39
       +
           command: |

     

       40
       +
              opam install . --confirm-level=unsafe-yes --deps-only

     

       41
       +
         - name: build

     

       42
       +
           command: |

     

       43
       +
              opam exec -- dune build -p conpool

     

       44
       +
         - name: switch-test

     

       45
       +
           command: |

     

       46
       +
              opam install . --confirm-level=unsafe-yes --deps-only --with-test

     

       47
       +
         - name: test

     

       48
       +
           command: |

     

       49
       +
              opam exec -- dune runtest --verbose

     

       50
       +
         - name: doc

     

       51
       +
           command: |

     

       52
       +
              opam install -y odoc

     

       53
       +
              opam exec -- dune build @doc

CHANGES.md

···

       1
       +
       # v1.0.0 (dev)

     

       2
       +
       

     

       3
       +
       - Initial release of Conpool

+15

LICENSE.md

···

       1
       +
       ISC License

     

       2
       +
       

     

       3
       +
       Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>

     

       4
       +
       

     

       5
       +
       Permission to use, copy, modify, and distribute this software for any

     

       6
       +
       purpose with or without fee is hereby granted, provided that the above

     

       7
       +
       copyright notice and this permission notice appear in all copies.

     

       8
       +
       

     

       9
       +
       THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES

     

       10
       +
       WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF

     

       11
       +
       MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR

     

       12
       +
       ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES

     

       13
       +
       WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN

     

       14
       +
       ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF

     

       15
       +
       OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

+113

README.md

···

       1
       +
       # Conpool - Protocol-agnostic Connection Pooling for Eio

     

       2
       +
       

     

       3
       +
       Conpool is a connection pooling library built on Eio that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol.

     

       4
       +
       

     

       5
       +
       ## Key Features

     

       6
       +
       

     

       7
       +
       - **Protocol-agnostic**: Works with HTTP, Redis, PostgreSQL, or any TCP-based protocol

     

       8
       +
       - **Health validation**: Automatically validates connections before reuse

     

       9
       +
       - **Per-endpoint limits**: Independent connection limits and pooling for each endpoint

     

       10
       +
       - **TLS support**: Optional TLS configuration for secure connections

     

       11
       +
       - **Statistics & monitoring**: Track connection usage, hits/misses, and health status

     

       12
       +
       - **Built on Eio**: Leverages Eio's structured concurrency and resource management

     

       13
       +
       

     

       14
       +
       ## Usage

     

       15
       +
       

     

       16
       +
       Basic example establishing a connection pool:

     

       17
       +
       

     

       18
       +
       ```ocaml

     

       19
       +
       open Eio.Std

     

       20
       +
       

     

       21
       +
       let run env =

     

       22
       +
         Switch.run (fun sw ->

     

       23
       +
           (* Create a connection pool *)

     

       24
       +
           let pool = Conpool.create

     

       25
       +
             ~sw

     

       26
       +
             ~net:(Eio.Stdenv.net env)

     

       27
       +
             ~clock:(Eio.Stdenv.clock env)

     

       28
       +
             ()

     

       29
       +
           in

     

       30
       +
       

     

       31
       +
           (* Define an endpoint *)

     

       32
       +
           let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:80 in

     

       33
       +
       

     

       34
       +
           (* Use a connection from the pool *)

     

       35
       +
           Conpool.with_connection pool endpoint (fun conn ->

     

       36
       +
             Eio.Flow.copy_string "GET / HTTP/1.1\r\nHost: example.com\r\n\r\n" conn;

     

       37
       +
             let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in

     

       38
       +
             Eio.Buf_read.take_all buf

     

       39
       +
           )

     

       40
       +
         )

     

       41
       +
       ```

     

       42
       +
       

     

       43
       +
       With TLS configuration:

     

       44
       +
       

     

       45
       +
       ```ocaml

     

       46
       +
       let run env =

     

       47
       +
         Switch.run (fun sw ->

     

       48
       +
           (* Create TLS configuration *)

     

       49
       +
           let tls = Conpool.Tls_config.make

     

       50
       +
             ~authenticator:(Ca_certs.authenticator ())

     

       51
       +
             ()

     

       52
       +
           in

     

       53
       +
       

     

       54
       +
           (* Create pool with TLS *)

     

       55
       +
           let pool = Conpool.create

     

       56
       +
             ~sw

     

       57
       +
             ~net:(Eio.Stdenv.net env)

     

       58
       +
             ~clock:(Eio.Stdenv.clock env)

     

       59
       +
             ~tls

     

       60
       +
             ()

     

       61
       +
           in

     

       62
       +
       

     

       63
       +
           let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:443 in

     

       64
       +
           Conpool.with_connection pool endpoint (fun conn ->

     

       65
       +
             (* Use TLS-encrypted connection *)

     

       66
       +
             ...

     

       67
       +
           )

     

       68
       +
         )

     

       69
       +
       ```

     

       70
       +
       

     

       71
       +
       Custom pool configuration:

     

       72
       +
       

     

       73
       +
       ```ocaml

     

       74
       +
       let config = Conpool.Config.make

     

       75
       +
         ~max_connections_per_endpoint:20

     

       76
       +
         ~max_idle_per_endpoint:5

     

       77
       +
         ~connection_timeout:10.0

     

       78
       +
         ~validation_interval:300.0

     

       79
       +
         ()

     

       80
       +
       in

     

       81
       +
       

     

       82
       +
       let pool = Conpool.create ~sw ~net ~clock ~config ()

     

       83
       +
       ```

     

       84
       +
       

     

       85
       +
       Monitor pool statistics:

     

       86
       +
       

     

       87
       +
       ```ocaml

     

       88
       +
       let stats = Conpool.stats pool endpoint in

     

       89
       +
       Printf.printf "Active: %d, Idle: %d, Hits: %d, Misses: %d\n"

     

       90
       +
         (Conpool.Stats.active_connections stats)

     

       91
       +
         (Conpool.Stats.idle_connections stats)

     

       92
       +
         (Conpool.Stats.cache_hits stats)

     

       93
       +
         (Conpool.Stats.cache_misses stats)

     

       94
       +
       ```

     

       95
       +
       

     

       96
       +
       ## Installation

     

       97
       +
       

     

       98
       +
       ```

     

       99
       +
       opam install conpool

     

       100
       +
       ```

     

       101
       +
       

     

       102
       +
       ## Documentation

     

       103
       +
       

     

       104
       +
       API documentation is available at https://tangled.org/@anil.recoil.org/ocaml-conpool or via:

     

       105
       +
       

     

       106
       +
       ```

     

       107
       +
       opam install conpool

     

       108
       +
       odig doc conpool

     

       109
       +
       ```

     

       110
       +
       

     

       111
       +
       ## License

     

       112
       +
       

     

       113
       +
       ISC

+8 -8

conpool.opam

···

       3
        
       synopsis: "Protocol-agnostic TCP/IP connection pooling library for Eio"

     

       4
        
       description:

     

       5
        
         "Conpool is a connection pooling library built on Eio.Pool that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol (HTTP, Redis, PostgreSQL, etc.)"

     

       6
       -
       maintainer: ["Your Name"]

     

       7
       -
       authors: ["Your Name"]

     

       8
       -
       license: "MIT"

     

       9
       -
       homepage: "https://github.com/username/conpool"

     

       10
       -
       bug-reports: "https://github.com/username/conpool/issues"

     

       11
        
       depends: [

     

       12
       -
         "ocaml"

     

       13
       -
         "dune" {>= "3.0" & >= "3.0"}

     

       14
        
         "eio"

     

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

     

       16
        
         "logs"

     
···

       32
        
           "@doc" {with-doc}

     

       33
        
         ]

     

       34
        
       ]

     

       35
       -
       dev-repo: "git+https://github.com/username/conpool.git"

···

       3
        
       synopsis: "Protocol-agnostic TCP/IP connection pooling library for Eio"

     

       4
        
       description:

     

       5
        
         "Conpool is a connection pooling library built on Eio.Pool that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol (HTTP, Redis, PostgreSQL, etc.)"

     

       6
       +
       maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       7
       +
       authors: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       8
       +
       license: "ISC"

     

       9
       +
       homepage: "https://tangled.org/@anil.recoil.org/ocaml-conpool"

     

       10
       +
       bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-conpool/issues"

     

       11
        
       depends: [

     

       12
       +
         "ocaml" {>= "5.1.0"}

     

       13
       +
         "dune" {>= "3.20" & >= "3.0"}

     

       14
        
         "eio"

     

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

     

       16
        
         "logs"

     
···

       32
        
           "@doc" {with-doc}

     

       33
        
         ]

     

       34
        
       ]

     

       35
       +
       x-maintenance-intent: ["(latest)"]

+11 -11

dune-project

···

       1
       -
       (lang dune 3.0)

     

       0
        
       
     

       2
        
       (name conpool)

     

       3
        
       

     

       4
        
       (generate_opam_files true)

     

       5
        
       

     

       6
       -
       (source

     

       7
       -
        (github username/conpool))

     

       8
       -
       

     

       9
       -
       (authors "Your Name")

     

       10
       -
       

     

       11
       -
       (maintainers "Your Name")

     

       12
       -
       

     

       13
       -
       (license MIT)

     

       14
        
       

     

       15
        
       (package

     

       16
        
        (name conpool)

     

       17
        
        (synopsis "Protocol-agnostic TCP/IP connection pooling library for Eio")

     

       18
        
        (description "Conpool is a connection pooling library built on Eio.Pool that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol (HTTP, Redis, PostgreSQL, etc.)")

     

       19
        
        (depends

     

       20
       -
         ocaml

     

       21
        
         (dune (>= 3.0))

     

       22
        
         eio

     

       23
        
         (tls-eio (>= 1.0))

     

       24
        
         logs

     

       25
        
         fmt

     

       26
       -
         cmdliner))

     

       0

···

       1
       +
       (lang dune 3.20)

     

       2
       +
       

     

       3
        
       (name conpool)

     

       4
        
       

     

       5
        
       (generate_opam_files true)

     

       6
        
       

     

       7
       +
       (license ISC)

     

       8
       +
       (authors "Anil Madhavapeddy <anil@recoil.org>")

     

       9
       +
       (homepage "https://tangled.org/@anil.recoil.org/ocaml-conpool")

     

       10
       +
       (maintainers "Anil Madhavapeddy <anil@recoil.org>")

     

       11
       +
       (bug_reports "https://tangled.org/@anil.recoil.org/ocaml-conpool/issues")

     

       12
       +
       (maintenance_intent "(latest)")

     

       0
        
       
     

       0
        
       
     

       13
        
       

     

       14
        
       (package

     

       15
        
        (name conpool)

     

       16
        
        (synopsis "Protocol-agnostic TCP/IP connection pooling library for Eio")

     

       17
        
        (description "Conpool is a connection pooling library built on Eio.Pool that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol (HTTP, Redis, PostgreSQL, etc.)")

     

       18
        
        (depends

     

       19
       +
         (ocaml (>= 5.1.0))

     

       20
        
         (dune (>= 3.0))

     

       21
        
         eio

     

       22
        
         (tls-eio (>= 1.0))

     

       23
        
         logs

     

       24
        
         fmt

     

       25
       +
         cmdliner

     

       26
       +
         (odoc :with-doc)))

+30 -25

lib/cmd.ml

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

       2
        
       

     

       3
        
       open Cmdliner

     

       4
        
       

     

       5
        
       let max_connections_per_endpoint =

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       8
        
       

     

       9
        
       let max_idle_time =

     

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

     

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

     

       12
        
       

     

       13
        
       let max_connection_lifetime =

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       16
        
       

     

       17
        
       let max_connection_uses =

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       20
        
       

     

       21
        
       let connect_timeout =

     

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

     

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

     

       24
        
       

     

       25
        
       let connect_retry_count =

     

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

     

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

     

       28
        
       

     

       29
        
       let connect_retry_delay =

     

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

     

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

     

       0
        
       
     

       32
        
       

     

       33
        
       let config =

     

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

     

       35
       -
           Config.make

     

       36
       -
             ~max_connections_per_endpoint:max_conn

     

       37
       -
             ~max_idle_time:max_idle

     

       38
       -
             ~max_connection_lifetime:max_lifetime

     

       39
       -
             ?max_connection_uses:max_uses

     

       40
       -
             ~connect_timeout:timeout

     

       41
       -
             ~connect_retry_count:retry_count

     

       42
       -
             ~connect_retry_delay:retry_delay

     

       43
       -
             ()

     

       44
        
         in

     

       45
       -
         Term.(const make

     

       46
       -
               $ max_connections_per_endpoint

     

       47
       -
               $ max_idle_time

     

       48
       -
               $ max_connection_lifetime

     

       49
       -
               $ max_connection_uses

     

       50
       -
               $ connect_timeout

     

       51
       -
               $ connect_retry_count

     

       52
       -
               $ connect_retry_delay)

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Cmdliner terms for connection pool configuration *)

     

       7
        
       

     

       8
        
       open Cmdliner

     

       9
        
       

     

       10
        
       let max_connections_per_endpoint =

     

       11
        
         let doc = "Maximum concurrent connections per endpoint." in

     

       12
       +
         Arg.(

     

       13
       +
           value & opt int 10

     

       14
       +
           & info [ "max-connections-per-endpoint" ] ~doc ~docv:"NUM")

     

       15
        
       

     

       16
        
       let max_idle_time =

     

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

     

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

     

       19
        
       

     

       20
        
       let max_connection_lifetime =

     

       21
        
         let doc = "Maximum connection age in seconds." in

     

       22
       +
         Arg.(

     

       23
       +
           value & opt float 300.0

     

       24
       +
           & info [ "max-connection-lifetime" ] ~doc ~docv:"SECONDS")

     

       25
        
       

     

       26
        
       let max_connection_uses =

     

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

     

       28
       +
         Arg.(

     

       29
       +
           value

     

       30
       +
           & opt (some int) None

     

       31
       +
           & info [ "max-connection-uses" ] ~doc ~docv:"NUM")

     

       32
        
       

     

       33
        
       let connect_timeout =

     

       34
        
         let doc = "Connection timeout in seconds." in

     

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

     

       36
        
       

     

       37
        
       let connect_retry_count =

     

       38
        
         let doc = "Number of connection retry attempts." in

     

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

     

       40
        
       

     

       41
        
       let connect_retry_delay =

     

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

     

       43
       +
         Arg.(

     

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

     

       45
        
       

     

       46
        
       let config =

     

       47
       +
         let make max_conn max_idle max_lifetime max_uses timeout retry_count

     

       48
       +
             retry_delay =

     

       49
       +
           Config.make ~max_connections_per_endpoint:max_conn ~max_idle_time:max_idle

     

       50
       +
             ~max_connection_lifetime:max_lifetime ?max_connection_uses:max_uses

     

       51
       +
             ~connect_timeout:timeout ~connect_retry_count:retry_count

     

       52
       +
             ~connect_retry_delay:retry_delay ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       53
        
         in

     

       54
       +
         Term.(

     

       55
       +
           const make $ max_connections_per_endpoint $ max_idle_time

     

       56
       +
           $ max_connection_lifetime $ max_connection_uses $ connect_timeout

     

       57
       +
           $ connect_retry_count $ connect_retry_delay)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+20 -22

lib/cmd.mli

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

       2
        
       

     

       3
        
       (** {1 Configuration Terms} *)

     

       4
        
       

     

       5
        
       val max_connections_per_endpoint : int Cmdliner.Term.t

     

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

     

       7
       -
           Default: 10

     

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

     

       9
        
       

     

       10
        
       val max_idle_time : float Cmdliner.Term.t

     

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

     

       12
       -
           Default: 60.0

     

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

     

       14
        
       

     

       15
        
       val max_connection_lifetime : float Cmdliner.Term.t

     

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

     

       17
       -
           Default: 300.0

     

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

     

       19
        
       

     

       20
        
       val max_connection_uses : int option Cmdliner.Term.t

     

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

     

       22
       -
           Default: None (unlimited)

     

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

     

       24
        
       

     

       25
        
       val connect_timeout : float Cmdliner.Term.t

     

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

     

       27
       -
           Default: 10.0

     

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

     

       29
        
       

     

       30
        
       val connect_retry_count : int Cmdliner.Term.t

     

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

     

       32
       -
           Default: 3

     

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

     

       34
        
       

     

       35
        
       val connect_retry_delay : float Cmdliner.Term.t

     

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

     

       37
       -
           Default: 0.1

     

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

     

       39
        
       

     

       40
        
       (** {1 Combined Terms} *)

     

       41
        
       

     

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

     

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

     

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

     

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

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Cmdliner terms for connection pool configuration *)

     

       7
        
       

     

       8
        
       (** {1 Configuration Terms} *)

     

       9
        
       

     

       10
        
       val max_connections_per_endpoint : int Cmdliner.Term.t

     

       11
       +
       (** Cmdliner term for maximum connections per endpoint. Default: 10 Flag:

     

       12
       +
           [--max-connections-per-endpoint] *)

     

       0
        
       
     

       13
        
       

     

       14
        
       val max_idle_time : float Cmdliner.Term.t

     

       15
       +
       (** Cmdliner term for maximum idle time in seconds. Default: 60.0 Flag:

     

       16
       +
           [--max-idle-time] *)

     

       0
        
       
     

       17
        
       

     

       18
        
       val max_connection_lifetime : float Cmdliner.Term.t

     

       19
       +
       (** Cmdliner term for maximum connection lifetime in seconds. Default: 300.0

     

       0
        
       
     

       20
        
           Flag: [--max-connection-lifetime] *)

     

       21
        
       

     

       22
        
       val max_connection_uses : int option Cmdliner.Term.t

     

       23
       +
       (** Cmdliner term for maximum connection uses. Default: None (unlimited) Flag:

     

       24
       +
           [--max-connection-uses] *)

     

       0
        
       
     

       25
        
       

     

       26
        
       val connect_timeout : float Cmdliner.Term.t

     

       27
       +
       (** Cmdliner term for connection timeout in seconds. Default: 10.0 Flag:

     

       28
       +
           [--connect-timeout] *)

     

       0
        
       
     

       29
        
       

     

       30
        
       val connect_retry_count : int Cmdliner.Term.t

     

       31
       +
       (** Cmdliner term for number of connection retry attempts. Default: 3 Flag:

     

       32
       +
           [--connect-retry-count] *)

     

       0
        
       
     

       33
        
       

     

       34
        
       val connect_retry_delay : float Cmdliner.Term.t

     

       35
       +
       (** Cmdliner term for initial retry delay in seconds. Default: 0.1 Flag:

     

       36
       +
           [--connect-retry-delay] *)

     

       0
        
       
     

       37
        
       

     

       38
        
       (** {1 Combined Terms} *)

     

       39
        
       

     

       40
        
       val config : Config.t Cmdliner.Term.t

     

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

     

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

     

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

+46 -37

lib/config.ml

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Configuration for connection pools *)

     

       2
        
       

     

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

     

       0
        
       
     

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

     

       5
        
       

     

       6
        
       type t = {

     
···

       8
        
         max_idle_time : float;

     

       9
        
         max_connection_lifetime : float;

     

       10
        
         max_connection_uses : int option;

     

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

     

       0
        
       
     

       12
        
         connect_timeout : float option;

     

       13
        
         connect_retry_count : int;

     

       14
        
         connect_retry_delay : float;

     
···

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

     

       18
        
       }

     

       19
        
       

     

       20
       -
       let make

     

       21
       -
           ?(max_connections_per_endpoint = 10)

     

       22
       -
           ?(max_idle_time = 60.0)

     

       23
       -
           ?(max_connection_lifetime = 300.0)

     

       24
       -
           ?max_connection_uses

     

       25
       -
           ?health_check

     

       26
       -
           ?(connect_timeout = 10.0)

     

       27
       -
           ?(connect_retry_count = 3)

     

       28
       -
           ?(connect_retry_delay = 0.1)

     

       29
       -
           ?on_connection_created

     

       30
       -
           ?on_connection_closed

     

       31
       -
           ?on_connection_reused

     

       32
       -
           () =

     

       33
        
         (* Validate parameters *)

     

       34
        
         if max_connections_per_endpoint <= 0 then

     

       35
       -
           invalid_arg (Printf.sprintf "max_connections_per_endpoint must be positive, got %d"

     

       36
       -
             max_connections_per_endpoint);

     

       0
        
       
     

       37
        
       

     

       38
        
         if max_idle_time <= 0.0 then

     

       39
       -
           invalid_arg (Printf.sprintf "max_idle_time must be positive, got %.2f" max_idle_time);

     

       0
        
       
     

       40
        
       

     

       41
        
         if max_connection_lifetime <= 0.0 then

     

       42
       -
           invalid_arg (Printf.sprintf "max_connection_lifetime must be positive, got %.2f"

     

       43
       -
             max_connection_lifetime);

     

       0
        
       
     

       44
        
       

     

       45
        
         (match max_connection_uses with

     

       46
       -
          | Some n when n <= 0 ->

     

       47
       -
              invalid_arg (Printf.sprintf "max_connection_uses must be positive, got %d" n)

     

       48
       -
          | _ -> ());

     

       0
        
       
     

       49
        
       

     

       50
        
         if connect_timeout <= 0.0 then

     

       51
       -
           invalid_arg (Printf.sprintf "connect_timeout must be positive, got %.2f" connect_timeout);

     

       0
        
       
     

       0
        
       
     

       52
        
       

     

       53
        
         if connect_retry_count < 0 then

     

       54
       -
           invalid_arg (Printf.sprintf "connect_retry_count must be non-negative, got %d"

     

       55
       -
             connect_retry_count);

     

       0
        
       
     

       56
        
       

     

       57
        
         if connect_retry_delay <= 0.0 then

     

       58
       -
           invalid_arg (Printf.sprintf "connect_retry_delay must be positive, got %.2f"

     

       59
       -
             connect_retry_delay);

     

       0
        
       
     

       60
        
       

     

       61
        
         Log.debug (fun m ->

     

       62
       -
           m "Creating config: max_connections=%d, max_idle=%.1fs, max_lifetime=%.1fs"

     

       63
       -
             max_connections_per_endpoint max_idle_time max_connection_lifetime);

     

       0
        
       
     

       0
        
       
     

       64
        
         {

     

       65
        
           max_connections_per_endpoint;

     

       66
        
           max_idle_time;

     
···

       76
        
         }

     

       77
        
       

     

       78
        
       let default = make ()

     

       79
       -
       

     

       80
        
       let max_connections_per_endpoint t = t.max_connections_per_endpoint

     

       81
        
       let max_idle_time t = t.max_idle_time

     

       82
        
       let max_connection_lifetime t = t.max_connection_lifetime

     
···

       99
        
            - connect_timeout: %s@,\

     

       100
        
            - connect_retry_count: %d@,\

     

       101
        
            - connect_retry_delay: %.2fs@]"

     

       102
       -
           t.max_connections_per_endpoint

     

       103
       -
           t.max_idle_time

     

       104
       -
           t.max_connection_lifetime

     

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

     

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

     

       107
       -
           t.connect_retry_count

     

       108
       -
           t.connect_retry_delay

     

       0

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Configuration for connection pools *)

     

       7
        
       

     

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

     

       9
       +
       

     

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

     

       11
        
       

     

       12
        
       type t = {

     
···

       14
        
         max_idle_time : float;

     

       15
        
         max_connection_lifetime : float;

     

       16
        
         max_connection_uses : int option;

     

       17
       +
         health_check :

     

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

     

       19
        
         connect_timeout : float option;

     

       20
        
         connect_retry_count : int;

     

       21
        
         connect_retry_delay : float;

     
···

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

     

       25
        
       }

     

       26
        
       

     

       27
       +
       let make ?(max_connections_per_endpoint = 10) ?(max_idle_time = 60.0)

     

       28
       +
           ?(max_connection_lifetime = 300.0) ?max_connection_uses ?health_check

     

       29
       +
           ?(connect_timeout = 10.0) ?(connect_retry_count = 3)

     

       30
       +
           ?(connect_retry_delay = 0.1) ?on_connection_created ?on_connection_closed

     

       31
       +
           ?on_connection_reused () =

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       32
        
         (* Validate parameters *)

     

       33
        
         if max_connections_per_endpoint <= 0 then

     

       34
       +
           invalid_arg

     

       35
       +
             (Printf.sprintf "max_connections_per_endpoint must be positive, got %d"

     

       36
       +
                max_connections_per_endpoint);

     

       37
        
       

     

       38
        
         if max_idle_time <= 0.0 then

     

       39
       +
           invalid_arg

     

       40
       +
             (Printf.sprintf "max_idle_time must be positive, got %.2f" max_idle_time);

     

       41
        
       

     

       42
        
         if max_connection_lifetime <= 0.0 then

     

       43
       +
           invalid_arg

     

       44
       +
             (Printf.sprintf "max_connection_lifetime must be positive, got %.2f"

     

       45
       +
                max_connection_lifetime);

     

       46
        
       

     

       47
        
         (match max_connection_uses with

     

       48
       +
         | Some n when n <= 0 ->

     

       49
       +
             invalid_arg

     

       50
       +
               (Printf.sprintf "max_connection_uses must be positive, got %d" n)

     

       51
       +
         | _ -> ());

     

       52
        
       

     

       53
        
         if connect_timeout <= 0.0 then

     

       54
       +
           invalid_arg

     

       55
       +
             (Printf.sprintf "connect_timeout must be positive, got %.2f"

     

       56
       +
                connect_timeout);

     

       57
        
       

     

       58
        
         if connect_retry_count < 0 then

     

       59
       +
           invalid_arg

     

       60
       +
             (Printf.sprintf "connect_retry_count must be non-negative, got %d"

     

       61
       +
                connect_retry_count);

     

       62
        
       

     

       63
        
         if connect_retry_delay <= 0.0 then

     

       64
       +
           invalid_arg

     

       65
       +
             (Printf.sprintf "connect_retry_delay must be positive, got %.2f"

     

       66
       +
                connect_retry_delay);

     

       67
        
       

     

       68
        
         Log.debug (fun m ->

     

       69
       +
             m

     

       70
       +
               "Creating config: max_connections=%d, max_idle=%.1fs, \

     

       71
       +
                max_lifetime=%.1fs"

     

       72
       +
               max_connections_per_endpoint max_idle_time max_connection_lifetime);

     

       73
        
         {

     

       74
        
           max_connections_per_endpoint;

     

       75
        
           max_idle_time;

     
···

       85
        
         }

     

       86
        
       

     

       87
        
       let default = make ()

     

       0
        
       
     

       88
        
       let max_connections_per_endpoint t = t.max_connections_per_endpoint

     

       89
        
       let max_idle_time t = t.max_idle_time

     

       90
        
       let max_connection_lifetime t = t.max_connection_lifetime

     
···

       107
        
            - connect_timeout: %s@,\

     

       108
        
            - connect_retry_count: %d@,\

     

       109
        
            - connect_retry_delay: %.2fs@]"

     

       110
       +
           t.max_connections_per_endpoint t.max_idle_time t.max_connection_lifetime

     

       111
       +
           (match t.max_connection_uses with

     

       112
       +
           | Some n -> string_of_int n

     

       113
       +
           | None -> "unlimited")

     

       114
       +
           (match t.connect_timeout with

     

       115
       +
           | Some f -> Fmt.str "%.1fs" f

     

       116
       +
           | None -> "none")

     

       117
       +
           t.connect_retry_count t.connect_retry_delay

+25 -15

lib/config.mli

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Configuration for connection pools *)

     

       2
        
       

     

       3
        
       (** {1 Logging} *)

     
···

       5
        
       val src : Logs.Src.t

     

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

     

       7
        
           {[

     

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

     

       9
       -
           ]}

     

       10
       -
       *)

     

       11
        
       

     

       12
        
       (** {1 Type} *)

     

       13
        
       

     
···

       21
        
         ?max_idle_time:float ->

     

       22
        
         ?max_connection_lifetime:float ->

     

       23
        
         ?max_connection_uses:int ->

     

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

     

       0
        
       
     

       25
        
         ?connect_timeout:float ->

     

       26
        
         ?connect_retry_count:int ->

     

       27
        
         ?connect_retry_delay:float ->

     

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

     

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

     

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

     

       31
       -
         unit -> t

     

       0
        
       
     

       32
        
       (** Create pool configuration with optional parameters.

     

       33
        
       

     

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

     

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

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

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

     

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

     

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

     

       0
        
       
     

       42
        
           @param on_connection_created Hook called when a connection is created

     

       43
        
           @param on_connection_closed Hook called when a connection is closed

     

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

     

       45
       -
       *)

     

       46
        
       

     

       47
        
       val default : t

     

       48
        
       (** Sensible defaults for most use cases:

     
···

       54
        
           - connect_timeout: 10.0s

     

       55
        
           - connect_retry_count: 3

     

       56
        
           - connect_retry_delay: 0.1s

     

       57
       -
           - hooks: none

     

       58
       -
       *)

     

       59
        
       

     

       60
        
       (** {1 Accessors} *)

     

       61
        
       

     
···

       71
        
       val max_connection_uses : t -> int option

     

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

     

       73
        
       

     

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

     

       0
        
       
     

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

     

       76
        
       

     

       77
        
       val connect_timeout : t -> float option

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Configuration for connection pools *)

     

       7
        
       

     

       8
        
       (** {1 Logging} *)

     
···

       10
        
       val src : Logs.Src.t

     

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

     

       12
        
           {[

     

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

     

       14
       +
           ]} *)

     

       0
        
       
     

       15
        
       

     

       16
        
       (** {1 Type} *)

     

       17
        
       

     
···

       25
        
         ?max_idle_time:float ->

     

       26
        
         ?max_connection_lifetime:float ->

     

       27
        
         ?max_connection_uses:int ->

     

       28
       +
         ?health_check:

     

       29
       +
           ([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> bool) ->

     

       30
        
         ?connect_timeout:float ->

     

       31
        
         ?connect_retry_count:int ->

     

       32
        
         ?connect_retry_delay:float ->

     

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

     

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

     

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

     

       36
       +
         unit ->

     

       37
       +
         t

     

       38
        
       (** Create pool configuration with optional parameters.

     

       39
        
       

     

       40
       +
           @param max_connections_per_endpoint

     

       41
       +
             Maximum concurrent connections per endpoint (default: 10)

     

       42
       +
           @param max_idle_time

     

       43
       +
             Maximum time a connection can sit idle in seconds (default: 60.0)

     

       44
       +
           @param max_connection_lifetime

     

       45
       +
             Maximum connection age in seconds (default: 300.0)

     

       46
       +
           @param max_connection_uses

     

       47
       +
             Maximum times a connection can be reused (default: unlimited)

     

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

     

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

     

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

     

       51
       +
           @param connect_retry_delay

     

       52
       +
             Initial retry delay in seconds, with exponential backoff (default: 0.1)

     

       53
        
           @param on_connection_created Hook called when a connection is created

     

       54
        
           @param on_connection_closed Hook called when a connection is closed

     

       55
       +
           @param on_connection_reused Hook called when a connection is reused *)

     

       0
        
       
     

       56
        
       

     

       57
        
       val default : t

     

       58
        
       (** Sensible defaults for most use cases:

     
···

       64
        
           - connect_timeout: 10.0s

     

       65
        
           - connect_retry_count: 3

     

       66
        
           - connect_retry_delay: 0.1s

     

       67
       +
           - hooks: none *)

     

       0
        
       
     

       68
        
       

     

       69
        
       (** {1 Accessors} *)

     

       70
        
       

     
···

       80
        
       val max_connection_uses : t -> int option

     

       81
        
       (** Get maximum connection uses, if any. *)

     

       82
        
       

     

       83
       +
       val health_check :

     

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

     

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

     

       86
        
       

     

       87
        
       val connect_timeout : t -> float option

+16 -13

lib/connection.ml

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

       2
        
       

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

       5
        
       

     

       6
        
       type t = {

     

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

     

       8
        
         created_at : float;

     

       9
        
         mutable last_used : float;

     

       10
        
         mutable use_count : int;

     
···

       15
        
       let flow t = t.flow

     

       16
        
       let endpoint t = t.endpoint

     

       17
        
       let created_at t = t.created_at

     

       18
       -
       

     

       19
       -
       let last_used t =

     

       20
       -
         Eio.Mutex.use_ro t.mutex (fun () -> t.last_used)

     

       21
       -
       

     

       22
       -
       let use_count t =

     

       23
       -
         Eio.Mutex.use_ro t.mutex (fun () -> t.use_count)

     

       24
        
       

     

       25
        
       let update_usage t ~now =

     

       26
        
         Eio.Mutex.use_rw ~protect:true t.mutex (fun () ->

     

       27
       -
           t.last_used <- now;

     

       28
       -
           t.use_count <- t.use_count + 1

     

       29
       -
         )

     

       30
        
       

     

       31
        
       let pp ppf t =

     

       32
        
         let uses = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count) in

     

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

     

       34
       -
           Endpoint.pp t.endpoint

     

       35
        
           (Unix.gettimeofday () -. t.created_at)

     

       36
        
           uses

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

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

     

       7
        
       

     

       8
       +
       let src =

     

       9
       +
         Logs.Src.create "conpool.connection"

     

       10
       +
           ~doc:"Connection pool internal connection management"

     

       11
       +
       

     

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

     

       13
        
       

     

       14
        
       type t = {

     

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

     

       16
        
         created_at : float;

     

       17
        
         mutable last_used : float;

     

       18
        
         mutable use_count : int;

     
···

       23
        
       let flow t = t.flow

     

       24
        
       let endpoint t = t.endpoint

     

       25
        
       let created_at t = t.created_at

     

       26
       +
       let last_used t = Eio.Mutex.use_ro t.mutex (fun () -> t.last_used)

     

       27
       +
       let use_count t = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       28
        
       

     

       29
        
       let update_usage t ~now =

     

       30
        
         Eio.Mutex.use_rw ~protect:true t.mutex (fun () ->

     

       31
       +
             t.last_used <- now;

     

       32
       +
             t.use_count <- t.use_count + 1)

     

       0
        
       
     

       33
        
       

     

       34
        
       let pp ppf t =

     

       35
        
         let uses = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count) in

     

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

     

       37
       +
           t.endpoint

     

       38
        
           (Unix.gettimeofday () -. t.created_at)

     

       39
        
           uses

+318 -275

lib/conpool.ml

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)

     

       2
        
       

     

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

     

       0
        
       
     

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

     

       5
        
       

     

       6
        
       (* Re-export submodules *)

     
···

       14
        
       

     

       15
        
       type error =

     

       16
        
         | Dns_resolution_failed of { hostname : string }

     

       17
       -
         | Connection_failed of { endpoint : Endpoint.t; attempts : int; last_error : string }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       18
        
         | Connection_timeout of { endpoint : Endpoint.t; timeout : float }

     

       19
        
         | Invalid_config of string

     

       20
        
         | Invalid_endpoint of string

     
···

       25
        
         | Dns_resolution_failed { hostname } ->

     

       26
        
             Fmt.pf ppf "DNS resolution failed for hostname: %s" hostname

     

       27
        
         | Connection_failed { endpoint; attempts; last_error } ->

     

       28
       -
             Fmt.pf ppf "Failed to connect to %a after %d attempts: %s"

     

       29
       -
               Endpoint.pp endpoint attempts last_error

     

       30
        
         | Connection_timeout { endpoint; timeout } ->

     

       31
       -
             Fmt.pf ppf "Connection timeout to %a after %.2fs"

     

       32
       -
               Endpoint.pp endpoint timeout

     

       33
       -
         | Invalid_config msg ->

     

       34
       -
             Fmt.pf ppf "Invalid configuration: %s" msg

     

       35
       -
         | Invalid_endpoint msg ->

     

       36
       -
             Fmt.pf ppf "Invalid endpoint: %s" msg

     

       37
        
       

     

       38
        
       type endp_stats = {

     

       39
        
         mutable active : int;

     
···

       62
        
       

     

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

     

       64
        
       

     

       65
       -
       module EndpointTbl = Hashtbl.Make(struct

     

       66
        
         type t = Endpoint.t

     

       0
        
       
     

       67
        
         let equal = Endpoint.equal

     

       68
        
         let hash = Endpoint.hash

     

       69
        
       end)

     

       70
        
       

     

       71
       -
       let get_time (pool : ('clock, 'net) internal) =

     

       72
       -
         Eio.Time.now pool.clock

     

       73
        
       

     

       74
       -
       let create_endp_stats () = {

     

       75
       -
         active = 0;

     

       76
       -
         idle = 0;

     

       77
       -
         total_created = 0;

     

       78
       -
         total_reused = 0;

     

       79
       -
         total_closed = 0;

     

       80
       -
         errors = 0;

     

       81
       -
       }

     

       0
        
       
     

       82
        
       

     

       83
        
       let snapshot_stats (stats : endp_stats) : Stats.t =

     

       84
       -
         Stats.make

     

       85
       -
           ~active:stats.active

     

       86
       -
           ~idle:stats.idle

     

       87
       -
           ~total_created:stats.total_created

     

       88
       -
           ~total_reused:stats.total_reused

     

       89
       -
           ~total_closed:stats.total_closed

     

       90
       -
           ~errors:stats.errors

     

       91
        
       

     

       92
        
       (** {1 DNS Resolution} *)

     

       93
        
       

     

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

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

       98
        
         match addrs with

     

       99
        
         | addr :: _ ->

     

       100
       -
             Log.debug (fun m -> m "Resolved %a to %a"

     

       101
       -
               Endpoint.pp endpoint Eio.Net.Sockaddr.pp addr);

     

       102
        
             addr

     

       103
        
         | [] ->

     

       104
       -
             Log.err (fun m -> m "Failed to resolve hostname: %s" (Endpoint.host endpoint));

     

       105
       -
             raise (Pool_error (Dns_resolution_failed { hostname = Endpoint.host endpoint }))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       106
        
       

     

       107
        
       (** {1 Connection Creation with Retry} *)

     

       108
        
       

     

       109
       -
       let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint attempt last_error =

     

       0
        
       
     

       110
        
         let retry_count = Config.connect_retry_count pool.config in

     

       111
        
         if attempt > retry_count then begin

     

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

     

       113
       -
             Endpoint.pp endpoint retry_count);

     

       114
       -
           raise (Pool_error (Connection_failed { endpoint; attempts = retry_count; last_error }))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       115
        
         end;

     

       116
        
       

     

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

     

       118
       -
           Endpoint.pp endpoint attempt retry_count);

     

       0
        
       
     

       119
        
       

     

       120
        
         try

     

       121
        
           let addr = resolve_endpoint pool endpoint in

     
···

       125
        
           let socket =

     

       126
        
             match Config.connect_timeout pool.config with

     

       127
        
             | Some timeout ->

     

       128
       -
                 Eio.Time.with_timeout_exn pool.clock timeout

     

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

     

       130
       -
             | None ->

     

       131
       -
                 Eio.Net.connect ~sw:pool.sw pool.net addr

     

       132
        
           in

     

       133
        
       

     

       134
       -
           Log.debug (fun m -> m "TCP connection established to %a" Endpoint.pp endpoint);

     

       0
        
       
     

       135
        
       

     

       136
       -
           let flow = match pool.tls with

     

       137
       -
             | None -> (socket :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)

     

       0
        
       
     

       0
        
       
     

       138
        
             | Some tls_cfg ->

     

       139
       -
                 Log.debug (fun m -> m "Initiating TLS handshake with %a" Endpoint.pp endpoint);

     

       140
       -
                 let host = match Tls_config.servername tls_cfg with

     

       0
        
       
     

       0
        
       
     

       141
        
                   | Some name -> Domain_name.(host_exn (of_string_exn name))

     

       142
       -
                   | None -> Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))

     

       0
        
       
     

       143
        
                 in

     

       144
       -
                 let tls_flow = Tls_eio.client_of_flow ~host (Tls_config.config tls_cfg) socket in

     

       145
       -
                 Log.info (fun m -> m "TLS connection established to %a" Endpoint.pp endpoint);

     

       146
       -
                 (tls_flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       147
        
           in

     

       148
        
       

     

       149
        
           let now = get_time pool in

     
···

       156
        
             endpoint;

     

       157
        
             mutex = Eio.Mutex.create ();

     

       158
        
           }

     

       159
       -
       

     

       160
        
         with

     

       161
        
         | Eio.Time.Timeout as e ->

     

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

     

       0
        
       
     

       163
        
             let error_msg = Printexc.to_string e in

     

       164
        
             if attempt >= Config.connect_retry_count pool.config then

     

       165
        
               (* Last attempt - convert to our error type *)

     
···

       167
        
               | Some timeout ->

     

       168
        
                   raise (Pool_error (Connection_timeout { endpoint; timeout }))

     

       169
        
               | None ->

     

       170
       -
                   raise (Pool_error (Connection_failed { endpoint; attempts = attempt; last_error = error_msg }))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       171
        
             else begin

     

       172
        
               (* Retry with exponential backoff *)

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       174
        
               Eio.Time.sleep pool.clock delay;

     

       175
        
               create_connection_with_retry pool endpoint (attempt + 1) error_msg

     

       176
        
             end

     

       177
        
         | e ->

     

       178
        
             (* Other errors - retry with backoff *)

     

       179
        
             let error_msg = Printexc.to_string e in

     

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

     

       181
       -
               attempt Endpoint.pp endpoint error_msg);

     

       0
        
       
     

       182
        
             if attempt < Config.connect_retry_count pool.config then (

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       184
        
               Eio.Time.sleep pool.clock delay;

     

       185
       -
               create_connection_with_retry pool endpoint (attempt + 1) error_msg

     

       186
       -
             ) else

     

       187
       -
               raise (Pool_error (Connection_failed { endpoint; attempts = attempt; last_error = error_msg }))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       188
        
       

     

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

     

       190
        
         create_connection_with_retry pool endpoint 1 "No attempts made"

     
···

       198
        
         let age = now -. Connection.created_at conn in

     

       199
        
         let max_lifetime = Config.max_connection_lifetime pool.config in

     

       200
        
         if age > max_lifetime then begin

     

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

     

       202
       -
             Endpoint.pp (Connection.endpoint conn) age max_lifetime);

     

       0
        
       
     

       203
        
           false

     

       204
        
         end

     

       205
       -
       

     

       206
        
         (* Check idle time *)

     

       207
       -
         else begin

     

       208
        
           let max_idle = Config.max_idle_time pool.config in

     

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

     

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

     

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

     

       212
       -
               Endpoint.pp (Connection.endpoint conn) idle_time max_idle);

     

       213
       -
             false

     

       214
       -
           end

     

       215
       -
       

     

       216
       -
           (* Check use count *)

     

       217
       -
           else if (match Config.max_connection_uses pool.config with

     

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

     

       219
       -
                    | None -> false) then begin

     

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

     

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

     

       222
        
             false

     

       223
       -
           end

     

       224
       -
       

     

       225
       -
           (* Optional: custom health check *)

     

       226
       -
           else if (match Config.health_check pool.config with

     

       227
       -
                    | Some check ->

     

       228
       -
                        (try

     

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

     

       230
       -
                          if not healthy then

     

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

     

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

     

       233
       -
                          not healthy

     

       234
       -
                         with e ->

     

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

     

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

     

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

     

       238
       -
                    | None -> false) then

     

       239
        
             false

     

       240
       -
       

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       242
        
           else if check_readable then

     

       243
        
             try

     

       244
        
               (* TODO avsm: a sockopt for this? *)

     

       245
        
               true

     

       246
       -
             with

     

       247
       -
             | _ -> false

     

       248
       -
       

     

       249
        
           else begin

     

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

     

       251
       -
               Endpoint.pp (Connection.endpoint conn)

     

       252
       -
               age

     

       253
       -
               (now -. Connection.last_used conn)

     

       254
       -
               (Connection.use_count conn));

     

       255
        
             true

     

       256
        
           end

     

       257
        
         end

     
···

       259
        
       (** {1 Internal Pool Operations} *)

     

       260
        
       

     

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

     

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

     

       263
       -
           Endpoint.pp (Connection.endpoint conn)

     

       264
       -
           (get_time pool -. Connection.created_at conn)

     

       265
       -
           (Connection.use_count conn));

     

       0
        
       
     

       266
        
       

     

       267
        
         Eio.Cancel.protect (fun () ->

     

       268
       -
           try

     

       269
       -
             Eio.Flow.close (Connection.flow conn)

     

       270
       -
           with _ -> ()

     

       271
       -
         );

     

       272
        
       

     

       273
        
         (* Call hook if configured *)

     

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

     

       0
        
       
     

       0
        
       
     

       275
        
       

     

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

     

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

     

       0
        
       
     

       278
        
       

     

       279
        
         (* First try with read lock *)

     

       280
       -
         match Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->

     

       281
       -
           Hashtbl.find_opt pool.endpoints endpoint

     

       282
       -
         ) with

     

       0
        
       
     

       283
        
         | Some ep_pool ->

     

       284
       -
             Log.debug (fun m -> m "Found existing endpoint pool for %a" Endpoint.pp endpoint);

     

       0
        
       
     

       285
        
             ep_pool

     

       286
        
         | None ->

     

       287
       -
             Log.debug (fun m -> m "No existing pool, need to create for %a" Endpoint.pp endpoint);

     

       0
        
       
     

       288
        
             (* Need to create - use write lock *)

     

       289
        
             Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->

     

       290
       -
               (* Check again in case another fiber created it *)

     

       291
       -
               match Hashtbl.find_opt pool.endpoints endpoint with

     

       292
       -
               | Some ep_pool ->

     

       293
       -
                   Log.debug (fun m -> m "Another fiber created pool for %a" Endpoint.pp endpoint);

     

       294
       -
                   ep_pool

     

       295
       -
               | None ->

     

       0
        
       
     

       296
        
                     (* Create new endpoint pool *)

     

       297
        
                     let stats = create_endp_stats () in

     

       298
        
                     let mutex = Eio.Mutex.create () in

     

       299
        
       

     

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

     

       301
       -
                       Endpoint.pp endpoint (Config.max_connections_per_endpoint pool.config));

     

       0
        
       
     

       0
        
       
     

       302
        
       

     

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

     

       0
        
       
     

       304
        
       

     

       305
       -
                     let eio_pool = Eio.Pool.create

     

       306
       -
                       (Config.max_connections_per_endpoint pool.config)

     

       307
       -
                       ~validate:(fun conn ->

     

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

     

       309
       -
                         (* Called before reusing from pool *)

     

       310
       -
                         let healthy = is_healthy pool ~check_readable:false conn in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       311
        
       

     

       312
       -
                         if healthy then (

     

       313
       -
                           Log.debug (fun m -> m "Reusing connection to %a from pool" Endpoint.pp endpoint);

     

       0
        
       
     

       0
        
       
     

       314
        
       

     

       315
       -
                           (* Update stats for reuse *)

     

       316
       -
                           Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       317
       -
                             stats.total_reused <- stats.total_reused + 1

     

       318
       -
                           );

     

       319
        
       

     

       320
       -
                           (* Call hook if configured *)

     

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

     

       0
        
       
     

       0
        
       
     

       322
        
       

     

       323
       -
                           (* Run health check if configured *)

     

       324
       -
                           match Config.health_check pool.config with

     

       325
       -
                           | Some check ->

     

       326
       -
                               (try check (Connection.flow conn)

     

       327
       -
                                with _ -> false)

     

       328
       -
                           | None -> true

     

       329
       -
                         ) else begin

     

       330
       -
                           Log.debug (fun m -> m "Connection to %a failed validation, creating new one" Endpoint.pp endpoint);

     

       331
       -
                           false

     

       332
       -
                         end

     

       333
       -
                       )

     

       334
       -
                       ~dispose:(fun conn ->

     

       335
       -
                         (* Called when removing from pool *)

     

       336
       -
                         Eio.Cancel.protect (fun () ->

     

       337
       -
                           close_internal pool conn;

     

       0
        
       
     

       0
        
       
     

       338
        
       

     

       339
       -
                           (* Update stats *)

     

       340
       -
                           Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       341
       -
                             stats.total_closed <- stats.total_closed + 1

     

       342
       -
                           )

     

       343
       -
                         )

     

       344
       -
                       )

     

       345
       -
                       (fun () ->

     

       346
       -
                         Log.debug (fun m -> m "Factory function called for %a" Endpoint.pp endpoint);

     

       347
       -
                         try

     

       348
       -
                           let conn = create_connection pool endpoint in

     

       349
        
       

     

       350
       -
                           Log.debug (fun m -> m "Connection created successfully for %a" Endpoint.pp endpoint);

     

       0
        
       
     

       0
        
       
     

       351
        
       

     

       352
       -
                           (* Update stats *)

     

       353
       -
                           Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       354
       -
                             stats.total_created <- stats.total_created + 1

     

       355
       -
                           );

     

       356
        
       

     

       357
       -
                           (* Call hook if configured *)

     

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

     

       0
        
       
     

       0
        
       
     

       359
        
       

     

       360
       -
                           conn

     

       361
       -
                         with e ->

     

       362
       -
                           Log.err (fun m -> m "Factory function failed for %a: %s"

     

       363
       -
                             Endpoint.pp endpoint (Printexc.to_string e));

     

       364
       -
                           (* Update error stats *)

     

       365
       -
                           Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       366
       -
                             stats.errors <- stats.errors + 1

     

       367
       -
                           );

     

       368
       -
                           raise e

     

       369
       -
                       )

     

       370
        
                     in

     

       371
        
       

     

       372
       -
                     Log.debug (fun m -> m "Eio.Pool created successfully for %a" Endpoint.pp endpoint);

     

       0
        
       
     

       373
        
       

     

       374
       -
                     let ep_pool = {

     

       375
       -
                       pool = eio_pool;

     

       376
       -
                       stats;

     

       377
       -
                       mutex;

     

       378
       -
                     } in

     

       379
        
       

     

       380
        
                     Hashtbl.add pool.endpoints endpoint ep_pool;

     

       381
       -
                     Log.debug (fun m -> m "Endpoint pool added to hashtable for %a" Endpoint.pp endpoint);

     

       382
       -
                     ep_pool

     

       383
       -
               )

     

       0
        
       
     

       384
        
       

     

       385
        
       (** {1 Public API - Pool Creation} *)

     

       386
        
       

     

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

     

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

     

       389
       -
           (Config.max_connections_per_endpoint config)

     

       390
       -
           (Config.max_idle_time config)

     

       391
       -
           (Config.max_connection_lifetime config));

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       392
        
       

     

       393
       -
         let pool = {

     

       394
       -
           sw;

     

       395
       -
           net;

     

       396
       -
           clock;

     

       397
       -
           config;

     

       398
       -
           tls;

     

       399
       -
           endpoints = Hashtbl.create 16;

     

       400
       -
           endpoints_mutex = Eio.Mutex.create ();

     

       401
       -
         } in

     

       0
        
       
     

       0
        
       
     

       402
        
       

     

       403
        
         (* Auto-cleanup on switch release *)

     

       404
        
         Eio.Switch.on_release sw (fun () ->

     

       405
       -
           Eio.Cancel.protect (fun () ->

     

       406
       -
             Log.info (fun m -> m "Closing connection pool");

     

       407
       -
             (* Close all idle connections - active ones will be cleaned up by switch *)

     

       408
       -
             Hashtbl.iter (fun _endpoint _ep_pool ->

     

       409
       -
               (* Connections are bound to the switch and will be auto-closed *)

     

       410
       -
               ()

     

       411
       -
             ) pool.endpoints;

     

       0
        
       
     

       412
        
       

     

       413
       -
             Hashtbl.clear pool.endpoints

     

       414
       -
           )

     

       415
       -
         );

     

       416
        
       

     

       417
        
         T pool

     

       418
        
       

     
···

       424
        
       

     

       425
        
         (* Increment active count *)

     

       426
        
         Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       427
       -
           ep_pool.stats.active <- ep_pool.stats.active + 1

     

       428
       -
         );

     

       429
        
       

     

       430
        
         Fun.protect

     

       431
        
           ~finally:(fun () ->

     

       432
        
             (* Decrement active count *)

     

       433
        
             Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       434
       -
               ep_pool.stats.active <- ep_pool.stats.active - 1

     

       435
       -
             );

     

       436
       -
             Log.debug (fun m -> m "Released connection to %a" Endpoint.pp endpoint)

     

       437
       -
           )

     

       438
        
           (fun () ->

     

       439
        
             (* Use Eio.Pool for resource management *)

     

       440
        
             Eio.Pool.use ep_pool.pool (fun conn ->

     

       441
       -
               Log.debug (fun m -> m "Using connection to %a (uses=%d)"

     

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

     

       0
        
       
     

       443
        
       

     

       444
       -
               (* Update last used time and use count *)

     

       445
       -
               Connection.update_usage conn ~now:(get_time pool);

     

       446
        
       

     

       447
       -
               (* Update idle stats (connection taken from idle pool) *)

     

       448
       -
               Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       449
       -
                 ep_pool.stats.idle <- max 0 (ep_pool.stats.idle - 1)

     

       450
       -
               );

     

       451
        
       

     

       452
       -
               try

     

       453
       -
                 let result = f conn.flow in

     

       454
        
       

     

       455
       -
                 (* Success - connection will be returned to pool by Eio.Pool *)

     

       456
       -
                 (* Update idle stats (connection returned to idle pool) *)

     

       457
       -
                 Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       458
       -
                   ep_pool.stats.idle <- ep_pool.stats.idle + 1

     

       459
       -
                 );

     

       460
        
       

     

       461
       -
                 result

     

       462
       -
               with e ->

     

       463
       -
                 (* Error - close connection so it won't be reused *)

     

       464
       -
                 Log.warn (fun m -> m "Error using connection to %a: %s"

     

       465
       -
                   Endpoint.pp endpoint (Printexc.to_string e));

     

       466
       -
                 close_internal pool conn;

     

       0
        
       
     

       467
        
       

     

       468
       -
                 (* Update error stats *)

     

       469
       -
                 Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       470
       -
                   ep_pool.stats.errors <- ep_pool.stats.errors + 1

     

       471
       -
                 );

     

       472
        
       

     

       473
       -
                 raise e

     

       474
       -
             )

     

       475
       -
           )

     

       476
        
       

     

       477
        
       (** {1 Public API - Statistics} *)

     

       478
        
       

     

       479
        
       let stats (T pool) endpoint =

     

       480
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       481
        
         | Some ep_pool ->

     

       482
       -
             Eio.Mutex.use_ro ep_pool.mutex (fun () ->

     

       483
       -
               snapshot_stats ep_pool.stats

     

       484
       -
             )

     

       485
        
         | None ->

     

       486
        
             (* No pool for this endpoint yet *)

     

       487
       -
             Stats.make

     

       488
       -
               ~active:0

     

       489
       -
               ~idle:0

     

       490
       -
               ~total_created:0

     

       491
       -
               ~total_reused:0

     

       492
       -
               ~total_closed:0

     

       493
       -
               ~errors:0

     

       494
        
       

     

       495
        
       let all_stats (T pool) =

     

       496
        
         Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->

     

       497
       -
           Hashtbl.fold (fun endpoint ep_pool acc ->

     

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

     

       499
       -
               snapshot_stats ep_pool.stats

     

       500
       -
             ) in

     

       501
       -
             (endpoint, stats) :: acc

     

       502
       -
           ) pool.endpoints []

     

       503
       -
         )

     

       0
        
       
     

       504
        
       

     

       505
        
       (** {1 Public API - Pool Management} *)

     

       506
        
       

     
···

       509
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       510
        
         | Some _ep_pool ->

     

       511
        
             Eio.Cancel.protect (fun () ->

     

       512
       -
               (* Remove endpoint pool from hashtable *)

     

       513
       -
               (* Idle connections will be discarded *)

     

       514
       -
               (* Active connections will be closed when returned *)

     

       515
       -
               Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->

     

       516
       -
                 Hashtbl.remove pool.endpoints endpoint

     

       517
       -
               )

     

       518
       -
             )

     

       519
        
         | None ->

     

       520
       -
             Log.debug (fun m -> m "No endpoint pool found for %a" Endpoint.pp endpoint)

     

       0

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)

     

       7
        
       

     

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

     

       9
       +
       

     

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

     

       11
        
       

     

       12
        
       (* Re-export submodules *)

     
···

       20
        
       

     

       21
        
       type error =

     

       22
        
         | Dns_resolution_failed of { hostname : string }

     

       23
       +
         | Connection_failed of {

     

       24
       +
             endpoint : Endpoint.t;

     

       25
       +
             attempts : int;

     

       26
       +
             last_error : string;

     

       27
       +
           }

     

       28
        
         | Connection_timeout of { endpoint : Endpoint.t; timeout : float }

     

       29
        
         | Invalid_config of string

     

       30
        
         | Invalid_endpoint of string

     
···

       35
        
         | Dns_resolution_failed { hostname } ->

     

       36
        
             Fmt.pf ppf "DNS resolution failed for hostname: %s" hostname

     

       37
        
         | Connection_failed { endpoint; attempts; last_error } ->

     

       38
       +
             Fmt.pf ppf "Failed to connect to %a after %d attempts: %s" Endpoint.pp

     

       39
       +
               endpoint attempts last_error

     

       40
        
         | Connection_timeout { endpoint; timeout } ->

     

       41
       +
             Fmt.pf ppf "Connection timeout to %a after %.2fs" Endpoint.pp endpoint

     

       42
       +
               timeout

     

       43
       +
         | Invalid_config msg -> Fmt.pf ppf "Invalid configuration: %s" msg

     

       44
       +
         | Invalid_endpoint msg -> Fmt.pf ppf "Invalid endpoint: %s" msg

     

       0
        
       
     

       0
        
       
     

       45
        
       

     

       46
        
       type endp_stats = {

     

       47
        
         mutable active : int;

     
···

       70
        
       

     

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

     

       72
        
       

     

       73
       +
       module EndpointTbl = Hashtbl.Make (struct

     

       74
        
         type t = Endpoint.t

     

       75
       +
       

     

       76
        
         let equal = Endpoint.equal

     

       77
        
         let hash = Endpoint.hash

     

       78
        
       end)

     

       79
        
       

     

       80
       +
       let get_time (pool : ('clock, 'net) internal) = Eio.Time.now pool.clock

     

       0
        
       
     

       81
        
       

     

       82
       +
       let create_endp_stats () =

     

       83
       +
         {

     

       84
       +
           active = 0;

     

       85
       +
           idle = 0;

     

       86
       +
           total_created = 0;

     

       87
       +
           total_reused = 0;

     

       88
       +
           total_closed = 0;

     

       89
       +
           errors = 0;

     

       90
       +
         }

     

       91
        
       

     

       92
        
       let snapshot_stats (stats : endp_stats) : Stats.t =

     

       93
       +
         Stats.make ~active:stats.active ~idle:stats.idle

     

       94
       +
           ~total_created:stats.total_created ~total_reused:stats.total_reused

     

       95
       +
           ~total_closed:stats.total_closed ~errors:stats.errors

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       96
        
       

     

       97
        
       (** {1 DNS Resolution} *)

     

       98
        
       

     

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

     

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

     

       101
       +
         let addrs =

     

       102
       +
           Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint)

     

       103
       +
             ~service:(string_of_int (Endpoint.port endpoint))

     

       104
       +
         in

     

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

     

       106
        
         match addrs with

     

       107
        
         | addr :: _ ->

     

       108
       +
             Log.debug (fun m ->

     

       109
       +
                 m "Resolved %a to %a" Endpoint.pp endpoint Eio.Net.Sockaddr.pp addr);

     

       110
        
             addr

     

       111
        
         | [] ->

     

       112
       +
             Log.err (fun m ->

     

       113
       +
                 m "Failed to resolve hostname: %s" (Endpoint.host endpoint));

     

       114
       +
             raise

     

       115
       +
               (Pool_error

     

       116
       +
                  (Dns_resolution_failed { hostname = Endpoint.host endpoint }))

     

       117
        
       

     

       118
        
       (** {1 Connection Creation with Retry} *)

     

       119
        
       

     

       120
       +
       let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint

     

       121
       +
           attempt last_error =

     

       122
        
         let retry_count = Config.connect_retry_count pool.config in

     

       123
        
         if attempt > retry_count then begin

     

       124
       +
           Log.err (fun m ->

     

       125
       +
               m "Failed to connect to %a after %d attempts" Endpoint.pp endpoint

     

       126
       +
                 retry_count);

     

       127
       +
           raise

     

       128
       +
             (Pool_error

     

       129
       +
                (Connection_failed { endpoint; attempts = retry_count; last_error }))

     

       130
        
         end;

     

       131
        
       

     

       132
       +
         Log.debug (fun m ->

     

       133
       +
             m "Connecting to %a (attempt %d/%d)" Endpoint.pp endpoint attempt

     

       134
       +
               retry_count);

     

       135
        
       

     

       136
        
         try

     

       137
        
           let addr = resolve_endpoint pool endpoint in

     
···

       141
        
           let socket =

     

       142
        
             match Config.connect_timeout pool.config with

     

       143
        
             | Some timeout ->

     

       144
       +
                 Eio.Time.with_timeout_exn pool.clock timeout (fun () ->

     

       145
       +
                     Eio.Net.connect ~sw:pool.sw pool.net addr)

     

       146
       +
             | None -> Eio.Net.connect ~sw:pool.sw pool.net addr

     

       0
        
       
     

       147
        
           in

     

       148
        
       

     

       149
       +
           Log.debug (fun m ->

     

       150
       +
               m "TCP connection established to %a" Endpoint.pp endpoint);

     

       151
        
       

     

       152
       +
           let flow =

     

       153
       +
             match pool.tls with

     

       154
       +
             | None ->

     

       155
       +
                 (socket :> [ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t)

     

       156
        
             | Some tls_cfg ->

     

       157
       +
                 Log.debug (fun m ->

     

       158
       +
                     m "Initiating TLS handshake with %a" Endpoint.pp endpoint);

     

       159
       +
                 let host =

     

       160
       +
                   match Tls_config.servername tls_cfg with

     

       161
        
                   | Some name -> Domain_name.(host_exn (of_string_exn name))

     

       162
       +
                   | None ->

     

       163
       +
                       Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))

     

       164
        
                 in

     

       165
       +
                 let tls_flow =

     

       166
       +
                   Tls_eio.client_of_flow ~host (Tls_config.config tls_cfg) socket

     

       167
       +
                 in

     

       168
       +
                 Log.info (fun m ->

     

       169
       +
                     m "TLS connection established to %a" Endpoint.pp endpoint);

     

       170
       +
                 (tls_flow :> [ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t)

     

       171
        
           in

     

       172
        
       

     

       173
        
           let now = get_time pool in

     
···

       180
        
             endpoint;

     

       181
        
             mutex = Eio.Mutex.create ();

     

       182
        
           }

     

       0
        
       
     

       183
        
         with

     

       184
        
         | Eio.Time.Timeout as e ->

     

       185
       +
             Log.warn (fun m ->

     

       186
       +
                 m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);

     

       187
        
             let error_msg = Printexc.to_string e in

     

       188
        
             if attempt >= Config.connect_retry_count pool.config then

     

       189
        
               (* Last attempt - convert to our error type *)

     
···

       191
        
               | Some timeout ->

     

       192
        
                   raise (Pool_error (Connection_timeout { endpoint; timeout }))

     

       193
        
               | None ->

     

       194
       +
                   raise

     

       195
       +
                     (Pool_error

     

       196
       +
                        (Connection_failed

     

       197
       +
                           { endpoint; attempts = attempt; last_error = error_msg }))

     

       198
        
             else begin

     

       199
        
               (* Retry with exponential backoff *)

     

       200
       +
               let delay =

     

       201
       +
                 Config.connect_retry_delay pool.config

     

       202
       +
                 *. (2.0 ** float_of_int (attempt - 1))

     

       203
       +
               in

     

       204
        
               Eio.Time.sleep pool.clock delay;

     

       205
        
               create_connection_with_retry pool endpoint (attempt + 1) error_msg

     

       206
        
             end

     

       207
        
         | e ->

     

       208
        
             (* Other errors - retry with backoff *)

     

       209
        
             let error_msg = Printexc.to_string e in

     

       210
       +
             Log.warn (fun m ->

     

       211
       +
                 m "Connection attempt %d to %a failed: %s" attempt Endpoint.pp

     

       212
       +
                   endpoint error_msg);

     

       213
        
             if attempt < Config.connect_retry_count pool.config then (

     

       214
       +
               let delay =

     

       215
       +
                 Config.connect_retry_delay pool.config

     

       216
       +
                 *. (2.0 ** float_of_int (attempt - 1))

     

       217
       +
               in

     

       218
        
               Eio.Time.sleep pool.clock delay;

     

       219
       +
               create_connection_with_retry pool endpoint (attempt + 1) error_msg)

     

       220
       +
             else

     

       221
       +
               raise

     

       222
       +
                 (Pool_error

     

       223
       +
                    (Connection_failed

     

       224
       +
                       { endpoint; attempts = attempt; last_error = error_msg }))

     

       225
        
       

     

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

     

       227
        
         create_connection_with_retry pool endpoint 1 "No attempts made"

     
···

       235
        
         let age = now -. Connection.created_at conn in

     

       236
        
         let max_lifetime = Config.max_connection_lifetime pool.config in

     

       237
        
         if age > max_lifetime then begin

     

       238
       +
           Log.debug (fun m ->

     

       239
       +
               m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"

     

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

     

       241
        
           false

     

       242
        
         end

     

       0
        
       
     

       243
        
         (* Check idle time *)

     

       244
       +
           else begin

     

       245
        
           let max_idle = Config.max_idle_time pool.config in

     

       246
       +
           if now -. Connection.last_used conn > max_idle then begin

     

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

     

       248
       +
             Log.debug (fun m ->

     

       249
       +
                 m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       251
        
             false

     

       252
       +
           end (* Check use count *)

     

       253
       +
           else if

     

       254
       +
             match Config.max_connection_uses pool.config with

     

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

     

       256
       +
             | None -> false

     

       257
       +
           then begin

     

       258
       +
             Log.debug (fun m ->

     

       259
       +
                 m "Connection to %a unhealthy: exceeded max use count (%d)"

     

       260
       +
                   Endpoint.pp (Connection.endpoint conn)

     

       261
       +
                   (Connection.use_count conn));

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       262
        
             false

     

       263
       +
           end (* Optional: custom health check *)

     

       264
       +
           else if

     

       265
       +
             match Config.health_check pool.config with

     

       266
       +
             | Some check -> (

     

       267
       +
                 try

     

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

     

       269
       +
                   if not healthy then

     

       270
       +
                     Log.debug (fun m ->

     

       271
       +
                         m "Connection to %a failed custom health check" Endpoint.pp

     

       272
       +
                           (Connection.endpoint conn));

     

       273
       +
                   not healthy

     

       274
       +
                 with e ->

     

       275
       +
                   Log.debug (fun m ->

     

       276
       +
                       m "Connection to %a health check raised exception: %s"

     

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

     

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

     

       279
       +
             | None -> false

     

       280
       +
           then false (* Optional: check if socket still connected *)

     

       281
        
           else if check_readable then

     

       282
        
             try

     

       283
        
               (* TODO avsm: a sockopt for this? *)

     

       284
        
               true

     

       285
       +
             with _ -> false

     

       0
        
       
     

       0
        
       
     

       286
        
           else begin

     

       287
       +
             Log.debug (fun m ->

     

       288
       +
                 m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"

     

       289
       +
                   Endpoint.pp (Connection.endpoint conn) age

     

       290
       +
                   (now -. Connection.last_used conn)

     

       291
       +
                   (Connection.use_count conn));

     

       292
        
             true

     

       293
        
           end

     

       294
        
         end

     
···

       296
        
       (** {1 Internal Pool Operations} *)

     

       297
        
       

     

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

     

       299
       +
         Log.debug (fun m ->

     

       300
       +
             m "Closing connection to %a (age=%.2fs, uses=%d)" Endpoint.pp

     

       301
       +
               (Connection.endpoint conn)

     

       302
       +
               (get_time pool -. Connection.created_at conn)

     

       303
       +
               (Connection.use_count conn));

     

       304
        
       

     

       305
        
         Eio.Cancel.protect (fun () ->

     

       306
       +
             try Eio.Flow.close (Connection.flow conn) with _ -> ());

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       307
        
       

     

       308
        
         (* Call hook if configured *)

     

       309
       +
         Option.iter

     

       310
       +
           (fun f -> f (Connection.endpoint conn))

     

       311
       +
           (Config.on_connection_closed pool.config)

     

       312
        
       

     

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

     

       314
       +
         Log.debug (fun m ->

     

       315
       +
             m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);

     

       316
        
       

     

       317
        
         (* First try with read lock *)

     

       318
       +
         match

     

       319
       +
           Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->

     

       320
       +
               Hashtbl.find_opt pool.endpoints endpoint)

     

       321
       +
         with

     

       322
        
         | Some ep_pool ->

     

       323
       +
             Log.debug (fun m ->

     

       324
       +
                 m "Found existing endpoint pool for %a" Endpoint.pp endpoint);

     

       325
        
             ep_pool

     

       326
        
         | None ->

     

       327
       +
             Log.debug (fun m ->

     

       328
       +
                 m "No existing pool, need to create for %a" Endpoint.pp endpoint);

     

       329
        
             (* Need to create - use write lock *)

     

       330
        
             Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->

     

       331
       +
                 (* Check again in case another fiber created it *)

     

       332
       +
                 match Hashtbl.find_opt pool.endpoints endpoint with

     

       333
       +
                 | Some ep_pool ->

     

       334
       +
                     Log.debug (fun m ->

     

       335
       +
                         m "Another fiber created pool for %a" Endpoint.pp endpoint);

     

       336
       +
                     ep_pool

     

       337
       +
                 | None ->

     

       338
        
                     (* Create new endpoint pool *)

     

       339
        
                     let stats = create_endp_stats () in

     

       340
        
                     let mutex = Eio.Mutex.create () in

     

       341
        
       

     

       342
       +
                     Log.info (fun m ->

     

       343
       +
                         m "Creating new endpoint pool for %a (max_connections=%d)"

     

       344
       +
                           Endpoint.pp endpoint

     

       345
       +
                           (Config.max_connections_per_endpoint pool.config));

     

       346
        
       

     

       347
       +
                     Log.debug (fun m ->

     

       348
       +
                         m "About to create Eio.Pool for %a" Endpoint.pp endpoint);

     

       349
        
       

     

       350
       +
                     let eio_pool =

     

       351
       +
                       Eio.Pool.create

     

       352
       +
                         (Config.max_connections_per_endpoint pool.config)

     

       353
       +
                         ~validate:(fun conn ->

     

       354
       +
                           Log.debug (fun m ->

     

       355
       +
                               m "Validate called for connection to %a" Endpoint.pp

     

       356
       +
                                 endpoint);

     

       357
       +
                           (* Called before reusing from pool *)

     

       358
       +
                           let healthy = is_healthy pool ~check_readable:false conn in

     

       359
        
       

     

       360
       +
                           if healthy then (

     

       361
       +
                             Log.debug (fun m ->

     

       362
       +
                                 m "Reusing connection to %a from pool" Endpoint.pp

     

       363
       +
                                   endpoint);

     

       364
        
       

     

       365
       +
                             (* Update stats for reuse *)

     

       366
       +
                             Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       367
       +
                                 stats.total_reused <- stats.total_reused + 1);

     

       0
        
       
     

       368
        
       

     

       369
       +
                             (* Call hook if configured *)

     

       370
       +
                             Option.iter

     

       371
       +
                               (fun f -> f endpoint)

     

       372
       +
                               (Config.on_connection_reused pool.config);

     

       373
        
       

     

       374
       +
                             (* Run health check if configured *)

     

       375
       +
                             match Config.health_check pool.config with

     

       376
       +
                             | Some check -> (

     

       377
       +
                                 try check (Connection.flow conn) with _ -> false)

     

       378
       +
                             | None -> true)

     

       379
       +
                           else begin

     

       380
       +
                             Log.debug (fun m ->

     

       381
       +
                                 m

     

       382
       +
                                   "Connection to %a failed validation, creating new \

     

       383
       +
                                    one"

     

       384
       +
                                   Endpoint.pp endpoint);

     

       385
       +
                             false

     

       386
       +
                           end)

     

       387
       +
                         ~dispose:(fun conn ->

     

       388
       +
                           (* Called when removing from pool *)

     

       389
       +
                           Eio.Cancel.protect (fun () ->

     

       390
       +
                               close_internal pool conn;

     

       391
        
       

     

       392
       +
                               (* Update stats *)

     

       393
       +
                               Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       394
       +
                                   stats.total_closed <- stats.total_closed + 1)))

     

       395
       +
                         (fun () ->

     

       396
       +
                           Log.debug (fun m ->

     

       397
       +
                               m "Factory function called for %a" Endpoint.pp endpoint);

     

       398
       +
                           try

     

       399
       +
                             let conn = create_connection pool endpoint in

     

       0
        
       
     

       0
        
       
     

       400
        
       

     

       401
       +
                             Log.debug (fun m ->

     

       402
       +
                                 m "Connection created successfully for %a" Endpoint.pp

     

       403
       +
                                   endpoint);

     

       404
        
       

     

       405
       +
                             (* Update stats *)

     

       406
       +
                             Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       407
       +
                                 stats.total_created <- stats.total_created + 1);

     

       0
        
       
     

       408
        
       

     

       409
       +
                             (* Call hook if configured *)

     

       410
       +
                             Option.iter

     

       411
       +
                               (fun f -> f endpoint)

     

       412
       +
                               (Config.on_connection_created pool.config);

     

       413
        
       

     

       414
       +
                             conn

     

       415
       +
                           with e ->

     

       416
       +
                             Log.err (fun m ->

     

       417
       +
                                 m "Factory function failed for %a: %s" Endpoint.pp

     

       418
       +
                                   endpoint (Printexc.to_string e));

     

       419
       +
                             (* Update error stats *)

     

       420
       +
                             Eio.Mutex.use_rw ~protect:true mutex (fun () ->

     

       421
       +
                                 stats.errors <- stats.errors + 1);

     

       422
       +
                             raise e)

     

       0
        
       
     

       423
        
                     in

     

       424
        
       

     

       425
       +
                     Log.debug (fun m ->

     

       426
       +
                         m "Eio.Pool created successfully for %a" Endpoint.pp endpoint);

     

       427
        
       

     

       428
       +
                     let ep_pool = { pool = eio_pool; stats; mutex } in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       429
        
       

     

       430
        
                     Hashtbl.add pool.endpoints endpoint ep_pool;

     

       431
       +
                     Log.debug (fun m ->

     

       432
       +
                         m "Endpoint pool added to hashtable for %a" Endpoint.pp

     

       433
       +
                           endpoint);

     

       434
       +
                     ep_pool)

     

       435
        
       

     

       436
        
       (** {1 Public API - Pool Creation} *)

     

       437
        
       

     

       438
       +
       let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls

     

       439
       +
           ?(config = Config.default) () : t =

     

       440
       +
         Log.info (fun m ->

     

       441
       +
             m

     

       442
       +
               "Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, \

     

       443
       +
                max_lifetime=%.1fs)"

     

       444
       +
               (Config.max_connections_per_endpoint config)

     

       445
       +
               (Config.max_idle_time config)

     

       446
       +
               (Config.max_connection_lifetime config));

     

       447
        
       

     

       448
       +
         let pool =

     

       449
       +
           {

     

       450
       +
             sw;

     

       451
       +
             net;

     

       452
       +
             clock;

     

       453
       +
             config;

     

       454
       +
             tls;

     

       455
       +
             endpoints = Hashtbl.create 16;

     

       456
       +
             endpoints_mutex = Eio.Mutex.create ();

     

       457
       +
           }

     

       458
       +
         in

     

       459
        
       

     

       460
        
         (* Auto-cleanup on switch release *)

     

       461
        
         Eio.Switch.on_release sw (fun () ->

     

       462
       +
             Eio.Cancel.protect (fun () ->

     

       463
       +
                 Log.info (fun m -> m "Closing connection pool");

     

       464
       +
                 (* Close all idle connections - active ones will be cleaned up by switch *)

     

       465
       +
                 Hashtbl.iter

     

       466
       +
                   (fun _endpoint _ep_pool ->

     

       467
       +
                     (* Connections are bound to the switch and will be auto-closed *)

     

       468
       +
                     ())

     

       469
       +
                   pool.endpoints;

     

       470
        
       

     

       471
       +
                 Hashtbl.clear pool.endpoints));

     

       0
        
       
     

       0
        
       
     

       472
        
       

     

       473
        
         T pool

     

       474
        
       

     
···

       480
        
       

     

       481
        
         (* Increment active count *)

     

       482
        
         Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       483
       +
             ep_pool.stats.active <- ep_pool.stats.active + 1);

     

       0
        
       
     

       484
        
       

     

       485
        
         Fun.protect

     

       486
        
           ~finally:(fun () ->

     

       487
        
             (* Decrement active count *)

     

       488
        
             Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       489
       +
                 ep_pool.stats.active <- ep_pool.stats.active - 1);

     

       490
       +
             Log.debug (fun m -> m "Released connection to %a" Endpoint.pp endpoint))

     

       0
        
       
     

       0
        
       
     

       491
        
           (fun () ->

     

       492
        
             (* Use Eio.Pool for resource management *)

     

       493
        
             Eio.Pool.use ep_pool.pool (fun conn ->

     

       494
       +
                 Log.debug (fun m ->

     

       495
       +
                     m "Using connection to %a (uses=%d)" Endpoint.pp endpoint

     

       496
       +
                       (Connection.use_count conn));

     

       497
        
       

     

       498
       +
                 (* Update last used time and use count *)

     

       499
       +
                 Connection.update_usage conn ~now:(get_time pool);

     

       500
        
       

     

       501
       +
                 (* Update idle stats (connection taken from idle pool) *)

     

       502
       +
                 Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       503
       +
                     ep_pool.stats.idle <- max 0 (ep_pool.stats.idle - 1));

     

       0
        
       
     

       504
        
       

     

       505
       +
                 try

     

       506
       +
                   let result = f conn.flow in

     

       507
        
       

     

       508
       +
                   (* Success - connection will be returned to pool by Eio.Pool *)

     

       509
       +
                   (* Update idle stats (connection returned to idle pool) *)

     

       510
       +
                   Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       511
       +
                       ep_pool.stats.idle <- ep_pool.stats.idle + 1);

     

       0
        
       
     

       512
        
       

     

       513
       +
                   result

     

       514
       +
                 with e ->

     

       515
       +
                   (* Error - close connection so it won't be reused *)

     

       516
       +
                   Log.warn (fun m ->

     

       517
       +
                       m "Error using connection to %a: %s" Endpoint.pp endpoint

     

       518
       +
                         (Printexc.to_string e));

     

       519
       +
                   close_internal pool conn;

     

       520
        
       

     

       521
       +
                   (* Update error stats *)

     

       522
       +
                   Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->

     

       523
       +
                       ep_pool.stats.errors <- ep_pool.stats.errors + 1);

     

       0
        
       
     

       524
        
       

     

       525
       +
                   raise e))

     

       0
        
       
     

       0
        
       
     

       526
        
       

     

       527
        
       (** {1 Public API - Statistics} *)

     

       528
        
       

     

       529
        
       let stats (T pool) endpoint =

     

       530
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       531
        
         | Some ep_pool ->

     

       532
       +
             Eio.Mutex.use_ro ep_pool.mutex (fun () -> snapshot_stats ep_pool.stats)

     

       0
        
       
     

       0
        
       
     

       533
        
         | None ->

     

       534
        
             (* No pool for this endpoint yet *)

     

       535
       +
             Stats.make ~active:0 ~idle:0 ~total_created:0 ~total_reused:0

     

       536
       +
               ~total_closed:0 ~errors:0

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       537
        
       

     

       538
        
       let all_stats (T pool) =

     

       539
        
         Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->

     

       540
       +
             Hashtbl.fold

     

       541
       +
               (fun endpoint ep_pool acc ->

     

       542
       +
                 let stats =

     

       543
       +
                   Eio.Mutex.use_ro ep_pool.mutex (fun () ->

     

       544
       +
                       snapshot_stats ep_pool.stats)

     

       545
       +
                 in

     

       546
       +
                 (endpoint, stats) :: acc)

     

       547
       +
               pool.endpoints [])

     

       548
        
       

     

       549
        
       (** {1 Public API - Pool Management} *)

     

       550
        
       

     
···

       553
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       554
        
         | Some _ep_pool ->

     

       555
        
             Eio.Cancel.protect (fun () ->

     

       556
       +
                 (* Remove endpoint pool from hashtable *)

     

       557
       +
                 (* Idle connections will be discarded *)

     

       558
       +
                 (* Active connections will be closed when returned *)

     

       559
       +
                 Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->

     

       560
       +
                     Hashtbl.remove pool.endpoints endpoint))

     

       0
        
       
     

       0
        
       
     

       561
        
         | None ->

     

       562
       +
             Log.debug (fun m ->

     

       563
       +
                 m "No endpoint pool found for %a" Endpoint.pp endpoint)

+41 -49

lib/conpool.mli

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)

     

       2
        
       

     

       3
        
       (** {1 Logging} *)

     
···

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

     

       7
        
           {[

     

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

     

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

     

       10
        
           ]}

     

       11
        
       

     

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

     

       13
        
           - {!Endpoint.src} - endpoint operations

     

       14
        
           - {!Tls_config.src} - TLS configuration

     

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

     

       16
       -
       *)

     

       17
        
       

     

       18
        
       (** {1 Core Types} *)

     

       19
        
       

     

       20
       -
       (** Network endpoint representation *)

     

       21
        
       module Endpoint : module type of Endpoint

     

       0
        
       
     

       22
        
       

     

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

     

       24
        
       module Tls_config : module type of Tls_config

     

       0
        
       
     

       25
        
       

     

       26
       -
       (** Configuration for connection pools *)

     

       27
        
       module Config : module type of Config

     

       0
        
       
     

       28
        
       

     

       0
        
       
     

       29
        
       (** Statistics for connection pool endpoints *)

     

       30
       -
       module Stats : module type of Stats

     

       31
        
       

     

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

     

       33
        
       module Cmd : module type of Cmd

     

       0
        
       
     

       34
        
       

     

       35
        
       (** {1 Errors} *)

     

       36
        
       

     

       37
        
       type error =

     

       38
        
         | Dns_resolution_failed of { hostname : string }

     

       39
       -
         (** DNS resolution failed for the given hostname *)

     

       40
       -
       

     

       41
       -
         | Connection_failed of { endpoint : Endpoint.t; attempts : int; last_error : string }

     

       42
       -
         (** Failed to establish connection after all retry attempts *)

     

       43
       -
       

     

       0
        
       
     

       44
        
         | Connection_timeout of { endpoint : Endpoint.t; timeout : float }

     

       45
       -
         (** Connection attempt timed out *)

     

       46
       -
       

     

       47
       -
         | Invalid_config of string

     

       48
       -
         (** Invalid configuration parameter *)

     

       49
       -
       

     

       50
       -
         | Invalid_endpoint of string

     

       51
       -
         (** Invalid endpoint specification *)

     

       52
        
       

     

       53
        
       exception Pool_error of error

     

       54
        
       (** Exception raised by pool operations.

     
···

       70
        
         clock:'clock Eio.Time.clock ->

     

       71
        
         ?tls:Tls_config.t ->

     

       72
        
         ?config:Config.t ->

     

       73
       -
         unit -> t

     

       74
       -
       (** Create connection pool bound to switch.

     

       75
       -
           All connections will be closed when switch is released.

     

       0
        
       
     

       76
        
       

     

       77
        
           @param sw Switch for resource management

     

       78
        
           @param net Network interface for creating connections

     

       79
        
           @param clock Clock for timeouts and time-based validation

     

       80
        
           @param tls Optional TLS configuration applied to all connections

     

       81
       -
           @param config Optional pool configuration (uses Config.default if not provided) *)

     

       0
        
       
     

       82
        
       

     

       83
        
       (** {1 Connection Usage} *)

     

       84
        
       

     
···

       90
        
       (** Acquire connection, use it, automatically release back to pool.

     

       91
        
       

     

       92
        
           If idle connection available and healthy:

     

       93
       -
             - Reuse from pool (validates health first)

     

       94
       -
           Else:

     

       95
       -
             - Create new connection (may block if endpoint at limit)

     

       96
        
       

     

       97
       -
           On success: connection returned to pool for reuse

     

       98
       -
           On error: connection closed, not returned to pool

     

       99
        
       

     

       100
        
           Example:

     

       101
        
           {[

     

       102
        
             let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:443 in

     

       103
        
             Conpool.with_connection pool endpoint (fun conn ->

     

       104
       -
               (* Use conn for HTTP request, Redis command, etc. *)

     

       105
       -
               Eio.Flow.copy_string "GET / HTTP/1.1\r\n\r\n" conn;

     

       106
       -
               let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in

     

       107
       -
               Eio.Buf_read.take_all buf

     

       108
       -
             )

     

       109
       -
           ]}

     

       110
       -
       *)

     

       111
        
       

     

       112
        
       (** {1 Statistics & Monitoring} *)

     

       113
        
       

     

       114
       -
       val stats :

     

       115
       -
         t ->

     

       116
       -
         Endpoint.t ->

     

       117
       -
         Stats.t

     

       118
        
       (** Get statistics for specific endpoint *)

     

       119
        
       

     

       120
       -
       val all_stats :

     

       121
       -
         t ->

     

       122
       -
         (Endpoint.t * Stats.t) list

     

       123
        
       (** Get statistics for all endpoints in pool *)

     

       124
        
       

     

       125
        
       (** {1 Pool Management} *)

     

       126
        
       

     

       127
       -
       val clear_endpoint :

     

       128
       -
         t ->

     

       129
       -
         Endpoint.t ->

     

       130
       -
         unit

     

       131
        
       (** Clear all cached connections for a specific endpoint.

     

       132
        
       

     

       133
        
           This removes the endpoint from the pool, discarding all idle connections.

     

       134
        
           Active connections will continue to work but won't be returned to the pool.

     

       135
        
       

     

       136
       -
           Use this when you know an endpoint's connections are no longer valid

     

       137
       -
           (e.g., server restarted, network reconfigured, credentials changed).

     

       138
        
       

     

       139
        
           The pool will be automatically cleaned up when its switch is released. *)

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)

     

       7
        
       

     

       8
        
       (** {1 Logging} *)

     
···

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

     

       12
        
           {[

     

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

     

       14
       +
             Logs.set_reporter (Logs_fmt.reporter ())

     

       15
        
           ]}

     

       16
        
       

     

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

     

       18
        
           - {!Endpoint.src} - endpoint operations

     

       19
        
           - {!Tls_config.src} - TLS configuration

     

       20
       +
           - {!Config.src} - pool configuration *)

     

       0
        
       
     

       21
        
       

     

       22
        
       (** {1 Core Types} *)

     

       23
        
       

     

       0
        
       
     

       24
        
       module Endpoint : module type of Endpoint

     

       25
       +
       (** Network endpoint representation *)

     

       26
        
       

     

       0
        
       
     

       27
        
       module Tls_config : module type of Tls_config

     

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

     

       29
        
       

     

       0
        
       
     

       30
        
       module Config : module type of Config

     

       31
       +
       (** Configuration for connection pools *)

     

       32
        
       

     

       33
       +
       module Stats : module type of Stats

     

       34
        
       (** Statistics for connection pool endpoints *)

     

       0
        
       
     

       35
        
       

     

       0
        
       
     

       36
        
       module Cmd : module type of Cmd

     

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

     

       38
        
       

     

       39
        
       (** {1 Errors} *)

     

       40
        
       

     

       41
        
       type error =

     

       42
        
         | Dns_resolution_failed of { hostname : string }

     

       43
       +
             (** DNS resolution failed for the given hostname *)

     

       44
       +
         | Connection_failed of {

     

       45
       +
             endpoint : Endpoint.t;

     

       46
       +
             attempts : int;

     

       47
       +
             last_error : string;

     

       48
       +
           }  (** Failed to establish connection after all retry attempts *)

     

       49
        
         | Connection_timeout of { endpoint : Endpoint.t; timeout : float }

     

       50
       +
             (** Connection attempt timed out *)

     

       51
       +
         | Invalid_config of string  (** Invalid configuration parameter *)

     

       52
       +
         | Invalid_endpoint of string  (** Invalid endpoint specification *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       53
        
       

     

       54
        
       exception Pool_error of error

     

       55
        
       (** Exception raised by pool operations.

     
···

       71
        
         clock:'clock Eio.Time.clock ->

     

       72
        
         ?tls:Tls_config.t ->

     

       73
        
         ?config:Config.t ->

     

       74
       +
         unit ->

     

       75
       +
         t

     

       76
       +
       (** Create connection pool bound to switch. All connections will be closed when

     

       77
       +
           switch is released.

     

       78
        
       

     

       79
        
           @param sw Switch for resource management

     

       80
        
           @param net Network interface for creating connections

     

       81
        
           @param clock Clock for timeouts and time-based validation

     

       82
        
           @param tls Optional TLS configuration applied to all connections

     

       83
       +
           @param config

     

       84
       +
             Optional pool configuration (uses Config.default if not provided) *)

     

       85
        
       

     

       86
        
       (** {1 Connection Usage} *)

     

       87
        
       

     
···

       93
        
       (** Acquire connection, use it, automatically release back to pool.

     

       94
        
       

     

       95
        
           If idle connection available and healthy:

     

       96
       +
           - Reuse from pool (validates health first) Else:

     

       97
       +
           - Create new connection (may block if endpoint at limit)

     

       0
        
       
     

       98
        
       

     

       99
       +
           On success: connection returned to pool for reuse On error: connection

     

       100
       +
           closed, not returned to pool

     

       101
        
       

     

       102
        
           Example:

     

       103
        
           {[

     

       104
        
             let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:443 in

     

       105
        
             Conpool.with_connection pool endpoint (fun conn ->

     

       106
       +
                 (* Use conn for HTTP request, Redis command, etc. *)

     

       107
       +
                 Eio.Flow.copy_string "GET / HTTP/1.1\r\n\r\n" conn;

     

       108
       +
                 let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in

     

       109
       +
                 Eio.Buf_read.take_all buf)

     

       110
       +
           ]} *)

     

       0
        
       
     

       0
        
       
     

       111
        
       

     

       112
        
       (** {1 Statistics & Monitoring} *)

     

       113
        
       

     

       114
       +
       val stats : t -> Endpoint.t -> Stats.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       115
        
       (** Get statistics for specific endpoint *)

     

       116
        
       

     

       117
       +
       val all_stats : t -> (Endpoint.t * Stats.t) list

     

       0
        
       
     

       0
        
       
     

       118
        
       (** Get statistics for all endpoints in pool *)

     

       119
        
       

     

       120
        
       (** {1 Pool Management} *)

     

       121
        
       

     

       122
       +
       val clear_endpoint : t -> Endpoint.t -> unit

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       123
        
       (** Clear all cached connections for a specific endpoint.

     

       124
        
       

     

       125
        
           This removes the endpoint from the pool, discarding all idle connections.

     

       126
        
           Active connections will continue to work but won't be returned to the pool.

     

       127
        
       

     

       128
       +
           Use this when you know an endpoint's connections are no longer valid (e.g.,

     

       129
       +
           server restarted, network reconfigured, credentials changed).

     

       130
        
       

     

       131
        
           The pool will be automatically cleaned up when its switch is released. *)

+14 -15

lib/endpoint.ml

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Network endpoint representation *)

     

       2
        
       

     

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

     

       0
        
       
     

       0
        
       
     

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

     

       5
        
       

     

       6
       -
       type t = {

     

       7
       -
         host : string;

     

       8
       -
         port : int;

     

       9
       -
       }

     

       10
        
       

     

       11
        
       let make ~host ~port =

     

       12
        
         (* Validate port range *)

     

       13
        
         if port < 1 || port > 65535 then

     

       14
       -
           invalid_arg (Printf.sprintf "Invalid port number: %d (must be 1-65535)" port);

     

       0
        
       
     

       15
        
       

     

       16
        
         (* Validate hostname is not empty *)

     

       17
       -
         if String.trim host = "" then

     

       18
       -
           invalid_arg "Hostname cannot be empty";

     

       19
        
       

     

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

     

       21
        
         { host; port }

     

       22
        
       

     

       23
        
       let host t = t.host

     

       24
        
       let port t = t.port

     

       25
       -
       

     

       26
       -
       let equal t1 t2 =

     

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

     

       28
       -
       

     

       29
       -
       let hash t =

     

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

     

       31
       -
       

     

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

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Network endpoint representation *)

     

       7
        
       

     

       8
       +
       let src =

     

       9
       +
         Logs.Src.create "conpool.endpoint" ~doc:"Connection pool endpoint operations"

     

       10
       +
       

     

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

     

       12
        
       

     

       13
       +
       type t = { host : string; port : int }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       14
        
       

     

       15
        
       let make ~host ~port =

     

       16
        
         (* Validate port range *)

     

       17
        
         if port < 1 || port > 65535 then

     

       18
       +
           invalid_arg

     

       19
       +
             (Printf.sprintf "Invalid port number: %d (must be 1-65535)" port);

     

       20
        
       

     

       21
        
         (* Validate hostname is not empty *)

     

       22
       +
         if String.trim host = "" then invalid_arg "Hostname cannot be empty";

     

       0
        
       
     

       23
        
       

     

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

     

       25
        
         { host; port }

     

       26
        
       

     

       27
        
       let host t = t.host

     

       28
        
       let port t = t.port

     

       29
       +
       let equal t1 t2 = String.equal t1.host t2.host && t1.port = t2.port

     

       30
       +
       let hash t = Hashtbl.hash (t.host, t.port)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

+7 -3

lib/endpoint.mli

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Network endpoint representation *)

     

       2
        
       

     

       3
        
       (** {1 Logging} *)

     
···

       5
        
       val src : Logs.Src.t

     

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

     

       7
        
           {[

     

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

     

       9
       -
           ]}

     

       10
       -
       *)

     

       11
        
       

     

       12
        
       (** {1 Type} *)

     

       13

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Network endpoint representation *)

     

       7
        
       

     

       8
        
       (** {1 Logging} *)

     
···

       10
        
       val src : Logs.Src.t

     

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

     

       12
        
           {[

     

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

     

       14
       +
           ]} *)

     

       0
        
       
     

       15
        
       

     

       16
        
       (** {1 Type} *)

     

       17

+6 -6

lib/stats.ml

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Statistics for connection pool endpoints *)

     

       2
        
       

     

       3
        
       type t = {

     
···

       28
        
            - Reused: %d@,\

     

       29
        
            - Closed: %d@,\

     

       30
        
            - Errors: %d@]"

     

       31
       -
           t.active

     

       32
       -
           t.idle

     

       33
       -
           t.total_created

     

       34
       -
           t.total_reused

     

       35
       -
           t.total_closed

     

       36
       -
           t.errors

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Statistics for connection pool endpoints *)

     

       7
        
       

     

       8
        
       type t = {

     
···

       33
        
            - Reused: %d@,\

     

       34
        
            - Closed: %d@,\

     

       35
        
            - Errors: %d@]"

     

       36
       +
           t.active t.idle t.total_created t.total_reused t.total_closed t.errors

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

lib/stats.mli

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** Statistics for connection pool endpoints *)

     

       2
        
       

     

       3
        
       (** {1 Type} *)

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** Statistics for connection pool endpoints *)

     

       7
        
       

     

       8
        
       (** {1 Type} *)

+9 -6

lib/tls_config.ml

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** TLS configuration for connection pools *)

     

       2
        
       

     

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

     

       0
        
       
     

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

     

       5
        
       

     

       6
       -
       type t = {

     

       7
       -
         config : Tls.Config.client;

     

       8
       -
         servername : string option;

     

       9
       -
       }

     

       10
        
       

     

       11
        
       let make ~config ?servername () =

     

       12
        
         Log.debug (fun m ->

     

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

     

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

     

       15
        
         { config; servername }

     

       16
        
       

     

       17
        
       let config t = t.config

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** TLS configuration for connection pools *)

     

       7
        
       

     

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

     

       9
       +
       

     

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

     

       11
        
       

     

       12
       +
       type t = { config : Tls.Config.client; servername : string option }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       13
        
       

     

       14
        
       let make ~config ?servername () =

     

       15
        
         Log.debug (fun m ->

     

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

     

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

     

       18
        
         { config; servername }

     

       19
        
       

     

       20
        
       let config t = t.config

+9 -4

lib/tls_config.mli

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (** TLS configuration for connection pools *)

     

       2
        
       

     

       3
        
       (** {1 Logging} *)

     
···

       5
        
       val src : Logs.Src.t

     

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

     

       7
        
           {[

     

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

     

       9
       -
           ]}

     

       10
       -
       *)

     

       11
        
       

     

       12
        
       (** {1 Type} *)

     

       13
        
       

     
···

       20
        
       (** Create TLS configuration.

     

       21
        
       

     

       22
        
           @param config TLS client configuration for all connections

     

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

     

       0
        
       
     

       24
        
       *)

     

       25
        
       

     

       26
        
       (** {1 Accessors} *)

···

       1
       +
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
       +
       

     

       6
        
       (** TLS configuration for connection pools *)

     

       7
        
       

     

       8
        
       (** {1 Logging} *)

     
···

       10
        
       val src : Logs.Src.t

     

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

     

       12
        
           {[

     

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

     

       14
       +
           ]} *)

     

       0
        
       
     

       15
        
       

     

       16
        
       (** {1 Type} *)

     

       17
        
       

     
···

       24
        
       (** Create TLS configuration.

     

       25
        
       

     

       26
        
           @param config TLS client configuration for all connections

     

       27
       +
           @param servername

     

       28
       +
             Optional SNI server name override. If [None], uses the endpoint's hostname

     

       29
        
       *)

     

       30
        
       

     

       31
        
       (** {1 Accessors} *)