comparing b3b475db2efb23e1e7e68d5140127404802f3a92 and main on 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

+54

.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
       +
             export PKG_CONFIG_PATH="${PKG_CONFIG_PATH}:$(nix build nixpkgs#gmp.dev --no-link --print-out-paths)/lib/pkgconfig"

     

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

     

       42
       +
         - name: build

     

       43
       +
           command: |

     

       44
       +
              opam exec -- dune build -p conpool

     

       45
       +
         - name: switch-test

     

       46
       +
           command: |

     

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

     

       48
       +
         - name: test

     

       49
       +
           command: |

     

       50
       +
              opam exec -- dune runtest --verbose

     

       51
       +
         - name: doc

     

       52
       +
           command: |

     

       53
       +
              opam install -y odoc

     

       54
       +
              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.

+110

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 - SNI servername is automatically set to the endpoint's hostname *)

     

       49
       +
           let tls_config = Tls.Config.client ~authenticator:(Ca_certs.authenticator ()) () in

     

       50
       +
       

     

       51
       +
           (* Create pool with TLS *)

     

       52
       +
           let pool = Conpool.create

     

       53
       +
             ~sw

     

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

     

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

     

       56
       +
             ~tls:tls_config

     

       57
       +
             ()

     

       58
       +
           in

     

       59
       +
       

     

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

     

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

     

       62
       +
             (* Use TLS-encrypted connection *)

     

       63
       +
             ...

     

       64
       +
           )

     

       65
       +
         )

     

       66
       +
       ```

     

       67
       +
       

     

       68
       +
       Custom pool configuration:

     

       69
       +
       

     

       70
       +
       ```ocaml

     

       71
       +
       let config = Conpool.Config.make

     

       72
       +
         ~max_connections_per_endpoint:20

     

       73
       +
         ~max_idle_per_endpoint:5

     

       74
       +
         ~connection_timeout:10.0

     

       75
       +
         ~validation_interval:300.0

     

       76
       +
         ()

     

       77
       +
       in

     

       78
       +
       

     

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

     

       80
       +
       ```

     

       81
       +
       

     

       82
       +
       Monitor pool statistics:

     

       83
       +
       

     

       84
       +
       ```ocaml

     

       85
       +
       let stats = Conpool.stats pool endpoint in

     

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

     

       87
       +
         (Conpool.Stats.active_connections stats)

     

       88
       +
         (Conpool.Stats.idle_connections stats)

     

       89
       +
         (Conpool.Stats.cache_hits stats)

     

       90
       +
         (Conpool.Stats.cache_misses stats)

     

       91
       +
       ```

     

       92
       +
       

     

       93
       +
       ## Installation

     

       94
       +
       

     

       95
       +
       ```

     

       96
       +
       opam install conpool

     

       97
       +
       ```

     

       98
       +
       

     

       99
       +
       ## Documentation

     

       100
       +
       

     

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

     

       102
       +
       

     

       103
       +
       ```

     

       104
       +
       opam install conpool

     

       105
       +
       odig doc conpool

     

       106
       +
       ```

     

       107
       +
       

     

       108
       +
       ## License

     

       109
       +
       

     

       110
       +
       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. *)

+42 -38

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);

     

       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
       +
           ([Eio.Resource.close_ty | Eio.Flow.two_way_ty] Eio.Resource.t -> bool) option;

     

       19
        
         connect_timeout : float option;

     

       20
        
         connect_retry_count : int;

     

       21
        
         connect_retry_delay : float;

     
···

       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
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       68
        
         {

     

       69
        
           max_connections_per_endpoint;

     

       70
        
           max_idle_time;

     
···

       80
        
         }

     

       81
        
       

     

       82
        
       let default = make ()

     

       0
        
       
     

       83
        
       let max_connections_per_endpoint t = t.max_connections_per_endpoint

     

       84
        
       let max_idle_time t = t.max_idle_time

     

       85
        
       let max_connection_lifetime t = t.max_connection_lifetime

     
···

       102
        
            - connect_timeout: %s@,\

     

       103
        
            - connect_retry_count: %d@,\

     

       104
        
            - connect_retry_delay: %.2fs@]"

     

       105
       +
           t.max_connections_per_endpoint t.max_idle_time t.max_connection_lifetime

     

       106
       +
           (match t.max_connection_uses with

     

       107
       +
           | Some n -> string_of_int n

     

       108
       +
           | None -> "unlimited")

     

       109
       +
           (match t.connect_timeout with

     

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

     

       111
       +
           | None -> "none")

     

       112
       +
           t.connect_retry_count t.connect_retry_delay

+24 -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) ->

     

       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:([Eio.Resource.close_ty | Eio.Flow.two_way_ty] Eio.Resource.t -> bool) ->

     

       29
        
         ?connect_timeout:float ->

     

       30
        
         ?connect_retry_count:int ->

     

       31
        
         ?connect_retry_delay:float ->

     

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

     

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

     

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

     

       35
       +
         unit ->

     

       36
       +
         t

     

       37
        
       (** Create pool configuration with optional parameters.

     

       38
        
       

     

       39
       +
           @param max_connections_per_endpoint

     

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

     

       41
       +
           @param max_idle_time

     

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

     

       43
       +
           @param max_connection_lifetime

     

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

     

       45
       +
           @param max_connection_uses

     

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

     

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

     

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

     

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

     

       50
       +
           @param connect_retry_delay

     

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

     

       52
        
           @param on_connection_created Hook called when a connection is created

     

       53
        
           @param on_connection_closed Hook called when a connection is closed

     

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

     

       0
        
       
     

       55
        
       

     

       56
        
       val default : t

     

       57
        
       (** Sensible defaults for most use cases:

     
···

       63
        
           - connect_timeout: 10.0s

     

       64
        
           - connect_retry_count: 3

     

       65
        
           - connect_retry_delay: 0.1s

     

       66
       +
           - hooks: none *)

     

       0
        
       
     

       67
        
       

     

       68
        
       (** {1 Accessors} *)

     

       69
        
       

     
···

       79
        
       val max_connection_uses : t -> int option

     

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

     

       81
        
       

     

       82
       +
       val health_check :

     

       83
       +
         t -> ([Eio.Resource.close_ty | Eio.Flow.two_way_ty] Eio.Resource.t -> bool) option

     

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

     

       85
        
       

     

       86
        
       val connect_timeout : t -> float option

+17 -16

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 : [Eio.Resource.close_ty | Eio.Flow.two_way_ty] 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 = t.last_used

     

       27
       +
       let use_count t = 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 = t.use_count in

     

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

     

       37
       +
           t.endpoint t.created_at uses

     

       0
        
       
     

       0

+345 -315

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 *)

     

       7
        
       module Endpoint = Endpoint

     

       8
       -
       module Tls_config = Tls_config

     

       9
        
       module Config = Config

     

       10
        
       module Stats = Stats

     

       11
        
       module Cmd = Cmd

     
···

       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

     

       21
        
       

     

       22
       -
       exception Pool_error of error

     

       23
       -
       

     

       24
        
       let pp_error ppf = function

     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       37
        
       

     

       38
        
       type endp_stats = {

     

       39
        
         mutable active : int;

     
···

       55
        
         net : 'net;

     

       56
        
         clock : 'clock;

     

       57
        
         config : Config.t;

     

       58
       -
         tls : Tls_config.t option;

     

       59
        
         endpoints : (Endpoint.t, endpoint_pool) Hashtbl.t;

     

       60
        
         endpoints_mutex : Eio.Mutex.t;

     

       61
        
       }

     

       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

     

       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
        
       
     

       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 }))

     

       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

     

       122
       -
           Log.debug (fun m -> m "Resolved %a to address" Endpoint.pp endpoint);

     

       123
        
       

     

       124
        
           (* Connect with optional timeout *)

     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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)

     

       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

     

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

     

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

     

       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
        
       
     

       0
        
       
     

       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);

     

       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 *)

     

       166
        
               match Config.connect_timeout pool.config with

     

       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
        
       
     

       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
        
       
     

       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);

     

       0
        
       
     

       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));

     

       0
        
       
     

       0
        
       
     

       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 *)

     

       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);

     

       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);

     

       285
        
             ep_pool

     

       286
        
         | None ->

     

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

     

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

     

       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
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       311
        
       

     

       312
       -
                         if healthy then (

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       -
                           );

     

       0
        
       
     

       0
        
       
     

       319
        
       

     

       320
       -
                           (* Call hook if configured *)

     

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

     

       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;

     

       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);

     

       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);

     

       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);

     

       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
       -
               )

     

       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
        
       

     

       419
        
       (** {1 Public API - Connection Management} *)

     

       420
        
       

     

       421
       -
       let with_connection (T pool) endpoint f =

     

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

     

       423
        
         let ep_pool = get_or_create_endpoint_pool pool endpoint in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       -
         );

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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));

     

       443
        
       

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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;

     

       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 *)

     

       13
        
       module Endpoint = Endpoint

     

       0
        
       
     

       14
        
       module Config = Config

     

       15
        
       module Stats = Stats

     

       16
        
       module Cmd = Cmd

     
···

       19
        
       

     

       20
        
       type error =

     

       21
        
         | Dns_resolution_failed of { hostname : string }

     

       22
       +
         | Connection_failed of {

     

       23
       +
             endpoint : Endpoint.t;

     

       24
       +
             attempts : int;

     

       25
       +
             last_error : string;

     

       26
       +
           }

     

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

     

       28
        
         | Invalid_config of string

     

       29
        
         | Invalid_endpoint of string

     

       30
        
       

     

       0
        
       
     

       0
        
       
     

       31
        
       let pp_error ppf = function

     

       32
        
         | Dns_resolution_failed { hostname } ->

     

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

     

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

     

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

     

       36
       +
               endpoint attempts last_error

     

       37
        
         | Connection_timeout { endpoint; timeout } ->

     

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

     

       39
       +
               timeout

     

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

     

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

     

       42
       +
       

     

       43
       +
       type Eio.Exn.err += E of error

     

       44
       +
       

     

       45
       +
       let err e = Eio.Exn.create (E e)

     

       46
       +
       

     

       47
       +
       let () =

     

       48
       +
         Eio.Exn.register_pp (fun f -> function

     

       49
       +
             | E e ->

     

       50
       +
                 Fmt.string f "Conpool ";

     

       51
       +
                 pp_error f e;

     

       52
       +
                 true

     

       53
       +
             | _ -> false)

     

       54
       +
       

     

       55
       +
       (** {1 Connection Types} *)

     

       56
       +
       

     

       57
       +
       type connection_ty = [Eio.Resource.close_ty | Eio.Flow.two_way_ty]

     

       58
       +
       type connection = connection_ty Eio.Resource.t

     

       59
        
       

     

       60
        
       type endp_stats = {

     

       61
        
         mutable active : int;

     
···

       77
        
         net : 'net;

     

       78
        
         clock : 'clock;

     

       79
        
         config : Config.t;

     

       80
       +
         tls : Tls.Config.client option;

     

       81
        
         endpoints : (Endpoint.t, endpoint_pool) Hashtbl.t;

     

       82
        
         endpoints_mutex : Eio.Mutex.t;

     

       83
        
       }

     

       84
        
       

     

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

     

       86
        
       

     

       87
       +
       module EndpointTbl = Hashtbl.Make (struct

     

       88
        
         type t = Endpoint.t

     

       89
       +
       

     

       90
        
         let equal = Endpoint.equal

     

       91
        
         let hash = Endpoint.hash

     

       92
        
       end)

     

       93
        
       

     

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

     

       0
        
       
     

       95
        
       

     

       96
       +
       let create_endp_stats () =

     

       97
       +
         {

     

       98
       +
           active = 0;

     

       99
       +
           idle = 0;

     

       100
       +
           total_created = 0;

     

       101
       +
           total_reused = 0;

     

       102
       +
           total_closed = 0;

     

       103
       +
           errors = 0;

     

       104
       +
         }

     

       105
        
       

     

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

     

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

     

       108
       +
           ~total_created:stats.total_created ~total_reused:stats.total_reused

     

       109
       +
           ~total_closed:stats.total_closed ~errors:stats.errors

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       110
        
       

     

       111
        
       (** {1 DNS Resolution} *)

     

       112
        
       

     

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

     

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

     

       115
       +
         try

     

       116
       +
           let addrs =

     

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

     

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

     

       119
       +
           in

     

       120
       +
           match addrs with

     

       121
       +
           | addr :: _ ->

     

       122
       +
               Log.debug (fun m ->

     

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

     

       124
       +
               addr

     

       125
       +
           | [] ->

     

       126
       +
               (* Raise exception with error code - context will be added when caught *)

     

       127
       +
               raise (err (Dns_resolution_failed { hostname = Endpoint.host endpoint }))

     

       128
       +
         with Eio.Io _ as ex ->

     

       129
       +
           let bt = Printexc.get_raw_backtrace () in

     

       130
       +
           Eio.Exn.reraise_with_context ex bt "resolving %a" Endpoint.pp endpoint

     

       131
        
       

     

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

     

       133
        
       

     

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

     

       135
       +
           attempt last_error =

     

       136
        
         let retry_count = Config.connect_retry_count pool.config in

     

       137
       +
         if attempt > retry_count then

     

       138
       +
           (* Raise exception with error code - context will be added when caught *)

     

       139
       +
           raise (err (Connection_failed { endpoint; attempts = retry_count; last_error }));

     

       0
        
       
     

       0
        
       
     

       140
        
       

     

       141
       +
         Log.debug (fun m ->

     

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

     

       143
       +
               retry_count);

     

       144
        
       

     

       145
        
         try

     

       146
        
           let addr = resolve_endpoint pool endpoint in

     

       0
        
       
     

       147
        
       

     

       148
        
           (* Connect with optional timeout *)

     

       149
        
           let socket =

     

       150
       +
             try

     

       151
       +
               match Config.connect_timeout pool.config with

     

       152
       +
               | Some timeout ->

     

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

     

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

     

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

     

       156
       +
             with Eio.Io _ as ex ->

     

       157
       +
               let bt = Printexc.get_raw_backtrace () in

     

       158
       +
               Eio.Exn.reraise_with_context ex bt "connecting to %a" Endpoint.pp endpoint

     

       159
        
           in

     

       160
        
       

     

       161
       +
           Log.debug (fun m ->

     

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

     

       163
        
       

     

       164
       +
           let flow =

     

       165
       +
             match pool.tls with

     

       166
       +
             | None ->

     

       167
       +
                 (socket :> connection)

     

       168
       +
             | Some tls_config ->

     

       169
       +
                 try

     

       170
       +
                   Log.debug (fun m ->

     

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

     

       172
       +
                   let host =

     

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

     

       174
       +
                   in

     

       175
       +
                   let tls_flow = Tls_eio.client_of_flow ~host tls_config socket in

     

       176
       +
                   Log.info (fun m ->

     

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

     

       178
       +
                   (tls_flow :> connection)

     

       179
       +
                 with Eio.Io _ as ex ->

     

       180
       +
                   let bt = Printexc.get_raw_backtrace () in

     

       181
       +
                   Eio.Exn.reraise_with_context ex bt "TLS handshake with %a" Endpoint.pp endpoint

     

       182
        
           in

     

       183
        
       

     

       184
        
           let now = get_time pool in

     
···

       191
        
             endpoint;

     

       192
        
             mutex = Eio.Mutex.create ();

     

       193
        
           }

     

       0
        
       
     

       194
        
         with

     

       195
       +
         | Eio.Time.Timeout ->

     

       196
       +
             Log.warn (fun m ->

     

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

     

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

     

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

     

       200
        
               match Config.connect_timeout pool.config with

     

       201
        
               | Some timeout ->

     

       202
       +
                   raise (err (Connection_timeout { endpoint; timeout }))

     

       203
        
               | None ->

     

       204
       +
                   raise (err (Connection_failed

     

       205
       +
                           { endpoint; attempts = attempt; last_error = "Timeout" }))

     

       206
        
             else begin

     

       207
        
               (* Retry with exponential backoff *)

     

       208
       +
               let delay =

     

       209
       +
                 Config.connect_retry_delay pool.config

     

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

     

       211
       +
               in

     

       212
        
               Eio.Time.sleep pool.clock delay;

     

       213
       +
               create_connection_with_retry pool endpoint (attempt + 1) "Timeout"

     

       214
        
             end

     

       215
       +
         | Eio.Io _ as ex ->

     

       216
       +
             (* Eio IO errors - retry with backoff and add context on final failure *)

     

       217
       +
             let error_msg = Printexc.to_string ex in

     

       218
       +
             Log.warn (fun m ->

     

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

     

       220
       +
                   endpoint error_msg);

     

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

     

       222
       +
               let delay =

     

       223
       +
                 Config.connect_retry_delay pool.config

     

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

     

       225
       +
               in

     

       226
        
               Eio.Time.sleep pool.clock delay;

     

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

     

       228
       +
             else

     

       229
       +
               let bt = Printexc.get_raw_backtrace () in

     

       230
       +
               Eio.Exn.reraise_with_context ex bt "after %d retry attempts" attempt

     

       231
        
       

     

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

     

       233
        
         create_connection_with_retry pool endpoint 1 "No attempts made"

     
···

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

     

       242
        
         let max_lifetime = Config.max_connection_lifetime pool.config in

     

       243
        
         if age > max_lifetime then begin

     

       244
       +
           Log.debug (fun m ->

     

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

     

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

     

       247
        
           false

     

       248
        
         end

     

       0
        
       
     

       249
        
         (* Check idle time *)

     

       250
       +
           else begin

     

       251
        
           let max_idle = Config.max_idle_time pool.config in

     

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

     

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

     

       254
       +
             Log.debug (fun m ->

     

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

     

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

     

       257
        
             false

     

       258
       +
           end (* Check use count *)

     

       259
       +
           else if

     

       260
       +
             match Config.max_connection_uses pool.config with

     

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

     

       262
       +
             | None -> false

     

       263
       +
           then begin

     

       264
       +
             Log.debug (fun m ->

     

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

     

       266
       +
                   Endpoint.pp (Connection.endpoint conn)

     

       267
       +
                   (Connection.use_count conn));

     

       268
        
             false

     

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

     

       270
       +
           else if

     

       271
       +
             match Config.health_check pool.config with

     

       272
       +
             | Some check -> (

     

       273
       +
                 try

     

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

     

       275
       +
                   if not healthy then

     

       276
       +
                     Log.debug (fun m ->

     

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

     

       278
       +
                           (Connection.endpoint conn));

     

       279
       +
                   not healthy

     

       280
       +
                 with e ->

     

       281
       +
                   Log.debug (fun m ->

     

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

     

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

     

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

     

       285
       +
             | None -> false

     

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

     

       0
        
       
     

       287
        
           else if check_readable then

     

       288
        
             try

     

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

     

       290
        
               true

     

       291
       +
             with _ -> false

     

       0
        
       
     

       0
        
       
     

       292
        
           else begin

     

       293
       +
             Log.debug (fun m ->

     

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

     

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

     

       296
       +
                   (now -. Connection.last_used conn)

     

       297
       +
                   (Connection.use_count conn));

     

       298
        
             true

     

       299
        
           end

     

       300
        
         end

     
···

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

     

       303
        
       

     

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

     

       305
       +
         Log.debug (fun m ->

     

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

     

       307
       +
               (Connection.endpoint conn)

     

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

     

       309
       +
               (Connection.use_count conn));

     

       310
        
       

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       313
        
       

     

       314
        
         (* Call hook if configured *)

     

       315
       +
         Option.iter

     

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

     

       317
       +
           (Config.on_connection_closed pool.config)

     

       318
        
       

     

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

     

       0
        
       
     

       0
        
       
     

       320
        
         (* First try with read lock *)

     

       321
       +
         match

     

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

     

       323
       +
               Hashtbl.find_opt pool.endpoints endpoint)

     

       324
       +
         with

     

       325
        
         | Some ep_pool ->

     

       0
        
       
     

       326
        
             ep_pool

     

       327
        
         | None ->

     

       0
        
       
     

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

     

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

     

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

     

       331
       +
                 match Hashtbl.find_opt pool.endpoints endpoint with

     

       332
       +
                 | Some ep_pool ->

     

       333
       +
                     ep_pool

     

       334
       +
                 | None ->

     

       0
        
       
     

       335
        
                     (* Create new endpoint pool *)

     

       336
        
                     let stats = create_endp_stats () in

     

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

     

       338
        
       

     

       339
       +
                     Log.info (fun m ->

     

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

     

       341
       +
                           Endpoint.pp endpoint

     

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

     

       343
        
       

     

       344
       +
                     let eio_pool =

     

       345
       +
                       Eio.Pool.create

     

       346
       +
                         (Config.max_connections_per_endpoint pool.config)

     

       347
       +
                         ~validate:(fun conn ->

     

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

     

       349
       +
                           if healthy then (

     

       350
       +
                             (* Update stats for reuse *)

     

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

     

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

     

       353
        
       

     

       354
       +
                             (* Call hook if configured *)

     

       355
       +
                             Option.iter

     

       356
       +
                               (fun f -> f endpoint)

     

       357
       +
                               (Config.on_connection_reused pool.config);

     

       0
        
       
     

       0
        
       
     

       358
        
       

     

       359
       +
                             (* Run health check if configured *)

     

       360
       +
                             match Config.health_check pool.config with

     

       361
       +
                             | Some check -> (

     

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

     

       363
       +
                             | None -> true)

     

       364
       +
                           else

     

       365
       +
                             false)

     

       366
       +
                         ~dispose:(fun conn ->

     

       367
       +
                           (* Called when removing from pool *)

     

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

     

       369
       +
                               close_internal pool conn;

     

       370
        
       

     

       371
       +
                               (* Update stats *)

     

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

     

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

     

       374
       +
                         (fun () ->

     

       375
       +
                           try

     

       376
       +
                             let conn = create_connection pool endpoint in

     

       377
        
       

     

       378
       +
                             (* Update stats *)

     

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

     

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

     

       381
        
       

     

       382
       +
                             (* Call hook if configured *)

     

       383
       +
                             Option.iter

     

       384
       +
                               (fun f -> f endpoint)

     

       385
       +
                               (Config.on_connection_created pool.config);

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       386
        
       

     

       387
       +
                             conn

     

       388
       +
                           with Eio.Io _ as ex ->

     

       389
       +
                             (* Eio.Io exceptions already have full context from create_connection.

     

       390
       +
                                Just update error stats and let the exception propagate. *)

     

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

     

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

     

       393
       +
                             raise ex)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       394
        
                     in

     

       395
        
       

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       397
        
                     Hashtbl.add pool.endpoints endpoint ep_pool;

     

       398
       +
                     ep_pool)

     

       0
        
       
     

       0
        
       
     

       399
        
       

     

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

     

       401
        
       

     

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

     

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

     

       404
       +
         Log.info (fun m ->

     

       405
       +
             m

     

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

     

       407
       +
                max_lifetime=%.1fs)"

     

       408
       +
               (Config.max_connections_per_endpoint config)

     

       409
       +
               (Config.max_idle_time config)

     

       410
       +
               (Config.max_connection_lifetime config));

     

       411
        
       

     

       412
       +
         let pool =

     

       413
       +
           {

     

       414
       +
             sw;

     

       415
       +
             net;

     

       416
       +
             clock;

     

       417
       +
             config;

     

       418
       +
             tls;

     

       419
       +
             endpoints = Hashtbl.create 16;

     

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

     

       421
       +
           }

     

       422
       +
         in

     

       423
        
       

     

       424
        
         (* Auto-cleanup on switch release *)

     

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

     

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

     

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

     

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

     

       429
       +
                 Hashtbl.iter

     

       430
       +
                   (fun _endpoint _ep_pool ->

     

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

     

       432
       +
                     ())

     

       433
       +
                   pool.endpoints;

     

       434
        
       

     

       435
       +
                 Hashtbl.clear pool.endpoints));

     

       0
        
       
     

       0
        
       
     

       436
        
       

     

       437
        
         T pool

     

       438
        
       

     

       439
        
       (** {1 Public API - Connection Management} *)

     

       440
        
       

     

       441
       +
       let connection_internal ~sw (T pool) endpoint =

     

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

     

       443
        
         let ep_pool = get_or_create_endpoint_pool pool endpoint in

     

       444
       +
       

     

       445
       +
         (* Create promises for connection handoff and cleanup signal *)

     

       446
       +
         let conn_promise, conn_resolver = Eio.Promise.create () in

     

       447
       +
         let done_promise, done_resolver = Eio.Promise.create () in

     

       448
        
       

     

       449
        
         (* Increment active count *)

     

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

     

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

     

       452
       +
       

     

       453
       +
         (* Fork a daemon fiber to manage the connection lifecycle.

     

       454
       +
            Important: Fork under pool.sw, not the caller's sw, so the daemon

     

       455
       +
            survives when the caller's switch ends and can return the connection

     

       456
       +
            to the pool for reuse. *)

     

       457
       +
         Eio.Fiber.fork_daemon ~sw:pool.sw (fun () ->

     

       458
       +
           Fun.protect

     

       459
       +
             ~finally:(fun () ->

     

       460
       +
               (* Decrement active count *)

     

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

     

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

     

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

     

       464
       +
             (fun () ->

     

       465
       +
               (* Use Eio.Pool for resource management *)

     

       466
       +
               Eio.Pool.use ep_pool.pool (fun conn ->

     

       467
       +
                   Log.debug (fun m ->

     

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

     

       469
       +
                         (Connection.use_count conn));

     

       470
       +
       

     

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

     

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

     

       473
       +
       

     

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

     

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

     

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

     

       477
       +
       

     

       478
       +
                   (* Hand off connection to caller *)

     

       479
       +
                   Eio.Promise.resolve conn_resolver conn.flow;

     

       480
        
       

     

       481
       +
                   try

     

       482
       +
                     (* Wait for switch to signal cleanup *)

     

       483
       +
                     Eio.Promise.await done_promise;

     

       484
       +
       

     

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

     

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

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       489
        
       

     

       490
       +
                     `Stop_daemon

     

       491
       +
                   with e ->

     

       492
       +
                     (* Error during connection usage - close so it won't be reused.

     

       493
       +
                        The exception already has context from where it was raised. *)

     

       494
       +
                     close_internal pool conn;

     

       495
        
       

     

       496
       +
                     (* Update error stats *)

     

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

     

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

     

       0
        
       
     

       499
        
       

     

       500
       +
                     raise e)));

     

       0
        
       
     

       501
        
       

     

       502
       +
         (* Signal cleanup when switch ends *)

     

       503
       +
         Eio.Switch.on_release sw (fun () ->

     

       504
       +
             Eio.Promise.resolve done_resolver ());

     

       0
        
       
     

       0
        
       
     

       505
        
       

     

       506
       +
         (* Return the connection *)

     

       507
       +
         Eio.Promise.await conn_promise

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       508
        
       

     

       509
       +
       let connection ~sw t endpoint = connection_internal ~sw t endpoint

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       510
        
       

     

       511
       +
       let with_connection t endpoint f =

     

       512
       +
         Eio.Switch.run (fun sw -> f (connection ~sw t endpoint))

     

       0
        
       
     

       513
        
       

     

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

     

       515
        
       

     

       516
        
       let stats (T pool) endpoint =

     

       517
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       518
        
         | Some ep_pool ->

     

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

     

       0
        
       
     

       0
        
       
     

       520
        
         | None ->

     

       521
        
             (* No pool for this endpoint yet *)

     

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

     

       523
       +
               ~total_closed:0 ~errors:0

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       524
        
       

     

       525
        
       let all_stats (T pool) =

     

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

     

       527
       +
             Hashtbl.fold

     

       528
       +
               (fun endpoint ep_pool acc ->

     

       529
       +
                 let stats =

     

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

     

       531
       +
                       snapshot_stats ep_pool.stats)

     

       532
       +
                 in

     

       533
       +
                 (endpoint, stats) :: acc)

     

       534
       +
               pool.endpoints [])

     

       535
        
       

     

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

     

       537
        
       

     
