comparing b3b475db2efb23e1e7e68d5140127404802f3a92 and main on anil.recoil.org/ocaml-conpool

+17 -1

.gitignore

···

       1
       1
       -
       _build

     

       1
       1
       +
       # OCaml build artifacts

     

       2
       2
       +
       _build/

     

       3
       3
       +
       *.install

     

       4
       4
       +
       *.merlin

     

       5
       5
       +
       

     

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

     

       7
       7
       +
       third_party/

     

       8
       8
       +
       

     

       9
       9
       +
       # Editor and OS files

     

       10
       10
       +
       .DS_Store

     

       11
       11
       +
       *.swp

     

       12
       12
       +
       *~

     

       13
       13
       +
       .vscode/

     

       14
       14
       +
       .idea/

     

       15
       15
       +
       

     

       16
       16
       +
       # Opam local switch

     

       17
       17
       +
       _opam/

.ocamlformat

···

       1
       1
       +
       version=0.28.1

+54

.tangled/workflows/build.yml

···

       1
       1
       +
       when:

     

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

     

       3
       3
       +
           branch: ["main"]

     

       4
       4
       +
       

     

       5
       5
       +
       engine: nixery

     

       6
       6
       +
       

     

       7
       7
       +
       dependencies:

     

       8
       8
       +
         nixpkgs:

     

       9
       9
       +
           - shell

     

       10
       10
       +
           - stdenv

     

       11
       11
       +
           - findutils

     

       12
       12
       +
           - binutils

     

       13
       13
       +
           - libunwind

     

       14
       14
       +
           - ncurses

     

       15
       15
       +
           - opam

     

       16
       16
       +
           - git

     

       17
       17
       +
           - gawk

     

       18
       18
       +
           - gnupatch

     

       19
       19
       +
           - gnum4

     

       20
       20
       +
           - gnumake

     

       21
       21
       +
           - gnutar

     

       22
       22
       +
           - gnused

     

       23
       23
       +
           - gnugrep

     

       24
       24
       +
           - diffutils

     

       25
       25
       +
           - gzip

     

       26
       26
       +
           - bzip2

     

       27
       27
       +
           - gcc

     

       28
       28
       +
           - ocaml

     

       29
       29
       +
           - pkg-config

     

       30
       30
       +
       

     

       31
       31
       +
       steps:

     

       32
       32
       +
         - name: opam

     

       33
       33
       +
           command: |

     

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

     

       35
       35
       +
         - name: repo

     

       36
       36
       +
           command: |

     

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

     

       38
       38
       +
         - name: switch

     

       39
       39
       +
           command: |

     

       40
       40
       +
             export PKG_CONFIG_PATH="${PKG_CONFIG_PATH}:$(nix build nixpkgs#gmp.dev --no-link --print-out-paths)/lib/pkgconfig"

     

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

     

       42
       42
       +
         - name: build

     

       43
       43
       +
           command: |

     

       44
       44
       +
              opam exec -- dune build -p conpool

     

       45
       45
       +
         - name: switch-test

     

       46
       46
       +
           command: |

     

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

     

       48
       48
       +
         - name: test

     

       49
       49
       +
           command: |

     

       50
       50
       +
              opam exec -- dune runtest --verbose

     

       51
       51
       +
         - name: doc

     

       52
       52
       +
           command: |

     

       53
       53
       +
              opam install -y odoc

     

       54
       54
       +
              opam exec -- dune build @doc

CHANGES.md

···

       1
       1
       +
       # v1.0.0 (dev)

     

       2
       2
       +
       

     

       3
       3
       +
       - Initial release of Conpool

+15

LICENSE.md

···

       1
       1
       +
       ISC License

     

       2
       2
       +
       

     

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

     

       4
       4
       +
       

     

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

     

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

     

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

     

       8
       8
       +
       

     

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

     

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

     

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

     

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

     

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

     

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

     

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

+110

README.md

···

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

     

       2
       2
       +
       

     

       3
       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
       4
       +
       

     

       5
       5
       +
       ## Key Features

     

       6
       6
       +
       

     

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

     

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

     

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

     

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

     

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

     

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

     

       13
       13
       +
       

     

       14
       14
       +
       ## Usage

     

       15
       15
       +
       

     

       16
       16
       +
       Basic example establishing a connection pool:

     

       17
       17
       +
       

     

       18
       18
       +
       ```ocaml

     

       19
       19
       +
       open Eio.Std

     

       20
       20
       +
       

     

       21
       21
       +
       let run env =

     

       22
       22
       +
         Switch.run (fun sw ->

     

       23
       23
       +
           (* Create a connection pool *)

     

       24
       24
       +
           let pool = Conpool.create

     

       25
       25
       +
             ~sw

     

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

     

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

     

       28
       28
       +
             ()

     

       29
       29
       +
           in

     

       30
       30
       +
       

     

       31
       31
       +
           (* Define an endpoint *)

     

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

     

       33
       33
       +
       

     

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

     

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

     

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

     

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

     

       38
       38
       +
             Eio.Buf_read.take_all buf

     

       39
       39
       +
           )

     

       40
       40
       +
         )

     

       41
       41
       +
       ```

     

       42
       42
       +
       

     

       43
       43
       +
       With TLS configuration:

     

       44
       44
       +
       

     

       45
       45
       +
       ```ocaml

     

       46
       46
       +
       let run env =

     

       47
       47
       +
         Switch.run (fun sw ->

     

       48
       48
       +
           (* Create TLS configuration - SNI servername is automatically set to the endpoint's hostname *)

     

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

     

       50
       50
       +
       

     

       51
       51
       +
           (* Create pool with TLS *)

     

       52
       52
       +
           let pool = Conpool.create

     

       53
       53
       +
             ~sw

     

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

     

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

     

       56
       56
       +
             ~tls:tls_config

     

       57
       57
       +
             ()

     

       58
       58
       +
           in

     

       59
       59
       +
       

     

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

     

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

     

       62
       62
       +
             (* Use TLS-encrypted connection *)

     

       63
       63
       +
             ...

     

       64
       64
       +
           )

     

       65
       65
       +
         )

     

       66
       66
       +
       ```

     

       67
       67
       +
       

     

       68
       68
       +
       Custom pool configuration:

     

       69
       69
       +
       

     

       70
       70
       +
       ```ocaml

     

       71
       71
       +
       let config = Conpool.Config.make

     

       72
       72
       +
         ~max_connections_per_endpoint:20

     

       73
       73
       +
         ~max_idle_per_endpoint:5

     

       74
       74
       +
         ~connection_timeout:10.0

     

       75
       75
       +
         ~validation_interval:300.0

     

       76
       76
       +
         ()

     

       77
       77
       +
       in

     

       78
       78
       +
       

     

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

     

       80
       80
       +
       ```

     

       81
       81
       +
       

     

       82
       82
       +
       Monitor pool statistics:

     

       83
       83
       +
       

     

       84
       84
       +
       ```ocaml

     

       85
       85
       +
       let stats = Conpool.stats pool endpoint in

     

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

     

       87
       87
       +
         (Conpool.Stats.active_connections stats)

     

       88
       88
       +
         (Conpool.Stats.idle_connections stats)

     

       89
       89
       +
         (Conpool.Stats.cache_hits stats)

     

       90
       90
       +
         (Conpool.Stats.cache_misses stats)

     

       91
       91
       +
       ```

     

       92
       92
       +
       

     

       93
       93
       +
       ## Installation

     

       94
       94
       +
       

     

       95
       95
       +
       ```

     

       96
       96
       +
       opam install conpool

     

       97
       97
       +
       ```

     

       98
       98
       +
       

     

       99
       99
       +
       ## Documentation

     

       100
       100
       +
       

     

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

     

       102
       102
       +
       

     

       103
       103
       +
       ```

     

       104
       104
       +
       opam install conpool

     

       105
       105
       +
       odig doc conpool

     

       106
       106
       +
       ```

     

       107
       107
       +
       

     

       108
       108
       +
       ## License

     

       109
       109
       +
       

     

       110
       110
       +
       ISC

+8 -8

conpool.opam

···

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

     

       4
       4
        
       description:

     

       5
       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
       6
       -
       maintainer: ["Your Name"]

     

       7
       7
       -
       authors: ["Your Name"]

     

       8
       8
       -
       license: "MIT"

     

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

     

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

     

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

     

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

     

       8
       8
       +
       license: "ISC"

     

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

     

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

     

       11
       11
        
       depends: [

     

       12
       12
       -
         "ocaml"

     

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

     

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

     

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

     

       14
       14
        
         "eio"

     

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

     

       16
       16
        
         "logs"

     
···

       32
       32
        
           "@doc" {with-doc}

     

       33
       33
        
         ]

     

       34
       34
        
       ]

     

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

     

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

+11 -11

dune-project

···

       1
       1
       -
       (lang dune 3.0)

     

       1
       1
       +
       (lang dune 3.20)

     

       2
       2
       +
       

     

       2
       3
        
       (name conpool)

     

       3
       4
        
       

     

       4
       5
        
       (generate_opam_files true)

     

       5
       6
        
       

     

       6
       6
       -
       (source

     

       7
       7
       -
        (github username/conpool))

     

       8
       8
       -
       

     

       9
       9
       -
       (authors "Your Name")

     

       10
       10
       -
       

     

       11
       11
       -
       (maintainers "Your Name")

     

       12
       12
       -
       

     

       13
       13
       -
       (license MIT)

     

       7
       7
       +
       (license ISC)

     

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

     

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

     

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

     

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

     

       12
       12
       +
       (maintenance_intent "(latest)")

     

       14
       13
        
       

     

       15
       14
        
       (package

     

       16
       15
        
        (name conpool)

     

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

     

       18
       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.)")

     

       19
       18
        
        (depends

     

       20
       20
       -
         ocaml

     

       19
       19
       +
         (ocaml (>= 5.1.0))

     

       21
       20
        
         (dune (>= 3.0))

     

       22
       21
        
         eio

     

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

     

       24
       23
        
         logs

     

       25
       24
        
         fmt

     

       26
       26
       -
         cmdliner))

     

       25
       25
       +
         cmdliner

     

       26
       26
       +
         (odoc :with-doc)))

+30 -25

