diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,6 +6,8 @@ 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. +[**Full Haddock documentation for all modules**](https://mbg.github.io/network-wait/) + ## Example All functions provided by this library work with retry policies from [`Control.Retry`](https://hackage.haskell.org/package/retry) which provide good control over the retry behaviour. To wait for a PostgreSQL server to become available on the same machine: @@ -38,6 +40,23 @@ ``` 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. diff --git a/network-wait.cabal b/network-wait.cabal --- a/network-wait.cabal +++ b/network-wait.cabal @@ -1,19 +1,21 @@ 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 +description: Please see the README on GitHub at and + Haddock documentation for all modules, including those that are gated behind + package flags, at category: Network 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 @@ -45,9 +47,11 @@ ghc-options: -Wall build-depends: base >=4.7 && <5 + , bytestring , exceptions , network , retry + default-language: Haskell2010 if flag(postgres) build-depends: postgresql-simple @@ -60,7 +64,6 @@ if flag(redis) exposed-modules: Network.Wait.Redis - default-language: Haskell2010 test-suite network-wait-test type: exitcode-stdio-1.0 @@ -72,6 +75,7 @@ ghc-options: -Wall build-depends: base >=4.7 && <5 + , bytestring , exceptions , network , network-simple @@ -79,13 +83,13 @@ , 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 @@ -97,12 +101,14 @@ 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 @@ -113,7 +119,6 @@ buildable: True else buildable: False - default-language: Haskell2010 test-suite network-wait-test-redis type: exitcode-stdio-1.0 @@ -125,12 +130,14 @@ 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 @@ -141,4 +148,3 @@ buildable: True else buildable: False - default-language: Haskell2010 diff --git a/src/Network/Wait/PostgreSQL.hs b/src/Network/Wait/PostgreSQL.hs --- a/src/Network/Wait/PostgreSQL.hs +++ b/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 @@ ------------------------------------------------------------------------------- +import Data.ByteString ( ByteString ) + import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class @@ -32,11 +35,23 @@ ------------------------------------------------------------------------------- +-- | 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 @@ -44,8 +59,8 @@ -- `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 @@ -- `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 @@ -- @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."