Merge branch 'main' into connect-timeout

Author: mbg

.github/workflows/build.yml

@@ -1,4 +1,4 @@
-name: build
+name: Haskell
 
 on:
   push:
@@ -7,7 +7,7 @@ on:
     tags:
       - "v*"
     paths:
-      - ".github/workflows/**"
+      - ".github/workflows/build.yml"
       - "src/**"
       - "test/**"
       - "test-postgres/**"
@@ -18,12 +18,14 @@ on:
 
 jobs:
   build:
+    name: "Build & Test"
     strategy:
       fail-fast: false
       matrix:
         resolver:
           - "stack-lts11"
           - "stack-lts18"
+          - "stack-lts24"
         postgres-flag:
           - ""
           - "--flag network-wait:postgres"
@@ -36,6 +38,12 @@ jobs:
     steps:
       - uses: actions/checkout@v4
 
+      - name: Set up Docker Compose
+        if: |
+          contains(matrix.postgres-flag, 'network-wait:postgres') ||
+          contains(matrix.redis-flag, 'network-wait:redis')
+        uses: docker/setup-compose-action@v1
+
       - uses: haskell/actions/setup@v2
         id: install-haskell
         with:
@@ -79,7 +87,7 @@ jobs:
         # only deploy the documentation for a build on `main` with all flags enabled
         if: |
           github.ref == 'refs/heads/main' &&
-          matrix.resolver == 'stack-lts18' &&
+          matrix.resolver == 'stack-lts24' &&
           contains(matrix.postgres-flag, 'network-wait:postgres') &&
           contains(matrix.redis-flag, 'network-wait:redis')
         uses: JamesIves/[email protected]
@@ -90,12 +98,12 @@ jobs:
       - name: Start Docker containers (PostgreSQL)
         if: ${{ contains(matrix.postgres-flag, 'network-wait:postgres') }}
         run: |
-          docker-compose -p postgres -f docker-compose.postgresql.yaml up -d
+          docker compose -p postgres -f docker-compose.postgresql.yaml up -d
 
       - name: Start Docker containers (Redis)
         if: ${{ contains(matrix.redis-flag, 'network-wait:redis') }}
         run: |
-          docker-compose -p redis -f docker-compose.redis.yaml up -d
+          docker compose -p redis -f docker-compose.redis.yaml up -d
 
       - name: Test
         run: |
@@ -107,9 +115,9 @@ jobs:
       - name: Stop Docker containers (PostgreSQL)
         if: ${{ contains(matrix.postgres-flag, 'network-wait:postgres') }}
         run: |
-          docker-compose -p postgres -f docker-compose.postgresql.yaml down
+          docker compose -p postgres -f docker-compose.postgresql.yaml down
 
       - name: Stop Docker containers (Redis)
         if: ${{ contains(matrix.redis-flag, 'network-wait:redis') }}
         run: |
-          docker-compose -p redis -f docker-compose.redis.yaml down
+          docker compose -p redis -f docker-compose.redis.yaml down

.github/workflows/hackage.yml

@@ -1,33 +1,41 @@
-name: hackage
+name: Hackage
 
 on:
   push:
-    tags:
-      - 'v*'
+    paths:
+      - ".github/workflows/hackage.yml"
+  release:
+    types:
+      - released
+      - prereleased
 
 jobs:
   publish-to-hackage:
-    name: 'Publish to Hackage'
+    name: "Publish"
     runs-on: ubuntu-latest
 
     steps:
-      - uses: actions/checkout@v4
+      - name: "Checkout repository"
+        uses: actions/checkout@v4
 
-      - uses: haskell/actions/setup@v2
+      - uses: haskell-actions/setup@v2
         id: install-haskell
         with:
           stack-no-global: true
           enable-stack: true
-          stack-version: 'latest'
+          stack-version: "latest"
 
       - name: Configure stack
         run: |
           mkdir -p ${{ steps.install-haskell.outputs.stack-root }}
           echo "save-hackage-creds: false" >> ${{ steps.install-haskell.outputs.stack-root }}/config.yaml
 
+      - name: Check source distribution
+        run: stack sdist .
+
       - name: Publish `network-wait`
-        if: startsWith(github.ref, 'refs/tags/v')
-        run: stack upload .
+        if: startsWith(github.ref, 'refs/tags/v') && github.event.action == 'released'
+        run: stack upload . --candidate
         env:
           HACKAGE_USERNAME: ${{ secrets.HACKAGE_USER }}
           HACKAGE_PASSWORD: ${{ secrets.HACKAGE_PASSWORD }}

ChangeLog.md

@@ -1,5 +1,9 @@
 # Changelog for network-wait
 
+## 0.3.0
+
+- Functions in the `Network.Wait.PostgreSQL` module are now overloaded to accept different types of connection information. In addition to the previously supported `ConnectInfo` type, the function now also accept connection strings in the form of `ByteString` values.
+
 ## 0.2.0
 
 - Add `Network.Wait.Redis` module with functions to wait for Redis servers to become ready to accept connections. This module and its dependency on `hedis` are not enabled by default. The `network-wait:redis` flag must be enabled for this package's Redis support.

