glue-core 0.4.4 → 0.4.5

raw patch · 4 files changed

+57/−9 lines, 4 filesdep ~glue-commonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: glue-common

API changes (from Hackage documentation)

Files

• glue-core.cabal +3/−2
• src/Glue/Retry.hs +10/−3
• test/Glue/RetrySpec.hs +19/−4
• test/Glue/SwitchingSpec.hs +25/−0

@@ -1,5 +1,5 @@ name:                   glue-core-version:                0.4.4+version:                0.4.5 synopsis:               Make better services and clients. description:            Combinator library to enhance the general functionality of services and clients. license:                BSD3@@ -26,7 +26,7 @@                         Glue.Switching   -- other-extensions:   build-depends:        base >=4.6 && <4.9,-                        glue-common == 0.4.4,+                        glue-common == 0.4.5,                         transformers,                         transformers-base,                         lifted-base,@@ -66,6 +66,7 @@                         Glue.CircuitBreakerSpec                         Glue.BatcherSpec                         Glue.PreloadSpec+                        Glue.SwitchingSpec                         Spec   ghc-options:          -rtsopts                         -Wall

@@ -35,15 +35,22 @@   , retryWaitTimeMultiplier = 0   } +possibleAsyncException :: SomeException -> Maybe SomeAsyncException+possibleAsyncException = fromException+ -- | Retries a call to a service multiple times, potentially backing off wait times between subsequent calls.+-- | Asynchronous exceptions don't result in a retry, they are immediately rethrown. retryingService :: (MonadBaseControl IO m)                 => RetryOptions a             -- ^ Instance of 'RetryOptions' to configure the retry functionality.                 -> BasicService m a b         -- ^ The service to perform retries of.                 -> BasicService m a b retryingService options service =-  let attempt retryCount request  = if (retryAllowed options) request && maxRetries > retryCount-                                      then catch (service request) (\(_ :: SomeException) -> (wait (retryCount + 1)) >> (attempt (retryCount + 1) request))-                                      else service request+  let catchHandler rc r e         = case possibleAsyncException e of+                                                                    Just ae -> throw ae+                                                                    Nothing -> wait (rc + 1) >> attempt (rc + 1) r+      attempt retryCount request  = if (retryAllowed options) request && maxRetries > retryCount+                                    then catch (service request) (catchHandler retryCount request)+                                    else service request       maxRetries                  = maximumRetries options       wait retryCount             = threadDelay $ round $ fromIntegral (retryInitialWaitTimeMs options) * ((retryWaitTimeMultiplier options) ^ retryCount)   in  attempt 0

@@ -2,21 +2,22 @@  module Glue.RetrySpec where +import Control.Concurrent import Data.IORef import Data.Typeable import Glue.Retry import Test.Hspec import Test.QuickCheck-import Control.Exception.Base hiding (throw, throwIO)-import Control.Exception.Lifted+import Control.Exception.Base hiding (throw, throwIO, throwTo)+import Control.Exception.Lifted hiding (throwTo) import Control.Monad.IO.Class  newtype SmallInt = SmallInt Int deriving (Eq, Show)  instance Arbitrary SmallInt where   arbitrary = sized $ \s -> do-                                 n <- choose (0, s `min` 10)-                                 return $ SmallInt n+                              n <- choose (0, s `min` 10)+                              return $ SmallInt n  data RetryTestException = RetryTestException deriving (Eq, Show, Typeable) instance Exception RetryTestException@@ -36,3 +37,17 @@           let successCase   = (retryService request) `shouldReturn` (request :: Int)           let failureCase   = (retryService request) `shouldThrow` (== RetryTestException)           if retries >= failures then successCase else failureCase+    it "Asynchronous exceptions are rethrown" $ do+      property $ \(request, retries) -> +        do+          ref <- liftIO $ newIORef 0+          let service req   = do+                                atomicModifyIORef' ref (\c -> (c + 1, ()))+                                threadId <- myThreadId+                                forkIO (threadDelay 10000 >> throwTo threadId UserInterrupt)+                                threadDelay 1000000+                                return (req * 2 :: Int)+          let options       = defaultRetryOptions { maximumRetries = retries }+          let retryService  = retryingService options service+          (retryService request) `shouldThrow` (== UserInterrupt)+          (readIORef ref) `shouldReturn` 1

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, ScopedTypeVariables #-}++module Glue.SwitchingSpec where++import Glue.Switching+import Glue.Types+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances()++spec :: Spec+spec = do+  describe "switchingService" $ do+    it "Requests should be handled by the service used" $ do+      property $ \(firstResult :: MultiGetResponse Int Int, secondResult :: MultiGetResponse Int Int, request :: MultiGetRequest Int) -> do+        let first _ = return firstResult+        let second _ = return secondResult+        (switchedService, serviceUpdate) <- switchingService first+        actualFirstResult <- switchedService request+        expectedFirstResult <- first request+        serviceUpdate second+        actualSecondResult <- switchedService request+        expectedSecondResult <- second request+        actualFirstResult `shouldBe` expectedFirstResult+        actualSecondResult `shouldBe` expectedSecondResult