···

       540
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       541
        
         | Some _ep_pool ->

     

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

     

       543
       +
                 (* Remove endpoint pool from hashtable *)

     

       544
       +
                 (* Idle connections will be discarded *)

     

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

     

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

     

       547
       +
                     Hashtbl.remove pool.endpoints endpoint))

     

       0
        
       
     

       0
        
       
     

       548
        
         | None ->

     

       549
       +
             Log.debug (fun m ->

     

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

+102 -63

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
        
       

     

       0
        
       
     

       20
        
       (** Network endpoint representation *)

     

       21
       -
       module Endpoint : module type of Endpoint

     

       22
       -
       

     

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

     

       24
       -
       module Tls_config : module type of Tls_config

     

       25
        
       

     

       0
        
       
     

       26
        
       (** Configuration for connection pools *)

     

       27
       -
       module Config : module type of Config

     

       28
        
       

     

       0
        
       
     

       29
        
       (** Statistics for connection pool endpoints *)

     

       30
       -
       module Stats : module type of Stats

     

       31
        
       

     

       0
        
       
     

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

     

       33
       -
       module Cmd : module type of Cmd

     

       34
        
       

     

       35
        
       (** {1 Errors} *)

     

       36
        
       

     

       37
        
       type error =

     

       38
        
         | Dns_resolution_failed of { hostname : string }

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       40
        
       

     

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

     

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

     

       43
        
       

     

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

     

       45
       -
         (** Connection attempt timed out *)

     

       0
        
       
     

       46
        
       

     

       47
       -
         | Invalid_config of string

     

       48
       -
         (** Invalid configuration parameter *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       49
        
       

     

       50
       -
         | Invalid_endpoint of string

     

       51
       -
         (** Invalid endpoint specification *)

     

       52
        
       

     

       53
       -
       exception Pool_error of error

     

       54
       -
       (** Exception raised by pool operations.

     

       55
        
       

     

       56
       -
           Most pool operations can raise this exception. Use {!pp_error} to get

     

       57
       -
           human-readable error messages. *)

     

       0
        
       
     

       58
        
       

     

       59
        
       val pp_error : error Fmt.t

     

       60
       -
       (** Pretty-printer for error values. *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       61
        
       

     

       62
        
       (** {1 Connection Pool} *)

     

       63
        
       

     
···

       68
        
         sw:Eio.Switch.t ->

     

       69
        
         net:'net Eio.Net.t ->

     

       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
        
       
     

       0
        
       
     

       0
        
       
     

       82
        
       

     

       83
        
       (** {1 Connection Usage} *)

     

       84
        
       

     

       85
       -
       val with_connection :

     

       86
       -
         t ->

     

       87
       -
         Endpoint.t ->

     

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

     

       89
       -
         'a

     

       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
       -
             )

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       109
        
           ]}

     

       110
       -
       *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       +
           - {!Config.src} - pool configuration *)

     

       0
        
       
     

       0
        
       
     

       20
        
       

     

       21
        
       (** {1 Core Types} *)

     

       22
        
       

     

       23
       +
       module Endpoint = Endpoint

     

       24
        
       (** Network endpoint representation *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       25
        
       

     

       26
       +
       module Config = Config

     

       27
        
       (** Configuration for connection pools *)

     

       0
        
       
     

       28
        
       

     

       29
       +
       module Stats = Stats

     

       30
        
       (** Statistics for connection pool endpoints *)

     

       0
        
       
     

       31
        
       

     

       32
       +
       module Cmd = Cmd

     

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

     

       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
       +
         | Connection_failed of {

     

       41
       +
             endpoint : Endpoint.t;

     

       42
       +
             attempts : int;

     

       43
       +
             last_error : string;

     

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

     

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

     

       46
       +
             (** Connection attempt timed out *)

     

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

     

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

     

       49
        
       

     

       50
       +
       type Eio.Exn.err += E of error

     

       51
       +
       (** Extension of Eio's error type for connection pool errors.

     

       52
        
       

     

       53
       +
           Pool operations raise [Eio.Io] exceptions with context information added at

     

       54
       +
           each layer. The innermost error is often [E error], wrapped with context

     

       55
       +
           strings that describe the operation being performed.

     

       56
        
       

     

       57
       +
           Example error message:

     

       58
       +
           {[

     

       59
       +
             Eio.Io Conpool Dns_resolution_failed { hostname = "invalid.example" },

     

       60
       +
               resolving invalid.example:443,

     

       61
       +
               connecting to invalid.example:443,

     

       62
       +
               after 3 retry attempts

     

       63
       +
           ]}

     

       64
        
       

     

       65
       +
           Use {!pp_error} to format just the error code, or let Eio format the full

     

       66
       +
           exception with context. *)

     

       67
        
       

     

       68
       +
       val err : error -> exn

     

       69
       +
       (** [err e] is [Eio.Exn.create (E e)].

     

       70
        
       

     

       71
       +
           This converts a connection pool error to an Eio exception, allowing it to

     

       72
       +
           be handled uniformly with other Eio I/O errors and enabling context to be

     

       73
       +
           added via [Eio.Exn.reraise_with_context]. *)

     

       74
        
       

     

       75
        
       val pp_error : error Fmt.t

     

       76
       +
       (** Pretty-printer for error values (without context).

     

       77
       +
       

     

       78
       +
           For full error messages including context, use [Eio.Exn.pp] or simply let

     

       79
       +
           the exception be printed naturally. *)

     

       80
       +
       

     

       81
       +
       (** {1 Connection Types} *)

     

       82
       +
       

     

       83
       +
       type connection_ty = [Eio.Resource.close_ty | Eio.Flow.two_way_ty]

     

       84
       +
       (** The type tags for a pooled connection.

     

       85
       +
           Connections support reading, writing, shutdown, and closing. *)

     

       86
       +
       

     

       87
       +
       type connection = connection_ty Eio.Resource.t

     

       88
       +
       (** A connection resource from the pool. *)

     

       89
        
       

     

       90
        
       (** {1 Connection Pool} *)

     

       91
        
       

     
···

       96
        
         sw:Eio.Switch.t ->

     

       97
        
         net:'net Eio.Net.t ->

     

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

     

       99
       +
         ?tls:Tls.Config.client ->

     

       100
        
         ?config:Config.t ->

     

       101
       +
         unit ->

     

       102
       +
         t

     

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

     

       104
       +
           switch is released.

     

       105
        
       

     

       106
        
           @param sw Switch for resource management

     

       107
        
           @param net Network interface for creating connections

     

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

     

       109
       +
           @param tls

     

       110
       +
             Optional TLS client configuration applied to all connections. SNI

     

       111
       +
             servername is automatically set to the endpoint's hostname.

     

       112
       +
           @param config

     

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

     

       114
        
       

     

       115
        
       (** {1 Connection Usage} *)

     

       116
        
       

     

       117
       +
       val connection : sw:Eio.Switch.t -> t -> Endpoint.t -> connection

     

       118
       +
       (** [connection ~sw pool endpoint] acquires a connection from the pool.

     

       119
       +
       

     

       120
       +
           The connection is automatically returned to the pool when [sw] finishes.

     

       121
       +
           If the connection becomes unhealthy or an error occurs during use, it is

     

       122
       +
           closed instead of being returned to the pool.

     

       123
        
       

     

       124
       +
           If an idle connection is available and healthy:

     

       125
       +
           - Reuse from pool (validates health first)

     

       0
        
       
     

       0
        
       
     

       126
        
       

     

       127
       +
           Otherwise:

     

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

     

       129
        
       

     

       130
        
           Example:

     

       131
        
           {[

     

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

     

       133
       +
             Eio.Switch.run (fun sw ->

     

       134
       +
                 let conn = Conpool.connection ~sw pool endpoint in

     

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

     

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

     

       137
       +
                 Eio.Buf_read.take_all buf)

     

       138
       +
           ]} *)

     

       139
       +
       

     

       140
       +
       val with_connection : t -> Endpoint.t -> (connection -> 'a) -> 'a

     

       141
       +
       (** [with_connection pool endpoint fn] is a convenience wrapper around

     

       142
       +
           {!val:connection}.

     

       143
       +
       

     

       144
       +
           Equivalent to:

     

       145
       +
           {[

     

       146
       +
             Eio.Switch.run (fun sw -> fn (connection ~sw pool endpoint))

     

       147
        
           ]}

     

       148
       +
       

     

       149
       +
           Example:

     

       150
       +
           {[

     

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

     

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

     

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

     

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

     

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

     

       156
       +
                 Eio.Buf_read.take_all buf)

     

       157
       +
           ]} *)

     

       158
        
       

     

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

     

       160
        
       

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       162
        
       (** Get statistics for specific endpoint *)

     

       163
        
       

     

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

     

       0
        
       
     

       0
        
       
     

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

     

       166
        
       

     

       167
        
       (** {1 Pool Management} *)

     

       168
        
       

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

       171
        
       

     

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

     

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

     

       174
        
       

     

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

     

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

     

       177
        
       

     

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

+14 -16

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
        
       

     

       0
        
       
     

       24
        
         { host; port }

     

       25
        
       

     

       26
        
       let host t = t.host

     

       27
        
       let port t = t.port

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       30
        
       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} *)