README.md

@@ -1,7 +1,7 @@
 # network-wait
 
 ![MIT](https://img.shields.io/github/license/mbg/network-wait)
-![CI](https://github.com/mbg/network-wait/workflows/build/badge.svg?branch=main)
+[![CI](https://github.com/mbg/network-wait/actions/workflows/build.yml/badge.svg)](https://github.com/mbg/network-wait/actions/workflows/build.yml)
 [![Hackage](https://img.shields.io/hackage/v/network-wait)](https://hackage.haskell.org/package/network-wait)
 
 A lightweight Haskell library for waiting on networked services to become available. This is useful if you are e.g. building a web application which relies on a database server to be available, but which may not be immediately available on application startup.
@@ -41,6 +41,23 @@ main = do
 
 Internally, this uses `postgresql-simple` to connect to the specified server (`defaultConnectInfo` in the example above) and send a `SELECT 1;` query. If the query is answered correctly, we consider the server to be in a state ready to accept commands.
 
+Alternatively, a connection string may be used instead of a `ConnectInfo` value:
+
+```haskell
+import Data.ByteString (ByteString)
+import Control.Retry (retryPolicyDefault)
+import Database.PostgreSQL.Simple (defaultConnectInfo)
+import Network.Wait.PostgreSQL (waitPostgreSQL)
+
+connStr :: ByteString
+connStr = "host=localhost port=5432"
+
+main :: IO ()
+main = do
+    waitPostgreSQL retryPolicyDefault connStr
+    putStrLn "Yay, the PostgreSQL server is ready to accept commands!"
+```
+
 The `Network.Wait.PostgreSQL` module is gated behind the `network-wait:postgres` flag so that the PostgreSQL-specific dependencies are only required when PostgresSQL support is required by users of this library.
 
 ## Example: Redis

network-wait.cabal

@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.38.1.
 --
 -- see: https://github.com/sol/hpack
 
 name:           network-wait
-version:        0.2.0.0
+version:        0.3.0.0
 synopsis:       Lightweight library for waiting on networked services to become available.
 description:    Please see the README on GitHub at <https://github.com/mbg/network-wait#readme> and
                 Haddock documentation for all modules, including those that are gated behind
@@ -15,7 +15,7 @@ homepage:       https://github.com/mbg/network-wait#readme
 bug-reports:    https://github.com/mbg/network-wait/issues
 author:         Michael B. Gale
 maintainer:     [email protected]
-copyright:      2022 Michael B. Gale
+copyright:      2025 Michael B. Gale
 license:        MIT
 license-file:   LICENSE
 build-type:     Simple
@@ -47,9 +47,11 @@ library
   ghc-options: -Wall
   build-depends:
       base >=4.7 && <5
+    , bytestring
     , exceptions
     , network
     , retry
+  default-language: Haskell2010
   if flag(postgres)
     build-depends:
         postgresql-simple
@@ -62,7 +64,6 @@ library
   if flag(redis)
     exposed-modules:
         Network.Wait.Redis
-  default-language: Haskell2010
 
 test-suite network-wait-test
   type: exitcode-stdio-1.0
@@ -74,20 +75,21 @@ test-suite network-wait-test
   ghc-options: -Wall
   build-depends:
       base >=4.7 && <5
+    , bytestring
     , exceptions
     , network
     , network-simple
     , network-wait
     , retry
     , tasty
     , tasty-hunit
+  default-language: Haskell2010
   if flag(postgres)
     build-depends:
         postgresql-simple
   if flag(redis)
     build-depends:
         hedis
-  default-language: Haskell2010
 
 test-suite network-wait-test-postgres
   type: exitcode-stdio-1.0
@@ -99,12 +101,14 @@ test-suite network-wait-test-postgres
   ghc-options: -Wall
   build-depends:
       base >=4.7 && <5
+    , bytestring
     , exceptions
     , network
     , network-wait
     , retry
     , tasty
     , tasty-hunit
+  default-language: Haskell2010
   if flag(postgres)
     build-depends:
         postgresql-simple
@@ -115,7 +119,6 @@ test-suite network-wait-test-postgres
     buildable: True
   else
     buildable: False
-  default-language: Haskell2010
 
 test-suite network-wait-test-redis
   type: exitcode-stdio-1.0
@@ -127,12 +130,14 @@ test-suite network-wait-test-redis
   ghc-options: -Wall
   build-depends:
       base >=4.7 && <5
+    , bytestring
     , exceptions
     , network
     , network-wait
     , retry
     , tasty
     , tasty-hunit
+  default-language: Haskell2010
   if flag(postgres)
     build-depends:
         postgresql-simple
@@ -143,4 +148,3 @@ test-suite network-wait-test-redis
     buildable: True
   else
     buildable: False
-  default-language: Haskell2010

package.yaml

@@ -1,10 +1,10 @@
 name: network-wait
-version: 0.2.0.0
+version: 0.3.0.0
 github: "mbg/network-wait"
 license: MIT
 author: "Michael B. Gale"
 maintainer: "[email protected]"
-copyright: "2022 Michael B. Gale"
+copyright: "2025 Michael B. Gale"
 
 extra-source-files:
   - README.md
@@ -20,6 +20,7 @@ description: |
 
 dependencies:
   - base >= 4.7 && < 5
+  - bytestring
   - exceptions
   - network
   - retry

src/Network/Wait/PostgreSQL.hs

@@ -12,6 +12,7 @@
 -- connection can be established, the functions in this module also check
 -- whether the PostgreSQL server is ready to accept commands.
 module Network.Wait.PostgreSQL (
+    PostgreSqlConnectInfo(..),
     waitPostgreSql,
     waitPostgreSqlVerbose,
     waitPostgreSqlVerboseFormat,
@@ -20,6 +21,8 @@ module Network.Wait.PostgreSQL (
 
 -------------------------------------------------------------------------------
 
+import Data.ByteString ( ByteString )
+
 import Control.Monad
 import Control.Monad.Catch
 import Control.Monad.IO.Class
@@ -32,20 +35,32 @@ import Network.Wait
 
 -------------------------------------------------------------------------------
 
+-- | Used to abstract over different ways to describe a database connection.
+class PostgreSqlConnectInfo a where
+    -- | `connectDb` @info@ attempts to establish a database connection using
+    -- a configuration given by @info@.
+    connectDb :: a -> IO Connection
+
+instance PostgreSqlConnectInfo ConnectInfo where
+    connectDb = connect
+
+instance PostgreSqlConnectInfo ByteString where
+    connectDb = connectPostgreSQL
+
 -- | `waitPostgreSql` @retryPolicy connectInfo@ is a variant of
 -- `waitPostgresWith` which does not install any additional handlers.
 waitPostgreSql
-    :: (MonadIO m, MonadMask m)
-    => RetryPolicyM m -> ConnectInfo -> m Connection
+    :: (MonadIO m, MonadMask m, PostgreSqlConnectInfo info)
+    => RetryPolicyM m -> info -> m Connection
 waitPostgreSql = waitPostgreSqlWith []
 
 -- | `waitPostgreSqlVerbose` @outputHandler retryPolicy connectInfo@ is a variant
 -- of `waitPostgreSqlVerboseFormat` which catches all exceptions derived from
 -- `SomeException` and formats retry attempt information using `defaultLogMsg`
 -- before passing the resulting `String` to @out@.
 waitPostgreSqlVerbose
-    :: (MonadIO m, MonadMask m)
-    => (String -> m ()) -> RetryPolicyM m -> ConnectInfo -> m Connection
+    :: (MonadIO m, MonadMask m, PostgreSqlConnectInfo info)
+    => (String -> m ()) -> RetryPolicyM m -> info -> m Connection
 waitPostgreSqlVerbose out =
     waitPostgreSqlVerboseFormat @SomeException $
     \b ex st -> out $ defaultLogMsg b ex st
@@ -55,10 +70,10 @@ waitPostgreSqlVerbose out =
 -- `logRetries` which passes status information for each retry attempt
 -- to @outputHandler@.
 waitPostgreSqlVerboseFormat
-    :: forall e m . (MonadIO m, MonadMask m, Exception e)
+    :: forall e m info. (MonadIO m, MonadMask m, PostgreSqlConnectInfo info, Exception e)
     => (Bool -> e -> RetryStatus -> m ())
     -> RetryPolicyM m
-    -> ConnectInfo
+    -> info
     -> m Connection
 waitPostgreSqlVerboseFormat out = waitPostgreSqlWith [h]
     where h = logRetries (const $ pure True) out
@@ -74,13 +89,13 @@ waitPostgreSqlVerboseFormat out = waitPostgreSqlWith [h]
 --  @extraHandlers@ may also be used to report retry attempts to e.g. the
 -- standard output or a logger.
 waitPostgreSqlWith
-    :: (MonadIO m, MonadMask m)
-    => [RetryStatus -> Handler m Bool] -> RetryPolicyM m -> ConnectInfo
+    :: (MonadIO m, MonadMask m, PostgreSqlConnectInfo info)
+    => [RetryStatus -> Handler m Bool] -> RetryPolicyM m -> info
     -> m Connection
 waitPostgreSqlWith hs policy info =
     recoveringWith hs policy $ \_ ->
     liftIO $
-    bracket (connect info) close $ \con -> do
+    bracket (connectDb info) close $ \con -> do
         rs <- query_ @[Int] con "SELECT 1;"
         unless (rs == [[1]]) $ throwM $
             fatalError "Unexpected result for SELECT 1."