diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,41 @@ # Change Log +## [1.3.6](https://github.com/brendanhay/amazonka/tree/1.3.6) +Released: **18 November, 2015**, Compare: [1.3.6](https://github.com/brendanhay/amazonka/compare/1.3.5.1...1.3.6) + +### Fixed + +- Upgrading `retry` dependency to `>= 0.7`. +- Fix S3 `BucketLocationConstraint` type de/serialisation. [\#249](https://github.com/brendanhay/amazonka/issues/249) +- Fix S3 `PutBucketACL` header vs request body serialisation. [\#241](https://github.com/brendanhay/amazonka/issues/241) + +### Updated + +- `await` responses now indicate request fulfillment. [\#245](https://github.com/brendanhay/amazonka/issues/245) + +### Updated Services Definitions + +- EC2: Documentation updates. +- IAM: Documentation updates. +- ELB: Documentation updates. +- Kinesis: Waiter updates. +- RDS: Documentation and type updates. +- SQS: Documentation updates. +- STS: Documentation updates. +- S3: Minor type and operation updates (`UploadPart` headers). +- DeviceFarm: Documentation updates. +- API Gateway: Multiple type, operation, and documentation updates. + + +## [1.3.5.1](https://github.com/brendanhay/amazonka/tree/1.3.5.1) +Released: **18 November, 2015**, Compare: [1.3.5.1](https://github.com/brendanhay/amazonka/compare/1.3.5...1.3.5.1) + +### Fixed + +- Fixed ambigiuty issue when using `lens >= 4.13` +- Constraining `retry < 0.7` to avoid breaking changes. + + ## [1.3.5](https://github.com/brendanhay/amazonka/tree/1.3.5) Released: **27 October, 2015**, Compare: [1.3.5](https://github.com/brendanhay/amazonka/compare/1.3.4...1.3.5) diff --git a/amazonka.cabal b/amazonka.cabal --- a/amazonka.cabal +++ b/amazonka.cabal @@ -1,5 +1,5 @@ name: amazonka -version: 1.3.5.1 +version: 1.3.6 synopsis: Comprehensive Amazon Web Services SDK. homepage: https://github.com/brendanhay/amazonka bug-reports: https://github.com/brendanhay/amazonka/issues @@ -55,7 +55,7 @@ , Network.AWS.Internal.Logger build-depends: - amazonka-core == 1.3.5.* + amazonka-core == 1.3.6.* , base >= 4.7 && < 5 , bytestring >= 0.9 , conduit >= 1.1 @@ -69,7 +69,7 @@ , monad-control >= 1 , mtl >= 2.1.3.1 , resourcet >= 1.1 - , retry >= 0.5 && < 0.7 + , retry >= 0.7 , text >= 1.1 , time >= 1.2 , transformers >= 0.2 diff --git a/src/Control/Monad/Trans/AWS.hs b/src/Control/Monad/Trans/AWS.hs --- a/src/Control/Monad/Trans/AWS.hs +++ b/src/Control/Monad/Trans/AWS.hs @@ -177,7 +177,7 @@ import qualified Network.AWS.Presign as Sign import Network.AWS.Request (requestURL) import Network.AWS.Types hiding (LogLevel (..)) -import Network.AWS.Waiter (Wait) +import Network.AWS.Waiter (Accept, Wait) type AWST = AWST' Env @@ -288,8 +288,8 @@ await :: (AWSConstraint r m, AWSRequest a) => Wait a -> a - -> m () -await w = waiter w >=> hoistError . maybe (Right ()) Left + -> m Accept +await w = waiter w >=> hoistError -- | Presign an URL that is valid from the specified time until the -- number of seconds expiry has elapsed. diff --git a/src/Network/AWS.hs b/src/Network/AWS.hs --- a/src/Network/AWS.hs +++ b/src/Network/AWS.hs @@ -260,7 +260,7 @@ -- | Poll the API with the supplied request until a specific 'Wait' condition -- is fulfilled. -await :: (MonadAWS m, AWSRequest a) => Wait a -> a -> m () +await :: (MonadAWS m, AWSRequest a) => Wait a -> a -> m AWST.Accept await w = liftAWS . AWST.await w -- | Presign an URL that is valid from the specified time until the diff --git a/src/Network/AWS/Env.hs b/src/Network/AWS/Env.hs --- a/src/Network/AWS/Env.hs +++ b/src/Network/AWS/Env.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -31,6 +32,9 @@ , within , once , timeout + + -- * Retry HTTP Exceptions + , retryConnectionFailure ) where import Control.Applicative @@ -168,6 +172,12 @@ -- and uses 'getAuth' to expand/discover the supplied 'Credentials'. -- Lenses from 'HasEnv' can be used to further configure the resulting 'Env'. -- +-- /Since:/ @1.3.6@ - The default logic for retrying 'HttpException's now uses +-- 'retryConnectionFailure' to retry specific connection failure conditions up to 3 times. +-- Previously only service specific errors were automatically retried. +-- This can be reverted to the old behaviour by resetting the 'Env' using +-- 'envRetryCheck' lens to @(\\_ _ -> False)@. +-- -- Throws 'AuthError' when environment variables or IAM profiles cannot be read. -- -- /See:/ 'newEnvWith'. @@ -188,7 +198,17 @@ -> Manager -> m Env newEnvWith r c p m = - Env r logger check mempty m <$> liftIO (newIORef p) <*> getAuth m c - where - logger _ _ = return () - check _ _ = True + Env r (\_ _ -> pure ()) (retryConnectionFailure 3) mempty m + <$> liftIO (newIORef p) + <*> getAuth m c + +-- | Retry the subset of transport specific errors encompassing connection +-- failure up to the specific number of times. +retryConnectionFailure :: Int -> Int -> HttpException -> Bool +retryConnectionFailure limit n = \case + _ | n >= limit -> False + NoResponseDataReceived -> True + FailedConnectionException {} -> True + FailedConnectionException2 {} -> True + TlsException {} -> True + _ -> False diff --git a/src/Network/AWS/Internal/HTTP.hs b/src/Network/AWS/Internal/HTTP.hs --- a/src/Network/AWS/Internal/HTTP.hs +++ b/src/Network/AWS/Internal/HTTP.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -49,28 +50,28 @@ retrier x = do e <- view environment rq <- configured x - retrying (policy rq) (check e rq) (perform e rq) + retrying (policy rq) (check e rq) (\_ -> perform e rq) where policy rq = retryStream rq <> retryService (_rqService rq) - check e rq n (Left r) - | Just p <- r ^? transportErr, p = msg e "http_error" n >> return True - | Just m <- r ^? serviceErr = msg e m n >> return True + check e rq s (Left r) + | Just p <- r ^? transportErr, p = msg e "http_error" s >> return True + | Just m <- r ^? serviceErr = msg e m s >> return True where - transportErr = _TransportError . to (_envRetryCheck e n) + transportErr = _TransportError . to (_envRetryCheck e (rsIterNumber s)) serviceErr = _ServiceError . to rc . _Just rc = rq ^. rqService . serviceRetry . retryCheck check _ _ _ _ = return False - msg :: MonadIO m => Env -> Text -> Int -> m () - msg e m n = logDebug (_envLogger e) + msg :: MonadIO m => Env -> Text -> RetryStatus -> m () + msg e m s = logDebug (_envLogger e) . mconcat . intersperse " " $ [ "[Retry " <> build m <> "]" , "after" - , build (n + 1) + , build (rsIterNumber s + 1) , "attempts." ] @@ -82,11 +83,11 @@ ) => Wait a -> a - -> m (Maybe Error) + -> m (Either Error Accept) waiter w@Wait{..} x = do e@Env{..} <- view environment rq <- configured x - retrying policy (check _envLogger) (result rq <$> perform e rq) >>= exit + retrying policy (check _envLogger) (\_ -> result rq <$> perform e rq) >>= exit where policy = limitRetries _waitAttempts <> constantDelay (microseconds _waitDelay) @@ -99,17 +100,17 @@ result rq = first (fromMaybe AcceptRetry . accept w rq) . join (,) - exit (AcceptSuccess, _) = return Nothing - exit (_, Left e) = return (Just e) - exit (_, _) = return Nothing + exit (AcceptSuccess, _) = return (Right AcceptSuccess) + exit (_, Left e) = return (Left e) + exit (a, _) = return (Right a) - msg l n a = logDebug l + msg l s a = logDebug l . mconcat . intersperse " " $ [ "[Await " <> build _waitName <> "]" , build a , "after" - , build (n + 1) + , build (rsIterNumber s + 1) , "attempts." ] @@ -153,15 +154,15 @@ return $! x & rqService %~ appEndo (getDual o) retryStream :: Request a -> RetryPolicy -retryStream x = RetryPolicy (const $ listToMaybe [0 | not p]) +retryStream x = RetryPolicyM (\_ -> return (listToMaybe [0 | not p])) where !p = isStreaming (_rqBody x) retryService :: Service -> RetryPolicy -retryService s = limitRetries _retryAttempts <> RetryPolicy delay +retryService s = limitRetries _retryAttempts <> RetryPolicyM (return . delay) where - delay n - | n >= 0 = Just $ truncate (grow * 1000000) + delay (rsIterNumber -> n) + | n >= 0 = Just $ truncate (grow * 1000000) | otherwise = Nothing where grow = _retryBase * (fromIntegral _retryGrowth ^^ (n - 1))