lib/cmd.ml

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

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

     

       2
       7
        
       

     

       3
       8
        
       open Cmdliner

     

       4
       9
        
       

     

       5
       10
        
       let max_connections_per_endpoint =

     

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

     

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

     

       12
       12
       +
         Arg.(

     

       13
       13
       +
           value & opt int 10

     

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

     

       8
       15
        
       

     

       9
       16
        
       let max_idle_time =

     

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

     

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

     

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

     

       12
       19
        
       

     

       13
       20
        
       let max_connection_lifetime =

     

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

     

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

     

       22
       22
       +
         Arg.(

     

       23
       23
       +
           value & opt float 300.0

     

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

     

       16
       25
        
       

     

       17
       26
        
       let max_connection_uses =

     

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

     

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

     

       28
       28
       +
         Arg.(

     

       29
       29
       +
           value

     

       30
       30
       +
           & opt (some int) None

     

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

     

       20
       32
        
       

     

       21
       33
        
       let connect_timeout =

     

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

     

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

     

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

     

       24
       36
        
       

     

       25
       37
        
       let connect_retry_count =

     

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

     

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

     

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

     

       28
       40
        
       

     

       29
       41
        
       let connect_retry_delay =

     

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

     

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

     

       43
       43
       +
         Arg.(

     

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

     

       32
       45
        
       

     

       33
       46
        
       let config =

     

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

     

       35
       35
       -
           Config.make

     

       36
       36
       -
             ~max_connections_per_endpoint:max_conn

     

       37
       37
       -
             ~max_idle_time:max_idle

     

       38
       38
       -
             ~max_connection_lifetime:max_lifetime

     

       39
       39
       -
             ?max_connection_uses:max_uses

     

       40
       40
       -
             ~connect_timeout:timeout

     

       41
       41
       -
             ~connect_retry_count:retry_count

     

       42
       42
       -
             ~connect_retry_delay:retry_delay

     

       43
       43
       -
             ()

     

       47
       47
       +
         let make max_conn max_idle max_lifetime max_uses timeout retry_count

     

       48
       48
       +
             retry_delay =

     

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

     

       50
       50
       +
             ~max_connection_lifetime:max_lifetime ?max_connection_uses:max_uses

     

       51
       51
       +
             ~connect_timeout:timeout ~connect_retry_count:retry_count

     

       52
       52
       +
             ~connect_retry_delay:retry_delay ()

     

       44
       53
        
         in

     

       45
       45
       -
         Term.(const make

     

       46
       46
       -
               $ max_connections_per_endpoint

     

       47
       47
       -
               $ max_idle_time

     

       48
       48
       -
               $ max_connection_lifetime

     

       49
       49
       -
               $ max_connection_uses

     

       50
       50
       -
               $ connect_timeout

     

       51
       51
       -
               $ connect_retry_count

     

       52
       52
       -
               $ connect_retry_delay)

     

       54
       54
       +
         Term.(

     

       55
       55
       +
           const make $ max_connections_per_endpoint $ max_idle_time

     

       56
       56
       +
           $ max_connection_lifetime $ max_connection_uses $ connect_timeout

     

       57
       57
       +
           $ connect_retry_count $ connect_retry_delay)

+20 -22

lib/cmd.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

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

     

       2
       7
        
       

     

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

     

       4
       9
        
       

     

       5
       10
        
       val max_connections_per_endpoint : int Cmdliner.Term.t

     

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

     

       7
       7
       -
           Default: 10

     

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

     

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

     

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

     

       9
       13
        
       

     

       10
       14
        
       val max_idle_time : float Cmdliner.Term.t

     

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

     

       12
       12
       -
           Default: 60.0

     

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

     

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

     

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

     

       14
       17
        
       

     

       15
       18
        
       val max_connection_lifetime : float Cmdliner.Term.t

     

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

     

       17
       17
       -
           Default: 300.0

     

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

     

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

     

       19
       21
        
       

     

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

     

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

     

       22
       22
       -
           Default: None (unlimited)

     

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

     

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

     

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

     

       24
       25
        
       

     

       25
       26
        
       val connect_timeout : float Cmdliner.Term.t

     

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

     

       27
       27
       -
           Default: 10.0

     

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

     

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

     

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

     

       29
       29
        
       

     

       30
       30
        
       val connect_retry_count : int Cmdliner.Term.t

     

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

     

       32
       32
       -
           Default: 3

     

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

     

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

     

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

     

       34
       33
        
       

     

       35
       34
        
       val connect_retry_delay : float Cmdliner.Term.t

     

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

     

       37
       37
       -
           Default: 0.1

     

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

     

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

     

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

     

       39
       37
        
       

     

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

     

       41
       39
        
       

     

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

     

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

     

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

     

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

     

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

     

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

+42 -38

lib/config.ml

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       1
       6
        
       (** Configuration for connection pools *)

     

       2
       7
        
       

     

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

     

       9
       9
       +
       

     

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

     

       5
       11
        
       

     

       6
       12
        
       type t = {

     
···

       8
       14
        
         max_idle_time : float;

     

       9
       15
        
         max_connection_lifetime : float;

     

       10
       16
        
         max_connection_uses : int option;

     

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

     

       17
       17
       +
         health_check :

     

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

     

       12
       19
        
         connect_timeout : float option;

     

       13
       20
        
         connect_retry_count : int;

     

       14
       21
        
         connect_retry_delay : float;

     
···

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

     

       18
       25
        
       }

     

       19
       26
        
       

     

       20
       20
       -
       let make

     

       21
       21
       -
           ?(max_connections_per_endpoint = 10)

     

       22
       22
       -
           ?(max_idle_time = 60.0)

     

       23
       23
       -
           ?(max_connection_lifetime = 300.0)

     

       24
       24
       -
           ?max_connection_uses

     

       25
       25
       -
           ?health_check

     

       26
       26
       -
           ?(connect_timeout = 10.0)

     

       27
       27
       -
           ?(connect_retry_count = 3)

     

       28
       28
       -
           ?(connect_retry_delay = 0.1)

     

       29
       29
       -
           ?on_connection_created

     

       30
       30
       -
           ?on_connection_closed

     

       31
       31
       -
           ?on_connection_reused

     

       32
       32
       -
           () =

     

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

     

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

     

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

     

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

     

       31
       31
       +
           ?on_connection_reused () =

     

       33
       32
        
         (* Validate parameters *)

     

       34
       33
        
         if max_connections_per_endpoint <= 0 then

     

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

     

       36
       36
       -
             max_connections_per_endpoint);

     

       34
       34
       +
           invalid_arg

     

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

     

       36
       36
       +
                max_connections_per_endpoint);

     

       37
       37
        
       

     

       38
       38
        
         if max_idle_time <= 0.0 then

     

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

     

       39
       39
       +
           invalid_arg

     

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

     

       40
       41
        
       

     

       41
       42
        
         if max_connection_lifetime <= 0.0 then

     

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

     

       43
       43
       -
             max_connection_lifetime);

     

       43
       43
       +
           invalid_arg

     

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

     

       45
       45
       +
                max_connection_lifetime);

     

       44
       46
        
       

     

       45
       47
        
         (match max_connection_uses with

     

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

     

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

     

       48
       48
       -
          | _ -> ());

     

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

     

       49
       49
       +
             invalid_arg

     

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

     

       51
       51
       +
         | _ -> ());

     

       49
       52
        
       

     

       50
       53
        
         if connect_timeout <= 0.0 then

     

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

     

       54
       54
       +
           invalid_arg

     

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

     

       56
       56
       +
                connect_timeout);

     

       52
       57
        
       

     

       53
       58
        
         if connect_retry_count < 0 then

     

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

     

       55
       55
       -
             connect_retry_count);

     

       59
       59
       +
           invalid_arg

     

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

     

       61
       61
       +
                connect_retry_count);

     

       56
       62
        
       

     

       57
       63
        
         if connect_retry_delay <= 0.0 then

     

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

     

       59
       59
       -
             connect_retry_delay);

     

       64
       64
       +
           invalid_arg

     

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

     

       66
       66
       +
                connect_retry_delay);

     

       60
       67
        
       

     

       61
       61
       -
         Log.debug (fun m ->

     

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

     

       63
       63
       -
             max_connections_per_endpoint max_idle_time max_connection_lifetime);

     

       64
       68
        
         {

     

       65
       69
        
           max_connections_per_endpoint;

     

       66
       70
        
           max_idle_time;

     
···

       76
       80
        
         }

     

       77
       81
        
       

     

       78
       82
        
       let default = make ()

     

       79
       79
       -
       

     

       80
       83
        
       let max_connections_per_endpoint t = t.max_connections_per_endpoint

     

       81
       84
        
       let max_idle_time t = t.max_idle_time

     

       82
       85
        
       let max_connection_lifetime t = t.max_connection_lifetime

     
···

       99
       102
        
            - connect_timeout: %s@,\

     

       100
       103
        
            - connect_retry_count: %d@,\

     

       101
       104
        
            - connect_retry_delay: %.2fs@]"

     

       102
       102
       -
           t.max_connections_per_endpoint

     

       103
       103
       -
           t.max_idle_time

     

       104
       104
       -
           t.max_connection_lifetime

     

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

     

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

     

       107
       107
       -
           t.connect_retry_count

     

       108
       108
       -
           t.connect_retry_delay

     

       105
       105
       +
           t.max_connections_per_endpoint t.max_idle_time t.max_connection_lifetime

     

       106
       106
       +
           (match t.max_connection_uses with

     

       107
       107
       +
           | Some n -> string_of_int n

     

       108
       108
       +
           | None -> "unlimited")

     

       109
       109
       +
           (match t.connect_timeout with

     

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

     

       111
       111
       +
           | None -> "none")

     

       112
       112
       +
           t.connect_retry_count t.connect_retry_delay

+24 -15

lib/config.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       1
       6
        
       (** Configuration for connection pools *)

     

       2
       7
        
       

     

       3
       8
        
       (** {1 Logging} *)

     
···

       5
       10
        
       val src : Logs.Src.t

     

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

     

       7
       12
        
           {[

     

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

     

       9
       9
       -
           ]}

     

       10
       10
       -
       *)

     

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

     

       14
       14
       +
           ]} *)

     

       11
       15
        
       

     

       12
       16
        
       (** {1 Type} *)

     

       13
       17
        
       

     
···

       21
       25
        
         ?max_idle_time:float ->

     

       22
       26
        
         ?max_connection_lifetime:float ->

     

       23
       27
        
         ?max_connection_uses:int ->

     

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

     

       28
       28
       +
         ?health_check:([Eio.Resource.close_ty | Eio.Flow.two_way_ty] Eio.Resource.t -> bool) ->

     

       25
       29
        
         ?connect_timeout:float ->

     

       26
       30
        
         ?connect_retry_count:int ->

     

       27
       31
        
         ?connect_retry_delay:float ->

     

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

     

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

     

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

     

       31
       31
       -
         unit -> t

     

       35
       35
       +
         unit ->

     

       36
       36
       +
         t

     

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

     

       33
       38
        
       

     

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

     

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

     

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

     

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

     

       39
       39
       +
           @param max_connections_per_endpoint

     

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

     

       41
       41
       +
           @param max_idle_time

     

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

     

       43
       43
       +
           @param max_connection_lifetime

     

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

     

       45
       45
       +
           @param max_connection_uses

     

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

     

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

     

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

     

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

     

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

     

       50
       50
       +
           @param connect_retry_delay

     

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

     

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

     

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

     

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

     

       45
       45
       -
       *)

     

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

     

       46
       55
        
       

     

       47
       56
        
       val default : t

     

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

     
···

       54
       63
        
           - connect_timeout: 10.0s

     

       55
       64
        
           - connect_retry_count: 3

     

       56
       65
        
           - connect_retry_delay: 0.1s

     

       57
       57
       -
           - hooks: none

     

       58
       58
       -
       *)

     

       66
       66
       +
           - hooks: none *)

     

       59
       67
        
       

     

       60
       68
        
       (** {1 Accessors} *)

     

       61
       69
        
       

     
···

       71
       79
        
       val max_connection_uses : t -> int option

     

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

     

       73
       81
        
       

     

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

     

       82
       82
       +
       val health_check :

     

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

     

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

     

       76
       85
        
       

     

       77
       86
        
       val connect_timeout : t -> float option

+17 -16

lib/connection.ml

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

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

     

       2
       7
        
       

     

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

     

       8
       8
       +
       let src =

     

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

     

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

     

       11
       11
       +
       

     

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

     

       5
       13
        
       

     

       6
       14
        
       type t = {

     

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

     

       15
       15
       +
         flow : [Eio.Resource.close_ty | Eio.Flow.two_way_ty] Eio.Resource.t;

     

       8
       16
        
         created_at : float;

     

       9
       17
        
         mutable last_used : float;

     

       10
       18
        
         mutable use_count : int;

     
···

       15
       23
        
       let flow t = t.flow

     

       16
       24
        
       let endpoint t = t.endpoint

     

       17
       25
        
       let created_at t = t.created_at

     

       18
       18
       -
       

     

       19
       19
       -
       let last_used t =

     

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

     

       21
       21
       -
       

     

       22
       22
       -
       let use_count t =

     

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

     

       26
       26
       +
       let last_used t = t.last_used

     

       27
       27
       +
       let use_count t = t.use_count

     

       24
       28
        
       

     

       25
       29
        
       let update_usage t ~now =

     

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

     

       27
       27
       -
           t.last_used <- now;

     

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

     

       29
       29
       -
         )

     

       31
       31
       +
             t.last_used <- now;

     

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

     

       30
       33
        
       

     

       31
       34
        
       let pp ppf t =

     

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

     

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

     

       34
       34
       -
           Endpoint.pp t.endpoint

     

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

     

       36
       36
       -
           uses

     

       35
       35
       +
         let uses = t.use_count in

     

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

     

       37
       37
       +
           t.endpoint t.created_at uses

+345 -315

lib/conpool.ml

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

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

     

       2
       7
        
       

     

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

     

       9
       9
       +
       

     

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

     

       5
       11
        
       

     

       6
       12
        
       (* Re-export submodules *)

     

       7
       13
        
       module Endpoint = Endpoint

     

       8
       8
       -
       module Tls_config = Tls_config

     

       9
       14
        
       module Config = Config

     

       10
       15
        
       module Stats = Stats

     

       11
       16
        
       module Cmd = Cmd

     
