Merge pull request #21 from mbg/psql/connection-string

PostgreSql: Support connecting with connection strings

Author: mbg

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

@@ -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:     github@michael-gale.co.uk
-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: "github@michael-gale.co.uk"
-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."