amazonka 1.1.0 → 1.2.0

raw patch · 7 files changed

+351/−280 lines, 7 filesdep ~amazonka-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: amazonka-core

API changes (from Hackage documentation)

Files

• amazonka.cabal +2/−2
• src/Control/Monad/Trans/AWS.hs +71/−99
• src/Network/AWS.hs +68/−20
• src/Network/AWS/Data.hs +2/−1
• src/Network/AWS/Env.hs +91/−57
• src/Network/AWS/Internal/HTTP.hs +104/−85
• src/Network/AWS/Presign.hs +13/−16

@@ -1,5 +1,5 @@ name:                  amazonka-version:               1.1.0+version:               1.2.0 synopsis:              Comprehensive Amazon Web Services SDK homepage:              https://github.com/brendanhay/amazonka license:               OtherLicense@@ -54,7 +54,7 @@         , Network.AWS.Internal.Logger      build-depends:-          amazonka-core       == 1.1.0.*+          amazonka-core       == 1.2.0.*         , base                >= 4.7     && < 5         , bytestring          >= 0.9         , conduit             >= 1.1

@@ -6,6 +6,7 @@ {-# LANGUAGE LambdaCase                 #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE UndecidableInstances       #-} @@ -59,20 +60,19 @@      , await -    -- ** Overriding Service Configuration+    -- ** Service Configuration     -- $service +    -- *** Overriding Defaults+    , configure+    , override+     -- *** Scoped Actions+    , reconfigure     , within     , once     , timeout -    -- *** Per Request-    , sendWith-    , paginateWith-    , awaitWith-    , presignWith-     -- ** Streaming     -- $streaming @@ -129,6 +129,10 @@     -- ** Constructing a Logger     , newLogger +    -- ** Endpoints+    , Endpoint+    , setEndpoint+     -- * Re-exported Types     , RqBody     , RsBody@@ -162,6 +166,7 @@ import           Network.AWS.Pager            (AWSPager (..)) import           Network.AWS.Prelude          as AWS import qualified Network.AWS.Presign          as Sign+import           Network.AWS.Request          (requestURL) import           Network.AWS.Types            hiding (LogLevel (..)) import           Network.AWS.Waiter           (Wait) @@ -181,8 +186,15 @@     throwM = lift . throwM  instance MonadCatch m => MonadCatch (AWST m) where-    catch (AWST m) f = AWST (m `catch` \e -> unAWST (f e))+    catch (AWST m) f = AWST (catch m (unAWST . f)) +instance MonadMask m => MonadMask (AWST m) where+    mask a = AWST $ mask $ \u ->+        unAWST $ a (AWST . u . unAWST)++    uninterruptibleMask a = AWST $ uninterruptibleMask $ \u ->+        unAWST $ a (AWST . u . unAWST)+ instance MonadBase b m => MonadBase b (AWST m) where     liftBase = liftBaseDefault @@ -237,137 +249,62 @@ -- | Send a request, returning the associated response if successful. -- -- Throws 'Error'.------ /See:/ 'sendWith' send :: (AWSConstraint r m, AWSRequest a)      => a      -> m (Rs a)-send = sendWith id---- | A variant of 'send' that allows modifying the default 'Service' definition--- used to configure the request.------ Throws 'Error'.-sendWith :: (AWSConstraint r m, AWSSigner (Sg s), AWSRequest a)-         => (Service (Sv a) -> Service s) -- ^ Modify the default service configuration.-         -> a                             -- ^ Request.-         -> m (Rs a)-sendWith f x = do-    e <- view environment-    r <- retrier e s rq (perform e s rq) >>= hoistError-    return (snd r)-  where-    rq = request x-    s  = f (serviceOf x)+send = retrier >=> fmap snd . hoistError  -- | Repeatedly send a request, automatically setting markers and -- paginating over multiple responses while available. -- -- Throws 'Error'.------ /See:/ 'paginateWith' paginate :: (AWSConstraint r m, AWSPager a)          => a          -> Source m (Rs a)-paginate = paginateWith id---- | A variant of 'paginate' that allows modifying the default 'Service' definition--- used to configure the request.------ Throws 'Error'.-paginateWith :: (AWSConstraint r m, AWSSigner (Sg s), AWSPager a)-             => (Service (Sv a) -> Service s) -- ^ Modify the default service configuration.-             -> a                             -- ^ Initial request.-             -> Source m (Rs a)-paginateWith f = go+paginate = go   where     go !x = do-        !y <- sendWith f x+        !y <- send x         yield y-        maybe (pure ())-              go-              (page x y)+        maybe (pure ()) go (page x y)  -- | Poll the API with the supplied request until a specific 'Wait' condition -- is fulfilled. -- -- Throws 'Error'.------ /See:/ 'awaitWith' await :: (AWSConstraint r m, AWSRequest a)       => Wait a       -> a       -> m ()-await = awaitWith id---- | A variant of 'await' that allows modifying the default 'Service' definition--- used to configure the request.------ Throws 'Error'.-awaitWith :: (AWSConstraint r m, AWSSigner (Sg s), AWSRequest a)-          => (Service (Sv a) -> Service s) -- ^ Modify the default service configuration.-          -> Wait a                        -- ^ Polling, error and acceptance criteria.-          -> a                             -- ^ Request to poll with.-          -> m ()-awaitWith f w x = do-    e <- view environment-    waiter e w rq (perform e s rq) >>= hoistError . maybe (Right ()) Left-  where-    rq = request x-    s  = f (serviceOf x)+await w = waiter w >=> hoistError . maybe (Right ()) Left  -- | Presign an URL that is valid from the specified time until the -- number of seconds expiry has elapsed.------ /See:/ 'presign', 'presignWith' presignURL :: ( MonadIO m               , MonadReader r m               , HasEnv r-              , AWSPresigner (Sg (Sv a))               , AWSRequest a               )            => UTCTime     -- ^ Signing time.            -> Seconds     -- ^ Expiry time.            -> a           -- ^ Request to presign.            -> m ByteString-presignURL ts ex x = do-    a <- view envAuth-    r <- view envRegion-    Sign.presignURL a r ts ex x+presignURL ts ex = liftM requestURL . presign ts ex  -- | Presign an HTTP request that is valid from the specified time until the -- number of seconds expiry has elapsed.------ /See:/ 'presignWith' presign :: ( MonadIO m            , MonadReader r m            , HasEnv r-           , AWSPresigner (Sg (Sv a))            , AWSRequest a            )         => UTCTime     -- ^ Signing time.         -> Seconds     -- ^ Expiry time.         -> a           -- ^ Request to presign.         -> m ClientRequest-presign = presignWith id---- | A variant of 'presign' that allows specifying the 'Service' definition--- used to configure the request.-presignWith :: ( MonadIO m-               , MonadReader r m-               , HasEnv r-               , AWSPresigner (Sg s)-               , AWSRequest a-               )-            => (Service (Sv a) -> Service s) -- ^ Function to modify the service configuration.-            -> UTCTime                       -- ^ Signing time.-            -> Seconds                       -- ^ Expiry time.-            -> a                             -- ^ Request to presign.-            -> m ClientRequest-presignWith f ts ex x = do-    a <- view envAuth-    g <- view envRegion-    Sign.presignWith f a g ts ex x+presign ts ex x = do+    Env{..} <- view environment+    Sign.presignWith (applyOverride _envOverride) _envAuth _envRegion ts ex x  -- | Test whether the underlying host is running on EC2. -- This is memoised and any external check occurs for the first invocation only.@@ -426,8 +363,7 @@ or 'paginate' and the library will take care of serialisation/authentication and so forth. -The default 'Service' configuration for a request (or the supplied 'Service' configuration-when using the @*With@ variants) contains retry configuration that is used to+The default 'Service' configuration for a request contains retry configuration that is used to determine if a request can safely be retried and what kind of back off/on strategy should be used. (Usually exponential.) Typically services define retry strategies that handle throttling, general server@@ -464,13 +400,49 @@ -}  {- $service-When a request is sent, various configuration values such as the endpoint,+When a request is sent, various values such as the endpoint, retry strategy, timeout and error handlers are taken from the associated 'Service'-configuration.+for a request. For example, 'DynamoDB' will use the 'Network.AWS.DynamoDB.dynamoDB'+configuration when sending 'PutItem', 'Query' and all other operations. -You can override the default configuration for a series of one or more actions-by using 'within', 'once' and 'timeout', or by using the @*With@ suffixed-functions on an individual request basis below.+You can modify a specific 'Service''s default configuration by using+'configure' or 'reconfigure'. To modify all configurations simultaneously, see 'override'.++An example of how you might alter default configuration using these mechanisms+is demonstrated below. Firstly, the default 'dynamoDB' service is configured to+use non-SSL localhost as the endpoint:++> let dynamo :: Service+>     dynamo = setEndpoint False "localhost" 8000 dynamoDB++The updated configuration is then passed to the 'Env' during setup:++> e <- newEnv Frankfurt Discover <&> configure dynamo+> runAWS e $ do+>     -- This S3 operation will communicate with remote AWS APIs.+>     x <- send listBuckets+>+>     -- DynamoDB operations will communicate with localhost:8000.+>     y <- send listTables+>+>     -- Any operations for services other than DynamoDB, are not affected.+>     ...++You can also scope the 'Endpoint' modifications (or any other 'Service' configuration)+to specific actions:++> e <- newEnv Ireland Discover+> runAWS e $ do+>     -- Service operations here will communicate with AWS, even DynamoDB.+>     x <- send listTables+>+>     reconfigure dynamo $ do+>        -- In here, DynamoDB operations will communicate with localhost:8000,+>        -- with operations for services not being affected.+>        ...++Functions such as 'within', 'once', and 'timeout' likewise modify the underlying+configuration for all service requests within their respective scope. -}  {- $streaming

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes        #-}  {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} @@ -57,10 +58,15 @@      , await -    -- ** Overriding Service Configuration+    -- ** Service Configuration     -- $service +    -- *** Overriding Defaults+    , Env.configure+    , Env.override+     -- *** Scoped Actions+    , reconfigure     , within     , once     , timeout@@ -120,6 +126,10 @@     -- ** Constructing a Logger     , newLogger +    -- ** Endpoints+    , Endpoint+    , AWST.setEndpoint+     -- * Re-exported Types     , RqBody     , RsBody@@ -133,6 +143,7 @@  import           Control.Applicative import           Control.Monad.Catch          (MonadCatch)+import           Control.Monad.IO.Class       (MonadIO) import           Control.Monad.Morph          (hoist) import qualified Control.Monad.RWS.Lazy       as LRW import qualified Control.Monad.RWS.Strict     as RW@@ -141,7 +152,6 @@ import           Control.Monad.Trans.AWS      (AWST) import qualified Control.Monad.Trans.AWS      as AWST import           Control.Monad.Trans.Class    (lift)-import           Control.Monad.Trans.Cont     (ContT) import           Control.Monad.Trans.Except   (ExceptT) import           Control.Monad.Trans.Identity (IdentityT) import           Control.Monad.Trans.List     (ListT)@@ -155,6 +165,7 @@ import           Network.AWS.Auth import qualified Network.AWS.EC2.Metadata     as EC2 import           Network.AWS.Env              (Env, HasEnv (..), newEnv)+import qualified Network.AWS.Env              as Env import           Network.AWS.Internal.Body import           Network.AWS.Internal.Logger import           Network.AWS.Pager            (AWSPager)@@ -168,7 +179,8 @@ type AWS = AWST (ResourceT IO)  -- | Monads in which 'AWS' actions may be embedded.-class (Functor m, Applicative m, Monad m) => MonadAWS m where+class (Functor m, Applicative m, Monad m, MonadIO m, MonadCatch m) => MonadAWS m+  where     -- | Lift a computation to the 'AWS' monad.     liftAWS :: AWS a -> m a @@ -179,7 +191,6 @@ instance MonadAWS m => MonadAWS (ListT       m) where liftAWS = lift . liftAWS instance MonadAWS m => MonadAWS (MaybeT      m) where liftAWS = lift . liftAWS instance MonadAWS m => MonadAWS (ExceptT   e m) where liftAWS = lift . liftAWS-instance MonadAWS m => MonadAWS (ContT     r m) where liftAWS = lift . liftAWS instance MonadAWS m => MonadAWS (ReaderT   r m) where liftAWS = lift . liftAWS instance MonadAWS m => MonadAWS (S.StateT  s m) where liftAWS = lift . liftAWS instance MonadAWS m => MonadAWS (LS.StateT s m) where liftAWS = lift . liftAWS@@ -206,6 +217,16 @@ runAWS :: (MonadResource m, HasEnv r) => r -> AWS a -> m a runAWS e = liftResourceT . AWST.runAWST e +-- | Scope an action such that all requests belonging to the supplied service+-- will use this configuration instead of the default.+--+-- It's suggested you use a modified version of the default service, such+-- as @Network.AWS.DynamoDB.dynamoDB@.+--+-- /See:/ 'Env.configure'.+reconfigure :: MonadAWS m => Service -> AWS a -> m a+reconfigure s = liftAWS . AWST.reconfigure s+ -- | Scope an action within the specific 'Region'. within :: MonadAWS m => Region -> AWS a -> m a within r = liftAWS . AWST.within r@@ -220,30 +241,22 @@ timeout s = liftAWS . AWST.timeout s  -- | Send a request, returning the associated response if successful.------ /See:/ 'AWST.sendWith' send :: (MonadAWS m, AWSRequest a) => a -> m (Rs a) send = liftAWS . AWST.send  -- | Repeatedly send a request, automatically setting markers and -- paginating over multiple responses while available.------ /See:/ 'AWST.paginateWith' paginate :: (MonadAWS m, AWSPager a) => a -> Source m (Rs a) paginate = hoist liftAWS . AWST.paginate  -- | Poll the API with the supplied request until a specific 'Wait' condition -- is fulfilled.------ /See:/ 'AWST.awaitWith' await :: (MonadAWS m, AWSRequest a) => Wait a -> a -> m () await w = liftAWS . AWST.await w  -- | Presign an URL that is valid from the specified time until the -- number of seconds expiry has elapsed.------ /See:/ 'AWST.presign', 'AWST.presignWith'-presignURL :: (MonadAWS m, AWSPresigner (Sg (Sv a)), AWSRequest a)+presignURL :: (MonadAWS m, AWSRequest a)            => UTCTime     -- ^ Signing time.            -> Seconds     -- ^ Expiry time.            -> a           -- ^ Request to presign.@@ -329,8 +342,7 @@ or 'paginate' and the library will take care of serialisation/authentication and so forth. -The default 'Service' configuration for a request (or the supplied 'Service' configuration-when using the @*With@ variants) contains retry configuration that is used to+The default 'Service' configuration for a request contains retry configuration that is used to determine if a request can safely be retried and what kind of back off/on strategy should be used. (Usually exponential.) Typically services define retry strategies that handle throttling, general server@@ -367,13 +379,49 @@ -}  {- $service-When a request is sent, various configuration values such as the endpoint,+When a request is sent, various values such as the endpoint, retry strategy, timeout and error handlers are taken from the associated 'Service'-configuration.+for a request. For example, 'DynamoDB' will use the 'Network.AWS.DynamoDB.dynamoDB'+configuration when sending 'PutItem', 'Query' and all other operations. -You can override the default configuration for a series of one or more actions-by using 'within', 'once' and 'timeout', or by using the @*With@ suffixed-functions on an individual request basis below.+You can modify a specific 'Service''s default configuration by using+'configure' or 'reconfigure'. To modify all configurations simultaneously, see 'override'.++An example of how you might alter default configuration using these mechanisms+is demonstrated below. Firstly, the default 'dynamoDB' service is configured to+use non-SSL localhost as the endpoint:++> let dynamo :: Service+>     dynamo = setEndpoint False "localhost" 8000 dynamoDB++The updated configuration is then passed to the 'Env' during setup:++> e <- newEnv Frankfurt Discover <&> configure dynamo+> runAWS e $ do+>     -- This S3 operation will communicate with remote AWS APIs.+>     x <- send listBuckets+>+>     -- DynamoDB operations will communicate with localhost:8000.+>     y <- send listTables+>+>     -- Any operations for services other than DynamoDB, are not affected.+>     ...++You can also scope the 'Endpoint' modifications (or any other 'Service' configuration)+to specific actions:++> e <- newEnv Ireland Discover+> runAWS e $ do+>     -- Service operations here will communicate with AWS, even DynamoDB.+>     x <- send listTables+>+>     reconfigure dynamo $ do+>        -- In here, DynamoDB operations will communicate with localhost:8000,+>        -- with operations for services not being affected.+>        ...++Functions such as 'within', 'once', and 'timeout' likewise modify the underlying+configuration for all service requests within their respective scope. -}  {- $streaming

@@ -18,7 +18,8 @@     -- * Text       FromText     (..)     , fromText-    , matchCI+    , fromTextError+    , takeLowerText     , ToText       (..)      -- * ByteString

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes        #-} {-# LANGUAGE RecordWildCards   #-}@@ -18,10 +19,16 @@       newEnv     , newEnvWith -    , Env    (..)-    , HasEnv (..)+    , Env      (..)+    , HasEnv   (..) +    -- * Overriding Default Configuration+    , Override (..)+    , override+    , configure+     -- * Scoped Actions+    , reconfigure     , within     , once     , timeout@@ -34,6 +41,7 @@ import           Control.Monad.IO.Class import           Control.Monad.Reader import           Control.Retry+import           Data.Function               (on) import           Data.IORef import           Data.Monoid import           Network.AWS.Auth@@ -45,67 +53,50 @@  -- | The environment containing the parameters required to make AWS requests. data Env = Env-    { _envRegion      :: !Region-    , _envLogger      :: !Logger-    , _envRetryCheck  :: !(Int -> HttpException -> IO Bool)-    , _envRetryPolicy :: !(Maybe RetryPolicy)-    , _envTimeout     :: !(Maybe Seconds)-    , _envManager     :: !Manager-    , _envEC2         :: !(IORef (Maybe Bool))-    , _envAuth        :: !Auth+    { _envRegion     :: !Region+    , _envLogger     :: !Logger+    , _envRetryCheck :: !(Int -> HttpException -> Bool)+    , _envOverride   :: !Override+    , _envManager    :: !Manager+    , _envEC2        :: !(IORef (Maybe Bool))+    , _envAuth       :: !Auth     }  -- Note: The strictness annotations aobe are applied to ensure -- total field initialisation.  class HasEnv a where-    environment    :: Lens' a Env+    environment   :: Lens' a Env     {-# MINIMAL environment #-}      -- | The current region.-    envRegion      :: Lens' a Region+    envRegion     :: Lens' a Region      -- | The function used to output log messages.-    envLogger      :: Lens' a Logger+    envLogger     :: Lens' a Logger      -- | The function used to determine if an 'HttpException' should be retried.-    envRetryCheck  :: Lens' a (Int -> HttpException -> IO Bool)--    -- | The 'RetryPolicy' used to determine backoff\/on and retry delay\/growth.-    envRetryPolicy :: Lens' a (Maybe RetryPolicy)+    envRetryCheck :: Lens' a (Int -> HttpException -> Bool) -    -- | A HTTP response timeout override to apply. This defaults to 'Nothing',-    -- and the timeout selection is outlined below.-    ---    -- Timeouts are chosen by considering:-    ---    -- * This 'envTimeout', if set.-    ---    -- * The related 'Service' timeout for the sent request if set. (Usually 70s)-    ---    -- * The 'envManager' timeout if set.-    ---    -- * The default 'ClientRequest' timeout. (Approximately 30s)-    ---    envTimeout     :: Lens' a (Maybe Seconds)+    -- | The currently applied overrides to all 'Service' configuration.+    envOverride   :: Lens' a Override      -- | The 'Manager' used to create and manage open HTTP connections.-    envManager     :: Lens' a Manager+    envManager    :: Lens' a Manager      -- | The credentials used to sign requests for authentication with AWS.-    envAuth        :: Lens' a Auth+    envAuth       :: Lens' a Auth      -- | A memoised predicate for whether the underlying host is an EC2 instance.-    envEC2         :: Getter a (IORef (Maybe Bool))+    envEC2        :: Getter a (IORef (Maybe Bool)) -    envRegion      = environment . lens _envRegion      (\s a -> s { _envRegion      = a })-    envLogger      = environment . lens _envLogger      (\s a -> s { _envLogger      = a })-    envRetryCheck  = environment . lens _envRetryCheck  (\s a -> s { _envRetryCheck  = a })-    envRetryPolicy = environment . lens _envRetryPolicy (\s a -> s { _envRetryPolicy = a })-    envTimeout     = environment . lens _envTimeout     (\s a -> s { _envTimeout     = a })-    envManager     = environment . lens _envManager     (\s a -> s { _envManager     = a })-    envAuth        = environment . lens _envAuth        (\s a -> s { _envAuth        = a })-    envEC2         = environment . to _envEC2+    envRegion     = environment . lens _envRegion     (\s a -> s { _envRegion     = a })+    envLogger     = environment . lens _envLogger     (\s a -> s { _envLogger     = a })+    envRetryCheck = environment . lens _envRetryCheck (\s a -> s { _envRetryCheck = a })+    envOverride   = environment . lens _envOverride   (\s a -> s { _envOverride   = a })+    envManager    = environment . lens _envManager    (\s a -> s { _envManager    = a })+    envAuth       = environment . lens _envAuth       (\s a -> s { _envAuth       = a })+    envEC2        = environment . to _envEC2  instance HasEnv Env where     environment = id@@ -115,12 +106,49 @@       where         b = buildLines             [ "[Amazonka Env] {"-            , "  region      = " <> build _envRegion-            , "  retry (n=0) = " <> build (join $ ($ 0) . getRetryPolicy <$> _envRetryPolicy)-            , "  timeout     = " <> build _envTimeout+            , "  region = " <> build _envRegion             , "}"             ] +-- | An override function to apply to service configuration before use.+newtype Override = Override { applyOverride :: Service -> Service }++instance Monoid Override where+    mempty      = Override id+    mappend a b = Override (applyOverride b . applyOverride a)++-- | Provide a function which will be added to the existing stack+-- of overrides applied to all service configuration.+--+-- To override a specific service, it's suggested you use+-- either 'configure' or 'reconfigure' with a modified version of the default+-- service, such as @Network.AWS.DynamoDB.dynamoDB@.+override :: HasEnv a => (Service -> Service) -> a -> a+override f = envOverride <>~ Override f++-- | Configure a specific service. All requests belonging to the+-- supplied service will use this configuration instead of the default.+--+-- It's suggested you use a modified version of the default service, such+-- as @Network.AWS.DynamoDB.dynamoDB@.+--+-- /See:/ 'reconfigure'.+configure :: HasEnv a => Service -> a -> a+configure s = override f+  where+    f x | on (==) _svcAbbrev s x = s+        | otherwise              = x++-- | Scope an action such that all requests belonging to the supplied service+-- will use this configuration instead of the default.+--+-- It's suggested you use a modified version of the default service, such+-- as @Network.AWS.DynamoDB.dynamoDB@.+--+-- /See:/ 'configure'.+reconfigure :: (MonadReader r m, HasEnv r) => Service -> m a -> m a+reconfigure = local . configure+ -- | Scope an action within the specific 'Region'. within :: (MonadReader r m, HasEnv r) => Region -> m a -> m a within r = local (envRegion .~ r)@@ -128,13 +156,21 @@ -- | Scope an action such that any retry logic for the 'Service' is -- ignored and any requests will at most be sent once. once :: (MonadReader r m, HasEnv r) => m a -> m a-once = local $ \e -> e-    & envRetryPolicy ?~ limitRetries 0-    & envRetryCheck  .~ (\_ _ -> return False)+once = local (override (serviceRetry . retryAttempts .~ 0))  -- | Scope an action such that any HTTP response will use this timeout value.+--+-- Default timeouts are chosen by considering:+--+-- * This 'timeout', if set.+--+-- * The related 'Service' timeout for the sent request if set. (Usually 70s)+--+-- * The 'envManager' timeout if set.+--+-- * The default 'ClientRequest' timeout. (Approximately 30s) timeout :: (MonadReader r m, HasEnv r) => Seconds -> m a -> m a-timeout s = local (envTimeout ?~ s)+timeout s = local (override (serviceTimeout ?~ s))  -- | Creates a new environment with a new 'Manager' without debug logging -- and uses 'getAuth' to expand/discover the supplied 'Credentials'.@@ -154,15 +190,13 @@ -- -- Throws 'AuthError' when environment variables or IAM profiles cannot be read. newEnvWith :: (Applicative m, MonadIO m, MonadCatch m)-           => Region      -- ^ Initial region to operate in.-           -> Credentials -- ^ Credential discovery mechanism.-           -> Maybe Bool  -- ^ Preload memoisation for the underlying EC2 instance check.+           => Region               -- ^ Initial region to operate in.+           -> Credentials          -- ^ Credential discovery mechanism.+           -> Maybe Bool           -- ^ Dictate if the instance is running on EC2. (Preload memoisation.)            -> Manager            -> m Env-newEnvWith r c p m = Env r logger check Nothing Nothing m-    <$> liftIO (newIORef p)-    <*> getAuth m c+newEnvWith r c p m =+    Env r logger check mempty m <$> liftIO (newIORef p) <*> getAuth m c   where     logger _ _ = return ()-    -- FIXME: verify the usage of check.-    check  _ _ = return True+    check  _ _ = True

@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE ViewPatterns      #-}  -- | -- Module      : Network.AWS.Internal.HTTP@@ -14,126 +15,94 @@ -- Portability : non-portable (GHC extensions) -- module Network.AWS.Internal.HTTP-    ( perform-    , retrier+    ( retrier     , waiter     ) where +import           Control.Arrow                (first) import           Control.Monad import           Control.Monad.Catch-import           Control.Monad.IO.Class+import           Control.Monad.Reader import           Control.Monad.Trans.Resource import           Control.Retry import           Data.List                    (intersperse) import           Data.Monoid+import           Data.Proxy import           Data.Time import           Network.AWS.Env import           Network.AWS.Internal.Logger import           Network.AWS.Prelude import           Network.AWS.Waiter-import           Network.HTTP.Conduit         hiding (Request, Response)+import           Network.HTTP.Conduit         hiding (Proxy, Request, Response)  import           Prelude -perform :: (MonadCatch m, MonadResource m, AWSSigner (Sg s), AWSRequest a)-        => Env-        -> Service s-        -> Request a+retrier :: ( MonadCatch m+           , MonadResource m+           , MonadReader r m+           , HasEnv r+           , AWSRequest a+           )+        => a         -> m (Either Error (Response a))-perform e@Env{..} svc x = catches go handlers+retrier x = do+    e  <- view environment+    rq <- configured x+    retrying (policy rq) (check e rq) (perform e rq)   where-    go = do-        t          <- liftIO getCurrentTime-        Signed m s <- withAuth _envAuth $ \a ->-            return (signed a _envRegion t svc x)--        let rq = s { responseTimeout = timeoutFor e svc }--        logTrace _envLogger m  -- trace:Signing:Meta-        logDebug _envLogger rq -- debug:ClientRequest--        rs         <- liftResourceT (http rq _envManager)--        logDebug _envLogger rs -- debug:ClientResponse--        Right <$>-            response _envLogger svc x rs--    handlers =-        [ Handler $ return . Left-        , Handler $ \er -> do-            logError _envLogger er-            return (Left (TransportError er))-        ]+    policy rq = retryStream rq <> retryService (_rqService rq) -retrier :: MonadIO m-        => Env-        -> Service s-        -> Request a-        -> m (Either Error (Response a))-        -> m (Either Error (Response a))-retrier Env{..} Service{..} rq =-    retrying (fromMaybe policy _envRetryPolicy) check-  where-    policy = limitRetries _retryAttempts-       <> RetryPolicy (const $ listToMaybe [0 | not stream])-       <> RetryPolicy delay+    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       where-        !stream = bodyStream (_rqBody rq)--        delay n-            | n > 0     = Just $ truncate (grow * 1000000)-            | otherwise = Nothing-          where-            grow = _retryBase * (fromIntegral _retryGrowth ^^ (n - 1))--    check n = \case-        Left (TransportError e) -> do-            p <- liftIO (_envRetryCheck n e)-            when p (msg "http_error" n) >> return p+        transportErr = _TransportError . to (_envRetryCheck e n)+        serviceErr   = _ServiceError . to rc . _Just -        Left e | Just x <- e ^? _ServiceError . to _retryCheck . _Just ->-            msg x n >> return True+        rc = rq ^. rqService . serviceRetry . retryCheck -        _ -> return False+    check _ _ _ _                          = return False -    msg x n = logDebug _envLogger+    msg :: MonadIO m => Env -> Text -> Int -> m ()+    msg e m n = logDebug (_envLogger e)         . mconcat         . intersperse " "-        $ [ "[Retry " <> build x <> "]"+        $ [ "[Retry " <> build m <> "]"           , "after"           , build (n + 1)           , "attempts."           ] -    Exponential{..} = _svcRetry--waiter :: MonadIO m-       => Env-       -> Wait a-       -> Request a-       -> m (Either Error (Response a))+waiter :: ( MonadCatch m+          , MonadResource m+          , MonadReader r m+          , HasEnv r+          , AWSRequest a+          )+       => Wait a+       -> a        -> m (Maybe Error)-waiter Env{..} w@Wait{..} rq f = retrying policy check wait >>= exit+waiter w@Wait{..} x = do+   e@Env{..} <- view environment+   rq        <- configured x+   retrying policy (check _envLogger) (result rq <$> perform e rq) >>= exit   where     policy = limitRetries _waitAttempts           <> constantDelay (microseconds _waitDelay) -    wait = do-        e <- f-        return (fromMaybe AcceptRetry (accept w rq e), e)--    exit (AcceptSuccess, _)      = return Nothing-    exit (_,             Left e) = return (Just e)-    exit (_,             _)      = return Nothing+    check e n (a, _) = msg e n a >> return (retry a)+      where+        retry AcceptSuccess = False+        retry AcceptFailure = False+        retry AcceptRetry   = True -    check n (a, _) = msg n a >> return (retry a)+    result rq = first (fromMaybe AcceptRetry . accept w rq) . join (,) -    retry AcceptSuccess = False-    retry AcceptFailure = False-    retry AcceptRetry   = True+    exit (AcceptSuccess, _) = return Nothing+    exit (_,        Left e) = return (Just e)+    exit (_,             _) = return Nothing -    msg n a = logDebug _envLogger+    msg l n a = logDebug l         . mconcat         . intersperse " "         $ [ "[Await " <> build _waitName <> "]"@@ -143,7 +112,57 @@           , "attempts."           ] --- | Returns the possible HTTP response timeout value in microseconds--- given the timeout configuration sources.-timeoutFor :: HasEnv a => a -> Service s -> Maybe Int-timeoutFor e s = microseconds <$> (e ^. envTimeout <|> _svcTimeout s)+-- | The 'Service' is configured + unwrapped at this point.+perform :: (MonadCatch m, MonadResource m, AWSRequest a)+        => Env+        -> Request a+        -> m (Either Error (Response a))+perform Env{..} x = catches go handlers+  where+    go = do+        t           <- liftIO getCurrentTime+        Signed m rq <-+            withAuth _envAuth $ \a ->+                return $! rqSign x a _envRegion t++        logTrace _envLogger m  -- trace:Signing:Meta+        logDebug _envLogger rq -- debug:ClientRequest++        rs          <- liftResourceT (http rq _envManager)++        logDebug _envLogger rs -- debug:ClientResponse++        Right <$> response _envLogger (_rqService x) (p x) rs++    handlers =+        [ Handler $ err+        , Handler $ err . TransportError+        ]+      where+        err e = logError _envLogger e >> return (Left e)++    p :: Request a -> Proxy a+    p = const Proxy++configured :: (MonadReader r m, HasEnv r, AWSRequest a)+           => a+           -> m (Request a)+configured (request -> x) = do+    o <- view envOverride+    return $! x & rqService %~ applyOverride o++retryStream :: Request a -> RetryPolicy+retryStream x = RetryPolicy (const $ listToMaybe [0 | not p])+  where+    !p = bodyStream (_rqBody x)++retryService :: Service -> RetryPolicy+retryService s = limitRetries _retryAttempts <> RetryPolicy delay+  where+    delay n+        | n > 0     = Just $ truncate (grow * 1000000)+        | otherwise = Nothing+      where+        grow = _retryBase * (fromIntegral _retryGrowth ^^ (n - 1))++    Exponential{..} = _svcRetry s

@@ -29,7 +29,7 @@ -- number of seconds expiry has elapsed. -- -- /See:/ 'presign', 'presignWith'-presignURL :: (MonadIO m, AWSPresigner (Sg (Sv a)), AWSRequest a)+presignURL :: (MonadIO m, AWSRequest a)            => Auth            -> Region            -> UTCTime     -- ^ Signing time.@@ -41,30 +41,27 @@ -- | Presign an HTTP request that is valid from the specified time until the -- number of seconds expiry has elapsed. ----- This requires the 'Service' signer to be an instance of 'AWSPresigner'.--- Not all signing algorithms support this.--- -- /See:/ 'presignWith'-presign :: (MonadIO m, AWSPresigner (Sg (Sv a)), AWSRequest a)+presign :: (MonadIO m, AWSRequest a)         => Auth         -> Region         -> UTCTime     -- ^ Signing time.         -> Seconds     -- ^ Expiry time.         -> a           -- ^ Request to presign.         -> m ClientRequest-presign a r ts ex = presignWith id a r ts ex+presign = presignWith id --- | A variant of 'presign' that allows specifying the 'Service' definition--- used to configure the request.-presignWith :: (MonadIO m, AWSPresigner (Sg s), AWSRequest a)-            => (Service (Sv a) -> Service s) -- ^ Modify the default service configuration.+-- | A variant of 'presign' that allows modifying the default 'Service'+-- definition used to configure the request.+presignWith :: (MonadIO m, AWSRequest a)+            => (Service -> Service) -- ^ Modify the default service configuration.             -> Auth             -> Region-            -> UTCTime                       -- ^ Signing time.-            -> Seconds                       -- ^ Expiry time.-            -> a                             -- ^ Request to presign.+            -> UTCTime              -- ^ Signing time.+            -> Seconds              -- ^ Expiry time.+            -> a                    -- ^ Request to presign.             -> m ClientRequest-presignWith s a r ts ex x =+presignWith f a r ts ex x =     withAuth a $ \ae ->-        return . view sgRequest $-            presigned ae r ts ex (s (serviceOf x)) (request x)+        return $! sgRequest $+            rqPresign ex (request x & rqService %~ f) ae r ts