-22

lib/tls_config.ml

···

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

     

       2
       -
       

     

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

     

       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

     

       18
       -
       let servername t = t.servername

     

       19
       -
       

     

       20
       -
       let pp ppf t =

     

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

     

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

-37

lib/tls_config.mli

···

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

     

       2
       -
       

     

       3
       -
       (** {1 Logging} *)

     

       4
       -
       

     

       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
       -
       

     

       14
       -
       type t

     

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

     

       16
       -
       

     

       17
       -
       (** {1 Construction} *)

     

       18
       -
       

     

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

     

       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

     

       24
       -
       *)

     

       25
       -
       

     

       26
       -
       (** {1 Accessors} *)

     

       27
       -
       

     

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

     

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

     

       30
       -
       

     

       31
       -
       val servername : t -> string option

     

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

     

       33
       -
       

     

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

     

       35
       -
       

     

       36
       -
       val pp : t Fmt.t

     

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

test/dune

···

       1
       +
       (executable

     

       2
       +
        (name stress_test)

     

       3
       +
        (modules stress_test)

     

       4
       +
        (libraries conpool eio eio_main unix))

     

       5
       +
       

     

       6
       +
       (rule

     

       7
       +
        (alias runtest)

     

       8
       +
        (deps stress_test.exe)

     

       9
       +
        (action (run ./stress_test.exe --all -o stress_test_results.json)))