···

       14
       19
        
       

     

       15
       20
        
       type error =

     

       16
       21
        
         | Dns_resolution_failed of { hostname : string }

     

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

     

       22
       22
       +
         | Connection_failed of {

     

       23
       23
       +
             endpoint : Endpoint.t;

     

       24
       24
       +
             attempts : int;

     

       25
       25
       +
             last_error : string;

     

       26
       26
       +
           }

     

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

     

       19
       28
        
         | Invalid_config of string

     

       20
       29
        
         | Invalid_endpoint of string

     

       21
       30
        
       

     

       22
       22
       -
       exception Pool_error of error

     

       23
       23
       -
       

     

       24
       31
        
       let pp_error ppf = function

     

       25
       32
        
         | Dns_resolution_failed { hostname } ->

     

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

     

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

     

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

     

       29
       29
       -
               Endpoint.pp endpoint attempts last_error

     

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

     

       36
       36
       +
               endpoint attempts last_error

     

       30
       37
        
         | Connection_timeout { endpoint; timeout } ->

     

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

     

       32
       32
       -
               Endpoint.pp endpoint timeout

     

       33
       33
       -
         | Invalid_config msg ->

     

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

     

       35
       35
       -
         | Invalid_endpoint msg ->

     

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

     

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

     

       39
       39
       +
               timeout

     

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

     

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

     

       42
       42
       +
       

     

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

     

       44
       44
       +
       

     

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

     

       46
       46
       +
       

     

       47
       47
       +
       let () =

     

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

     

       49
       49
       +
             | E e ->

     

       50
       50
       +
                 Fmt.string f "Conpool ";

     

       51
       51
       +
                 pp_error f e;

     

       52
       52
       +
                 true

     

       53
       53
       +
             | _ -> false)

     

       54
       54
       +
       

     

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

     

       56
       56
       +
       

     

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

     

       58
       58
       +
       type connection = connection_ty Eio.Resource.t

     

       37
       59
        
       

     

       38
       60
        
       type endp_stats = {

     

       39
       61
        
         mutable active : int;

     
···

       55
       77
        
         net : 'net;

     

       56
       78
        
         clock : 'clock;

     

       57
       79
        
         config : Config.t;

     

       58
       58
       -
         tls : Tls_config.t option;

     

       80
       80
       +
         tls : Tls.Config.client option;

     

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

     

       60
       82
        
         endpoints_mutex : Eio.Mutex.t;

     

       61
       83
        
       }

     

       62
       84
        
       

     

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

     

       64
       86
        
       

     

       65
       65
       -
       module EndpointTbl = Hashtbl.Make(struct

     

       87
       87
       +
       module EndpointTbl = Hashtbl.Make (struct

     

       66
       88
        
         type t = Endpoint.t

     

       89
       89
       +
       

     

       67
       90
        
         let equal = Endpoint.equal

     

       68
       91
        
         let hash = Endpoint.hash

     

       69
       92
        
       end)

     

       70
       93
        
       

     

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

     

       72
       72
       -
         Eio.Time.now pool.clock

     

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

     

       73
       95
        
       

     

       74
       74
       -
       let create_endp_stats () = {

     

       75
       75
       -
         active = 0;

     

       76
       76
       -
         idle = 0;

     

       77
       77
       -
         total_created = 0;

     

       78
       78
       -
         total_reused = 0;

     

       79
       79
       -
         total_closed = 0;

     

       80
       80
       -
         errors = 0;

     

       81
       81
       -
       }

     

       96
       96
       +
       let create_endp_stats () =

     

       97
       97
       +
         {

     

       98
       98
       +
           active = 0;

     

       99
       99
       +
           idle = 0;

     

       100
       100
       +
           total_created = 0;

     

       101
       101
       +
           total_reused = 0;

     

       102
       102
       +
           total_closed = 0;

     

       103
       103
       +
           errors = 0;

     

       104
       104
       +
         }

     

       82
       105
        
       

     

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

     

       84
       84
       -
         Stats.make

     

       85
       85
       -
           ~active:stats.active

     

       86
       86
       -
           ~idle:stats.idle

     

       87
       87
       -
           ~total_created:stats.total_created

     

       88
       88
       -
           ~total_reused:stats.total_reused

     

       89
       89
       -
           ~total_closed:stats.total_closed

     

       90
       90
       -
           ~errors:stats.errors

     

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

     

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

     

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

     

       91
       110
        
       

     

       92
       111
        
       (** {1 DNS Resolution} *)

     

       93
       112
        
       

     

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

     

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

     

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

     

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

     

       98
       98
       -
         match addrs with

     

       99
       99
       -
         | addr :: _ ->

     

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

     

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

     

       102
       102
       -
             addr

     

       103
       103
       -
         | [] ->

     

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

     

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

     

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

     

       115
       115
       +
         try

     

       116
       116
       +
           let addrs =

     

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

     

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

     

       119
       119
       +
           in

     

       120
       120
       +
           match addrs with

     

       121
       121
       +
           | addr :: _ ->

     

       122
       122
       +
               Log.debug (fun m ->

     

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

     

       124
       124
       +
               addr

     

       125
       125
       +
           | [] ->

     

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

     

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

     

       128
       128
       +
         with Eio.Io _ as ex ->

     

       129
       129
       +
           let bt = Printexc.get_raw_backtrace () in

     

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

     

       106
       131
        
       

     

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

     

       108
       133
        
       

     

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

     

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

     

       135
       135
       +
           attempt last_error =

     

       110
       136
        
         let retry_count = Config.connect_retry_count pool.config in

     

       111
       111
       -
         if attempt > retry_count then begin

     

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

     

       113
       113
       -
             Endpoint.pp endpoint retry_count);

     

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

     

       115
       115
       -
         end;

     

       137
       137
       +
         if attempt > retry_count then

     

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

     

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

     

       116
       140
        
       

     

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

     

       118
       118
       -
           Endpoint.pp endpoint attempt retry_count);

     

       141
       141
       +
         Log.debug (fun m ->

     

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

     

       143
       143
       +
               retry_count);

     

       119
       144
        
       

     

       120
       145
        
         try

     

       121
       146
        
           let addr = resolve_endpoint pool endpoint in

     

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

     

       123
       147
        
       

     

       124
       148
        
           (* Connect with optional timeout *)

     

       125
       149
        
           let socket =

     

       126
       126
       -
             match Config.connect_timeout pool.config with

     

       127
       127
       -
             | Some timeout ->

     

       128
       128
       -
                 Eio.Time.with_timeout_exn pool.clock timeout

     

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

     

       130
       130
       -
             | None ->

     

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

     

       150
       150
       +
             try

     

       151
       151
       +
               match Config.connect_timeout pool.config with

     

       152
       152
       +
               | Some timeout ->

     

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

     

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

     

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

     

       156
       156
       +
             with Eio.Io _ as ex ->

     

       157
       157
       +
               let bt = Printexc.get_raw_backtrace () in

     

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

     

       132
       159
        
           in

     

       133
       160
        
       

     

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

     

       161
       161
       +
           Log.debug (fun m ->

     

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

     

       135
       163
        
       

     

       136
       136
       -
           let flow = match pool.tls with

     

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

     

       138
       138
       -
             | Some tls_cfg ->

     

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

     

       140
       140
       -
                 let host = match Tls_config.servername tls_cfg with

     

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

     

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

     

       143
       143
       -
                 in

     

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

     

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

     

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

     

       164
       164
       +
           let flow =

     

       165
       165
       +
             match pool.tls with

     

       166
       166
       +
             | None ->

     

       167
       167
       +
                 (socket :> connection)

     

       168
       168
       +
             | Some tls_config ->

     

       169
       169
       +
                 try

     

       170
       170
       +
                   Log.debug (fun m ->

     

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

     

       172
       172
       +
                   let host =

     

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

     

       174
       174
       +
                   in

     

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

     

       176
       176
       +
                   Log.info (fun m ->

     

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

     

       178
       178
       +
                   (tls_flow :> connection)

     

       179
       179
       +
                 with Eio.Io _ as ex ->

     

       180
       180
       +
                   let bt = Printexc.get_raw_backtrace () in

     

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

     

       147
       182
        
           in

     

       148
       183
        
       

     

       149
       184
        
           let now = get_time pool in

     
···

       156
       191
        
             endpoint;

     

       157
       192
        
             mutex = Eio.Mutex.create ();

     

       158
       193
        
           }

     

       159
       159
       -
       

     

       160
       194
        
         with

     

       161
       161
       -
         | Eio.Time.Timeout as e ->

     

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

     

       163
       163
       -
             let error_msg = Printexc.to_string e in

     

       195
       195
       +
         | Eio.Time.Timeout ->

     

       196
       196
       +
             Log.warn (fun m ->

     

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

     

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

     

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

     

       166
       200
        
               match Config.connect_timeout pool.config with

     

       167
       201
        
               | Some timeout ->

     

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

     

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

     

       169
       203
        
               | None ->

     

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

     

       204
       204
       +
                   raise (err (Connection_failed

     

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

     

       171
       206
        
             else begin

     

       172
       207
        
               (* Retry with exponential backoff *)

     

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

     

       208
       208
       +
               let delay =

     

       209
       209
       +
                 Config.connect_retry_delay pool.config

     

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

     

       211
       211
       +
               in

     

       174
       212
        
               Eio.Time.sleep pool.clock delay;

     

       175
       175
       -
               create_connection_with_retry pool endpoint (attempt + 1) error_msg

     

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

     

       176
       214
        
             end

     

       177
       177
       -
         | e ->

     

       178
       178
       -
             (* Other errors - retry with backoff *)

     

       179
       179
       -
             let error_msg = Printexc.to_string e in

     

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

     

       181
       181
       -
               attempt Endpoint.pp endpoint error_msg);

     

       215
       215
       +
         | Eio.Io _ as ex ->

     

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

     

       217
       217
       +
             let error_msg = Printexc.to_string ex in

     

       218
       218
       +
             Log.warn (fun m ->

     

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

     

       220
       220
       +
                   endpoint error_msg);

     

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

     

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

     

       222
       222
       +
               let delay =

     

       223
       223
       +
                 Config.connect_retry_delay pool.config

     

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

     

       225
       225
       +
               in

     

       184
       226
        
               Eio.Time.sleep pool.clock delay;

     

       185
       185
       -
               create_connection_with_retry pool endpoint (attempt + 1) error_msg

     

       186
       186
       -
             ) else

     

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

     

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

     

       228
       228
       +
             else

     

       229
       229
       +
               let bt = Printexc.get_raw_backtrace () in

     

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

     

       188
       231
        
       

     

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

     

       190
       233
        
         create_connection_with_retry pool endpoint 1 "No attempts made"

     
···

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

     

       199
       242
        
         let max_lifetime = Config.max_connection_lifetime pool.config in

     

       200
       243
        
         if age > max_lifetime then begin

     

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

     

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

     

       244
       244
       +
           Log.debug (fun m ->

     

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

     

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

     

       203
       247
        
           false

     

       204
       248
        
         end

     

       205
       205
       -
       

     

       206
       249
        
         (* Check idle time *)

     

       207
       207
       -
         else begin

     

       250
       250
       +
           else begin

     

       208
       251
        
           let max_idle = Config.max_idle_time pool.config in

     

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

     

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

     

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

     

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

     

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

     

       254
       254
       +
             Log.debug (fun m ->

     

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

     

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

     

       213
       257
        
             false

     

       214
       214
       -
           end

     

       215
       215
       -
       

     

       216
       216
       -
           (* Check use count *)

     

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

     

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

     

       219
       219
       -
                    | None -> false) then begin

     

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

     

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

     

       258
       258
       +
           end (* Check use count *)

     

       259
       259
       +
           else if

     

       260
       260
       +
             match Config.max_connection_uses pool.config with

     

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

     

       262
       262
       +
             | None -> false

     

       263
       263
       +
           then begin

     

       264
       264
       +
             Log.debug (fun m ->

     

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

     

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

     

       267
       267
       +
                   (Connection.use_count conn));

     

       222
       268
        
             false

     

       223
       223
       -
           end

     

       224
       224
       -
       

     

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

     

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

     

       227
       227
       -
                    | Some check ->

     

       228
       228
       -
                        (try

     

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

     

       230
       230
       -
                          if not healthy then

     

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

     

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

     

       233
       233
       -
                          not healthy

     

       234
       234
       -
                         with e ->

     

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

     

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

     

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

     

       238
       238
       -
                    | None -> false) then

     

       239
       239
       -
             false

     

       240
       240
       -
       

     

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

     

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

     

       270
       270
       +
           else if

     

       271
       271
       +
             match Config.health_check pool.config with

     

       272
       272
       +
             | Some check -> (

     

       273
       273
       +
                 try

     

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

     

       275
       275
       +
                   if not healthy then

     

       276
       276
       +
                     Log.debug (fun m ->

     

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

     

       278
       278
       +
                           (Connection.endpoint conn));

     

       279
       279
       +
                   not healthy

     

       280
       280
       +
                 with e ->

     

       281
       281
       +
                   Log.debug (fun m ->

     

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

     

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

     

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

     

       285
       285
       +
             | None -> false

     

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

     

       242
       287
        
           else if check_readable then

     

       243
       288
        
             try

     

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

     

       245
       290
        
               true

     

       246
       246
       -
             with

     

       247
       247
       -
             | _ -> false

     

       248
       248
       -
       

     

       291
       291
       +
             with _ -> false

     

       249
       292
        
           else begin

     

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

     

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

     

       252
       252
       -
               age

     

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

     

       254
       254
       -
               (Connection.use_count conn));

     

       293
       293
       +
             Log.debug (fun m ->

     

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

     

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

     

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

     

       297
       297
       +
                   (Connection.use_count conn));

     

       255
       298
        
             true

     

       256
       299
        
           end

     

       257
       300
        
         end

     
···

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

     

       260
       303
        
       

     

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

     

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

     

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

     

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

     

       265
       265
       -
           (Connection.use_count conn));

     

       305
       305
       +
         Log.debug (fun m ->

     

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

     

       307
       307
       +
               (Connection.endpoint conn)

     

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

     

       309
       309
       +
               (Connection.use_count conn));

     

       266
       310
        
       

     

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

     

       268
       268
       -
           try

     

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

     

       270
       270
       -
           with _ -> ()

     

       271
       271
       -
         );

     

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

     

       272
       313
        
       

     

       273
       314
        
         (* Call hook if configured *)

     

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

     

       315
       315
       +
         Option.iter

     

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

     

       317
       317
       +
           (Config.on_connection_closed pool.config)

     

       275
       318
        
       

     

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

     

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

     

       278
       278
       -
       

     

       279
       320
        
         (* First try with read lock *)

     

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

     

       281
       281
       -
           Hashtbl.find_opt pool.endpoints endpoint

     

       282
       282
       -
         ) with

     

       321
       321
       +
         match

     

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

     

       323
       323
       +
               Hashtbl.find_opt pool.endpoints endpoint)

     

       324
       324
       +
         with

     

       283
       325
        
         | Some ep_pool ->

     

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

     

       285
       326
        
             ep_pool

     

       286
       327
        
         | None ->

     

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

     

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

     

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

     

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

     

       291
       291
       -
               match Hashtbl.find_opt pool.endpoints endpoint with

     

       292
       292
       -
               | Some ep_pool ->

     

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

     

       294
       294
       -
                   ep_pool

     

       295
       295
       -
               | None ->

     

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

     

       331
       331
       +
                 match Hashtbl.find_opt pool.endpoints endpoint with

     

       332
       332
       +
                 | Some ep_pool ->

     

       333
       333
       +
                     ep_pool

     

       334
       334
       +
                 | None ->

     

       296
       335
        
                     (* Create new endpoint pool *)

     

       297
       336
        
                     let stats = create_endp_stats () in

     

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

     

       299
       338
        
       

     

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

     

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

     

       339
       339
       +
                     Log.info (fun m ->

     

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

     

       341
       341
       +
                           Endpoint.pp endpoint

     

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

     

       302
       343
        
       

     

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

     

       344
       344
       +
                     let eio_pool =

     

       345
       345
       +
                       Eio.Pool.create

     

       346
       346
       +
                         (Config.max_connections_per_endpoint pool.config)

     

       347
       347
       +
                         ~validate:(fun conn ->

     

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

     

       349
       349
       +
                           if healthy then (

     

       350
       350
       +
                             (* Update stats for reuse *)

     

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

     

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

     

       304
       353
        
       

     

       305
       305
       -
                     let eio_pool = Eio.Pool.create

     

       306
       306
       -
                       (Config.max_connections_per_endpoint pool.config)

     

       307
       307
       -
                       ~validate:(fun conn ->

     

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

     

       309
       309
       -
                         (* Called before reusing from pool *)

     

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

     

       354
       354
       +
                             (* Call hook if configured *)

     

       355
       355
       +
                             Option.iter

     

       356
       356
       +
                               (fun f -> f endpoint)

     

       357
       357
       +
                               (Config.on_connection_reused pool.config);

     

       311
       358
        
       

     

       312
       312
       -
                         if healthy then (

     

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

     

       359
       359
       +
                             (* Run health check if configured *)

     

       360
       360
       +
                             match Config.health_check pool.config with

     

       361
       361
       +
                             | Some check -> (

     

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

     

       363
       363
       +
                             | None -> true)

     

       364
       364
       +
                           else

     

       365
       365
       +
                             false)

     

       366
       366
       +
                         ~dispose:(fun conn ->

     

       367
       367
       +
                           (* Called when removing from pool *)

     

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

     

       369
       369
       +
                               close_internal pool conn;

     

       314
       370
        
       

     

       315
       315
       -
                           (* Update stats for reuse *)

     

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

     

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

     

       318
       318
       -
                           );

     

       371
       371
       +
                               (* Update stats *)

     

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

     

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

     

       374
       374
       +
                         (fun () ->

     

       375
       375
       +
                           try

     

       376
       376
       +
                             let conn = create_connection pool endpoint in

     

       319
       377
        
       

     

       320
       320
       -
                           (* Call hook if configured *)

     

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

     

       378
       378
       +
                             (* Update stats *)

     

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

     

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

     

       322
       381
        
       

     

       323
       323
       -
                           (* Run health check if configured *)

     

       324
       324
       -
                           match Config.health_check pool.config with

     

       325
       325
       -
                           | Some check ->

     

       326
       326
       -
                               (try check (Connection.flow conn)

     

       327
       327
       -
                                with _ -> false)

     

       328
       328
       -
                           | None -> true

     

       329
       329
       -
                         ) else begin

     

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

     

       331
       331
       -
                           false

     

       332
       332
       -
                         end

     

       333
       333
       -
                       )

     

       334
       334
       -
                       ~dispose:(fun conn ->

     

       335
       335
       -
                         (* Called when removing from pool *)

     

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

     

       337
       337
       -
                           close_internal pool conn;

     

       382
       382
       +
                             (* Call hook if configured *)

     

       383
       383
       +
                             Option.iter

     

       384
       384
       +
                               (fun f -> f endpoint)

     

       385
       385
       +
                               (Config.on_connection_created pool.config);

     

       338
       386
        
       

     

       339
       339
       -
                           (* Update stats *)

     

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

     

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

     

       342
       342
       -
                           )

     

       343
       343
       -
                         )

     

       344
       344
       -
                       )

     

       345
       345
       -
                       (fun () ->

     

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

     

       347
       347
       -
                         try

     

       348
       348
       -
                           let conn = create_connection pool endpoint in

     

       349
       349
       -
       

     

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

     

       351
       351
       -
       

     

       352
       352
       -
                           (* Update stats *)

     

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

     

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

     

       355
       355
       -
                           );

     

       356
       356
       -
       

     

       357
       357
       -
                           (* Call hook if configured *)

     

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

     

       359
       359
       -
       

     

       360
       360
       -
                           conn

     

       361
       361
       -
                         with e ->

     

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

     

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

     

       364
       364
       -
                           (* Update error stats *)

     

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

     

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

     

       367
       367
       -
                           );

     

       368
       368
       -
                           raise e

     

       369
       369
       -
                       )

     

       387
       387
       +
                             conn

     

       388
       388
       +
                           with Eio.Io _ as ex ->

     

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

     

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

     

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

     

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

     

       393
       393
       +
                             raise ex)

     

       370
       394
        
                     in

     

       371
       395
        
       

     

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

     

       373
       373
       -
       

     

       374
       374
       -
                     let ep_pool = {

     

       375
       375
       -
                       pool = eio_pool;

     

       376
       376
       -
                       stats;

     

       377
       377
       -
                       mutex;

     

       378
       378
       -
                     } in

     

       379
       379
       -
       

     

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

     

       380
       397
        
                     Hashtbl.add pool.endpoints endpoint ep_pool;

     

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

     

       382
       382
       -
                     ep_pool

     

       383
       383
       -
               )

     

       398
       398
       +
                     ep_pool)

     

       384
       399
        
       

     

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

     

       386
       401
        
       

     

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

     

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

     

       389
       389
       -
           (Config.max_connections_per_endpoint config)

     

       390
       390
       -
           (Config.max_idle_time config)

     

       391
       391
       -
           (Config.max_connection_lifetime config));

     

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

     

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

     

       404
       404
       +
         Log.info (fun m ->

     

       405
       405
       +
             m

     

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

     

       407
       407
       +
                max_lifetime=%.1fs)"

     

       408
       408
       +
               (Config.max_connections_per_endpoint config)

     

       409
       409
       +
               (Config.max_idle_time config)

     

       410
       410
       +
               (Config.max_connection_lifetime config));

     

       392
       411
        
       

     

       393
       393
       -
         let pool = {

     

       394
       394
       -
           sw;

     

       395
       395
       -
           net;

     

       396
       396
       -
           clock;

     

       397
       397
       -
           config;

     

       398
       398
       -
           tls;

     

       399
       399
       -
           endpoints = Hashtbl.create 16;

     

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

     

       401
       401
       -
         } in

     

       412
       412
       +
         let pool =

     

       413
       413
       +
           {

     

       414
       414
       +
             sw;

     

       415
       415
       +
             net;

     

       416
       416
       +
             clock;

     

       417
       417
       +
             config;

     

       418
       418
       +
             tls;

     

       419
       419
       +
             endpoints = Hashtbl.create 16;

     

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

     

       421
       421
       +
           }

     

       422
       422
       +
         in

     

       402
       423
        
       

     

       403
       424
        
         (* Auto-cleanup on switch release *)

     

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

     

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

     

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

     

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

     

       408
       408
       -
             Hashtbl.iter (fun _endpoint _ep_pool ->

     

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

     

       410
       410
       -
               ()

     

       411
       411
       -
             ) pool.endpoints;

     

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

     

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

     

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

     

       429
       429
       +
                 Hashtbl.iter

     

       430
       430
       +
                   (fun _endpoint _ep_pool ->

     

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

     

       432
       432
       +
                     ())

     

       433
       433
       +
                   pool.endpoints;

     

       412
       434
        
       

     

       413
       413
       -
             Hashtbl.clear pool.endpoints

     

       414
       414
       -
           )

     

       415
       415
       -
         );

     

       435
       435
       +
                 Hashtbl.clear pool.endpoints));

     

       416
       436
        
       

     

       417
       437
        
         T pool

     

       418
       438
        
       

     

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

     

       420
       440
        
       

     

       421
       421
       -
       let with_connection (T pool) endpoint f =

     

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

     

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

     

       423
       443
        
         let ep_pool = get_or_create_endpoint_pool pool endpoint in

     

       444
       444
       +
       

     

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

     

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

     

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

     

       424
       448
        
       

     

       425
       449
        
         (* Increment active count *)

     

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

     

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

     

       428
       428
       -
         );

     

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

     

       452
       452
       +
       

     

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

     

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

     

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

     

       456
       456
       +
            to the pool for reuse. *)

     

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

     

       458
       458
       +
           Fun.protect

     

       459
       459
       +
             ~finally:(fun () ->

     

       460
       460
       +
               (* Decrement active count *)

     

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

     

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

     

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

     

       464
       464
       +
             (fun () ->

     

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

     

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

     

       467
       467
       +
                   Log.debug (fun m ->

     

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

     

       469
       469
       +
                         (Connection.use_count conn));

     

       470
       470
       +
       

     

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

     

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

     

       473
       473
       +
       

     

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

     

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

     

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

     

       477
       477
       +
       

     

       478
       478
       +
                   (* Hand off connection to caller *)

     

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

     

       429
       480
        
       

     

       430
       430
       -
         Fun.protect

     

       431
       431
       -
           ~finally:(fun () ->

     

       432
       432
       -
             (* Decrement active count *)

     

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

     

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

     

       435
       435
       -
             );

     

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

     

       437
       437
       -
           )

     

       438
       438
       -
           (fun () ->

     

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

     

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

     

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

     

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

     

       481
       481
       +
                   try

     

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

     

       483
       483
       +
                     Eio.Promise.await done_promise;

     

       484
       484
       +
       

     

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

     

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

     

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

     

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

     

       443
       489
        
       

     

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

     

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

     

       490
       490
       +
                     `Stop_daemon

     

       491
       491
       +
                   with e ->

     

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

     

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

     

       494
       494
       +
                     close_internal pool conn;

     

       446
       495
        
       

     

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

     

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

     

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

     

       450
       450
       -
               );

     

       496
       496
       +
                     (* Update error stats *)

     

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

     

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

     

       451
       499
        
       

     

       452
       452
       -
               try

     

       453
       453
       -
                 let result = f conn.flow in

     

       500
       500
       +
                     raise e)));

     

       454
       501
        
       

     

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

     

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

     

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

     

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

     

       459
       459
       -
                 );

     

       502
       502
       +
         (* Signal cleanup when switch ends *)

     

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

     

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

     

       460
       505
        
       

     

       461
       461
       -
                 result

     

       462
       462
       -
               with e ->

     

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

     

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

     

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

     

       466
       466
       -
                 close_internal pool conn;

     

       506
       506
       +
         (* Return the connection *)

     

       507
       507
       +
         Eio.Promise.await conn_promise

     

       467
       508
        
       

     

       468
       468
       -
                 (* Update error stats *)

     

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

     

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

     

       471
       471
       -
                 );

     

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

     

       472
       510
        
       

     

       473
       473
       -
                 raise e

     

       474
       474
       -
             )

     

       475
       475
       -
           )

     

       511
       511
       +
       let with_connection t endpoint f =

     

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

     

       476
       513
        
       

     

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

     

       478
       515
        
       

     

       479
       516
        
       let stats (T pool) endpoint =

     

       480
       517
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       481
       518
        
         | Some ep_pool ->

     

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

     

       483
       483
       -
               snapshot_stats ep_pool.stats

     

       484
       484
       -
             )

     

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

     

       485
       520
        
         | None ->

     

       486
       521
        
             (* No pool for this endpoint yet *)

     

       487
       487
       -
             Stats.make

     

       488
       488
       -
               ~active:0

     

       489
       489
       -
               ~idle:0

     

       490
       490
       -
               ~total_created:0

     

       491
       491
       -
               ~total_reused:0

     

       492
       492
       -
               ~total_closed:0

     

       493
       493
       -
               ~errors:0

     

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

     

       523
       523
       +
               ~total_closed:0 ~errors:0

     

       494
       524
        
       

     

       495
       525
        
       let all_stats (T pool) =

     

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

     

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

     

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

     

       499
       499
       -
               snapshot_stats ep_pool.stats

     

       500
       500
       -
             ) in

     

       501
       501
       -
             (endpoint, stats) :: acc

     

       502
       502
       -
           ) pool.endpoints []

     

       503
       503
       -
         )

     

       527
       527
       +
             Hashtbl.fold

     

       528
       528
       +
               (fun endpoint ep_pool acc ->

     

       529
       529
       +
                 let stats =

     

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

     

       531
       531
       +
                       snapshot_stats ep_pool.stats)

     

       532
       532
       +
                 in

     

       533
       533
       +
                 (endpoint, stats) :: acc)

     

       534
       534
       +
               pool.endpoints [])

     

       504
       535
        
       

     

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

     

       506
       537
        
       

     
···

       509
       540
        
         match Hashtbl.find_opt pool.endpoints endpoint with

     

       510
       541
        
         | Some _ep_pool ->

     

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

     

       512
       512
       -
               (* Remove endpoint pool from hashtable *)

     

       513
       513
       -
               (* Idle connections will be discarded *)

     

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

     

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

     

       516
       516
       -
                 Hashtbl.remove pool.endpoints endpoint

     

       517
       517
       -
               )

     

       518
       518
       -
             )

     

       543
       543
       +
                 (* Remove endpoint pool from hashtable *)

     

       544
       544
       +
                 (* Idle connections will be discarded *)

     

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

     

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

     

       547
       547
       +
                     Hashtbl.remove pool.endpoints endpoint))

     

       519
       548
        
         | None ->

     

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

     

       549
       549
       +
             Log.debug (fun m ->

     

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

+102 -63

lib/conpool.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

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

     

       2
       7
        
       

     

       3
       8
        
       (** {1 Logging} *)

     
···

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

     

       7
       12
        
           {[

     

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

     

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

     

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

     

       10
       15
        
           ]}

     

       11
       16
        
       

     

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

     

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

     

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

     

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

     

       16
       16
       -
       *)

     

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

     

       17
       20
        
       

     

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

     

       19
       22
        
       

     

       23
       23
       +
       module Endpoint = Endpoint

     

       20
       24
        
       (** Network endpoint representation *)

     

       21
       21
       -
       module Endpoint : module type of Endpoint

     

       22
       22
       -
       

     

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

     

       24
       24
       -
       module Tls_config : module type of Tls_config

     

       25
       25
        
       

     

       26
       26
       +
       module Config = Config

     

       26
       27
        
       (** Configuration for connection pools *)

     

       27
       27
       -
       module Config : module type of Config

     

       28
       28
        
       

     

       29
       29
       +
       module Stats = Stats

     

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

     

       30
       30
       -
       module Stats : module type of Stats

     

       31
       31
        
       

     

       32
       32
       +
       module Cmd = Cmd

     

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

     

       33
       33
       -
       module Cmd : module type of Cmd

     

       34
       34
        
       

     

       35
       35
        
       (** {1 Errors} *)

     

       36
       36
        
       

     

       37
       37
        
       type error =

     

       38
       38
        
         | Dns_resolution_failed of { hostname : string }

     

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

     

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

     

       40
       40
       +
         | Connection_failed of {

     

       41
       41
       +
             endpoint : Endpoint.t;

     

       42
       42
       +
             attempts : int;

     

       43
       43
       +
             last_error : string;

     

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

     

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

     

       46
       46
       +
             (** Connection attempt timed out *)

     

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

     

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

     

       40
       49
        
       

     

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

     

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

     

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

     

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

     

       43
       52
        
       

     

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

     

       45
       45
       -
         (** Connection attempt timed out *)

     

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

     

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

     

       55
       55
       +
           strings that describe the operation being performed.

     

       46
       56
        
       

     

       47
       47
       -
         | Invalid_config of string

     

       48
       48
       -
         (** Invalid configuration parameter *)

     

       57
       57
       +
           Example error message:

     

       58
       58
       +
           {[

     

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

     

       60
       60
       +
               resolving invalid.example:443,

     

       61
       61
       +
               connecting to invalid.example:443,

     

       62
       62
       +
               after 3 retry attempts

     

       63
       63
       +
           ]}

     

       49
       64
        
       

     

       50
       50
       -
         | Invalid_endpoint of string

     

       51
       51
       -
         (** Invalid endpoint specification *)

     

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

     

       66
       66
       +
           exception with context. *)

     

       52
       67
        
       

     

       53
       53
       -
       exception Pool_error of error

     

       54
       54
       -
       (** Exception raised by pool operations.

     

       68
       68
       +
       val err : error -> exn

     

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

     

       55
       70
        
       

     

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

     

       57
       57
       -
           human-readable error messages. *)

     

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

     

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

     

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

     

       58
       74
        
       

     

       59
       75
        
       val pp_error : error Fmt.t

     

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

     

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

     

       77
       77
       +
       

     

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

     

       79
       79
       +
           the exception be printed naturally. *)

     

       80
       80
       +
       

     

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

     

       82
       82
       +
       

     

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

     

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

     

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

     

       86
       86
       +
       

     

       87
       87
       +
       type connection = connection_ty Eio.Resource.t

     

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

     

       61
       89
        
       

     

       62
       90
        
       (** {1 Connection Pool} *)

     

       63
       91
        
       

     
···

       68
       96
        
         sw:Eio.Switch.t ->

     

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

     

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

     

       71
       71
       -
         ?tls:Tls_config.t ->

     

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

     

       72
       100
        
         ?config:Config.t ->

     

       73
       73
       -
         unit -> t

     

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

     

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

     

       101
       101
       +
         unit ->

     

       102
       102
       +
         t

     

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

     

       104
       104
       +
           switch is released.

     

       76
       105
        
       

     

       77
       106
        
           @param sw Switch for resource management

     

       78
       107
        
           @param net Network interface for creating connections

     

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

     

       80
       80
       -
           @param tls Optional TLS configuration applied to all connections

     

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

     

       109
       109
       +
           @param tls

     

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

     

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

     

       112
       112
       +
           @param config

     

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

     

       82
       114
        
       

     

       83
       115
        
       (** {1 Connection Usage} *)

     

       84
       116
        
       

     

       85
       85
       -
       val with_connection :

     

       86
       86
       -
         t ->

     

       87
       87
       -
         Endpoint.t ->

     

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

     

       89
       89
       -
         'a

     

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

     

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

     

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

     

       119
       119
       +
       

     

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

     

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

     

       122
       122
       +
           closed instead of being returned to the pool.

     

       91
       123
        
       

     

       92
       92
       -
           If idle connection available and healthy:

     

       93
       93
       -
             - Reuse from pool (validates health first)

     

       94
       94
       -
           Else:

     

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

     

       124
       124
       +
           If an idle connection is available and healthy:

     

       125
       125
       +
           - Reuse from pool (validates health first)

     

       96
       126
        
       

     

       97
       97
       -
           On success: connection returned to pool for reuse

     

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

     

       127
       127
       +
           Otherwise:

     

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

     

       99
       129
        
       

     

       100
       130
        
           Example:

     

       101
       131
        
           {[

     

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

     

       103
       103
       -
             Conpool.with_connection pool endpoint (fun conn ->

     

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

     

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

     

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

     

       107
       107
       -
               Eio.Buf_read.take_all buf

     

       108
       108
       -
             )

     

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

     

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

     

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

     

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

     

       137
       137
       +
                 Eio.Buf_read.take_all buf)

     

       138
       138
       +
           ]} *)

     

       139
       139
       +
       

     

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

     

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

     

       142
       142
       +
           {!val:connection}.

     

       143
       143
       +
       

     

       144
       144
       +
           Equivalent to:

     

       145
       145
       +
           {[

     

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

     

       109
       147
        
           ]}

     

       110
       110
       -
       *)

     

       148
       148
       +
       

     

       149
       149
       +
           Example:

     

       150
       150
       +
           {[

     

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

     

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

     

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

     

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

     

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

     

       156
       156
       +
                 Eio.Buf_read.take_all buf)

     

       157
       157
       +
           ]} *)

     

       111
       158
        
       

     

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

     

       113
       160
        
       

     

       114
       114
       -
       val stats :

     

       115
       115
       -
         t ->

     

       116
       116
       -
         Endpoint.t ->

     

       117
       117
       -
         Stats.t

     

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

     

       118
       162
        
       (** Get statistics for specific endpoint *)

     

       119
       163
        
       

     

       120
       120
       -
       val all_stats :

     

       121
       121
       -
         t ->

     

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

     

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

     

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

     

       124
       166
        
       

     

       125
       167
        
       (** {1 Pool Management} *)

     

       126
       168
        
       

     

       127
       127
       -
       val clear_endpoint :

     

       128
       128
       -
         t ->

     

       129
       129
       -
         Endpoint.t ->

     

       130
       130
       -
         unit

     

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

     

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

     

       132
       171
        
       

     

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

     

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

     

       135
       174
        
       

     

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

     

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

     

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

     

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

     

       138
       177
        
       

     

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

+14 -16

lib/endpoint.ml

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       1
       6
        
       (** Network endpoint representation *)

     

       2
       7
        
       

     

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

     

       8
       8
       +
       let src =

     

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

     

       10
       10
       +
       

     

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

     

       5
       12
        
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         host : string;

     

       8
       8
       -
         port : int;

     

       9
       9
       -
       }

     

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

     

       10
       14
        
       

     

       11
       15
        
       let make ~host ~port =

     

       12
       16
        
         (* Validate port range *)

     

       13
       17
        
         if port < 1 || port > 65535 then

     

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

     

       18
       18
       +
           invalid_arg

     

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

     

       15
       20
        
       

     

       16
       21
        
         (* Validate hostname is not empty *)

     

       17
       17
       -
         if String.trim host = "" then

     

       18
       18
       -
           invalid_arg "Hostname cannot be empty";

     

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

     

       19
       23
        
       

     

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

     

       21
       24
        
         { host; port }

     

       22
       25
        
       

     

       23
       26
        
       let host t = t.host

     

       24
       27
        
       let port t = t.port

     

       25
       25
       -
       

     

       26
       26
       -
       let equal t1 t2 =

     

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

     

       28
       28
       -
       

     

       29
       29
       -
       let hash t =

     

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

     

       31
       31
       -
       

     

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

     

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

     

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

+7 -3

lib/endpoint.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       1
       6
        
       (** Network endpoint representation *)

     

       2
       7
        
       

     

       3
       8
        
       (** {1 Logging} *)

     
···

       5
       10
        
       val src : Logs.Src.t

     

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

     

       7
       12
        
           {[

     

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

     

       9
       9
       -
           ]}

     

       10
       10
       -
       *)

     

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

     

       14
       14
       +
           ]} *)

     

       11
       15
        
       

     

       12
       16
        
       (** {1 Type} *)

     

       13
       17

+6 -6

lib/stats.ml

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

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

     

       2
       7
        
       

     

       3
       8
        
       type t = {

     
···

       28
       33
        
            - Reused: %d@,\

     

       29
       34
        
            - Closed: %d@,\

     

       30
       35
        
            - Errors: %d@]"

     

       31
       31
       -
           t.active

     

       32
       32
       -
           t.idle

     

       33
       33
       -
           t.total_created

     

       34
       34
       -
           t.total_reused

     

       35
       35
       -
           t.total_closed

     

       36
       36
       -
           t.errors

     

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

lib/stats.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

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

     

       2
       7
        
       

     

       3
       8
        
       (** {1 Type} *)

-22

lib/tls_config.ml

···

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

     

       2
       2
       -
       

     

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

     

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

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         config : Tls.Config.client;

     

       8
       8
       -
         servername : string option;

     

       9
       9
       -
       }

     

       10
       10
       -
       

     

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

     

       12
       12
       -
         Log.debug (fun m ->

     

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

     

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

     

       15
       15
       -
         { config; servername }

     

       16
       16
       -
       

     

       17
       17
       -
       let config t = t.config

     

       18
       18
       -
       let servername t = t.servername

     

       19
       19
       -
       

     

       20
       20
       -
       let pp ppf t =

     

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

     

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

-37

lib/tls_config.mli

···

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

     

       2
       2
       -
       

     

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

     

       4
       4
       -
       

     

       5
       5
       -
       val src : Logs.Src.t

     

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

     

       7
       7
       -
           {[

     

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

     

       9
       9
       -
           ]}

     

       10
       10
       -
       *)

     

       11
       11
       -
       

     

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

     

       13
       13
       -
       

     

       14
       14
       -
       type t

     

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

     

       16
       16
       -
       

     

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

     

       18
       18
       -
       

     

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

     

       20
       20
       -
       (** Create TLS configuration.

     

       21
       21
       -
       

     

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

     

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

     

       24
       24
       -
       *)

     

       25
       25
       -
       

     

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

     

       27
       27
       -
       

     

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

     

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

     

       30
       30
       -
       

     

       31
       31
       -
       val servername : t -> string option

     

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

     

       33
       33
       -
       

     

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

     

       35
       35
       -
       

     

       36
       36
       -
       val pp : t Fmt.t

     

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

test/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (name stress_test)

     

       3
       3
       +
        (modules stress_test)

     

       4
       4
       +
        (libraries conpool eio eio_main unix))

     

       5
       5
       +
       

     

       6
       6
       +
       (rule

     

       7
       7
       +
        (alias runtest)

     

       8
       8
       +
        (deps stress_test.exe)

     

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

+993

test/stress_test.ml

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Stress test framework for conpool

     

       7
       7
       +
       

     

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

     

       9
       9
       +
           the connection pool with multiple parallel client fibers.

     

       10
       10
       +
           Collects detailed event traces for visualization.

     

       11
       11
       +
       *)

     

       12
       12
       +
       

     

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

     

       14
       14
       +
       type config = {

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       22
       22
       +
       }

     

       23
       23
       +
       

     

       24
       24
       +
       let default_config = {

     

       25
       25
       +
         name = "default";

     

       26
       26
       +
         num_servers = 3;

     

       27
       27
       +
         num_clients = 10;

     

       28
       28
       +
         messages_per_client = 5;

     

       29
       29
       +
         max_parallel_clients = 20;

     

       30
       30
       +
         message_size = 64;

     

       31
       31
       +
         pool_size = 5;

     

       32
       32
       +
       }

     

       33
       33
       +
       

     

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

     

       35
       35
       +
       let presets = [

     

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

     

       37
       37
       +
         { name = "high_reuse";

     

       38
       38
       +
           num_servers = 2;

     

       39
       39
       +
           num_clients = 20;

     

       40
       40
       +
           messages_per_client = 50;

     

       41
       41
       +
           max_parallel_clients = 10;

     

       42
       42
       +
           message_size = 32;

     

       43
       43
       +
           pool_size = 3;

     

       44
       44
       +
         };

     

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

     

       46
       46
       +
         { name = "many_endpoints";

     

       47
       47
       +
           num_servers = 10;

     

       48
       48
       +
           num_clients = 10;

     

       49
       49
       +
           messages_per_client = 10;

     

       50
       50
       +
           max_parallel_clients = 50;

     

       51
       51
       +
           message_size = 64;

     

       52
       52
       +
           pool_size = 5;

     

       53
       53
       +
         };

     

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

     

       55
       55
       +
         { name = "high_concurrency";

     

       56
       56
       +
           num_servers = 3;

     

       57
       57
       +
           num_clients = 100;

     

       58
       58
       +
           messages_per_client = 5;

     

       59
       59
       +
           max_parallel_clients = 100;

     

       60
       60
       +
           message_size = 64;

     

       61
       61
       +
           pool_size = 20;

     

       62
       62
       +
         };

     

       63
       63
       +
         (* Large messages - test throughput *)

     

       64
       64
       +
         { name = "large_messages";

     

       65
       65
       +
           num_servers = 3;

     

       66
       66
       +
           num_clients = 20;

     

       67
       67
       +
           messages_per_client = 20;

     

       68
       68
       +
           max_parallel_clients = 30;

     

       69
       69
       +
           message_size = 1024;

     

       70
       70
       +
           pool_size = 10;

     

       71
       71
       +
         };

     

       72
       72
       +
         (* Constrained pool - force queuing *)

     

       73
       73
       +
         { name = "constrained_pool";

     

       74
       74
       +
           num_servers = 2;

     

       75
       75
       +
           num_clients = 50;

     

       76
       76
       +
           messages_per_client = 10;

     

       77
       77
       +
           max_parallel_clients = 50;

     

       78
       78
       +
           message_size = 64;

     

       79
       79
       +
           pool_size = 2;

     

       80
       80
       +
         };

     

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

     

       82
       82
       +
         { name = "burst_traffic";

     

       83
       83
       +
           num_servers = 5;

     

       84
       84
       +
           num_clients = 200;

     

       85
       85
       +
           messages_per_client = 2;

     

       86
       86
       +
           max_parallel_clients = 100;

     

       87
       87
       +
           message_size = 32;

     

       88
       88
       +
           pool_size = 15;

     

       89
       89
       +
         };

     

       90
       90
       +
       ]

     

       91
       91
       +
       

     

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

     

       93
       93
       +
       let extended_preset = {

     

       94
       94
       +
         name = "extended_stress";

     

       95
       95
       +
         num_servers = 30;

     

       96
       96
       +
         num_clients = 1000;

     

       97
       97
       +
         messages_per_client = 100;

     

       98
       98
       +
         max_parallel_clients = 500;

     

       99
       99
       +
         message_size = 128;

     

       100
       100
       +
         pool_size = 50;

     

       101
       101
       +
       }

     

       102
       102
       +
       

     

       103
       103
       +
       (** Statistics collected during test *)

     

       104
       104
       +
       type latency_stats = {

     

       105
       105
       +
         mutable count : int;

     

       106
       106
       +
         mutable total : float;

     

       107
       107
       +
         mutable min : float;

     

       108
       108
       +
         mutable max : float;

     

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

     

       110
       110
       +
       }

     

       111
       111
       +
       

     

       112
       112
       +
       let create_latency_stats () = {

     

       113
       113
       +
         count = 0;

     

       114
       114
       +
         total = 0.0;

     

       115
       115
       +
         min = Float.infinity;

     

       116
       116
       +
         max = 0.0;

     

       117
       117
       +
         latencies = [];

     

       118
       118
       +
       }

     

       119
       119
       +
       

     

       120
       120
       +
       let update_latency stats latency timestamp =

     

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

     

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

     

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

     

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

     

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

     

       126
       126
       +
       

     

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

     

       128
       128
       +
       let generate_message size =

     

       129
       129
       +
         let chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" in

     

       130
       130
       +
         let len = String.length chars in

     

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

     

       132
       132
       +
       

     

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

     

       134
       134
       +
       let handle_echo_client flow _addr =

     

       135
       135
       +
         let buf = Cstruct.create 4096 in

     

       136
       136
       +
         let rec loop () =

     

       137
       137
       +
           match Eio.Flow.single_read flow buf with

     

       138
       138
       +
           | n ->

     

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

     

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

     

       141
       141
       +
               loop ()

     

       142
       142
       +
           | exception End_of_file -> ()

     

       143
       143
       +
         in

     

       144
       144
       +
         loop ()

     

       145
       145
       +
       

     

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

     

       147
       147
       +
       let start_echo_server ~sw net =

     

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

     

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

     

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

     

       151
       151
       +
         let port = match actual_addr with

     

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

     

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

     

       154
       154
       +
         in

     

       155
       155
       +
       

     

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

     

       157
       157
       +
           try

     

       158
       158
       +
             while true do

     

       159
       159
       +
               Eio.Net.accept_fork ~sw listening_socket

     

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

     

       161
       161
       +
                 handle_echo_client

     

       162
       162
       +
             done;

     

       163
       163
       +
             `Stop_daemon

     

       164
       164
       +
           with Eio.Cancel.Cancelled _ ->

     

       165
       165
       +
             `Stop_daemon

     

       166
       166
       +
         );

     

       167
       167
       +
       

     

       168
       168
       +
         port

     

       169
       169
       +
       

     

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

     

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

     

       172
       172
       +
         let msg_len = String.length message in

     

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

     

       174
       174
       +
       

     

       175
       175
       +
         try

     

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

     

       177
       177
       +
             (* Send message *)

     

       178
       178
       +
             Eio.Flow.copy_string message flow;

     

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

     

       180
       180
       +
       

     

       181
       181
       +
             (* Read echo response *)

     

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

     

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

     

       184
       184
       +
       

     

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

     

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

     

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

     

       188
       188
       +
       

     

       189
       189
       +
             if String.equal echoed message then begin

     

       190
       190
       +
               update_latency latency_stats latency relative_time

     

       191
       191
       +
             end else begin

     

       192
       192
       +
               incr errors

     

       193
       193
       +
             end

     

       194
       194
       +
           )

     

       195
       195
       +
         with _ex ->

     

       196
       196
       +
           incr errors

     

       197
       197
       +
       

     

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

     

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

     

       200
       200
       +
         for _ = 1 to cfg.messages_per_client do

     

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

     

       202
       202
       +
           let endpoint = endpoints.(endpoint_idx) in

     

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

     

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

     

       205
       205
       +
         done

     

       206
       206
       +
       

     

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

     

       208
       208
       +
       type pool_stats = {

     

       209
       209
       +
         total_created : int;

     

       210
       210
       +
         total_reused : int;

     

       211
       211
       +
         total_closed : int;

     

       212
       212
       +
         active : int;

     

       213
       213
       +
         idle : int;

     

       214
       214
       +
         pool_errors : int;

     

       215
       215
       +
       }

     

       216
       216
       +
       

     

       217
       217
       +
       (** Test result type *)

     

       218
       218
       +
       type test_result = {

     

       219
       219
       +
         test_name : string;

     

       220
       220
       +
         num_servers : int;

     

       221
       221
       +
         num_clients : int;

     

       222
       222
       +
         messages_per_client : int;

     

       223
       223
       +
         pool_size : int;

     

       224
       224
       +
         duration : float;

     

       225
       225
       +
         total_messages : int;

     

       226
       226
       +
         total_errors : int;

     

       227
       227
       +
         throughput : float;

     

       228
       228
       +
         avg_latency : float;

     

       229
       229
       +
         min_latency : float;

     

       230
       230
       +
         max_latency : float;

     

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

     

       232
       232
       +
         pool_stats : pool_stats;

     

       233
       233
       +
       }

     

       234
       234
       +
       

     

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

     

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

     

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

     

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

     

       239
       239
       +
       

     

       240
       240
       +
         let latency_stats = create_latency_stats () in

     

       241
       241
       +
         let errors = ref 0 in

     

       242
       242
       +
         let ports = ref [||] in

     

       243
       243
       +
       

     

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

     

       245
       245
       +
       

     

       246
       246
       +
         begin

     

       247
       247
       +
           try

     

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

     

       249
       249
       +
               (* Start echo servers *)

     

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

     

       251
       251
       +
                 start_echo_server ~sw net

     

       252
       252
       +
               );

     

       253
       253
       +
       

     

       254
       254
       +
               Eio.Time.sleep clock 0.05;

     

       255
       255
       +
       

     

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

     

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

     

       258
       258
       +
               ) !ports in

     

       259
       259
       +
       

     

       260
       260
       +
               (* Create connection pool *)

     

       261
       261
       +
               let pool_config = Conpool.Config.make

     

       262
       262
       +
                 ~max_connections_per_endpoint:cfg.pool_size

     

       263
       263
       +
                 ~max_idle_time:30.0

     

       264
       264
       +
                 ~max_connection_lifetime:120.0

     

       265
       265
       +
                 ~connect_timeout:5.0

     

       266
       266
       +
                 ~connect_retry_count:3

     

       267
       267
       +
                 ()

     

       268
       268
       +
               in

     

       269
       269
       +
       

     

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

     

       271
       271
       +
       

     

       272
       272
       +
               (* Record start time *)

     

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

     

       274
       274
       +
       

     

       275
       275
       +
               (* Run clients in parallel *)

     

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

     

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

     

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

     

       279
       279
       +
                 (fun client_id ->

     

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

     

       281
       281
       +
                 client_ids;

     

       282
       282
       +
       

     

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

     

       284
       284
       +
               let duration = end_time -. start_time in

     

       285
       285
       +
       

     

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

     

       287
       287
       +
               let all_stats = Conpool.all_stats pool in

     

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

     

       289
       289
       +
                 {

     

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

     

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

     

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

     

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

     

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

     

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

     

       296
       296
       +
                 }

     

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

     

       298
       298
       +
       

     

       299
       299
       +
               (* Build result *)

     

       300
       300
       +
               let r : test_result = {

     

       301
       301
       +
                 test_name = cfg.name;

     

       302
       302
       +
                 num_servers = cfg.num_servers;

     

       303
       303
       +
                 num_clients = cfg.num_clients;

     

       304
       304
       +
                 messages_per_client = cfg.messages_per_client;

     

       305
       305
       +
                 pool_size = cfg.pool_size;

     

       306
       306
       +
                 duration;

     

       307
       307
       +
                 total_messages = latency_stats.count;

     

       308
       308
       +
                 total_errors = !errors;

     

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

     

       310
       310
       +
                 avg_latency = if latency_stats.count > 0

     

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

     

       312
       312
       +
                   else 0.0;

     

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

     

       314
       314
       +
                 max_latency = latency_stats.max;

     

       315
       315
       +
                 latency_data = List.rev latency_stats.latencies;

     

       316
       316
       +
                 pool_stats;

     

       317
       317
       +
               } in

     

       318
       318
       +
               result := Some r;

     

       319
       319
       +
       

     

       320
       320
       +
               Eio.Switch.fail sw Exit

     

       321
       321
       +
           with Exit -> ()

     

       322
       322
       +
         end;

     

       323
       323
       +
       

     

       324
       324
       +
         match !result with

     

       325
       325
       +
         | Some r -> r

     

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

     

       327
       327
       +
       

     

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

     

       329
       329
       +
       let result_to_json result =

     

       330
       330
       +
         Printf.sprintf {|{

     

       331
       331
       +
         "test_name": "%s",

     

       332
       332
       +
         "num_servers": %d,

     

       333
       333
       +
         "num_clients": %d,

     

       334
       334
       +
         "messages_per_client": %d,

     

       335
       335
       +
         "duration": %.3f,

     

       336
       336
       +
         "total_messages": %d,

     

       337
       337
       +
         "total_errors": %d,

     

       338
       338
       +
         "throughput": %.2f,

     

       339
       339
       +
         "avg_latency": %.2f,

     

       340
       340
       +
         "min_latency": %.2f,

     

       341
       341
       +
         "max_latency": %.2f

     

       342
       342
       +
       }|}

     

       343
       343
       +
           result.test_name

     

       344
       344
       +
           result.num_servers

     

       345
       345
       +
           result.num_clients

     

       346
       346
       +
           result.messages_per_client

     

       347
       347
       +
           result.duration

     

       348
       348
       +
           result.total_messages

     

       349
       349
       +
           result.total_errors

     

       350
       350
       +
           result.throughput

     

       351
       351
       +
           result.avg_latency

     

       352
       352
       +
           result.min_latency

     

       353
       353
       +
           result.max_latency

     

       354
       354
       +
       

     

       355
       355
       +
       (** Escape strings for JavaScript *)

     

       356
       356
       +
       let js_escape s =

     

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

     

       358
       358
       +
         String.iter (fun c ->

     

       359
       359
       +
           match c with

     

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

     

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

     

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

     

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

     

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

     

       365
       365
       +
           | _ -> Buffer.add_char buf c

     

       366
       366
       +
         ) s;

     

       367
       367
       +
         Buffer.contents buf

     

       368
       368
       +
       

     

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

     

       370
       370
       +
       let calculate_histogram latencies num_buckets =

     

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

     

       372
       372
       +
         let latency_values = List.map snd latencies in

     

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

     

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

     

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

     

       376
       376
       +
       

     

       377
       377
       +
         let buckets = Array.make num_buckets 0 in

     

       378
       378
       +
         List.iter (fun lat ->

     

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

     

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

     

       381
       381
       +
         ) latency_values;

     

       382
       382
       +
       

     

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

     

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

     

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

     

       386
       386
       +
         ) in

     

       387
       387
       +
         let bucket_counts = Array.to_list buckets in

     

       388
       388
       +
         (bucket_labels, bucket_counts)

     

       389
       389
       +
       

     

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

     

       391
       391
       +
       let generate_html_report results =

     

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

     

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

     

       394
       394
       +
           (timestamp.Unix.tm_year + 1900)

     

       395
       395
       +
           (timestamp.Unix.tm_mon + 1)

     

       396
       396
       +
           timestamp.Unix.tm_mday

     

       397
       397
       +
           timestamp.Unix.tm_hour

     

       398
       398
       +
           timestamp.Unix.tm_min

     

       399
       399
       +
           timestamp.Unix.tm_sec

     

       400
       400
       +
         in

     

       401
       401
       +
       

     

       402
       402
       +
         (* Calculate summary statistics *)

     

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

     

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

     

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

     

       406
       406
       +
       

     

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

     

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

     

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

     

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

     

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

     

       412
       412
       +
           if r.total_messages > 0 then

     

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

     

       414
       414
       +
           else "0.0"

     

       415
       415
       +
         ) results) in

     

       416
       416
       +
       

     

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

     

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

     

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

     

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

     

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

     

       422
       422
       +
       

     

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

     

       424
       424
       +
           let max_points = 500 in

     

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

     

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

     

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

     

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

     

       429
       429
       +
           ) sampled_data) in

     

       430
       430
       +
       

     

       431
       431
       +
           Printf.sprintf {|

     

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

     

       433
       433
       +
               <h3>%s</h3>

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       446
       446
       +
               </div>

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       454
       454
       +
               </div>

     

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

     

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

     

       457
       457
       +
                   <h4>Latency Distribution</h4>

     

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

     

       459
       459
       +
                 </div>

     

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

     

       461
       461
       +
                   <h4>Latency Timeline</h4>

     

       462
       462
       +
                   <canvas id="timeline_%d"></canvas>

     

       463
       463
       +
                 </div>

     

       464
       464
       +
               </div>

     

       465
       465
       +
             </div>

     

       466
       466
       +
             <script>

     

       467
       467
       +
               new Chart(document.getElementById('hist_%d'), {

     

       468
       468
       +
                 type: 'bar',

     

       469
       469
       +
                 data: {

     

       470
       470
       +
                   labels: [%s],

     

       471
       471
       +
                   datasets: [{

     

       472
       472
       +
                     label: 'Count',

     

       473
       473
       +
                     data: [%s],

     

       474
       474
       +
                     backgroundColor: 'rgba(102, 126, 234, 0.6)',

     

       475
       475
       +
                     borderColor: 'rgba(102, 126, 234, 1)',

     

       476
       476
       +
                     borderWidth: 1

     

       477
       477
       +
                   }]

     

       478
       478
       +
                 },

     

       479
       479
       +
                 options: {

     

       480
       480
       +
                   responsive: true,

     

       481
       481
       +
                   maintainAspectRatio: false,

     

       482
       482
       +
                   plugins: { legend: { display: false } },

     

       483
       483
       +
                   scales: {

     

       484
       484
       +
                     x: { title: { display: true, text: 'Latency (ms)' } },

     

       485
       485
       +
                     y: { beginAtZero: true, title: { display: true, text: 'Count' } }

     

       486
       486
       +
                   }

     

       487
       487
       +
                 }

     

       488
       488
       +
               });

     

       489
       489
       +
       

     

       490
       490
       +
               new Chart(document.getElementById('timeline_%d'), {

     

       491
       491
       +
                 type: 'scatter',

     

       492
       492
       +
                 data: {

     

       493
       493
       +
                   datasets: [{

     

       494
       494
       +
                     label: 'Latency',

     

       495
       495
       +
                     data: [%s],

     

       496
       496
       +
                     backgroundColor: 'rgba(118, 75, 162, 0.5)',

     

       497
       497
       +
                     borderColor: 'rgba(118, 75, 162, 0.8)',

     

       498
       498
       +
                     pointRadius: 2

     

       499
       499
       +
                   }]

     

       500
       500
       +
                 },

     

       501
       501
       +
                 options: {

     

       502
       502
       +
                   responsive: true,

     

       503
       503
       +
                   maintainAspectRatio: false,

     

       504
       504
       +
                   plugins: { legend: { display: false } },

     

       505
       505
       +
                   scales: {

     

       506
       506
       +
                     x: { title: { display: true, text: 'Time (ms)' } },

     

       507
       507
       +
                     y: { beginAtZero: true, title: { display: true, text: 'Latency (ms)' } }

     

       508
       508
       +
                   }

     

       509
       509
       +
                 }

     

       510
       510
       +
               });

     

       511
       511
       +
             </script>|}

     

       512
       512
       +
             (js_escape r.test_name)

     

       513
       513
       +
             r.num_servers

     

       514
       514
       +
             r.num_clients

     

       515
       515
       +
             r.messages_per_client

     

       516
       516
       +
             r.pool_size

     

       517
       517
       +
             r.total_messages

     

       518
       518
       +
             r.duration

     

       519
       519
       +
             r.throughput

     

       520
       520
       +
             r.avg_latency

     

       521
       521
       +
             r.min_latency

     

       522
       522
       +
             r.max_latency

     

       523
       523
       +
             (if r.total_errors > 0 then "error" else "")

     

       524
       524
       +
             r.total_errors

     

       525
       525
       +
             r.pool_stats.total_created

     

       526
       526
       +
             r.pool_stats.total_reused

     

       527
       527
       +
             r.pool_stats.total_closed

     

       528
       528
       +
             r.pool_stats.active

     

       529
       529
       +
             r.pool_stats.idle

     

       530
       530
       +
             (if r.pool_stats.total_created > 0 then

     

       531
       531
       +
               (float_of_int r.pool_stats.total_reused /. float_of_int r.pool_stats.total_created *. 100.0)

     

       532
       532
       +
             else 0.0)

     

       533
       533
       +
             idx idx idx

     

       534
       534
       +
             hist_labels_str

     

       535
       535
       +
             hist_counts_str

     

       536
       536
       +
             idx

     

       537
       537
       +
             timeline_data

     

       538
       538
       +
         ) results) in

     

       539
       539
       +
       

     

       540
       540
       +
         Printf.sprintf {|<!DOCTYPE html>

     

       541
       541
       +
       <html lang="en">

     

       542
       542
       +
       <head>

     

       543
       543
       +
         <meta charset="UTF-8">

     

       544
       544
       +
         <meta name="viewport" content="width=device-width, initial-scale=1.0">

     

       545
       545
       +
         <title>Connection Pool Stress Test Results</title>

     

       546
       546
       +
         <script src="https://cdn.jsdelivr.net/npm/chart.js@4.4.0/dist/chart.umd.min.js"></script>

     

       547
       547
       +
         <style>

     

       548
       548
       +
           * { margin: 0; padding: 0; box-sizing: border-box; }

     

       549
       549
       +
           body {

     

       550
       550
       +
             font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif;

     

       551
       551
       +
             background: #f5f5f5;

     

       552
       552
       +
             padding: 1rem;

     

       553
       553
       +
             color: #333;

     

       554
       554
       +
             font-size: 14px;

     

       555
       555
       +
           }

     

       556
       556
       +
           .container { max-width: 1600px; margin: 0 auto; }

     

       557
       557
       +
           h1 {

     

       558
       558
       +
             color: #667eea;

     

       559
       559
       +
             text-align: center;

     

       560
       560
       +
             margin-bottom: 0.3rem;

     

       561
       561
       +
             font-size: 1.8rem;

     

       562
       562
       +
           }

     

       563
       563
       +
           .subtitle {

     

       564
       564
       +
             text-align: center;

     

       565
       565
       +
             margin-bottom: 1rem;

     

       566
       566
       +
             font-size: 0.9rem;

     

       567
       567
       +
             color: #666;

     

       568
       568
       +
           }

     

       569
       569
       +
           .summary {

     

       570
       570
       +
             background: white;

     

       571
       571
       +
             border-radius: 6px;

     

       572
       572
       +
             padding: 1rem;

     

       573
       573
       +
             margin-bottom: 1rem;

     

       574
       574
       +
             box-shadow: 0 2px 4px rgba(0,0,0,0.1);

     

       575
       575
       +
           }

     

       576
       576
       +
           .summary h2 {

     

       577
       577
       +
             color: #667eea;

     

       578
       578
       +
             margin-bottom: 0.8rem;

     

       579
       579
       +
             font-size: 1.2rem;

     

       580
       580
       +
           }

     

       581
       581
       +
           .summary-grid {

     

       582
       582
       +
             display: grid;

     

       583
       583
       +
             grid-template-columns: repeat(auto-fit, minmax(120px, 1fr));

     

       584
       584
       +
             gap: 0.8rem;

     

       585
       585
       +
           }

     

       586
       586
       +
           .summary-metric {

     

       587
       587
       +
             text-align: center;

     

       588
       588
       +
             padding: 0.8rem;

     

       589
       589
       +
             background: linear-gradient(135deg, #667eea 0%%, #764ba2 100%%);

     

       590
       590
       +
             border-radius: 4px;

     

       591
       591
       +
             color: white;

     

       592
       592
       +
           }

     

       593
       593
       +
           .summary-metric-label {

     

       594
       594
       +
             font-size: 0.75rem;

     

       595
       595
       +
             opacity: 0.9;

     

       596
       596
       +
             margin-bottom: 0.3rem;

     

       597
       597
       +
           }

     

       598
       598
       +
           .summary-metric-value {

     

       599
       599
       +
             font-size: 1.4rem;

     

       600
       600
       +
             font-weight: bold;

     

       601
       601
       +
           }

     

       602
       602
       +
           .comparison {

     

       603
       603
       +
             background: white;

     

       604
       604
       +
             border-radius: 6px;

     

       605
       605
       +
             padding: 1rem;

     

       606
       606
       +
             margin-bottom: 1rem;

     

       607
       607
       +
             box-shadow: 0 2px 4px rgba(0,0,0,0.1);

     

       608
       608
       +
           }

     

       609
       609
       +
           .comparison h2 {

     

       610
       610
       +
             color: #667eea;

     

       611
       611
       +
             margin-bottom: 0.8rem;

     

       612
       612
       +
             font-size: 1.2rem;

     

       613
       613
       +
           }

     

       614
       614
       +
           .comparison-charts {

     

       615
       615
       +
             display: grid;

     

       616
       616
       +
             grid-template-columns: repeat(3, 1fr);

     

       617
       617
       +
             gap: 1rem;

     

       618
       618
       +
           }

     

       619
       619
       +
           .comparison-chart {

     

       620
       620
       +
             height: 200px;

     

       621
       621
       +
             position: relative;

     

       622
       622
       +
           }

     

       623
       623
       +
           .test-detail {

     

       624
       624
       +
             background: white;

     

       625
       625
       +
             border-radius: 6px;

     

       626
       626
       +
             padding: 1rem;

     

       627
       627
       +
             margin-bottom: 1rem;

     

       628
       628
       +
             box-shadow: 0 2px 4px rgba(0,0,0,0.1);

     

       629
       629
       +
             border-left: 3px solid #667eea;

     

       630
       630
       +
           }

     

       631
       631
       +
           .test-detail h3 {

     

       632
       632
       +
             color: #764ba2;

     

       633
       633
       +
             margin-bottom: 0.6rem;

     

       634
       634
       +
             font-size: 1.1rem;

     

       635
       635
       +
           }

     

       636
       636
       +
           .test-detail h4 {

     

       637
       637
       +
             color: #666;

     

       638
       638
       +
             margin-bottom: 0.4rem;

     

       639
       639
       +
             font-size: 0.9rem;

     

       640
       640
       +
             font-weight: 500;

     

       641
       641
       +
           }

     

       642
       642
       +
           .compact-grid {

     

       643
       643
       +
             display: grid;

     

       644
       644
       +
             grid-template-columns: repeat(auto-fit, minmax(100px, 1fr));

     

       645
       645
       +
             gap: 0.4rem;

     

       646
       646
       +
             margin-bottom: 0.8rem;

     

       647
       647
       +
             font-size: 0.85rem;

     

       648
       648
       +
           }

     

       649
       649
       +
           .compact-metric {

     

       650
       650
       +
             background: #f8f9fa;

     

       651
       651
       +
             padding: 0.4rem 0.6rem;

     

       652
       652
       +
             border-radius: 3px;

     

       653
       653
       +
             display: flex;

     

       654
       654
       +
             justify-content: space-between;

     

       655
       655
       +
             align-items: center;

     

       656
       656
       +
           }

     

       657
       657
       +
           .compact-metric .label {

     

       658
       658
       +
             color: #666;

     

       659
       659
       +
             font-weight: 500;

     

       660
       660
       +
           }

     

       661
       661
       +
           .compact-metric .value {

     

       662
       662
       +
             color: #333;

     

       663
       663
       +
             font-weight: 600;

     

       664
       664
       +
           }

     

       665
       665
       +
           .compact-metric.highlight {

     

       666
       666
       +
             background: linear-gradient(135deg, #667eea 0%%, #764ba2 100%%);

     

       667
       667
       +
             color: white;

     

       668
       668
       +
           }

     

       669
       669
       +
           .compact-metric.highlight .label,

     

       670
       670
       +
           .compact-metric.highlight .value {

     

       671
       671
       +
             color: white;

     

       672
       672
       +
           }

     

       673
       673
       +
           .compact-metric.error {

     

       674
       674
       +
             background: #fee;

     

       675
       675
       +
             border: 1px solid #fcc;

     

       676
       676
       +
           }

     

       677
       677
       +
           .chart-row {

     

       678
       678
       +
             display: grid;

     

       679
       679
       +
             grid-template-columns: 1fr 1fr;

     

       680
       680
       +
             gap: 1rem;

     

       681
       681
       +
           }

     

       682
       682
       +
           .chart-half {

     

       683
       683
       +
             position: relative;

     

       684
       684
       +
             height: 220px;

     

       685
       685
       +
           }

     

       686
       686
       +
           @media (max-width: 1200px) {

     

       687
       687
       +
             .comparison-charts { grid-template-columns: 1fr; }

     

       688
       688
       +
             .chart-row { grid-template-columns: 1fr; }

     

       689
       689
       +
           }

     

       690
       690
       +
           @media (max-width: 768px) {

     

       691
       691
       +
             .compact-grid { grid-template-columns: repeat(2, 1fr); }

     

       692
       692
       +
           }

     

       693
       693
       +
         </style>

     

       694
       694
       +
       </head>

     

       695
       695
       +
       <body>

     

       696
       696
       +
         <div class="container">

     

       697
       697
       +
           <h1>Connection Pool Stress Test Results</h1>

     

       698
       698
       +
           <div class="subtitle">%s</div>

     

       699
       699
       +
       

     

       700
       700
       +
           <div class="summary">

     

       701
       701
       +
             <h2>Summary</h2>

     

       702
       702
       +
             <div class="summary-grid">

     

       703
       703
       +
               <div class="summary-metric">

     

       704
       704
       +
                 <div class="summary-metric-label">Tests</div>

     

       705
       705
       +
                 <div class="summary-metric-value">%d</div>

     

       706
       706
       +
               </div>

     

       707
       707
       +
               <div class="summary-metric">

     

       708
       708
       +
                 <div class="summary-metric-label">Messages</div>

     

       709
       709
       +
                 <div class="summary-metric-value">%s</div>

     

       710
       710
       +
               </div>

     

       711
       711
       +
               <div class="summary-metric">

     

       712
       712
       +
                 <div class="summary-metric-label">Errors</div>

     

       713
       713
       +
                 <div class="summary-metric-value">%d</div>

     

       714
       714
       +
               </div>

     

       715
       715
       +
               <div class="summary-metric">

     

       716
       716
       +
                 <div class="summary-metric-label">Duration</div>

     

       717
       717
       +
                 <div class="summary-metric-value">%.1fs</div>

     

       718
       718
       +
               </div>

     

       719
       719
       +
             </div>

     

       720
       720
       +
           </div>

     

       721
       721
       +
       

     

       722
       722
       +
           <div class="comparison">

     

       723
       723
       +
             <h2>Comparison</h2>

     

       724
       724
       +
             <div class="comparison-charts">

     

       725
       725
       +
               <div class="comparison-chart"><canvas id="cmpThroughput"></canvas></div>

     

       726
       726
       +
               <div class="comparison-chart"><canvas id="cmpLatency"></canvas></div>

     

       727
       727
       +
               <div class="comparison-chart"><canvas id="cmpErrors"></canvas></div>

     

       728
       728
       +
             </div>

     

       729
       729
       +
           </div>

     

       730
       730
       +
       

     

       731
       731
       +
       %s

     

       732
       732
       +
         </div>

     

       733
       733
       +
       

     

       734
       734
       +
         <script>

     

       735
       735
       +
           const testNames = [%s];

     

       736
       736
       +
           const throughputs = [%s];

     

       737
       737
       +
           const avgLatencies = [%s];

     

       738
       738
       +
           const errorRates = [%s];

     

       739
       739
       +
       

     

       740
       740
       +
           const cc = {

     

       741
       741
       +
             primary: 'rgba(102, 126, 234, 0.8)',

     

       742
       742
       +
             secondary: 'rgba(118, 75, 162, 0.8)',

     

       743
       743
       +
             danger: 'rgba(220, 53, 69, 0.8)',

     

       744
       744
       +
           };

     

       745
       745
       +
       

     

       746
       746
       +
           new Chart(document.getElementById('cmpThroughput'), {

     

       747
       747
       +
             type: 'bar',

     

       748
       748
       +
             data: {

     

       749
       749
       +
               labels: testNames,

     

       750
       750
       +
               datasets: [{

     

       751
       751
       +
                 label: 'msg/s',

     

       752
       752
       +
                 data: throughputs,

     

       753
       753
       +
                 backgroundColor: cc.primary,

     

       754
       754
       +
                 borderColor: cc.primary,

     

       755
       755
       +
                 borderWidth: 1

     

       756
       756
       +
               }]

     

       757
       757
       +
             },

     

       758
       758
       +
             options: {

     

       759
       759
       +
               responsive: true,

     

       760
       760
       +
               maintainAspectRatio: false,

     

       761
       761
       +
               plugins: {

     

       762
       762
       +
                 legend: { display: false },

     

       763
       763
       +
                 title: { display: true, text: 'Throughput (msg/s)' }

     

       764
       764
       +
               },

     

       765
       765
       +
               scales: { y: { beginAtZero: true } }

     

       766
       766
       +
             }

     

       767
       767
       +
           });

     

       768
       768
       +
       

     

       769
       769
       +
           new Chart(document.getElementById('cmpLatency'), {

     

       770
       770
       +
             type: 'bar',

     

       771
       771
       +
             data: {

     

       772
       772
       +
               labels: testNames,

     

       773
       773
       +
               datasets: [{

     

       774
       774
       +
                 label: 'ms',

     

       775
       775
       +
                 data: avgLatencies,

     

       776
       776
       +
                 backgroundColor: cc.secondary,

     

       777
       777
       +
                 borderColor: cc.secondary,

     

       778
       778
       +
                 borderWidth: 1

     

       779
       779
       +
               }]

     

       780
       780
       +
             },

     

       781
       781
       +
             options: {

     

       782
       782
       +
               responsive: true,

     

       783
       783
       +
               maintainAspectRatio: false,

     

       784
       784
       +
               plugins: {

     

       785
       785
       +
                 legend: { display: false },

     

       786
       786
       +
                 title: { display: true, text: 'Avg Latency (ms)' }

     

       787
       787
       +
               },

     

       788
       788
       +
               scales: { y: { beginAtZero: true } }

     

       789
       789
       +
             }

     

       790
       790
       +
           });

     

       791
       791
       +
       

     

       792
       792
       +
           new Chart(document.getElementById('cmpErrors'), {

     

       793
       793
       +
             type: 'bar',

     

       794
       794
       +
             data: {

     

       795
       795
       +
               labels: testNames,

     

       796
       796
       +
               datasets: [{

     

       797
       797
       +
                 label: '%%',

     

       798
       798
       +
                 data: errorRates,

     

       799
       799
       +
                 backgroundColor: cc.danger,

     

       800
       800
       +
                 borderColor: cc.danger,

     

       801
       801
       +
                 borderWidth: 1

     

       802
       802
       +
               }]

     

       803
       803
       +
             },

     

       804
       804
       +
             options: {

     

       805
       805
       +
               responsive: true,

     

       806
       806
       +
               maintainAspectRatio: false,

     

       807
       807
       +
               plugins: {

     

       808
       808
       +
                 legend: { display: false },

     

       809
       809
       +
                 title: { display: true, text: 'Error Rate (%%)' }

     

       810
       810
       +
               },

     

       811
       811
       +
               scales: { y: { beginAtZero: true } }

     

       812
       812
       +
             }

     

       813
       813
       +
           });

     

       814
       814
       +
         </script>

     

       815
       815
       +
       </body>

     

       816
       816
       +
       </html>|}

     

       817
       817
       +
           date_str

     

       818
       818
       +
           (List.length results)

     

       819
       819
       +
           (if total_messages >= 1000 then

     

       820
       820
       +
             Printf.sprintf "%d,%03d" (total_messages / 1000) (total_messages mod 1000)

     

       821
       821
       +
           else

     

       822
       822
       +
             string_of_int total_messages)

     

       823
       823
       +
           total_errors

     

       824
       824
       +
           total_duration

     

       825
       825
       +
           test_details

     

       826
       826
       +
           test_names

     

       827
       827
       +
           throughputs

     

       828
       828
       +
           avg_latencies

     

       829
       829
       +
           error_rates

     

       830
       830
       +
       

     

       831
       831
       +
       (** Run all preset tests and return results *)

     

       832
       832
       +
       let run_all_presets ~env =

     

       833
       833
       +
         List.map (fun config ->

     

       834
       834
       +
           Printf.eprintf "Running test: %s\n%!" config.name;

     

       835
       835
       +
           run_stress_test ~env config

     

       836
       836
       +
         ) presets

     

       837
       837
       +
       

     

       838
       838
       +
       (** Parse command line arguments *)

     

       839
       839
       +
       type mode =

     

       840
       840
       +
         | Single of config

     

       841
       841
       +
         | AllPresets

     

       842
       842
       +
         | Extended

     

       843
       843
       +
         | ListPresets

     

       844
       844
       +
       

     

       845
       845
       +
       let parse_args () =

     

       846
       846
       +
         let mode = ref (Single default_config) in

     

       847
       847
       +
         let name = ref default_config.name in

     

       848
       848
       +
         let num_servers = ref default_config.num_servers in

     

       849
       849
       +
         let num_clients = ref default_config.num_clients in

     

       850
       850
       +
         let messages_per_client = ref default_config.messages_per_client in

     

       851
       851
       +
         let max_parallel = ref default_config.max_parallel_clients in

     

       852
       852
       +
         let message_size = ref default_config.message_size in

     

       853
       853
       +
         let pool_size = ref default_config.pool_size in

     

       854
       854
       +
         let output_file = ref "stress_test_results.json" in

     

       855
       855
       +
       

     

       856
       856
       +
         let specs = [

     

       857
       857
       +
           ("--all", Arg.Unit (fun () -> mode := AllPresets),

     

       858
       858
       +
             "Run all preset test configurations");

     

       859
       859
       +
           ("--extended", Arg.Unit (fun () -> mode := Extended),

     

       860
       860
       +
             "Run extended stress test (30 servers, 1000 clients, 100 msgs each = 3M messages)");

     

       861
       861
       +
           ("--list", Arg.Unit (fun () -> mode := ListPresets),

     

       862
       862
       +
             "List available presets");

     

       863
       863
       +
           ("--preset", Arg.String (fun p ->

     

       864
       864
       +
             match List.find_opt (fun c -> c.name = p) presets with

     

       865
       865
       +
             | Some c -> mode := Single c

     

       866
       866
       +
             | None -> failwith (Printf.sprintf "Unknown preset: %s" p)),

     

       867
       867
       +
             "Use a named preset configuration");

     

       868
       868
       +
           ("-n", Arg.Set_string name, "Test name");

     

       869
       869
       +
           ("-s", Arg.Set_int num_servers, Printf.sprintf "Number of servers (default: %d)" default_config.num_servers);

     

       870
       870
       +
           ("-c", Arg.Set_int num_clients, Printf.sprintf "Clients per server (default: %d)" default_config.num_clients);

     

       871
       871
       +
           ("-m", Arg.Set_int messages_per_client, Printf.sprintf "Messages per client (default: %d)" default_config.messages_per_client);

     

       872
       872
       +
           ("-p", Arg.Set_int max_parallel, Printf.sprintf "Max parallel clients (default: %d)" default_config.max_parallel_clients);

     

       873
       873
       +
           ("-b", Arg.Set_int message_size, Printf.sprintf "Message size (default: %d)" default_config.message_size);

     

       874
       874
       +
           ("-P", Arg.Set_int pool_size, Printf.sprintf "Pool size per endpoint (default: %d)" default_config.pool_size);

     

       875
       875
       +
           ("-o", Arg.Set_string output_file, "Output JSON file (default: stress_test_results.json)");

     

       876
       876
       +
         ] in

     

       877
       877
       +
       

     

       878
       878
       +
         let usage = "Usage: stress_test [options]\n\nOptions:" in

     

       879
       879
       +
         Arg.parse specs (fun _ -> ()) usage;

     

       880
       880
       +
       

     

       881
       881
       +
         let config = {

     

       882
       882
       +
           name = !name;

     

       883
       883
       +
           num_servers = !num_servers;

     

       884
       884
       +
           num_clients = !num_clients;

     

       885
       885
       +
           messages_per_client = !messages_per_client;

     

       886
       886
       +
           max_parallel_clients = !max_parallel;

     

       887
       887
       +
           message_size = !message_size;

     

       888
       888
       +
           pool_size = !pool_size;

     

       889
       889
       +
         } in

     

       890
       890
       +
       

     

       891
       891
       +
         (!mode, config, !output_file)

     

       892
       892
       +
       

     

       893
       893
       +
       let () =

     

       894
       894
       +
         Random.self_init ();

     

       895
       895
       +
         let (mode, custom_config, output_file) = parse_args () in

     

       896
       896
       +
       

     

       897
       897
       +
         match mode with

     

       898
       898
       +
         | ListPresets ->

     

       899
       899
       +
             Printf.printf "Available presets:\n";

     

       900
       900
       +
             List.iter (fun c ->

     

       901
       901
       +
               Printf.printf "  %s: %d servers, %d clients, %d msgs/client, pool=%d\n"

     

       902
       902
       +
                 c.name c.num_servers c.num_clients c.messages_per_client c.pool_size

     

       903
       903
       +
             ) presets

     

       904
       904
       +
       

     

       905
       905
       +
         | Single config ->

     

       906
       906
       +
             let config = if config.name = "default" then custom_config else config in

     

       907
       907
       +
             Eio_main.run @@ fun env ->

     

       908
       908
       +
               let result = run_stress_test ~env config in

     

       909
       909
       +
               let results = [result] in

     

       910
       910
       +
       

     

       911
       911
       +
               (* Write JSON *)

     

       912
       912
       +
               let json = Printf.sprintf "[%s]" (result_to_json result) in

     

       913
       913
       +
               let oc = open_out output_file in

     

       914
       914
       +
               output_string oc json;

     

       915
       915
       +
               close_out oc;

     

       916
       916
       +
               Printf.printf "Results written to %s\n" output_file;

     

       917
       917
       +
       

     

       918
       918
       +
               (* Write HTML *)

     

       919
       919
       +
               let html_file =

     

       920
       920
       +
                 if Filename.check_suffix output_file ".json" then

     

       921
       921
       +
                   Filename.chop_suffix output_file ".json" ^ ".html"

     

       922
       922
       +
                 else

     

       923
       923
       +
                   output_file ^ ".html"

     

       924
       924
       +
               in

     

       925
       925
       +
               let html = generate_html_report results in

     

       926
       926
       +
               let oc_html = open_out html_file in

     

       927
       927
       +
               output_string oc_html html;

     

       928
       928
       +
               close_out oc_html;

     

       929
       929
       +
               Printf.printf "HTML report written to %s\n" html_file;

     

       930
       930
       +
       

     

       931
       931
       +
               Printf.printf "Test: %s - %d messages, %.2f msg/s, %.2fms avg latency, %d errors\n"

     

       932
       932
       +
                 result.test_name result.total_messages result.throughput result.avg_latency result.total_errors

     

       933
       933
       +
       

     

       934
       934
       +
         | AllPresets ->

     

       935
       935
       +
             Eio_main.run @@ fun env ->

     

       936
       936
       +
               let results = run_all_presets ~env in

     

       937
       937
       +
       

     

       938
       938
       +
               (* Write JSON *)

     

       939
       939
       +
               let json = "[" ^ String.concat ",\n" (List.map result_to_json results) ^ "]" in

     

       940
       940
       +
               let oc = open_out output_file in

     

       941
       941
       +
               output_string oc json;

     

       942
       942
       +
               close_out oc;

     

       943
       943
       +
               Printf.printf "Results written to %s\n" output_file;

     

       944
       944
       +
       

     

       945
       945
       +
               (* Write HTML *)

     

       946
       946
       +
               let html_file =

     

       947
       947
       +
                 if Filename.check_suffix output_file ".json" then

     

       948
       948
       +
                   Filename.chop_suffix output_file ".json" ^ ".html"

     

       949
       949
       +
                 else

     

       950
       950
       +
                   output_file ^ ".html"

     

       951
       951
       +
               in

     

       952
       952
       +
               let html = generate_html_report results in

     

       953
       953
       +
               let oc_html = open_out html_file in

     

       954
       954
       +
               output_string oc_html html;

     

       955
       955
       +
               close_out oc_html;

     

       956
       956
       +
               Printf.printf "HTML report written to %s\n" html_file;

     

       957
       957
       +
       

     

       958
       958
       +
               List.iter (fun r ->

     

       959
       959
       +
                 Printf.printf "  %s: %d messages, %.2f msg/s, %.2fms avg latency, %d errors\n"

     

       960
       960
       +
                   r.test_name r.total_messages r.throughput r.avg_latency r.total_errors

     

       961
       961
       +
               ) results

     

       962
       962
       +
       

     

       963
       963
       +
         | Extended ->

     

       964
       964
       +
             Printf.printf "Running extended stress test: %d servers, %d clients/server, %d msgs/client\n"

     

       965
       965
       +
               extended_preset.num_servers extended_preset.num_clients extended_preset.messages_per_client;

     

       966
       966
       +
             Printf.printf "Total messages: %d\n%!"

     

       967
       967
       +
               (extended_preset.num_servers * extended_preset.num_clients * extended_preset.messages_per_client);

     

       968
       968
       +
             Eio_main.run @@ fun env ->

     

       969
       969
       +
               let result = run_stress_test ~env extended_preset in

     

       970
       970
       +
               let results = [result] in

     

       971
       971
       +
       

     

       972
       972
       +
               (* Write JSON *)

     

       973
       973
       +
               let json = Printf.sprintf "[%s]" (result_to_json result) in

     

       974
       974
       +
               let oc = open_out output_file in

     

       975
       975
       +
               output_string oc json;

     

       976
       976
       +
               close_out oc;

     

       977
       977
       +
               Printf.printf "Results written to %s\n" output_file;

     

       978
       978
       +
       

     

       979
       979
       +
               (* Write HTML *)

     

       980
       980
       +
               let html_file =

     

       981
       981
       +
                 if Filename.check_suffix output_file ".json" then

     

       982
       982
       +
                   Filename.chop_suffix output_file ".json" ^ ".html"

     

       983
       983
       +
                 else

     

       984
       984
       +
                   output_file ^ ".html"

     

       985
       985
       +
               in

     

       986
       986
       +
               let html = generate_html_report results in

     

       987
       987
       +
               let oc_html = open_out html_file in

     

       988
       988
       +
               output_string oc_html html;

     

       989
       989
       +
               close_out oc_html;

     

       990
       990
       +
               Printf.printf "HTML report written to %s\n" html_file;

     

       991
       991
       +
       

     

       992
       992
       +
               Printf.printf "Test: %s - %d messages, %.2f msg/s, %.2fms avg latency, %d errors\n"

     

       993
       993
       +
                 result.test_name result.total_messages result.throughput result.avg_latency result.total_errors

Compare changes