network-wait 0.1.1.0 → 0.1.2.0

raw patch · 5 files changed

+27/−4 lines, 5 files

Files

• ChangeLog.md +4/−0
• network-wait.cabal +1/−1
• src/Network/Wait.hs +3/−0
• test-postgres/Spec.hs +9/−1
• test/Spec.hs +10/−2

@@ -1,5 +1,9 @@ # Changelog for network-wait +## 0.1.2++- Compatibility with GHC 8.2 and Stack LTS 11+ ## 0.1.1  - Add `Network.Wait.PostgreSQL` module with functions to wait for PostgreSQL servers to become ready to accept connections. This module and its dependency on `postgresql-simple` are not enabled by default. The `network-wait:postgres` flag must be enabled for this package's PostgreSQL support.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           network-wait-version:        0.1.1.0+version:        0.1.2.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> category:       Network

@@ -3,6 +3,7 @@ -- Copyright 2022 Michael B. Gale (github@michael-gale.co.uk) ------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-unused-imports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -34,6 +35,8 @@ import Control.Monad.Catch import Control.Monad.IO.Class import Control.Retry+-- Only needed for base < 4.11, redundant otherwise+import Data.Semigroup  import Network.Socket 

@@ -3,10 +3,13 @@ -- Copyright 2022 Michael B. Gale (github@michael-gale.co.uk) ------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-unused-imports #-} {-# LANGUAGE TypeApplications #-}  import Control.Monad.Catch import Control.Retry+-- Only needed for base < 4.11, redundant otherwise+import Data.Semigroup  import Database.PostgreSQL.Simple @@ -17,11 +20,16 @@  ------------------------------------------------------------------------------- +-- | Essentially the same as `retryPolicyDefault`, but here for compatibility+-- with older versions of `retry`.+testRetryPolicy :: Monad m => RetryPolicyM m+testRetryPolicy = constantDelay 50000 <> limitRetries 5+ tests :: TestTree tests = testGroup "Network.Wait.PostgreSQL"     [ testCase "Can't connect to server that doesn't exist" $ do         res <- try @IO @SomeException $-            waitPostgreSql retryPolicyDefault defaultConnectInfo{+            waitPostgreSql testRetryPolicy defaultConnectInfo{                 connectHost = "doesnotexist"             } 

@@ -3,11 +3,14 @@ -- Copyright 2022 Michael B. Gale (github@michael-gale.co.uk) ------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-unused-imports #-} {-# LANGUAGE TypeApplications #-}  import Control.Concurrent import Control.Monad.Catch import Control.Retry+-- Only needed for base < 4.11, redundant otherwise+import Data.Semigroup  import Test.Tasty import Test.Tasty.HUnit@@ -17,6 +20,11 @@  ------------------------------------------------------------------------------- +-- | Essentially the same as `retryPolicyDefault`, but here for compatibility+-- with older versions of `retry`.+testRetryPolicy :: Monad m => RetryPolicyM m+testRetryPolicy = constantDelay 50000 <> limitRetries 5+ -- | `withServer` @delay action@ runs @action@ while asynchronously setting up -- a TCP server on @localhost:5999@ with a @delay@ microseconds delay. The TCP -- server will accept exactly one connection before shutting down.@@ -44,7 +52,7 @@ tests = testGroup "network-wait"     [ testCase "Can't connect to service that doesn't exist" $ do         res <- try @IO @SomeException $-            waitTcp retryPolicyDefault "localhost" "5999"+            waitTcp testRetryPolicy "localhost" "5999"          case res of             Left _ -> pure ()@@ -52,7 +60,7 @@     , testCase "Can connect to service that does exist" $         withServer 0 $ do             res <- try @IO @SomeException $-                waitTcp retryPolicyDefault "localhost" "5999"+                waitTcp testRetryPolicy "localhost" "5999"              case res of                 Left ex -> assertFailure $