network-wait 0.3.0.0 → 0.4.0.0
raw patch · 5 files changed
+72/−10 lines, 5 files
Files
- ChangeLog.md +5/−0
- README.md +1/−1
- network-wait.cabal +1/−1
- src/Network/Wait.hs +58/−8
- test/Spec.hs +7/−0
ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog for network-wait +## 0.4.0++- Fixed [an issue](https://github.com/mbg/network-wait/issues/19) where under some circumstances an attempt to connect to a socket could become stuck for a long time or possibly forever. A timeout is now applied to all connection attempts made by functions in the `Network.Wait` module to ensure that the checks terminate in a reasonable amount of time. Contributed by [@thomasjm](https://github.com/thomasjm) in [#20](https://github.com/mbg/network-wait/pull/20).+- Added a new `recoveringWithStatus` function which provides the `RetryStatus` to the action.+ ## 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.
README.md view
@@ -1,7 +1,7 @@ # network-wait -+[](https://github.com/mbg/network-wait/actions/workflows/build.yml) [](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.
network-wait.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: network-wait-version: 0.3.0.0+version: 0.4.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
src/Network/Wait.hs view
@@ -27,21 +27,45 @@ waitSocketWith, -- * Utility- recoveringWith+ recoveringWith,+ recoveringWithStatus ) where ------------------------------------------------------------------------------- +import Control.Exception (throwIO) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Retry -- Only needed for base < 4.11, redundant otherwise import Data.Semigroup+import System.IO.Error+import System.Timeout import Network.Socket ------------------------------------------------------------------------------- +-- | Each individual connect attempt needs a timeout to prevent it from hanging+-- indefinitely. This policy allows us to make that timeout length adaptive,+-- based on the 'RetryStatus' of the outer retry policy.+--+-- Thus, the first attempt to connect will have a short timeout (currently 100ms),+-- and then successive attempts will get longer timeouts via "FullJitter" backoff.+-- The goals of this are twofold:+--+-- 1) If a connect call hangs during the first few attempts, it is timed out quickly+-- and re-attempted, so on a healthy network you aren't penalized too much by the hang.+-- The outer retry policy can control the time between attempts, so the user can set+-- it high enough to make this be the case.+--+-- 2) If the network is slow, we will eventually reach the maximum timeout of 3 seconds,+-- which should be long enough. Note that the popular wait-for script uses 1 second+-- timeouts, so this is extra conservative:+-- https://github.com/eficode/wait-for/blob/7586b3622f010808bb2027c19aaf367221b4ad54/wait-for#L72+connectRetryPolicy :: MonadIO m => RetryPolicyM m+connectRetryPolicy = capDelay (3000000) (fullJitterBackoff 100000)+ -- | `waitTcp` @retryPolicy hostName serviceName@ is a variant of `waitTcpWith` -- which does not install any additional handlers. --@@ -141,13 +165,21 @@ => [RetryStatus -> Handler m Bool] -> RetryPolicyM m -> AddrInfo -> m Socket waitSocketWith hs policy addr =- recoveringWith hs policy $+ recoveringWithStatus hs policy $ \retryStatus -> -- all of the networking code runs in IO liftIO $ -- we want to make sure that we close the socket after every attempt; -- `bracket` will re-throw any error afterwards- bracket initSocket close $- \sock -> connect sock (addrAddress addr) >> pure sock+ bracket initSocket close $ \sock -> do+ maybeConnectTimeoutUs <- (getRetryPolicyM connectRetryPolicy) retryStatus+ connectTimeoutUs <- case maybeConnectTimeoutUs of+ Nothing -> throwIO $ userError "Timeout in connect attempt"+ Just us -> pure us++ maybeResult <- timeout connectTimeoutUs (connect sock (addrAddress addr))+ case maybeResult of+ Nothing -> throwIO $ userError "Timeout in connect attempt"+ Just () -> pure sock where initSocket = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)@@ -164,14 +196,32 @@ recoveringWith :: (MonadIO m, MonadMask m) => [RetryStatus -> Handler m Bool] -> RetryPolicyM m -> m a -> m a-recoveringWith hs policy action =+recoveringWith hs policy =+ recoveringWithStatus hs policy . const+++-- | `recoveringWithStatus` @extraHandlers retryPolicy action@ will attempt to+-- run @action@. If the @action@ fails, @retryPolicy@ is used+-- to determine whether (and how often) this function should attempt to+-- retry @action@. The `RetryStatus` is given to @action@ as argument.+-- By default, this function will retry after all+-- exceptions (except for those given by `skipAsyncExceptions`). This+-- behaviour may be customised with @extraHandlers@ which are installed+-- after `skipAsyncExceptions`, but before the default exception handler.+-- The @extraHandlers@ may also be used to report retry attempts to e.g.+-- the standard output or a logger.+recoveringWithStatus+ :: (MonadIO m, MonadMask m)+ => [RetryStatus -> Handler m Bool]+ -> RetryPolicyM m+ -> (RetryStatus -> m a)+ -> m a+recoveringWithStatus hs policy action = -- apply the retry policy to the following code, with the combinations of -- the `skipAsyncExceptions`, given, and default handlers. The order of -- the handlers matters as they are checked in order. recovering policy (skipAsyncExceptions <> hs <> [defHandler]) $- -- we want to make sure that we close the socket after every attempt;- -- `bracket` will re-throw any error afterwards- const action+ action where -- our default handler, which works with any exception derived from -- `SomeException`, and signals that we should retry if allowed by
test/Spec.hs view
@@ -57,6 +57,13 @@ case res of Left _ -> pure () Right _ -> assertFailure "`waitTcp` did not fail"+ , localOption (mkTimeout $ 10*1000*1000) $ testCase "Can't connect to non-routable private IP" $ do+ res <- try @IO @SomeException $+ waitTcp testRetryPolicy "10.255.255.1" "80"++ case res of+ Left _ -> pure ()+ Right _ -> assertFailure "`waitTcp` did not fail" , testCase "Can connect to service that does exist" $ withServer 0 $ do res <- try @IO @SomeException $