+993

test/stress_test.ml

···

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

     

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

     

       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       +
       

     

       6
       +
       (** Stress test framework for conpool

     

       7
       +
       

     

       8
       +
           Spawns variable number of echo servers on random ports, then exercises

     

       9
       +
           the connection pool with multiple parallel client fibers.

     

       10
       +
           Collects detailed event traces for visualization.

     

       11
       +
       *)

     

       12
       +
       

     

       13
       +
       (** Configuration for the stress test *)

     

       14
       +
       type config = {

     

       15
       +
         name : string;           (** Test name for identification *)

     

       16
       +
         num_servers : int;       (** Number of echo servers to spawn *)

     

       17
       +
         num_clients : int;       (** Number of client connections per server *)

     

       18
       +
         messages_per_client : int;  (** Number of messages each client sends *)

     

       19
       +
         max_parallel_clients : int; (** Maximum concurrent client fibers *)

     

       20
       +
         message_size : int;      (** Size of each message in bytes *)

     

       21
       +
         pool_size : int;         (** Max connections per endpoint *)

     

       22
       +
       }

     

       23
       +
       

     

       24
       +
       let default_config = {

     

       25
       +
         name = "default";

     

       26
       +
         num_servers = 3;

     

       27
       +
         num_clients = 10;

     

       28
       +
         messages_per_client = 5;

     

       29
       +
         max_parallel_clients = 20;

     

       30
       +
         message_size = 64;

     

       31
       +
         pool_size = 5;

     

       32
       +
       }

     

       33
       +
       

     

       34
       +
       (** Test presets for different scenarios *)

     

       35
       +
       let presets = [

     

       36
       +
         (* High connection reuse - few connections, many messages *)

     

       37
       +
         { name = "high_reuse";

     

       38
       +
           num_servers = 2;

     

       39
       +
           num_clients = 20;

     

       40
       +
           messages_per_client = 50;

     

       41
       +
           max_parallel_clients = 10;

     

       42
       +
           message_size = 32;

     

       43
       +
           pool_size = 3;

     

       44
       +
         };

     

       45
       +
         (* Many endpoints - test endpoint scaling *)

     

       46
       +
         { name = "many_endpoints";

     

       47
       +
           num_servers = 10;

     

       48
       +
           num_clients = 10;

     

       49
       +
           messages_per_client = 10;

     

       50
       +
           max_parallel_clients = 50;

     

       51
       +
           message_size = 64;

     

       52
       +
           pool_size = 5;

     

       53
       +
         };

     

       54
       +
         (* High concurrency - stress parallel connections *)

     

       55
       +
         { name = "high_concurrency";

     

       56
       +
           num_servers = 3;

     

       57
       +
           num_clients = 100;

     

       58
       +
           messages_per_client = 5;

     

       59
       +
           max_parallel_clients = 100;

     

       60
       +
           message_size = 64;

     

       61
       +
           pool_size = 20;

     

       62
       +
         };

     

       63
       +
         (* Large messages - test throughput *)

     

       64
       +
         { name = "large_messages";

     

       65
       +
           num_servers = 3;

     

       66
       +
           num_clients = 20;

     

       67
       +
           messages_per_client = 20;

     

       68
       +
           max_parallel_clients = 30;

     

       69
       +
           message_size = 1024;

     

       70
       +
           pool_size = 10;

     

       71
       +
         };

     

       72
       +
         (* Constrained pool - force queuing *)

     

       73
       +
         { name = "constrained_pool";

     

       74
       +
           num_servers = 2;

     

       75
       +
           num_clients = 50;

     

       76
       +
           messages_per_client = 10;

     

       77
       +
           max_parallel_clients = 50;

     

       78
       +
           message_size = 64;

     

       79
       +
           pool_size = 2;

     

       80
       +
         };

     

       81
       +
         (* Burst traffic - many clients, few messages each *)

     

       82
       +
         { name = "burst_traffic";

     

       83
       +
           num_servers = 5;

     

       84
       +
           num_clients = 200;

     

       85
       +
           messages_per_client = 2;

     

       86
       +
           max_parallel_clients = 100;

     

       87
       +
           message_size = 32;

     

       88
       +
           pool_size = 15;

     

       89
       +
         };

     

       90
       +
       ]

     

       91
       +
       

     

       92
       +
       (** Extended stress test - 100x messages, 10x clients/servers *)

     

       93
       +
       let extended_preset = {

     

       94
       +
         name = "extended_stress";

     

       95
       +
         num_servers = 30;

     

       96
       +
         num_clients = 1000;

     

       97
       +
         messages_per_client = 100;

     

       98
       +
         max_parallel_clients = 500;

     

       99
       +
         message_size = 128;

     

       100
       +
         pool_size = 50;

     

       101
       +
       }

     

       102
       +
       

     

       103
       +
       (** Statistics collected during test *)

     

       104
       +
       type latency_stats = {

     

       105
       +
         mutable count : int;

     

       106
       +
         mutable total : float;

     

       107
       +
         mutable min : float;

     

       108
       +
         mutable max : float;

     

       109
       +
         mutable latencies : (float * float) list; (* (timestamp, latency) pairs *)

     

       110
       +
       }

     

       111
       +
       

     

       112
       +
       let create_latency_stats () = {

     

       113
       +
         count = 0;

     

       114
       +
         total = 0.0;

     

       115
       +
         min = Float.infinity;

     

       116
       +
         max = 0.0;

     

       117
       +
         latencies = [];

     

       118
       +
       }

     

       119
       +
       

     

       120
       +
       let update_latency stats latency timestamp =

     

       121
       +
         stats.count <- stats.count + 1;

     

       122
       +
         stats.total <- stats.total +. latency;

     

       123
       +
         stats.min <- min stats.min latency;

     

       124
       +
         stats.max <- max stats.max latency;

     

       125
       +
         stats.latencies <- (timestamp, latency) :: stats.latencies

     

       126
       +
       

     

       127
       +
       (** Generate a random message of given size *)

     

       128
       +
       let generate_message size =

     

       129
       +
         let chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" in

     

       130
       +
         let len = String.length chars in

     

       131
       +
         String.init size (fun _ -> chars.[Random.int len])

     

       132
       +
       

     

       133
       +
       (** Echo server handler - echoes back everything it receives *)

     

       134
       +
       let handle_echo_client flow _addr =

     

       135
       +
         let buf = Cstruct.create 4096 in

     

       136
       +
         let rec loop () =

     

       137
       +
           match Eio.Flow.single_read flow buf with

     

       138
       +
           | n ->

     

       139
       +
               let data = Cstruct.sub buf 0 n in

     

       140
       +
               Eio.Flow.write flow [data];

     

       141
       +
               loop ()

     

       142
       +
           | exception End_of_file -> ()

     

       143
       +
         in

     

       144
       +
         loop ()

     

       145
       +
       

     

       146
       +
       (** Start an echo server on a random port, returns the port number *)

     

       147
       +
       let start_echo_server ~sw net =

     

       148
       +
         let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, 0) in

     

       149
       +
         let listening_socket = Eio.Net.listen net ~sw ~backlog:128 ~reuse_addr:true addr in

     

       150
       +
         let actual_addr = Eio.Net.listening_addr listening_socket in

     

       151
       +
         let port = match actual_addr with

     

       152
       +
           | `Tcp (_, port) -> port

     

       153
       +
           | _ -> failwith "Expected TCP address"

     

       154
       +
         in

     

       155
       +
       

     

       156
       +
         Eio.Fiber.fork_daemon ~sw (fun () ->

     

       157
       +
           try

     

       158
       +
             while true do

     

       159
       +
               Eio.Net.accept_fork ~sw listening_socket

     

       160
       +
                 ~on_error:(fun _ -> ())

     

       161
       +
                 handle_echo_client

     

       162
       +
             done;

     

       163
       +
             `Stop_daemon

     

       164
       +
           with Eio.Cancel.Cancelled _ ->

     

       165
       +
             `Stop_daemon

     

       166
       +
         );

     

       167
       +
       

     

       168
       +
         port

     

       169
       +
       

     

       170
       +
       (** Client test: connect via pool, send message, verify echo *)

     

       171
       +
       let run_client_test ~clock ~test_start_time pool endpoint message latency_stats errors =

     

       172
       +
         let msg_len = String.length message in

     

       173
       +
         let start_time = Eio.Time.now clock in

     

       174
       +
       

     

       175
       +
         try

     

       176
       +
           Conpool.with_connection pool endpoint (fun flow ->

     

       177
       +
             (* Send message *)

     

       178
       +
             Eio.Flow.copy_string message flow;

     

       179
       +
             Eio.Flow.copy_string "\n" flow;

     

       180
       +
       

     

       181
       +
             (* Read echo response *)

     

       182
       +
             let response = Eio.Buf_read.of_flow flow ~max_size:(msg_len + 1) in

     

       183
       +
             let echoed = Eio.Buf_read.line response in

     

       184
       +
       

     

       185
       +
             let end_time = Eio.Time.now clock in

     

       186
       +
             let latency = (end_time -. start_time) *. 1000.0 in  (* Convert to ms *)

     

       187
       +
             let relative_time = (end_time -. test_start_time) *. 1000.0 in (* ms since test start *)

     

       188
       +
       

     

       189
       +
             if String.equal echoed message then begin

     

       190
       +
               update_latency latency_stats latency relative_time

     

       191
       +
             end else begin

     

       192
       +
               incr errors

     

       193
       +
             end

     

       194
       +
           )

     

       195
       +
         with _ex ->

     

       196
       +
           incr errors

     

       197
       +
       

     

       198
       +
       (** Run a single client that sends multiple messages *)

     

       199
       +
       let run_client ~clock ~test_start_time pool endpoints (cfg : config) latency_stats errors client_id =

     

       200
       +
         for _ = 1 to cfg.messages_per_client do

     

       201
       +
           let endpoint_idx = Random.int (Array.length endpoints) in

     

       202
       +
           let endpoint = endpoints.(endpoint_idx) in

     

       203
       +
           let message = Printf.sprintf "c%d-%s" client_id (generate_message cfg.message_size) in

     

       204
       +
           run_client_test ~clock ~test_start_time pool endpoint message latency_stats errors

     

       205
       +
         done

     

       206
       +
       

     

       207
       +
       (** Pool statistics aggregated from all endpoints *)

     

       208
       +
       type pool_stats = {

     

       209
       +
         total_created : int;

     

       210
       +
         total_reused : int;

     

       211
       +
         total_closed : int;

     

       212
       +
         active : int;

     

       213
       +
         idle : int;

     

       214
       +
         pool_errors : int;

     

       215
       +
       }

     

       216
       +
       

     

       217
       +
       (** Test result type *)

     

       218
       +
       type test_result = {

     

       219
       +
         test_name : string;

     

       220
       +
         num_servers : int;

     

       221
       +
         num_clients : int;

     

       222
       +
         messages_per_client : int;

     

       223
       +
         pool_size : int;

     

       224
       +
         duration : float;

     

       225
       +
         total_messages : int;

     

       226
       +
         total_errors : int;

     

       227
       +
         throughput : float;

     

       228
       +
         avg_latency : float;

     

       229
       +
         min_latency : float;

     

       230
       +
         max_latency : float;

     

       231
       +
         latency_data : (float * float) list; (* (timestamp, latency) pairs for visualization *)

     

       232
       +
         pool_stats : pool_stats;

     

       233
       +
       }

     

       234
       +
       

     

       235
       +
       (** Main stress test runner - returns a test result *)

     

       236
       +
       let run_stress_test ~env (cfg : config) : test_result =

     

       237
       +
         let net = Eio.Stdenv.net env in

     

       238
       +
         let clock = Eio.Stdenv.clock env in

     

       239
       +
       

     

       240
       +
         let latency_stats = create_latency_stats () in

     

       241
       +
         let errors = ref 0 in

     

       242
       +
         let ports = ref [||] in

     

       243
       +
       

     

       244
       +
         let result : test_result option ref = ref None in

     

       245
       +
       

     

       246
       +
         begin

     

       247
       +
           try

     

       248
       +
             Eio.Switch.run @@ fun sw ->

     

       249
       +
               (* Start echo servers *)

     

       250
       +
               ports := Array.init cfg.num_servers (fun _ ->

     

       251
       +
                 start_echo_server ~sw net

     

       252
       +
               );

     

       253
       +
       

     

       254
       +
               Eio.Time.sleep clock 0.05;

     

       255
       +
       

     

       256
       +
               let endpoints = Array.map (fun port ->

     

       257
       +
                 Conpool.Endpoint.make ~host:"127.0.0.1" ~port

     

       258
       +
               ) !ports in

     

       259
       +
       

     

       260
       +
               (* Create connection pool *)

     

       261
       +
               let pool_config = Conpool.Config.make

     

       262
       +
                 ~max_connections_per_endpoint:cfg.pool_size

     

       263
       +
                 ~max_idle_time:30.0

     

       264
       +
                 ~max_connection_lifetime:120.0

     

       265
       +
                 ~connect_timeout:5.0

     

       266
       +
                 ~connect_retry_count:3

     

       267
       +
                 ()

     

       268
       +
               in

     

       269
       +
       

     

       270
       +
               let pool = Conpool.create ~sw ~net ~clock ~config:pool_config () in

     

       271
       +
       

     

       272
       +
               (* Record start time *)

     

       273
       +
               let start_time = Eio.Time.now clock in

     

       274
       +
       

     

       275
       +
               (* Run clients in parallel *)

     

       276
       +
               let total_clients = cfg.num_servers * cfg.num_clients in

     

       277
       +
               let client_ids = List.init total_clients (fun i -> i) in

     

       278
       +
               Eio.Fiber.List.iter ~max_fibers:cfg.max_parallel_clients

     

       279
       +
                 (fun client_id ->

     

       280
       +
                   run_client ~clock ~test_start_time:start_time pool endpoints cfg latency_stats errors client_id)

     

       281
       +
                 client_ids;

     

       282
       +
       

     

       283
       +
               let end_time = Eio.Time.now clock in

     

       284
       +
               let duration = end_time -. start_time in

     

       285
       +
       

     

       286
       +
               (* Collect pool statistics from all endpoints *)

     

       287
       +
               let all_stats = Conpool.all_stats pool in

     

       288
       +
               let pool_stats = List.fold_left (fun acc (_, stats) ->

     

       289
       +
                 {

     

       290
       +
                   total_created = acc.total_created + Conpool.Stats.total_created stats;

     

       291
       +
                   total_reused = acc.total_reused + Conpool.Stats.total_reused stats;

     

       292
       +
                   total_closed = acc.total_closed + Conpool.Stats.total_closed stats;

     

       293
       +
                   active = acc.active + Conpool.Stats.active stats;

     

       294
       +
                   idle = acc.idle + Conpool.Stats.idle stats;

     

       295
       +
                   pool_errors = acc.pool_errors + Conpool.Stats.errors stats;

     

       296
       +
                 }

     

       297
       +
               ) { total_created = 0; total_reused = 0; total_closed = 0; active = 0; idle = 0; pool_errors = 0 } all_stats in

     

       298
       +
       

     

       299
       +
               (* Build result *)

     

       300
       +
               let r : test_result = {

     

       301
       +
                 test_name = cfg.name;

     

       302
       +
                 num_servers = cfg.num_servers;

     

       303
       +
                 num_clients = cfg.num_clients;

     

       304
       +
                 messages_per_client = cfg.messages_per_client;

     

       305
       +
                 pool_size = cfg.pool_size;

     

       306
       +
                 duration;

     

       307
       +
                 total_messages = latency_stats.count;

     

       308
       +
                 total_errors = !errors;

     

       309
       +
                 throughput = float_of_int latency_stats.count /. duration;

     

       310
       +
                 avg_latency = if latency_stats.count > 0

     

       311
       +
                   then latency_stats.total /. float_of_int latency_stats.count

     

       312
       +
                   else 0.0;

     

       313
       +
                 min_latency = if latency_stats.count > 0 then latency_stats.min else 0.0;

     

       314
       +
                 max_latency = latency_stats.max;

     

       315
       +
                 latency_data = List.rev latency_stats.latencies;

     

       316
       +
                 pool_stats;

     

       317
       +
               } in

     

       318
       +
               result := Some r;

     

       319
       +
       

     

       320
       +
               Eio.Switch.fail sw Exit

     

       321
       +
           with Exit -> ()

     

       322
       +
         end;

     

       323
       +
       

     

       324
       +
         match !result with

     

       325
       +
         | Some r -> r

     

       326
       +
         | None -> failwith "Test failed to produce result"

     

       327
       +
       

     

       328
       +
       (** Convert result to JSON string *)

     

       329
       +
       let result_to_json result =

     

       330
       +
         Printf.sprintf {|{

     

       331
       +
         "test_name": "%s",

     

       332
       +
         "num_servers": %d,

     

       333
       +
         "num_clients": %d,

     

       334
       +
         "messages_per_client": %d,

     

       335
       +
         "duration": %.3f,

     

       336
       +
         "total_messages": %d,

     

       337
       +
         "total_errors": %d,

     

       338
       +
         "throughput": %.2f,

     

       339
       +
         "avg_latency": %.2f,

     

       340
       +
         "min_latency": %.2f,

     

       341
       +
         "max_latency": %.2f

     

       342
       +
       }|}

     

       343
       +
           result.test_name

     

       344
       +
           result.num_servers

     

       345
       +
           result.num_clients

     

       346
       +
           result.messages_per_client

     

       347
       +
           result.duration

     

       348
       +
           result.total_messages

     

       349
       +
           result.total_errors

     

       350
       +
           result.throughput

     

       351
       +
           result.avg_latency

     

       352
       +
           result.min_latency

     

       353
       +
           result.max_latency

     

       354
       +
       

     

       355
       +
       (** Escape strings for JavaScript *)

     

       356
       +
       let js_escape s =

     

       357
       +
         let buf = Buffer.create (String.length s) in

     

       358
       +
         String.iter (fun c ->

     

       359
       +
           match c with

     

       360
       +
           | '\\' -> Buffer.add_string buf "\\\\"

     

       361
       +
           | '"' -> Buffer.add_string buf "\\\""

     

       362
       +
           | '\n' -> Buffer.add_string buf "\\n"

     

       363
       +
           | '\r' -> Buffer.add_string buf "\\r"

     

       364
       +
           | '\t' -> Buffer.add_string buf "\\t"

     

       365
       +
           | _ -> Buffer.add_char buf c

     

       366
       +
         ) s;

     

       367
       +
         Buffer.contents buf

     

       368
       +
       

     

       369
       +
       (** Calculate histogram buckets for latency data *)

     

       370
       +
       let calculate_histogram latencies num_buckets =

     

       371
       +
         if List.length latencies = 0 then ([], []) else

     

       372
       +
         let latency_values = List.map snd latencies in

     

       373
       +
         let min_lat = List.fold_left min Float.infinity latency_values in

     

       374
       +
         let max_lat = List.fold_left max 0.0 latency_values in

     

       375
       +
         let bucket_width = (max_lat -. min_lat) /. float_of_int num_buckets in

     

       376
       +
       

     

       377
       +
         let buckets = Array.make num_buckets 0 in

     

       378
       +
         List.iter (fun lat ->

     

       379
       +
           let bucket_idx = min (num_buckets - 1) (int_of_float ((lat -. min_lat) /. bucket_width)) in

     

       380
       +
           buckets.(bucket_idx) <- buckets.(bucket_idx) + 1

     

       381
       +
         ) latency_values;

     

       382
       +
       

     

       383
       +
         let bucket_labels = List.init num_buckets (fun i ->

     

       384
       +
           let start = min_lat +. (float_of_int i *. bucket_width) in

     

       385
       +
           Printf.sprintf "%.2f" start

     

       386
       +
         ) in

     

       387
       +
         let bucket_counts = Array.to_list buckets in

     

       388
       +
         (bucket_labels, bucket_counts)

     

       389
       +
       

     

       390
       +
       (** Generate HTML report from test results *)

     

       391
       +
       let generate_html_report results =

     

       392
       +
         let timestamp = Unix.time () |> Unix.gmtime in

     

       393
       +
         let date_str = Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC"

     

       394
       +
           (timestamp.Unix.tm_year + 1900)

     

       395
       +
           (timestamp.Unix.tm_mon + 1)

     

       396
       +
           timestamp.Unix.tm_mday

     

       397
       +
           timestamp.Unix.tm_hour

     

       398
       +
           timestamp.Unix.tm_min

     

       399
       +
           timestamp.Unix.tm_sec

     

       400
       +
         in

     

       401
       +
       

     

       402
       +
         (* Calculate summary statistics *)

     

       403
       +
         let total_messages = List.fold_left (fun acc r -> acc + r.total_messages) 0 results in

     

       404
       +
         let total_errors = List.fold_left (fun acc r -> acc + r.total_errors) 0 results in

     

       405
       +
         let total_duration = List.fold_left (fun acc r -> acc +. r.duration) 0.0 results in

     

       406
       +
       

     

       407
       +
         (* Generate JavaScript arrays for comparison charts *)

     

       408
       +
         let test_names = String.concat ", " (List.map (fun r -> Printf.sprintf "\"%s\"" (js_escape r.test_name)) results) in

     

       409
       +
         let throughputs = String.concat ", " (List.map (fun r -> Printf.sprintf "%.2f" r.throughput) results) in

     

       410
       +
         let avg_latencies = String.concat ", " (List.map (fun r -> Printf.sprintf "%.2f" r.avg_latency) results) in

     

       411
       +
         let error_rates = String.concat ", " (List.map (fun r ->

     

       412
       +
           if r.total_messages > 0 then

     

       413
       +
             Printf.sprintf "%.2f" (float_of_int r.total_errors /. float_of_int r.total_messages *. 100.0)

     

       414
       +
           else "0.0"

     

       415
       +
         ) results) in

     

       416
       +
       

     

       417
       +
         (* Generate per-test detailed sections with histograms and timelines *)

     

       418
       +
         let test_details = String.concat "\n" (List.mapi (fun idx r ->

     

       419
       +
           let (hist_labels, hist_counts) = calculate_histogram r.latency_data 20 in

     

       420
       +
           let hist_labels_str = String.concat ", " (List.map (fun s -> Printf.sprintf "\"%s\"" s) hist_labels) in

     

       421
       +
           let hist_counts_str = String.concat ", " (List.map string_of_int hist_counts) in

     

       422
       +
       

     

       423
       +
           (* Sample data points for timeline (take every Nth point if too many) *)

     

       424
       +
           let max_points = 500 in

     

       425
       +
           let sample_rate = max 1 ((List.length r.latency_data) / max_points) in

     

       426
       +
           let sampled_data = List.filteri (fun i _ -> i mod sample_rate = 0) r.latency_data in

     

       427
       +
           let timeline_data = String.concat ", " (List.map (fun (t, l) ->

     

       428
       +
             Printf.sprintf "{x: %.2f, y: %.3f}" t l

     

       429
       +
           ) sampled_data) in

     

       430
       +
       

     

       431
       +
           Printf.sprintf {|

     

       432
       +
             <div class="test-detail">

     

       433
       +
               <h3>%s</h3>

     

       434
       +
               <div class="compact-grid">

     

       435
       +
                 <div class="compact-metric"><span class="label">Servers:</span> <span class="value">%d</span></div>

     

       436
       +
                 <div class="compact-metric"><span class="label">Clients:</span> <span class="value">%d</span></div>

     

       437
       +
                 <div class="compact-metric"><span class="label">Msgs/Client:</span> <span class="value">%d</span></div>

     

       438
       +
                 <div class="compact-metric"><span class="label">Pool Size:</span> <span class="value">%d</span></div>

     

       439
       +
                 <div class="compact-metric"><span class="label">Total Msgs:</span> <span class="value">%d</span></div>

     

       440
       +
                 <div class="compact-metric"><span class="label">Duration:</span> <span class="value">%.2fs</span></div>

     

       441
       +
                 <div class="compact-metric highlight"><span class="label">Throughput:</span> <span class="value">%.0f/s</span></div>

     

       442
       +
                 <div class="compact-metric highlight"><span class="label">Avg Lat:</span> <span class="value">%.2fms</span></div>

     

       443
       +
                 <div class="compact-metric"><span class="label">Min Lat:</span> <span class="value">%.2fms</span></div>

     

       444
       +
                 <div class="compact-metric"><span class="label">Max Lat:</span> <span class="value">%.2fms</span></div>

     

       445
       +
                 <div class="compact-metric %s"><span class="label">Errors:</span> <span class="value">%d</span></div>

     

       446
       +
               </div>

     

       447
       +
               <div class="compact-grid" style="margin-top: 0.5rem;">

     

       448
       +
                 <div class="compact-metric"><span class="label">Conns Created:</span> <span class="value">%d</span></div>

     

       449
       +
                 <div class="compact-metric"><span class="label">Conns Reused:</span> <span class="value">%d</span></div>

     

       450
       +
                 <div class="compact-metric"><span class="label">Conns Closed:</span> <span class="value">%d</span></div>

     

       451
       +
                 <div class="compact-metric"><span class="label">Active:</span> <span class="value">%d</span></div>

     

       452
       +
                 <div class="compact-metric"><span class="label">Idle:</span> <span class="value">%d</span></div>

     

       453
       +
                 <div class="compact-metric"><span class="label">Reuse Rate:</span> <span class="value">%.1f%%%%</span></div>

     

       454
       +
               </div>

     

       455
       +
               <div class="chart-row">

     

       456
       +
                 <div class="chart-half">

     

       457
       +
                   <h4>Latency Distribution</h4>

     

       458
       +
                   <canvas id="hist_%d"></canvas>

     

       459
       +
                 </div>

     

       460
       +
                 <div class="chart-half">

     

       461
       +
                   <h4>Latency Timeline</h4>

     

       462
       +
                   <canvas id="timeline_%d"></canvas>

     

       463
       +
                 </div>

     

       464
       +
               </div>

     

       465
       +
             </div>

     

       466
       +
             <script>

     

       467
       +
               new Chart(document.getElementById('hist_%d'), {

     

       468
       +
                 type: 'bar',

     

       469
       +
                 data: {

     

       470
       +
                   labels: [%s],

     

       471
       +
                   datasets: [{

     

       472
       +
                     label: 'Count',

     

       473
       +
                     data: [%s],

     

       474
       +
                     backgroundColor: 'rgba(102, 126, 234, 0.6)',

     

       475
       +
                     borderColor: 'rgba(102, 126, 234, 1)',

     

       476
       +
                     borderWidth: 1

     

       477
       +
                   }]

     

       478
       +
                 },

     

       479
       +
                 options: {

     

       480
       +
                   responsive: true,

     

       481
       +
                   maintainAspectRatio: false,

     

       482
       +
                   plugins: { legend: { display: false } },

     

       483
       +
                   scales: {

     

       484
       +
                     x: { title: { display: true, text: 'Latency (ms)' } },

     

       485
       +
                     y: { beginAtZero: true, title: { display: true, text: 'Count' } }

     

       486
       +
                   }

     

       487
       +
                 }

     

       488
       +
               });

     

       489
       +
       

     

       490
       +
               new Chart(document.getElementById('timeline_%d'), {

     

       491
       +
                 type: 'scatter',

     

       492
       +
                 data: {

     

       493
       +
                   datasets: [{

     

       494
       +
                     label: 'Latency',

     

       495
       +
                     data: [%s],

     

       496
       +
                     backgroundColor: 'rgba(118, 75, 162, 0.5)',

     

       497
       +
                     borderColor: 'rgba(118, 75, 162, 0.8)',

     

       498
       +
                     pointRadius: 2

     

       499
       +
                   }]

     

       500
       +
                 },

     

       501
       +
                 options: {

     

       502
       +
                   responsive: true,

     

       503
       +
                   maintainAspectRatio: false,

     

       504
       +
                   plugins: { legend: { display: false } },

     

       505
       +
                   scales: {

     

       506
       +
                     x: { title: { display: true, text: 'Time (ms)' } },

     

       507
       +
                     y: { beginAtZero: true, title: { display: true, text: 'Latency (ms)' } }

     

       508
       +
                   }

     

       509
       +
                 }

     

       510
       +
               });

     

       511
       +
             </script>|}

     

       512
       +
             (js_escape r.test_name)

     

       513
       +
             r.num_servers

     

       514
       +
             r.num_clients

     

       515
       +
             r.messages_per_client

     

       516
       +
             r.pool_size

     

       517
       +
             r.total_messages

     

       518
       +
             r.duration

     

       519
       +
             r.throughput

     

       520
       +
             r.avg_latency

     

       521
       +
             r.min_latency

     

       522
       +
             r.max_latency

     

       523
       +
             (if r.total_errors > 0 then "error" else "")

     

       524
       +
             r.total_errors

     

       525
       +
             r.pool_stats.total_created

     

       526
       +
             r.pool_stats.total_reused

     

       527
       +
             r.pool_stats.total_closed

     

       528
       +
             r.pool_stats.active

     

       529
       +
             r.pool_stats.idle

     

       530
       +
             (if r.pool_stats.total_created > 0 then

     

       531
       +
               (float_of_int r.pool_stats.total_reused /. float_of_int r.pool_stats.total_created *. 100.0)

     

       532
       +
             else 0.0)

     

       533
       +
             idx idx idx

     

       534
       +
             hist_labels_str

     

       535
       +
             hist_counts_str

     

       536
       +
             idx

     

       537
       +
             timeline_data

     

       538
       +
         ) results) in

     

       539
       +
       

     

       540
       +
         Printf.sprintf {|<!DOCTYPE html>

     

       541
       +
       <html lang="en">

     

       542
       +
       <head>

     

       543
       +
         <meta charset="UTF-8">

     

       544
       +
         <meta name="viewport" content="width=device-width, initial-scale=1.0">

     

       545
       +
         <title>Connection Pool Stress Test Results</title>

     

       546
       +
         <script src="https://cdn.jsdelivr.net/npm/chart.js@4.4.0/dist/chart.umd.min.js"></script>

     

       547
       +
         <style>

     

       548
       +
           * { margin: 0; padding: 0; box-sizing: border-box; }

     

       549
       +
           body {

     

       550
       +
             font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif;

     

       551
       +
             background: #f5f5f5;

     

       552
       +
             padding: 1rem;

     

       553
       +
             color: #333;

     

       554
       +
             font-size: 14px;

     

       555
       +
           }

     

       556
       +
           .container { max-width: 1600px; margin: 0 auto; }

     

       557
       +
           h1 {

     

       558
       +
             color: #667eea;

     

       559
       +
             text-align: center;

     

       560
       +
             margin-bottom: 0.3rem;

     

       561
       +
             font-size: 1.8rem;

     

       562
       +
           }

     

       563
       +
           .subtitle {

     

       564
       +
             text-align: center;

     

       565
       +
             margin-bottom: 1rem;

     

       566
       +
             font-size: 0.9rem;

     

       567
       +
             color: #666;

     

       568
       +
           }

     

       569
       +
           .summary {

     

       570
       +
             background: white;

     

       571
       +
             border-radius: 6px;

     

       572
       +
             padding: 1rem;

     

       573
       +
             margin-bottom: 1rem;

     

       574
       +
             box-shadow: 0 2px 4px rgba(0,0,0,0.1);

     

       575
       +
           }

     

       576
       +
           .summary h2 {

     

       577
       +
             color: #667eea;

     

       578
       +
             margin-bottom: 0.8rem;

     

       579
       +
             font-size: 1.2rem;

     

       580
       +
           }

     

       581
       +
           .summary-grid {

     

       582
       +
             display: grid;

     

       583
       +
             grid-template-columns: repeat(auto-fit, minmax(120px, 1fr));

     

       584
       +
             gap: 0.8rem;

     

       585
       +
           }

     

       586
       +
           .summary-metric {

     

       587
       +
             text-align: center;

     

       588
       +
             padding: 0.8rem;

     

       589
       +
             background: linear-gradient(135deg, #667eea 0%%, #764ba2 100%%);

     

       590
       +
             border-radius: 4px;

     

       591
       +
             color: white;

     

       592
       +
           }

     

       593
       +
           .summary-metric-label {

     

       594
       +
             font-size: 0.75rem;

     

       595
       +
             opacity: 0.9;

     

       596
       +
             margin-bottom: 0.3rem;

     

       597
       +
           }

     

       598
       +
           .summary-metric-value {

     

       599
       +
             font-size: 1.4rem;

     

       600
       +
             font-weight: bold;

     

       601
       +
           }

     

       602
       +
           .comparison {

     

       603
       +
             background: white;

     

       604
       +
             border-radius: 6px;

     

       605
       +
             padding: 1rem;

     

       606
       +
             margin-bottom: 1rem;

     

       607
       +
             box-shadow: 0 2px 4px rgba(0,0,0,0.1);

     

       608
       +
           }

     

       609
       +
           .comparison h2 {

     

       610
       +
             color: #667eea;

     

       611
       +
             margin-bottom: 0.8rem;

     

       612
       +
             font-size: 1.2rem;

     

       613
       +
           }

     

       614
       +
           .comparison-charts {

     

       615
       +
             display: grid;

     

       616
       +
             grid-template-columns: repeat(3, 1fr);

     

       617
       +
             gap: 1rem;

     

       618
       +
           }

     

       619
       +
           .comparison-chart {

     

       620
       +
             height: 200px;

     

       621
       +
             position: relative;

     

       622
       +
           }

     

       623
       +
           .test-detail {

     

       624
       +
             background: white;

     

       625
       +
             border-radius: 6px;

     

       626
       +
             padding: 1rem;

     

       627
       +
             margin-bottom: 1rem;

     

       628
       +
             box-shadow: 0 2px 4px rgba(0,0,0,0.1);

     

       629
       +
             border-left: 3px solid #667eea;

     

       630
       +
           }

     

       631
       +
           .test-detail h3 {

     

       632
       +
             color: #764ba2;

     

       633
       +
             margin-bottom: 0.6rem;

     

       634
       +
             font-size: 1.1rem;

     

       635
       +
           }

     

       636
       +
           .test-detail h4 {

     

       637
       +
             color: #666;

     

       638
       +
             margin-bottom: 0.4rem;

     

       639
       +
             font-size: 0.9rem;

     

       640
       +
             font-weight: 500;

     

       641
       +
           }

     

       642
       +
           .compact-grid {

     

       643
       +
             display: grid;

     

       644
       +
             grid-template-columns: repeat(auto-fit, minmax(100px, 1fr));

     

       645
       +
             gap: 0.4rem;

     

       646
       +
             margin-bottom: 0.8rem;

     

       647
       +
             font-size: 0.85rem;

     

       648
       +
           }

     

       649
       +
           .compact-metric {

     

       650
       +
             background: #f8f9fa;

     

       651
       +
             padding: 0.4rem 0.6rem;

     

       652
       +
             border-radius: 3px;

     

       653
       +
             display: flex;

     

       654
       +
             justify-content: space-between;

     

       655
       +
             align-items: center;

     

       656
       +
           }

     

       657
       +
           .compact-metric .label {

     

       658
       +
             color: #666;

     

       659
       +
             font-weight: 500;

     

       660
       +
           }

     

       661
       +
           .compact-metric .value {

     

       662
       +
             color: #333;

     

       663
       +
             font-weight: 600;

     

       664
       +
           }

     

       665
       +
           .compact-metric.highlight {

     

       666
       +
             background: linear-gradient(135deg, #667eea 0%%, #764ba2 100%%);

     

       667
       +
             color: white;

     

       668
       +
           }

     

       669
       +
           .compact-metric.highlight .label,

     

       670
       +
           .compact-metric.highlight .value {

     

       671
       +
             color: white;

     

       672
       +
           }

     

       673
       +
           .compact-metric.error {

     

       674
       +
             background: #fee;

     

       675
       +
             border: 1px solid #fcc;

     

       676
       +
           }

     

       677
       +
           .chart-row {

     

       678
       +
             display: grid;

     

       679
       +
             grid-template-columns: 1fr 1fr;

     

       680
       +
             gap: 1rem;

     

       681
       +
           }

     

       682
       +
           .chart-half {

     

       683
       +
             position: relative;

     

       684
       +
             height: 220px;

     

       685
       +
           }

     

       686
       +
           @media (max-width: 1200px) {

     

       687
       +
             .comparison-charts { grid-template-columns: 1fr; }

     

       688
       +
             .chart-row { grid-template-columns: 1fr; }

     

       689
       +
           }

     

       690
       +
           @media (max-width: 768px) {

     

       691
       +
             .compact-grid { grid-template-columns: repeat(2, 1fr); }

     

       692
       +
           }

     

       693
       +
         </style>

     

       694
       +
       </head>

     

       695
       +
       <body>

     

       696
       +
         <div class="container">

     

       697
       +
           <h1>Connection Pool Stress Test Results</h1>

     

       698
       +
           <div class="subtitle">%s</div>

     

       699
       +
       

     

       700
       +
           <div class="summary">

     

       701
       +
             <h2>Summary</h2>

     

       702
       +
             <div class="summary-grid">

     

       703
       +
               <div class="summary-metric">

     

       704
       +
                 <div class="summary-metric-label">Tests</div>

     

       705
       +
                 <div class="summary-metric-value">%d</div>

     

       706
       +
               </div>

     

       707
       +
               <div class="summary-metric">

     

       708
       +
                 <div class="summary-metric-label">Messages</div>

     

       709
       +
                 <div class="summary-metric-value">%s</div>

     

       710
       +
               </div>

     

       711
       +
               <div class="summary-metric">

     

       712
       +
                 <div class="summary-metric-label">Errors</div>

     

       713
       +
                 <div class="summary-metric-value">%d</div>

     

       714
       +
               </div>

     

       715
       +
               <div class="summary-metric">

     

       716
       +
                 <div class="summary-metric-label">Duration</div>

     

       717
       +
                 <div class="summary-metric-value">%.1fs</div>

     

       718
       +
               </div>

     

       719
       +
             </div>

     

       720
       +
           </div>

     

       721
       +
       

     

       722
       +
           <div class="comparison">

     

       723
       +
             <h2>Comparison</h2>

     

       724
       +
             <div class="comparison-charts">

     

       725
       +
               <div class="comparison-chart"><canvas id="cmpThroughput"></canvas></div>

     

       726
       +
               <div class="comparison-chart"><canvas id="cmpLatency"></canvas></div>

     

       727
       +
               <div class="comparison-chart"><canvas id="cmpErrors"></canvas></div>

     

       728
       +
             </div>

     

       729
       +
           </div>

     

       730
       +
       

     

       731
       +
       %s

     

       732
       +
         </div>

     

       733
       +
       

     

       734
       +
         <script>

     

       735
       +
           const testNames = [%s];

     

       736
       +
           const throughputs = [%s];

     

       737
       +
           const avgLatencies = [%s];

     

       738
       +
           const errorRates = [%s];

     

       739
       +
       

     

       740
       +
           const cc = {

     

       741
       +
             primary: 'rgba(102, 126, 234, 0.8)',

     

       742
       +
             secondary: 'rgba(118, 75, 162, 0.8)',

     

       743
       +
             danger: 'rgba(220, 53, 69, 0.8)',

     

       744
       +
           };

     

       745
       +
       

     

       746
       +
           new Chart(document.getElementById('cmpThroughput'), {

     

       747
       +
             type: 'bar',

     

       748
       +
             data: {

     

       749
       +
               labels: testNames,

     

       750
       +
               datasets: [{

     

       751
       +
                 label: 'msg/s',

     

       752
       +
                 data: throughputs,

     

       753
       +
                 backgroundColor: cc.primary,

     

       754
       +
                 borderColor: cc.primary,

     

       755
       +
                 borderWidth: 1

     

       756
       +
               }]

     

       757
       +
             },

     

       758
       +
             options: {

     

       759
       +
               responsive: true,

     

       760
       +
               maintainAspectRatio: false,

     

       761
       +
               plugins: {

     

       762
       +
                 legend: { display: false },

     

       763
       +
                 title: { display: true, text: 'Throughput (msg/s)' }

     

       764
       +
               },

     

       765
       +
               scales: { y: { beginAtZero: true } }

     

       766
       +
             }

     

       767
       +
           });

     

       768
       +
       

     

       769
       +
           new Chart(document.getElementById('cmpLatency'), {

     

       770
       +
             type: 'bar',

     

       771
       +
             data: {

     

       772
       +
               labels: testNames,

     

       773
       +
               datasets: [{

     

       774
       +
                 label: 'ms',

     

       775
       +
                 data: avgLatencies,

     

       776
       +
                 backgroundColor: cc.secondary,

     

       777
       +
                 borderColor: cc.secondary,

     

       778
       +
                 borderWidth: 1

     

       779
       +
               }]

     

       780
       +
             },

     

       781
       +
             options: {

     

       782
       +
               responsive: true,

     

       783
       +
               maintainAspectRatio: false,

     

       784
       +
               plugins: {

     

       785
       +
                 legend: { display: false },

     

       786
       +
                 title: { display: true, text: 'Avg Latency (ms)' }

     

       787
       +
               },

     

       788
       +
               scales: { y: { beginAtZero: true } }

     

       789
       +
             }

     

       790
       +
           });

     

       791
       +
       

     

       792
       +
           new Chart(document.getElementById('cmpErrors'), {

     

       793
       +
             type: 'bar',

     

       794
       +
             data: {

     

       795
       +
               labels: testNames,

     

       796
       +
               datasets: [{

     

       797
       +
                 label: '%%',

     

       798
       +
                 data: errorRates,

     

       799
       +
                 backgroundColor: cc.danger,

     

       800
       +
                 borderColor: cc.danger,

     

       801
       +
                 borderWidth: 1

     

       802
       +
               }]

     

       803
       +
             },

     

       804
       +
             options: {

     

       805
       +
               responsive: true,

     

       806
       +
               maintainAspectRatio: false,

     

       807
       +
               plugins: {

     

       808
       +
                 legend: { display: false },

     

       809
       +
                 title: { display: true, text: 'Error Rate (%%)' }

     

       810
       +
               },

     

       811
       +
               scales: { y: { beginAtZero: true } }

     

       812
       +
             }

     

       813
       +
           });

     

       814
       +
         </script>

     

       815
       +
       </body>

     

       816
       +
       </html>|}

     

       817
       +
           date_str

     

       818
       +
           (List.length results)

     

       819
       +
           (if total_messages >= 1000 then

     

       820
       +
             Printf.sprintf "%d,%03d" (total_messages / 1000) (total_messages mod 1000)

     

       821
       +
           else

     

       822
       +
             string_of_int total_messages)

     

       823
       +
           total_errors

     

       824
       +
           total_duration

     

       825
       +
           test_details

     

       826
       +
           test_names

     

       827
       +
           throughputs

     

       828
       +
           avg_latencies

     

       829
       +
           error_rates

     

       830
       +
       

     

       831
       +
       (** Run all preset tests and return results *)

     

       832
       +
       let run_all_presets ~env =

     

       833
       +
         List.map (fun config ->

     

       834
       +
           Printf.eprintf "Running test: %s\n%!" config.name;

     

       835
       +
           run_stress_test ~env config

     

       836
       +
         ) presets

     

       837
       +
       

     

       838
       +
       (** Parse command line arguments *)

     

       839
       +
       type mode =

     

       840
       +
         | Single of config

     

       841
       +
         | AllPresets

     

       842
       +
         | Extended

     

       843
       +
         | ListPresets

     

       844
       +
       

     

       845
       +
       let parse_args () =

     

       846
       +
         let mode = ref (Single default_config) in

     

       847
       +
         let name = ref default_config.name in

     

       848
       +
         let num_servers = ref default_config.num_servers in

     

       849
       +
         let num_clients = ref default_config.num_clients in

     

       850
       +
         let messages_per_client = ref default_config.messages_per_client in

     

       851
       +
         let max_parallel = ref default_config.max_parallel_clients in

     

       852
       +
         let message_size = ref default_config.message_size in

     

       853
       +
         let pool_size = ref default_config.pool_size in

     

       854
       +
         let output_file = ref "stress_test_results.json" in

     

       855
       +
       

     

       856
       +
         let specs = [

     

       857
       +
           ("--all", Arg.Unit (fun () -> mode := AllPresets),

     

       858
       +
             "Run all preset test configurations");

     

       859
       +
           ("--extended", Arg.Unit (fun () -> mode := Extended),

     

       860
       +
             "Run extended stress test (30 servers, 1000 clients, 100 msgs each = 3M messages)");

     

       861
       +
           ("--list", Arg.Unit (fun () -> mode := ListPresets),

     

       862
       +
             "List available presets");

     

       863
       +
           ("--preset", Arg.String (fun p ->

     

       864
       +
             match List.find_opt (fun c -> c.name = p) presets with

     

       865
       +
             | Some c -> mode := Single c

     

       866
       +
             | None -> failwith (Printf.sprintf "Unknown preset: %s" p)),

     

       867
       +
             "Use a named preset configuration");

     

       868
       +
           ("-n", Arg.Set_string name, "Test name");

     

       869
       +
           ("-s", Arg.Set_int num_servers, Printf.sprintf "Number of servers (default: %d)" default_config.num_servers);

     

       870
       +
           ("-c", Arg.Set_int num_clients, Printf.sprintf "Clients per server (default: %d)" default_config.num_clients);

     

       871
       +
           ("-m", Arg.Set_int messages_per_client, Printf.sprintf "Messages per client (default: %d)" default_config.messages_per_client);

     

       872
       +
           ("-p", Arg.Set_int max_parallel, Printf.sprintf "Max parallel clients (default: %d)" default_config.max_parallel_clients);

     

       873
       +
           ("-b", Arg.Set_int message_size, Printf.sprintf "Message size (default: %d)" default_config.message_size);

     

       874
       +
           ("-P", Arg.Set_int pool_size, Printf.sprintf "Pool size per endpoint (default: %d)" default_config.pool_size);

     

       875
       +
           ("-o", Arg.Set_string output_file, "Output JSON file (default: stress_test_results.json)");

     

       876
       +
         ] in

     

       877
       +
       

     

       878
       +
         let usage = "Usage: stress_test [options]\n\nOptions:" in

     

       879
       +
         Arg.parse specs (fun _ -> ()) usage;

     

       880
       +
       

     

       881
       +
         let config = {

     

       882
       +
           name = !name;

     

       883
       +
           num_servers = !num_servers;

     

       884
       +
           num_clients = !num_clients;

     

       885
       +
           messages_per_client = !messages_per_client;

     

       886
       +
           max_parallel_clients = !max_parallel;

     

       887
       +
           message_size = !message_size;

     

       888
       +
           pool_size = !pool_size;

     

       889
       +
         } in

     

       890
       +
       

     

       891
       +
         (!mode, config, !output_file)

     

       892
       +
       

     

       893
       +
       let () =

     

       894
       +
         Random.self_init ();

     

       895
       +
         let (mode, custom_config, output_file) = parse_args () in

     

       896
       +
       

     

       897
       +
         match mode with

     

       898
       +
         | ListPresets ->

     

       899
       +
             Printf.printf "Available presets:\n";

     

       900
       +
             List.iter (fun c ->

     

       901
       +
               Printf.printf "  %s: %d servers, %d clients, %d msgs/client, pool=%d\n"

     

       902
       +
                 c.name c.num_servers c.num_clients c.messages_per_client c.pool_size

     

       903
       +
             ) presets

     

       904
       +
       

     

       905
       +
         | Single config ->

     

       906
       +
             let config = if config.name = "default" then custom_config else config in

     

       907
       +
             Eio_main.run @@ fun env ->

     

       908
       +
               let result = run_stress_test ~env config in

     

       909
       +
               let results = [result] in

     

       910
       +
       

     

       911
       +
               (* Write JSON *)

     

       912
       +
               let json = Printf.sprintf "[%s]" (result_to_json result) in

     

       913
       +
               let oc = open_out output_file in

     

       914
       +
               output_string oc json;

     

       915
       +
               close_out oc;

     

       916
       +
               Printf.printf "Results written to %s\n" output_file;

     

       917
       +
       

     

       918
       +
               (* Write HTML *)

     

       919
       +
               let html_file =

     

       920
       +
                 if Filename.check_suffix output_file ".json" then

     

       921
       +
                   Filename.chop_suffix output_file ".json" ^ ".html"

     

       922
       +
                 else

     

       923
       +
                   output_file ^ ".html"

     

       924
       +
               in

     

       925
       +
               let html = generate_html_report results in

     

       926
       +
               let oc_html = open_out html_file in

     

       927
       +
               output_string oc_html html;

     

       928
       +
               close_out oc_html;

     

       929
       +
               Printf.printf "HTML report written to %s\n" html_file;

     

       930
       +
       

     

       931
       +
               Printf.printf "Test: %s - %d messages, %.2f msg/s, %.2fms avg latency, %d errors\n"

     

       932
       +
                 result.test_name result.total_messages result.throughput result.avg_latency result.total_errors

     

       933
       +
       

     

       934
       +
         | AllPresets ->

     

       935
       +
             Eio_main.run @@ fun env ->

     

       936
       +
               let results = run_all_presets ~env in

     

       937
       +
       

     

       938
       +
               (* Write JSON *)

     

       939
       +
               let json = "[" ^ String.concat ",\n" (List.map result_to_json results) ^ "]" in

     

       940
       +
               let oc = open_out output_file in

     

       941
       +
               output_string oc json;

     

       942
       +
               close_out oc;

     

       943
       +
               Printf.printf "Results written to %s\n" output_file;

     

       944
       +
       

     

       945
       +
               (* Write HTML *)

     

       946
       +
               let html_file =

     

       947
       +
                 if Filename.check_suffix output_file ".json" then

     

       948
       +
                   Filename.chop_suffix output_file ".json" ^ ".html"

     

       949
       +
                 else

     

       950
       +
                   output_file ^ ".html"

     

       951
       +
               in

     

       952
       +
               let html = generate_html_report results in

     

       953
       +
               let oc_html = open_out html_file in

     

       954
       +
               output_string oc_html html;

     

       955
       +
               close_out oc_html;

     

       956
       +
               Printf.printf "HTML report written to %s\n" html_file;

     

       957
       +
       

     

       958
       +
               List.iter (fun r ->

     

       959
       +
                 Printf.printf "  %s: %d messages, %.2f msg/s, %.2fms avg latency, %d errors\n"

     

       960
       +
                   r.test_name r.total_messages r.throughput r.avg_latency r.total_errors

     

       961
       +
               ) results

     

       962
       +
       

     

       963
       +
         | Extended ->

     

       964
       +
             Printf.printf "Running extended stress test: %d servers, %d clients/server, %d msgs/client\n"

     

       965
       +
               extended_preset.num_servers extended_preset.num_clients extended_preset.messages_per_client;

     

       966
       +
             Printf.printf "Total messages: %d\n%!"

     

       967
       +
               (extended_preset.num_servers * extended_preset.num_clients * extended_preset.messages_per_client);

     

       968
       +
             Eio_main.run @@ fun env ->

     

       969
       +
               let result = run_stress_test ~env extended_preset in

     

       970
       +
               let results = [result] in

     

       971
       +
       

     

       972
       +
               (* Write JSON *)

     

       973
       +
               let json = Printf.sprintf "[%s]" (result_to_json result) in

     

       974
       +
               let oc = open_out output_file in

     

       975
       +
               output_string oc json;

     

       976
       +
               close_out oc;

     

       977
       +
               Printf.printf "Results written to %s\n" output_file;

     

       978
       +
       

     

       979
       +
               (* Write HTML *)

     

       980
       +
               let html_file =

     

       981
       +
                 if Filename.check_suffix output_file ".json" then

     

       982
       +
                   Filename.chop_suffix output_file ".json" ^ ".html"

     

       983
       +
                 else

     

       984
       +
                   output_file ^ ".html"

     

       985
       +
               in

     

       986
       +
               let html = generate_html_report results in

     

       987
       +
               let oc_html = open_out html_file in

     

       988
       +
               output_string oc_html html;

     

       989
       +
               close_out oc_html;

     

       990
       +
               Printf.printf "HTML report written to %s\n" html_file;

     

       991
       +
       

     

       992
       +
               Printf.printf "Test: %s - %d messages, %.2f msg/s, %.2fms avg latency, %d errors\n"

     

       993
       +
                 result.test_name result.total_messages result.throughput result.avg_latency result.total_errors

Compare changes