amazonka 0.3.6 → 1.0.0

raw patch · 18 files changed

+2118/−1104 lines, 18 filesdep +amazonkadep +directorydep +freedep −cryptohashdep −cryptohash-conduitdep ~amazonka-coredep ~basedep ~conduit-extraPVP ok

version bump matches the API change (PVP)

Dependencies added: amazonka, directory, free, http-client, ini, tasty, tasty-hunit

Dependencies removed: cryptohash, cryptohash-conduit

Dependency ranges changed: amazonka-core, base, conduit-extra, mmorph, monad-control, retry, transformers-base

API changes (from Hackage documentation)

Files

• README.md +3/−2
• amazonka.cabal +55/−17
• src/Control/Monad/Trans/AWS.hs +353/−363
• src/Network/AWS.hs +417/−181
• src/Network/AWS/Auth.hs +446/−0
• src/Network/AWS/Data.hs +32/−0
• src/Network/AWS/EC2/Metadata.hs +112/−110
• src/Network/AWS/Env.hs +168/−0
• src/Network/AWS/Free.hs +196/−0
• src/Network/AWS/Internal/Auth.hs +0/−194
• src/Network/AWS/Internal/Body.hs +43/−20
• src/Network/AWS/Internal/Env.hs +0/−80
• src/Network/AWS/Internal/HTTP.hs +143/−0
• src/Network/AWS/Internal/Log.hs +0/−46
• src/Network/AWS/Internal/Logger.hs +59/−0
• src/Network/AWS/Internal/Retry.hs +0/−91
• src/Network/AWS/Presign.hs +75/−0
• test/Main.hs +16/−0

@@ -6,8 +6,9 @@  ## Description -Client library containing request and response primitives to be used alongside-the types from all `amazonka-*` libraries.+Client library containing request and response logic to communicate+with Amazon Web Service compatible APIs. Intended to be used alongside+the types supplied by the various `amazonka-*` service libraries.   ## Contribute

@@ -1,5 +1,5 @@ name:                  amazonka-version:               0.3.6+version:               1.0.0 synopsis:              Comprehensive Amazon Web Services SDK homepage:              https://github.com/brendanhay/amazonka license:               OtherLicense@@ -13,11 +13,28 @@ cabal-version:         >= 1.10  description:-    Client library containing request and response primitives to be used-    alongside the types from all amazonka related service libraries.+    This client library contains request and response logic to communicate+    with Amazon Web Service compatible APIs using the types supplied by the+    various @amazonka-*@ service libraries. See the <http://hackage.haskell.org/packages/#cat:AWS AWS>+    category on Hackage for supported services.     .-    /Warning:/ This is an experimental preview release which is still under-    heavy development and not intended for public consumption, caveat emptor!+    To get started, import the desired @amazonka-*@ library (such as+    <http://hackage.haskell.org/package/amazonka-ml/docs/Network-AWS-MachineLearning.html Network.AWS.MachineLearning>)+    and one of the following:+    .+    * "Control.Monad.Trans.AWS": The 'Control.Monad.Trans.AWS.AWST' transformer+    and generalised operations.+    .+    * "Network.AWS": The 'Network.AWS.AWS' monad and 'Network.AWS.MonadAWS' type+    class for automatically lifting operations when embedded as a layer in a transformer stack.+    This is built upon "Control.Monad.Trans.AWS".+    .+    Both 'Control.Monad.Trans.AWS.AWST' (and 'Network.AWS.AWS') and the provided+    functions are built upon the 'Control.Monad.Trans.Free' DSL defined in+    "Network.AWS.Free". This allows writing a custom interpreter (say, for+    mocking purposes) and defining your own AWS logic if desired.+    .+    GHC 7.8.4 and higher is officially supported.  source-repository head     type:     git@@ -32,33 +49,54 @@     exposed-modules:           Control.Monad.Trans.AWS         , Network.AWS+        , Network.AWS.Auth+        , Network.AWS.Data         , Network.AWS.EC2.Metadata+        , Network.AWS.Env+        , Network.AWS.Free+        , Network.AWS.Presign      other-modules:-          Network.AWS.Internal.Auth-        , Network.AWS.Internal.Body-        , Network.AWS.Internal.Env-        , Network.AWS.Internal.Log-        , Network.AWS.Internal.Retry+          Network.AWS.Internal.Body+        , Network.AWS.Internal.HTTP+        , Network.AWS.Internal.Logger      build-depends:-          amazonka-core       == 0.3.6.*+          amazonka-core       == 1.0.0.*         , base                >= 4.7     && < 5         , bytestring          >= 0.9         , conduit             >= 1.1-        , conduit-extra       == 1.1.*-        , cryptohash          == 0.11.*-        , cryptohash-conduit  >= 0.1.1+        , conduit-extra       >= 1.1+        , directory           >= 1.2         , exceptions          >= 0.6+        , free                >= 4.5+        , http-client         >= 0.4.9         , http-conduit        >= 2.1.4+        , ini                 >= 0.2         , lens                >= 4.4-        , mmorph              >= 1       && < 2-        , monad-control       >= 1       && < 2+        , mmorph              >= 1+        , monad-control       >= 1         , mtl                 >= 2.1.3.1         , resourcet           >= 1.1         , retry               >= 0.5         , text                >= 1.1         , time                >= 1.2         , transformers        >= 0.2-        , transformers-base   >= 0.4.2+        , transformers-base   >= 0.4         , transformers-compat >= 0.3++test-suite tests+    type:              exitcode-stdio-1.0+    default-language:  Haskell2010+    hs-source-dirs:    test+    main-is:           Main.hs++    ghc-options:       -Wall -threaded++    other-modules:++    build-depends:+          amazonka+        , base+        , tasty+        , tasty-hunit

@@ -1,446 +1,436 @@-{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE BangPatterns               #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeFamilies               #-}---- This is required due to the MonadBaseControl instance. {-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE ViewPatterns               #-} +{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}++-- | -- Module      : Control.Monad.Trans.AWS--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0. -- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental+-- Stability   : provisional -- Portability : non-portable (GHC extensions)---- | A monad transformer built on top of functions from "Network.AWS" which--- encapsulates various common parameters, errors, and usage patterns.+--+-- The 'AWST' transformer provides the environment required to perform AWS+-- operations and constructs a 'Command' AST using 'FreeT' which can then be+-- interpreted using 'runAWST'. The transformer is intended to be used directly+-- or embedded as a layer within a transformer stack.+--+-- "Network.AWS" contains a 'IO' specialised version of 'AWST' with a typeclass+-- to assist in automatically lifting operations. module Control.Monad.Trans.AWS     (-    -- * Requests-    -- ** Synchronous-      send-    , send_-    , sendCatch-    -- ** Paginated+    -- * Running AWS Actions+      AWST+    , runAWST+    , execAWST++    -- * Authentication and Environment+    , newEnv+    , Env+    , HasEnv       (..)++    -- ** Credential Discovery+    , Credentials  (..)+    -- $discovery++    -- ** Supported Regions+    , Region       (..)++    -- * Sending Requests+    -- $sending++    , send++    -- ** Pagination+    -- $pagination+     , paginate-    , paginateCatch-    -- ** Eventual consistency-    , await-    , awaitCatch-    -- ** Pre-signing URLs-    , presign-    , presignURL -    -- * Transformer-    , AWS-    , AWST-    , MonadAWS+    -- ** Waiters+    -- $waiters -    -- * Running-    , runAWST+    , await -    -- * Regionalisation-    , Region      (..)-    , within+    -- ** Overriding Service Configuration+    -- $service -    -- * Retries+    -- *** Scoped Actions+    , within     , once--    -- * Environment-    , Env-    -- ** Lenses-    , envRegion-    , envLogger-    , envRetryCheck-    , envRetryPolicy-    , envManager-    , envAuth-    -- ** Creating the environment-    , AWS.newEnv-    , AWS.getEnv-    -- ** Specifying credentials-    , Credentials (..)-    , fromKeys-    , fromSession-    , getAuth-    , accessKey-    , secretKey+    , timeout -    -- * Logging-    , newLogger-    , info-    , debug-    , trace+    -- *** Per Request+    , sendWith+    , paginateWith+    , awaitWith+    , presignWith -    -- * Errors-    , Error-    , hoistEither-    , throwAWSError-    , verify-    , verifyWith+    -- ** Streaming+    -- $streaming -    -- ** Streaming body helpers+    -- *** Request Bodies+    , ToBody       (..)     , sourceBody     , sourceHandle     , sourceFile     , sourceFileIO -    -- * Types-    , ToBuilder   (..)+    -- *** Response Bodies+    , sinkBody++    -- *** File Size and MD5/SHA256+    , getFileSize+    , sinkMD5+    , sinkSHA256++    -- * Presigning Requests+    -- $presigning++    , presignURL+    , presign++    -- * EC2 Instance Metadata+    -- $metadata++    , isEC2+    , dynamic+    , metadata+    , userdata++    , EC2.Dynamic  (..)+    , EC2.Metadata (..)++    -- * Running Asynchronous Actions+    -- $async++    -- * Handling Errors+    -- $errors++    , AsError      (..)+    , AsAuthError  (..)++    , trying+    , catching++    -- * Logging+    -- $logging++    , Logger+    , LogLevel     (..)++    -- ** Constructing a Logger+    , newLogger++    -- * Re-exported Types+    , RqBody+    , RsBody     , module Network.AWS.Types-    , module Network.AWS.Error+    , module Network.AWS.Waiter+    , module Network.AWS.Pager++    -- * runResourceT+    , runResourceT     ) where  import           Control.Applicative-import           Control.Arrow                (first)-import           Control.Lens+import           Control.Exception.Lens import           Control.Monad.Base import           Control.Monad.Catch-import           Control.Monad.Error          (MonadError, throwError)+import           Control.Monad.Error.Class       (MonadError (..)) import           Control.Monad.Morph import           Control.Monad.Reader+import           Control.Monad.State.Class import           Control.Monad.Trans.Control-import           Control.Monad.Trans.Except+import           Control.Monad.Trans.Free+import qualified Control.Monad.Trans.Free.Church as Free import           Control.Monad.Trans.Resource-import           Control.Retry                (limitRetries)-import           Data.ByteString              (ByteString)-import           Data.Conduit                 hiding (await)-import           Data.Time                    (UTCTime)-import qualified Network.AWS                  as AWS-import           Network.AWS.Data             (ToBuilder (..))-import           Network.AWS.Error-import           Network.AWS.Internal.Auth+import           Control.Monad.Writer.Class+import           Data.IORef+import           Network.AWS.Auth+import qualified Network.AWS.EC2.Metadata        as EC2+import           Network.AWS.Env+import           Network.AWS.Free import           Network.AWS.Internal.Body-import           Network.AWS.Internal.Env-import           Network.AWS.Internal.Log     hiding (debug, info, trace)-import qualified Network.AWS.Internal.Log     as Log-import           Network.AWS.Types-import           Network.AWS.Waiters-import qualified Network.HTTP.Conduit         as Client---- | The top-level error type.-type Error = ServiceError String---- | A convenient alias for 'AWST' 'IO'.-type AWS = AWST IO---- | Provides an alias for shortening type signatures if preferred.------ /Note:/ requires the @ConstraintKinds@ extension.-type MonadAWS m =-    ( MonadBaseControl IO m-    , MonadCatch m-    , MonadResource m-    , MonadError Error m-    , MonadReader Env m-    )+import           Network.AWS.Internal.HTTP+import           Network.AWS.Internal.Logger+import           Network.AWS.Pager               (AWSPager)+import           Network.AWS.Prelude             as AWS+import qualified Network.AWS.Presign             as Sign+import           Network.AWS.Types               hiding (LogLevel (..))+import           Network.AWS.Waiter              (Wait) --- | The transformer. This satisfies all of the constraints that the functions--- in this module require, such as providing 'MonadResource' instances,--- and keeping track of the 'Env' environment.------ The 'MonadError' instance for this transformer internally uses 'ExceptT'--- to handle actions that result in an 'Error'. For more information see--- 'sendCatch' and 'paginateCatch'.-newtype AWST m a = AWST-    { unAWST :: ReaderT (Env, InternalState) (ExceptT Error m) a-    } deriving+-- | The 'AWST' transformer.+newtype AWST m a = AWST { unAWST :: FreeT Command (ReaderT Env m) a }+    deriving         ( Functor         , Applicative         , Alternative         , Monad-        , MonadIO         , MonadPlus-        , MonadThrow-        , MonadCatch-        , MonadError Error+        , MonadIO+        , MonadFree Command+        , MonadReader Env         ) -instance Monad m => MonadReader Env (AWST m) where-    ask = AWST (fst `liftM` ask)-    {-# INLINE ask #-}--    local f = AWST . local (first f) . unAWST-    {-# INLINE local #-}+instance MonadThrow m => MonadThrow (AWST m) where+    throwM = lift . throwM -instance MonadTrans AWST where-    lift = AWST . lift . lift-    {-# INLINE lift #-}+instance MonadCatch m => MonadCatch (AWST m) where+    catch (AWST m) f = AWST (m `catch` \e -> unAWST (f e))  instance MonadBase b m => MonadBase b (AWST m) where     liftBase = liftBaseDefault-    {-# INLINE liftBase #-} -instance MonadTransControl AWST where-    type StT AWST a =-        StT (ExceptT Error) (StT (ReaderT (Env, InternalState)) a)+instance MFunctor AWST where+    hoist nat = AWST . hoistFreeT (hoist nat) . unAWST -    liftWith f = AWST $-        liftWith $ \g ->-            liftWith $ \h ->-                f (h . g . unAWST)-    {-# INLINE liftWith #-}+instance MonadBaseControl b m => MonadBaseControl b (AWST m) where+    type StM (AWST m) a =+         StM m (FreeF Command a (FreeT Command (ReaderT Env m) a)) -    restoreT = AWST . restoreT . restoreT-    {-# INLINE restoreT #-}+    liftBaseWith f = AWST . FreeT . liftM Pure $+        liftBaseWith $ \runInBase ->+            f $ \k ->+                runInBase (runFreeT (unAWST k)) -instance MonadBaseControl b m => MonadBaseControl b (AWST m) where-    type StM (AWST m) a = ComposeSt AWST m a+    restoreM = AWST . FreeT . restoreM -    liftBaseWith = defaultLiftBaseWith-    {-# INLINE liftBaseWith #-}+instance MonadTrans AWST where+    lift = AWST . lift . lift -    restoreM = defaultRestoreM-    {-# INLINE restoreM #-}+instance MonadResource m => MonadResource (AWST m) where+    liftResourceT = lift . liftResourceT -instance MFunctor AWST where-    hoist nat m = AWST (ReaderT (ExceptT . nat . runAWST' m))-    {-# INLINE hoist #-}+instance MonadError e m => MonadError e (AWST m) where+    throwError     = lift . throwError+    catchError m f = AWST (unAWST m `catchError` (unAWST . f)) -instance MMonad AWST where-    embed f m = liftM2 (,) ask resources-            >>= f . runAWST' m-            >>= either throwError return-    {-# INLINE embed #-}+instance MonadState s m => MonadState s (AWST m) where+    get = lift get+    put = lift . put -instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m)-    => MonadResource (AWST m) where-        liftResourceT f = resources >>= liftIO . runInternalState f-        {-# INLINE liftResourceT #-}+instance MonadWriter w m => MonadWriter w (AWST m) where+    writer = lift . writer+    tell   = lift . tell+    listen = AWST . listen . unAWST+    pass   = AWST . pass   . unAWST --- | Unwrap an 'AWST' transformer, calling all of the registered 'ResourceT'--- release actions.-runAWST :: MonadBaseControl IO m => Env -> AWST m a -> m (Either Error a)-runAWST e m = runResourceT . withInternalState $ runAWST' f . (e,)+-- | Run an 'AWST' action with the specified 'HasEnv' environment.+-- Any outstanding HTTP responses' 'ResumableSource' will+-- be closed when the 'ResourceT' computation is unwrapped with 'runResourceT'.+--+-- Throws 'Error' during interpretation of the underlying 'FreeT' 'Command' AST.+--+-- /See:/ 'runResourceT'.+runAWST :: (MonadCatch m, MonadResource m, HasEnv r) => r -> AWST m a -> m a+runAWST = execAWST hoistError++-- | Run an 'AWST' action with configurable 'Error' handling.+--+-- Does not explictly throw 'Error's and instead uses the supplied lift function.+execAWST :: (MonadCatch m, MonadResource m, HasEnv r)+         => (forall a. Either Error a -> m a)+            -- ^ Lift an 'Error' into the base Monad.+         -> r+         -> AWST m b+         -> m b+execAWST f = innerAWST go   where-    f = liftBase (_envLogger e Debug (build e)) >> m+    go (CheckF k) = do+        io <- view envEC2+        mp <- liftIO (readIORef io)+        case mp of+            Just p  -> k p+            Nothing -> do+                m  <- view envManager+                !r <- lift . f =<< tryT (EC2.isEC2 m)+                liftIO (atomicWriteIORef io (Just r))+                k r -runAWST' :: AWST m a -> (Env, InternalState) -> m (Either Error a)-runAWST' (AWST k) = runExceptT . runReaderT k+    go (DynF x k) = do+        m <- view envManager+        r <- lift . f =<< tryT (EC2.dynamic m x)+        k r -resources :: Monad m => AWST m InternalState-resources = AWST (ReaderT (return . snd))+    go (MetaF x k) = do+        m <- view envManager+        r <- lift . f =<< tryT (EC2.metadata m x)+        k r --- | Hoist an 'Either' throwing the 'Left' case, and returning the 'Right'.-hoistEither :: (MonadError Error m, AWSError e) => Either e a -> m a-hoistEither = either throwAWSError return+    go (UserF k) = do+        m <- view envManager+        r <- lift . f =<< tryT (EC2.userdata m)+        k r --- | Throw any 'AWSError' using 'throwError'.-throwAWSError :: (MonadError Error m, AWSError e) => e -> m a-throwAWSError = throwError . awsError+    go (SignF s ts ex x k) = do+        a <- view envAuth+        g <- view envRegion+        r <- Sign.presignWith (const s) a g ts ex x+        k r --- | Verify that an 'AWSError' matches the given 'Prism', otherwise throw the--- error using 'throwAWSError'.-verify :: (AWSError e, MonadError Error m)-       => Prism' e a-       -> e-       -> m ()-verify p e-    | isn't p e = throwAWSError e-    | otherwise = return ()+    go (SendF s (request -> x) k) = do+        e <- view environment+        r <- lift . f =<< retrier e s x (perform e s x)+        k (snd r) --- | Verify that an 'AWSError' matches the given 'Prism', with an additional--- guard on the result of the 'Prism'.------ /See:/ 'verify'-verifyWith :: (AWSError e, MonadError Error m)-           => Prism' e a-           -> (a -> Bool)-           -> e-           -> m ()-verifyWith p f e = either (const err) g (matching p e)-  where-    g x | f x       = return ()-        | otherwise = err+    go (AwaitF s w (request -> x) k) = do+        e <- view environment+        r <- lift . f =<< waiter e w x (perform e s x)+        k (snd r) -    err = throwAWSError e+    tryT m = either (Left . TransportError) Right <$> try m --- | Pass the current environment to a function.-scoped :: MonadReader Env m => (Env -> m a) -> m a-scoped f = ask >>= f+innerAWST :: (Monad m, HasEnv r)+          => (Command (ReaderT Env m a) -> ReaderT Env m a)+          -> r+          -> AWST m a+          -> m a+innerAWST f e (AWST m) =+    runReaderT (f `Free.iterT` Free.toFT m) (e ^. environment) --- | Use the supplied logger from 'envLogger' to log info messages.------ /Note:/ By default, the library does not output 'Info' level messages.--- Exclusive output is guaranteed via use of this function.-info :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m ()-info x = view envLogger >>= (`Log.info` x)+hoistError :: MonadThrow m => Either Error a -> m a+hoistError = either (throwingM _Error) return --- | Use the supplied logger from 'envLogger' to log debug messages.-debug :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m ()-debug x = view envLogger >>= (`Log.debug` x)+{- $discovery+AuthN/AuthZ information is handled similarly to other AWS SDKs. You can read+some of the options available <http://blogs.aws.amazon.com/security/post/Tx3D6U6WSFGOK2H/A-New-and-Standardized-Way-to-Manage-Credentials-in-the-AWS-SDKs here>. --- | Use the supplied logger from 'envLogger' to log trace messages.-trace :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m ()-trace x = view envLogger >>= (`Log.trace` x)+When running on an EC2 instance and using 'FromProfile' or 'Discover', a thread+is forked which transparently handles the expiry and subsequent refresh of IAM+profile information. See 'Network.AWS.Auth.fromProfileName' for more information.+-} --- | Scope a monadic action within the specific 'Region'.-within :: MonadReader Env m => Region -> m a -> m a-within r = local (envRegion .~ r)+{- $sending+To send a request you need to create a value of the desired operation type using+the relevant constructor, as well as any further modifications of default/optional+parameters using the appropriate lenses. This value can then be sent using 'send'+or 'paginate' and the library will take care of serialisation/authentication and+so forth. --- | Scope a monadic action such that any retry logic for the 'Service' is--- ignored and any requests will at most be sent once.-once :: MonadReader Env m => m a -> m a-once = local $ \e ->-    e & envRetryPolicy ?~ limitRetries 0-      & envRetryCheck  .~ (\_ _ -> return False)+The default 'Service' configuration for a request (or the supplied 'Service' configuration+when using the @*With@ variants) 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+errors and transport errors. Streaming requests are never retried.+-} --- | Send a data type which is an instance of 'AWSRequest', returning it's--- associated 'Rs' response type.------ This will throw any 'HTTPException' or 'AWSServiceError' returned by the--- service using the 'MonadError' instance. In the case of 'AWST' this will--- cause the internal 'ExceptT' to short-circuit and return an 'Error' in--- the 'Left' case as the result of the computation.------ /See:/ 'sendCatch'-send :: ( MonadCatch m-        , MonadResource m-        , MonadReader Env m-        , MonadError Error m-        , AWSRequest a-        )-     => a-     -> m (Rs a)-send = sendCatch >=> hoistEither+{- $pagination+Some AWS operations return results that are incomplete and require subsequent+requests in order to obtain the entire result set. The process of sending+subsequent requests to continue where a previous request left off is called+pagination. For example, the 'ListObjects' operation of Amazon S3 returns up to+1000 objects at a time, and you must send subsequent requests with the+appropriate Marker in order to retrieve the next page of results. --- | A variant of 'send' which discards any successful response.------ /See:/ 'send'-send_ :: ( MonadCatch m-         , MonadResource m-         , MonadReader Env m-         , MonadError Error m-         , AWSRequest a-         )-      => a-      -> m ()-send_ = void . send+Operations that have an 'AWSPager' instance can transparently perform subsequent+requests, correctly setting Markers and other request facets to iterate through+the entire result set of a truncated API operation. Operations which support+this have an additional note in the documentation. --- | Send a data type which is an instance of 'AWSRequest', returning either the--- associated 'Rs' response type in the success case, or the related service's--- 'Er' type in the error case.------ This includes 'HTTPExceptions', serialisation errors, and any service--- errors returned as part of the 'Response'.------ /Note:/ Requests will be retried depending upon each service's respective--- strategy. This can be overriden using 'once' or 'envRetry'.--- Requests which contain streaming request bodies (such as S3's 'PutObject') are--- never considered for retries.-sendCatch :: ( MonadCatch m-             , MonadResource m-             , MonadReader Env m-             , AWSRequest a-             )-          => a-          -> m (Response a)-sendCatch x = scoped (`AWS.send` x)+Many operations have the ability to filter results on the server side. See the+individual operation parameters for details.+-} --- | Send a data type which is an instance of 'AWSPager' and paginate while--- there are more results as defined by the related service operation.------ Errors will be handle identically to 'send'.------ /Note:/ The 'ResumableSource' will close when there are no more results or the--- 'ResourceT' computation is unwrapped. See: 'runResourceT' for more information.------ /See:/ 'paginateCatch'-paginate :: ( MonadCatch m-            , MonadResource m-            , MonadReader Env m-            , MonadError Error m-            , AWSPager a-            )-         => a-         -> Source m (Rs a)-paginate x = paginateCatch x $= awaitForever (hoistEither >=> yield)+{- $waiters+Waiters poll by repeatedly sending a request until some remote success condition+configured by the 'Wait' specification is fulfilled. The 'Wait' specification+determines how many attempts should be made, in addition to delay and retry strategies.+Error conditions that are not handled by the 'Wait' configuration will be thrown,+or the first successful response that fulfills the success condition will be+returned. --- | Send a data type which is an instance of 'AWSPager' and paginate over--- the associated 'Rs' response type in the success case, or the related service's--- 'Er' type in the error case.------ /Note:/ The 'ResumableSource' will close when there are no more results or the--- 'ResourceT' computation is unwrapped. See: 'runResourceT' for more information.-paginateCatch :: ( MonadCatch m-                 , MonadResource m-                 , MonadReader Env m-                 , AWSPager a-                 )-              => a-              -> Source m (Response a)-paginateCatch x = scoped (`AWS.paginate` x)+'Wait' specifications can be found under the @Network.AWS.{ServiceName}.Waiters@+namespace for services which support 'await'.+-} --- | Poll the API until a predfined condition is fulfilled using the--- supplied 'Wait' specification from the respective service.------ Any errors which are unhandled by the 'Wait' specification during retries--- will be thrown in the same manner as 'send'.------ /See:/ 'awaitCatch'-await :: ( MonadCatch m-         , MonadResource m-         , MonadReader Env m-         , MonadError Error m-         , AWSRequest a-         )-      => Wait a-      -> a-      -> m (Rs a)-await w = awaitCatch w >=> hoistEither+{- $service+When a request is sent, various configuration values such as the endpoint,+retry strategy, timeout and error handlers are taken from the associated 'Service'+configuration. --- | Poll the API until a predfined condition is fulfilled using the--- supplied 'Wait' specification from the respective service.------ The response will be either the first error returned that is not handled--- by the specification, or the successful response from the await request.------ /Note:/ You can find any available 'Wait' specifications under the--- namespace @Network.AWS.<ServiceName>.Waiters@ for supported services.-awaitCatch :: ( MonadCatch m-              , MonadResource m-              , MonadReader Env m-              , AWSRequest a-              )-           => Wait a-           -> a-           -> m (Response a)-awaitCatch w x = scoped (\e -> AWS.await e w x)+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.+-} --- | Presign an HTTP request that expires at the specified amount of time--- in the future.------ /Note:/ Requires the service's signer to be an instance of 'AWSPresigner'.--- Not all signing process support this.-presign :: ( MonadIO m-           , MonadReader Env m-           , AWSRequest a-           , AWSPresigner (Sg (Sv a))-           )-        => a       -- ^ Request to presign.-        -> UTCTime -- ^ Signing time.-        -> Integer -- ^ Expiry time in seconds.-        -> m Client.Request-presign x t ex = scoped (\e -> AWS.presign e x t ex)+{- $streaming+Streaming request bodies (such as 'PutObject') require a precomputed+'SHA256' for signing purposes.+The 'ToBody' typeclass has instances available to construct a 'RqBody',+automatically calculating the hash as needed for types such as 'Text' and 'ByteString'. --- | Presign a URL that expires at the specified amount of time in the future.------ /See:/ 'presign'-presignURL :: ( MonadIO m-             , MonadReader Env m-             , AWSRequest a-             , AWSPresigner (Sg (Sv a))-             )-           => a       -- ^ Request to presign.-           -> UTCTime -- ^ Signing time.-           -> Integer -- ^ Expiry time in seconds.-           -> m ByteString-presignURL x t ex = scoped (\e -> AWS.presignURL e x t ex)+For reading files and handles, functions such 'sourceFileIO' or 'sourceHandle'+can be used.+For responses that contain streaming bodies (such as 'GetObject'), you can use+'sinkBody' to connect the response body to a <http://hackage.haskell.org/package/conduit conduit>+compatible sink.+-}++{- $presigning+Presigning requires the 'Service' signer to be an instance of 'AWSPresigner'.+Not all signing algorithms support this.+-}++{- $metadata+Metadata can be retrieved from the underlying host assuming that you're running+the code on an EC2 instance or have a compatible @instance-data@ endpoint available.+-}++{- $async+Requests can be sent asynchronously, but due to guarantees about resource closure+require the use of <http://hackage.haskell.org/package/lifted-async lifted-async>.++The following example demonstrates retrieving two objects from S3 concurrently:++> import Control.Concurrent.Async.Lifted+> import Control.Lens+> import Control.Monad.Trans.AWS+> import Network.AWS.S3+>+> do x   <- async . send $ getObject "bucket" "prefix/object-foo"+>    y   <- async . send $ getObject "bucket" "prefix/object-bar"+>    foo <- wait x+>    bar <- wait y+>    ...++/See:/ <http://hackage.haskell.org/package/lifted-async Control.Concurrent.Async.Lifted>+-}++{- $errors+Errors are thrown by the library using 'MonadThrow' (unless "Control.Monad.Error.AWS" is used).+Sub-errors of the canonical 'Error' type can be caught using 'trying' or+'catching' and the appropriate 'AsError' 'Prism':++@+trying '_Error'          (send $ ListObjects "bucket-name") :: Either 'Error'          ListObjectsResponse+trying '_TransportError' (send $ ListObjects "bucket-name") :: Either 'HttpException'  ListObjectsResponse+trying '_SerializeError' (send $ ListObjects "bucket-name") :: Either 'SerializeError' ListObjectsResponse+trying '_ServiceError'   (send $ ListObjects "bucket-name") :: Either 'ServiceError'   ListObjectsResponse+@++Many of the individual @amazonka-*@ libraries export compatible 'Getter's for+matching service specific error codes and messages in the style above.+See the @Error Matchers@ heading in each respective library for details.+-}++{- $logging+The exposed logging interface is a primitive 'Logger' function which gets+threaded through service calls and serialisation routines. This allows the+library to output useful information and diagnostics.++The 'newLogger' function can be used to construct a simple logger which writes+output to a 'Handle', but in most production code you should probably consider+using a more robust logging library such as+<http://hackage.haskell.org/package/tiny-log tiny-log> or+<http://hackage.haskell.org/package/fast-logger fast-logger>.+-}

@@ -1,223 +1,459 @@-{-# LANGUAGE ConstraintKinds   #-} {-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TupleSections     #-}-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE ViewPatterns      #-}+{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}++-- | -- Module      : Network.AWS--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0. -- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental+-- Stability   : provisional -- Portability : non-portable (GHC extensions)---- | The core module for making requests to the various AWS services.+--+-- This module provides a simple 'AWS' monad and a set of operations which+-- can be performed against remote Amazon Web Services APIs, for use with the types+-- supplied by the various @amazonka-*@ libraries.+--+-- A 'MonadAWS' typeclass is used as a function constraint to provide automatic+-- lifting of functions when embedding 'AWS' as a layer inside your own+-- application stack.+--+-- "Control.Monad.Trans.AWS" contains the underlying 'AWST' transformer. module Network.AWS     (-    -- * Requests-    -- ** Synchronous-      send-    -- ** Paginated+    -- * Usage+    -- $usage++    -- * Running AWS Actions+      AWS+    , MonadAWS    (..)+    , runAWS++    -- * Authentication and Environment+    , newEnv+    , Env+    , HasEnv       (..)++    -- ** Credential Discovery+    , Credentials  (..)+    -- $discovery++    -- ** Supported Regions+    , Region       (..)++    -- * Sending Requests+    -- $sending++    , send++    -- ** Pagination+    -- $pagination+     , paginate-    -- ** Eventual consistency++    -- ** Waiters+    -- $waiters+     , await-    -- ** Pre-signing URLs-    , presign-    , presignURL -    -- * Environment-    , Env-    -- ** Lenses-    , envRegion-    , envLogger-    , envRetryCheck-    , envRetryPolicy-    , envManager-    , envAuth-    -- ** Creating the environment-    , newEnv-    , getEnv-    -- ** Specifying credentials-    , Credentials (..)-    , fromKeys-    , fromSession-    , getAuth-    , accessKey-    , secretKey+    -- ** Overriding Service Configuration+    -- $service -    -- * Logging-    , newLogger+    -- *** Scoped Actions+    , within+    , once+    , timeout -    -- ** Streaming body helpers+    -- ** Streaming+    -- $streaming++    -- *** Request Bodies+    , ToBody       (..)     , sourceBody     , sourceHandle     , sourceFile     , sourceFileIO -    -- * Types+    -- *** Response Bodies+    , sinkBody++    -- *** File Size and MD5/SHA256+    , getFileSize+    , sinkMD5+    , sinkSHA256++    -- * Presigning Requests+    -- $presigning++    , presignURL++    -- * EC2 Instance Metadata+    -- $metadata++    , isEC2+    , dynamic+    , metadata+    , userdata++    , EC2.Dynamic  (..)+    , EC2.Metadata (..)++    -- * Running Asynchronous Actions+    -- $async++    -- * Handling Errors+    -- $errors++    , AsError      (..)+    , AsAuthError  (..)++    , AWST.trying+    , AWST.catching++    -- * Logging+    -- $logging++    , Logger+    , LogLevel     (..)++    -- ** Constructing a Logger+    , newLogger++    -- * Re-exported Types+    , RqBody+    , RsBody     , module Network.AWS.Types-    , module Network.AWS.Error+    , module Network.AWS.Waiter+    , module Network.AWS.Pager++    -- * runResourceT+    , runResourceT     ) where  import           Control.Applicative-import           Control.Monad-import           Control.Monad.Catch-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Class-import           Control.Monad.Trans.Except+import           Control.Monad.Catch             (MonadCatch)+import           Control.Monad.Morph             (hoist)+import qualified Control.Monad.RWS.Lazy          as LRW+import qualified Control.Monad.RWS.Strict        as RW+import qualified Control.Monad.State.Lazy        as LS+import qualified Control.Monad.State.Strict      as S+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.Free        (FreeT)+import           Control.Monad.Trans.Free.Church (FT)+import           Control.Monad.Trans.Identity    (IdentityT)+import           Control.Monad.Trans.Iter        (IterT)+import           Control.Monad.Trans.List        (ListT)+import           Control.Monad.Trans.Maybe       (MaybeT)+import           Control.Monad.Trans.Reader      (ReaderT) import           Control.Monad.Trans.Resource-import           Data.ByteString              (ByteString)-import           Data.Conduit                 hiding (await)+import qualified Control.Monad.Writer.Lazy       as LW+import qualified Control.Monad.Writer.Strict     as W+import           Data.Conduit                    (Source) import           Data.Monoid-import           Data.Time                    (getCurrentTime)-import           Network.AWS.Data-import           Network.AWS.Error-import           Network.AWS.Internal.Auth+import           Network.AWS.Auth+import qualified Network.AWS.EC2.Metadata        as EC2+import           Network.AWS.Env                 (Env, HasEnv (..), newEnv) import           Network.AWS.Internal.Body-import           Network.AWS.Internal.Env-import           Network.AWS.Internal.Log-import           Network.AWS.Internal.Retry-import qualified Network.AWS.Signing          as Sign-import           Network.AWS.Types-import           Network.AWS.Waiters-import           Network.HTTP.Conduit         hiding (Request, Response)-import qualified Network.HTTP.Conduit         as Client+import           Network.AWS.Internal.Logger+import           Network.AWS.Pager               (AWSPager)+import           Network.AWS.Prelude+import           Network.AWS.Types               hiding (LogLevel (..))+import           Network.AWS.Waiter              (Wait) --- | This creates a new environment without debug logging and uses 'getAuth'--- to expand/discover the supplied 'Credentials'.------ Lenses such as 'envLogger' can be used to modify the 'Env' with a debug logger.-newEnv :: (Functor m, MonadIO m)-       => Region-       -> Credentials-       -> Manager-       -> ExceptT String m Env-newEnv r c m = Env r logger check Nothing m `liftM` getAuth m c-  where-    logger _ _ = return ()-    check  _ _ = return True+import           Prelude --- | Create a new environment in the specified 'Region' with silent log output--- and a new 'Manager'.------ Any errors are thrown using 'error'.------ /See:/ 'newEnv' for safe 'Env' instantiation.-getEnv :: Region -> Credentials -> IO Env-getEnv r c = do-    m <- newManager conduitManagerSettings-    runExceptT (newEnv r c m) >>= either error return+-- | A specialisation of the 'AWST' transformer.+type AWS = AWST IO --- | Send a data type which is an instance of 'AWSRequest', returning either the--- associated 'Rs' response type in the success case, or the related service's--- 'Er' type in the error case.+-- | Monads in which 'AWS' actions may be embedded.+class (Functor m, Applicative m, Monad m) => MonadAWS m where+    -- | Lift a computation to the 'AWS' monad.+    liftAWS :: AWS a -> m a++instance MonadAWS AWS where+    liftAWS = id++instance MonadAWS m => MonadAWS (IdentityT   m) where liftAWS = lift . liftAWS+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+instance MonadAWS m => MonadAWS (IterT       m) where liftAWS = lift . liftAWS+instance MonadAWS m => MonadAWS (FT        f m) where liftAWS = lift . liftAWS++instance (Monoid w, MonadAWS m) => MonadAWS (W.WriterT w m) where+    liftAWS = lift . liftAWS++instance (Monoid w, MonadAWS m) => MonadAWS (LW.WriterT w m) where+    liftAWS = lift . liftAWS++instance (Monoid w, MonadAWS m) => MonadAWS (RW.RWST r w s m) where+    liftAWS = lift . liftAWS++instance (Monoid w, MonadAWS m) => MonadAWS (LRW.RWST r w s m) where+    liftAWS = lift . liftAWS++instance (Functor f, MonadAWS m) => MonadAWS (FreeT f m) where+    liftAWS = lift . liftAWS++-- FIXME: verify the use of withInternalState to create a ResourceT here++-- | Run the 'AWS' monad. Any outstanding HTTP responses' 'ResumableSource' will+-- be closed when the 'ResourceT' computation is unwrapped with 'runResourceT'. ----- This includes 'HTTPExceptions', serialisation errors, and any service--- errors returned as part of the 'Response'.+-- Throws 'Error', which will include 'HTTPExceptions', serialisation errors,+-- or any particular errors returned by the respective AWS service. ----- /Note:/ Requests will be retried depending upon each service's respective--- strategy. This can be overriden using 'envRetry'. Requests which contain--- streaming request bodies (such as S3's 'PutObject') are never considered for retries.-send :: (MonadCatch m, MonadResource m, AWSRequest a)-     => Env-     -> a-     -> m (Response a)-send e@Env{..} (request -> rq) = fmap snd <$> retrier e rq (raw e rq)+-- /See:/ 'runAWST', 'runResourceT'.+runAWS :: (MonadCatch m, MonadResource m, HasEnv r) => r -> AWS a -> m a+runAWS e = liftResourceT . AWST.runAWST e . hoist (withInternalState . const) --- | Poll the API until a predefined condition is fulfilled using the--- supplied 'Wait' specification from the respective service.------ The response will be either the first error returned that is not handled--- by the specification, or the successful response from the await request.+-- | Scope an action within the specific 'Region'.+within :: MonadAWS m => Region -> AWS a -> m a+within r = liftAWS . AWST.within r++-- | Scope an action such that any retry logic for the 'Service' is+-- ignored and any requests will at most be sent once.+once :: MonadAWS m => AWS a -> m a+once = liftAWS . AWST.once++-- | Scope an action such that any HTTP response will use this timeout value.+timeout :: MonadAWS m => Seconds -> AWS a -> m a+timeout s = liftAWS . AWST.timeout s++-- | Send a request, returning the associated response if successful. ----- /Note:/ You can find any available 'Wait' specifications under then--- @Network.AWS.<ServiceName>.Waiters@ namespace for supported services.-await :: (MonadCatch m, MonadResource m, AWSRequest a)-      => Env-      -> Wait a-      -> a-      -> m (Response a)-await e w (request -> rq) = fmap snd <$> waiter e w rq (raw e rq)+-- /See:/ 'AWST.sendWith'+send :: (MonadAWS m, AWSRequest a) => a -> m (Rs a)+send = liftAWS . AWST.send --- | Send a data type which is an instance of 'AWSPager' and paginate over--- the associated 'Rs' response type in the success case, or the related service's--- 'Er' type in the error case.+-- | Repeatedly send a request, automatically setting markers and+-- paginating over multiple responses while available. ----- /Note:/ The 'ResumableSource' will close when there are no more results or the--- 'ResourceT' computation is unwrapped. See: 'runResourceT' for more information.-paginate :: (MonadCatch m, MonadResource m, AWSPager a)-         => Env-         -> a-         -> Source m (Response a)-paginate e = go-  where-    go x = do-        y <- lift (send e x)-        yield y-        either (const (return ()))-               (maybe (return ()) go . page x)-               y+-- /See:/ 'AWST.paginateWith'+paginate :: (MonadAWS m, AWSPager a) => a -> Source m (Rs a)+paginate = hoist liftAWS . AWST.paginate --- | Presign an HTTP request that expires at the specified amount of time--- in the future.+-- | Poll the API with the supplied request until a specific 'Wait' condition+-- is fulfilled. ----- /Note:/ Requires the service's signer to be an instance of 'AWSPresigner'.--- Not all signing process support this.-presign :: (MonadIO m, AWSRequest a, AWSPresigner (Sg (Sv a)))-        => Env-        -> a       -- ^ Request to presign.-        -> UTCTime -- ^ Signing time.-        -> Integer -- ^ Expiry time in seconds.-        -> m Client.Request-presign Env{..} (request -> rq) t ex =-    _sgRequest `liftM` Sign.presign _envAuth _envRegion rq t ex+-- /See:/ 'AWST.awaitWith'+await :: (MonadAWS m, AWSRequest a) => Wait a -> a -> m (Rs a)+await w = liftAWS . AWST.await w --- | Presign a URL that expires at the specified amount of time in the future.+-- | Presign an URL that is valid from the specified time until the+-- number of seconds expiry has elapsed. ----- /See:/ 'presign'-presignURL :: (MonadIO m, AWSRequest a, AWSPresigner (Sg (Sv a)))-           => Env-           -> a       -- ^ Request to presign.-           -> UTCTime -- ^ Signing time.-           -> Integer -- ^ Expiry time in seconds.+-- /See:/ 'AWST.presign', 'AWST.presignWith'+presignURL :: (MonadAWS m, AWSPresigner (Sg (Sv a)), AWSRequest a)+           => UTCTime     -- ^ Signing time.+           -> Seconds     -- ^ Expiry time.+           -> a           -- ^ Request to presign.            -> m ByteString-presignURL e x t ex = (toBS . uri) `liftM` presign e x t ex-  where-    uri rq =-           scheme (secure rq)-        <> build  (host rq)-        <> port'  (port rq)-        <> build  (path rq)-        <> build  (queryString rq)+presignURL t ex = liftAWS . AWST.presignURL t ex -    scheme True = "https://"-    scheme _    = "http://"+-- | Test whether the underlying host is running on EC2.+-- This is memoised and an HTTP request is made to the host's metadata+-- endpoint for the first call only.+isEC2 :: MonadAWS m => m Bool+isEC2 = liftAWS AWST.isEC2 -    port' = \case-        80  -> ""-        443 -> ""-        n   -> build ':' <> build n+-- | Retrieve the specified 'Dynamic' data.+dynamic :: MonadAWS m => EC2.Dynamic -> m ByteString+dynamic = liftAWS . AWST.dynamic -raw :: (MonadCatch m, MonadResource m, AWSRequest a)-    => Env-    -> Request a-    -> m (Response' a)-raw Env{..} rq = catch go err >>= response _envLogger rq-  where-    go = do-        trace _envLogger (build rq)-        t  <- liftIO getCurrentTime-        Signed m s <- Sign.sign _envAuth _envRegion rq t-        debug _envLogger (build s)-        trace _envLogger (build m)-        rs <- liftResourceT (http s _envManager)-        debug _envLogger (build rs)-        return (Right rs)+-- | Retrieve the specified 'Metadata'.+metadata :: MonadAWS m => EC2.Metadata -> m ByteString+metadata = liftAWS . AWST.metadata -    err ex = return (Left (ex :: HttpException))+-- | Retrieve the user data. Returns 'Nothing' if no user data is assigned+-- to the instance.+userdata :: MonadAWS m => m (Maybe ByteString)+userdata = liftAWS AWST.userdata++{- $usage+The key functions dealing with the request/response lifecycle are:++* 'send'++* 'paginate'++* 'await'++To utilise these, you will need to specify what 'Region' you wish to operate in+and your Amazon credentials for AuthN/AuthZ purposes.++'Credentials' can be supplied in a number of ways. Either via explicit keys,+via session profiles, or have Amazonka determine the credentials from an+underlying IAM Role/Profile.++As a basic example, you might wish to store an object in an S3 bucket using+<http://hackage.haskell.org/package/amazonka-s3 amazonka-s3>:++@+import Control.Lens+import Network.AWS+import Network.AWS.S3+import System.IO++example :: IO PutObjectResponse+example = do+    -- To specify configuration preferences, 'newEnv' is used to create a new 'Env'. The 'Region' denotes the AWS region requests will be performed against,+    -- and 'Credentials' is used to specify the desired mechanism for supplying or retrieving AuthN/AuthZ information.+    -- In this case, 'Discover' will cause the library to try a number of options such as default environment variables, or an instance's IAM Profile:+    e <- newEnv Frankfurt Discover++    -- A new 'Logger' to replace the default noop logger is created, with the logger set to print debug information and errors to stdout:+    l <- newLogger Debug stdout++    -- The payload (and hash) for the S3 object is retrieved from a FilePath:+    b <- sourceFileIO "local\/path\/to\/object-payload"++    -- We now run the AWS computation with the overriden logger, performing the PutObject request:+    runAWS (e & envLogger .~ l) $+        send (putObject "bucket-name" "object-key" b)+@+-}++{- $discovery+AuthN/AuthZ information is handled similarly to other AWS SDKs. You can read+some of the options available <http://blogs.aws.amazon.com/security/post/Tx3D6U6WSFGOK2H/A-New-and-Standardized-Way-to-Manage-Credentials-in-the-AWS-SDKs here>.++When running on an EC2 instance and using 'FromProfile' or 'Discover', a thread+is forked which transparently handles the expiry and subsequent refresh of IAM+profile information. See 'Network.AWS.Auth.fromProfileName' for more information.+-}++{- $sending+To send a request you need to create a value of the desired operation type using+the relevant constructor, as well as any further modifications of default/optional+parameters using the appropriate lenses. This value can then be sent using 'send'+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+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+errors and transport errors. Streaming requests are never retried.+-}++{- $pagination+Some AWS operations return results that are incomplete and require subsequent+requests in order to obtain the entire result set. The process of sending+subsequent requests to continue where a previous request left off is called+pagination. For example, the 'ListObjects' operation of Amazon S3 returns up to+1000 objects at a time, and you must send subsequent requests with the+appropriate Marker in order to retrieve the next page of results.++Operations that have an 'AWSPager' instance can transparently perform subsequent+requests, correctly setting Markers and other request facets to iterate through+the entire result set of a truncated API operation. Operations which support+this have an additional note in the documentation.++Many operations have the ability to filter results on the server side. See the+individual operation parameters for details.+-}++{- $waiters+Waiters poll by repeatedly sending a request until some remote success condition+configured by the 'Wait' specification is fulfilled. The 'Wait' specification+determines how many attempts should be made, in addition to delay and retry strategies.+Error conditions that are not handled by the 'Wait' configuration will be thrown,+or the first successful response that fulfills the success condition will be+returned.++'Wait' specifications can be found under the @Network.AWS.{ServiceName}.Waiters@+namespace for services which support 'await'.+-}++{- $service+When a request is sent, various configuration values such as the endpoint,+retry strategy, timeout and error handlers are taken from the associated 'Service'+configuration.++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.+-}++{- $streaming+Streaming request bodies (such as 'PutObject') require a precomputed+'SHA256' for signing purposes.+The 'ToBody' typeclass has instances available to construct a 'RqBody',+automatically calculating the hash as needed for types such as 'Text' and 'ByteString'.++For reading files and handles, functions such 'sourceFileIO' or 'sourceHandle'+can be used.+For responses that contain streaming bodies (such as 'GetObject'), you can use+'sinkBody' to connect the response body to a <http://hackage.haskell.org/package/conduit conduit>+compatible sink.+-}++{- $presigning+Presigning requires the 'Service' signer to be an instance of 'AWSPresigner'.+Not all signing algorithms support this.+-}++{- $metadata+Metadata can be retrieved from the underlying host assuming that you're running+the code on an EC2 instance or have a compatible @instance-data@ endpoint available.+-}++{- $async+Requests can be sent asynchronously, but due to guarantees about resource closure+require the use of <http://hackage.haskell.org/package/lifted-async lifted-async>.++The following example demonstrates retrieving two objects from S3 concurrently:++> import Control.Concurrent.Async.Lifted+> import Control.Lens+> import Control.Monad.Trans.AWS+> import Network.AWS.S3+>+> do x   <- async . send $ getObject "bucket" "prefix/object-foo"+>    y   <- async . send $ getObject "bucket" "prefix/object-bar"+>    foo <- wait x+>    bar <- wait y+>    ...++/See:/ <http://hackage.haskell.org/package/lifted-async Control.Concurrent.Async.Lifted>+-}++{- $errors+Errors are thrown by the library using 'MonadThrow' (unless "Control.Monad.Error.AWS" is used).+Sub-errors of the canonical 'Error' type can be caught using 'trying' or+'catching' and the appropriate 'AsError' 'Prism':++@+trying '_Error'          (send $ ListObjects "bucket-name") :: Either 'Error'          ListObjectsResponse+trying '_TransportError' (send $ ListObjects "bucket-name") :: Either 'HttpException'  ListObjectsResponse+trying '_SerializeError' (send $ ListObjects "bucket-name") :: Either 'SerializeError' ListObjectsResponse+trying '_ServiceError'   (send $ ListObjects "bucket-name") :: Either 'ServiceError'   ListObjectsResponse+@++Many of the individual @amazonka-*@ libraries export compatible 'Getter's for+matching service specific error codes and messages in the style above.+See the @Error Matchers@ heading in each respective library for details.+-}++{- $logging+The exposed logging interface is a primitive 'Logger' function which gets+threaded through service calls and serialisation routines. This allows the+library to output useful information and diagnostics.++The 'newLogger' function can be used to construct a simple logger which writes+output to a 'Handle', but in most production code you should probably consider+using a more robust logging library such as+<http://hackage.haskell.org/package/tiny-log tiny-log> or+<http://hackage.haskell.org/package/fast-logger fast-logger>.+-}

@@ -0,0 +1,446 @@+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE LambdaCase         #-}+{-# LANGUAGE OverloadedStrings  #-}++-- |+-- Module      : Network.AWS.Auth+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Explicitly specify your Amazon AWS security credentials, or retrieve them+-- from the underlying OS.+--+-- The format of environment variables and the credentials file follows the official+-- <http://blogs.aws.amazon.com/security/post/Tx3D6U6WSFGOK2H/A-New-and-Standardized-Way-to-Manage-Credentials-in-the-AWS-SDKs AWS SDK guidelines>.+module Network.AWS.Auth+    (+    -- * Authentication+    -- ** Retrieving authentication+      getAuth+    , Credentials   (..)+    , Auth++    -- ** Defaults+    -- *** Environment+    , envAccessKey+    , envSecretKey+    , envSessionToken++    -- *** Credentials File+    , credAccessKey+    , credSecretKey+    , credSessionToken+    , credProfile+    , credFile++    -- $credentials++    , fromKeys+    , fromSession+    , fromEnv+    , fromEnvKeys+    , fromFile+    , fromFilePath+    , fromProfile+    , fromProfileName++    -- ** Keys+    , AccessKey    (..)+    , SecretKey    (..)+    , SessionToken (..)++    -- ** Handling Errors+    , AsAuthError (..)+    , AuthError   (..)+    ) where++import           Control.Applicative+import           Control.Concurrent+import           Control.Exception.Lens+import           Control.Monad+import           Control.Monad.Catch+import           Control.Monad.IO.Class+import qualified Data.ByteString.Char8      as BS8+import qualified Data.ByteString.Lazy.Char8 as LBS8+import qualified Data.Ini                   as INI+import           Data.IORef+import           Data.Monoid+import qualified Data.Text                  as Text+import qualified Data.Text.Encoding         as Text+import           Data.Time                  (diffUTCTime, getCurrentTime)+import           Network.AWS.Data.Log+import           Network.AWS.EC2.Metadata+import           Network.AWS.Prelude+import           Network.AWS.Types+import           Network.HTTP.Conduit+import           System.Directory           (doesFileExist, getHomeDirectory)+import           System.Environment+import           System.Mem.Weak++import           Prelude++-- | Default access key environment variable.+envAccessKey :: Text -- ^ AWS_ACCESS_KEY_ID+envAccessKey = "AWS_ACCESS_KEY_ID"++-- | Default secret key environment variable.+envSecretKey :: Text -- ^ AWS_SECRET_ACCESS_KEY+envSecretKey = "AWS_SECRET_ACCESS_KEY"++-- | Default session token environment variable.+envSessionToken :: Text -- ^ AWS_SESSION_TOKEN+envSessionToken = "AWS_SESSION_TOKEN"++-- | Credentials INI file access key variable.+credAccessKey :: Text -- ^ aws_access_key_id+credAccessKey = "aws_access_key_id"++-- | Credentials INI file secret key variable.+credSecretKey :: Text -- ^ aws_secret_access_key+credSecretKey = "aws_secret_access_key"++-- | Credentials INI file session token variable.+credSessionToken :: Text -- ^ aws_session_token+credSessionToken = "aws_session_token"++-- | Credentials INI default profile section variable.+credProfile :: Text -- ^ default+credProfile = "default"++-- | Default path for the credentials file. This looks in in the @HOME@ directory+-- as determined by the <http://hackage.haskell.org/package/directory directory>+-- library.+--+-- * UNIX/OSX: @$HOME/.aws/credentials@+--+-- * Windows: @C:\/Users\//\<user\>\.aws\credentials@+--+-- /Note:/ This does not match the default AWS SDK location of+-- @%USERPROFILE%\.aws\credentials@ on Windows. (Sorry.)+credFile :: MonadIO m => m FilePath+credFile = (<> "/.aws/credentials") `liftM` liftIO getHomeDirectory+-- TODO: probably should be using System.FilePath above.++{- $credentials+'getAuth' is implemented using the following @from*@-styled functions below.+Both 'fromKeys' and 'fromSession' can be used directly to avoid the 'MonadIO'+constraint.+-}++-- | Explicit access and secret keys.+fromKeys :: AccessKey -> SecretKey -> Auth+fromKeys a s = Auth (AuthEnv a s Nothing Nothing)++-- | A session containing the access key, secret key, and a session token.+fromSession :: AccessKey -> SecretKey -> SessionToken -> Auth+fromSession a s t = Auth (AuthEnv a s (Just t) Nothing)++-- | Determines how AuthN/AuthZ information is retrieved.+data Credentials+    = FromKeys AccessKey SecretKey+      -- ^ Explicit access and secret keys. See 'fromKeys'.++    | FromSession AccessKey SecretKey SessionToken+      -- ^ Explicit access key, secret key and a session token. See 'fromSession'.++    | FromEnv Text Text (Maybe Text)+      -- ^ Lookup specific environment variables for access key, secret key, and+      -- an optional session token respectively.++    | FromProfile Text+      -- ^ An IAM Profile name to lookup from the local EC2 instance-data.+      -- ^ Environment variables to lookup for the access key, secret key and+      -- optional session token.++    | FromFile Text FilePath+      -- ^ A credentials profile name (the INI section) and the path to the AWS+      -- <http://blogs.aws.amazon.com/security/post/Tx3D6U6WSFGOK2H/A-New-and-Standardized-Way-to-Manage-Credentials-in-the-AWS-SDKs credentials> file.++    | Discover+      -- ^ Attempt to credentials discovery via the following steps:+      --+      -- * Read the 'envAccessKey' and 'envSecretKey' from the environment if they are set.+      --+      -- * Read the credentials file if 'credFile' exists.+      --+      -- * Retrieve the first available IAM profile if running on EC2.+      --+      -- An attempt is made to resolve <http://instance-data> rather than directly+      -- retrieving <http://169.254.169.254> for IAM profile information.+      -- This assists in ensuring the DNS lookup terminates promptly if not+      -- running on EC2.+      deriving (Eq)++instance ToLog Credentials where+    build = \case+        FromKeys    a _   -> "FromKeys "    <> build a <> " ****"+        FromSession a _ _ -> "FromSession " <> build a <> " **** ****"+        FromEnv     a s t -> "FromEnv "     <> build a <> " " <> build s <> " " <> m t+        FromProfile n     -> "FromProfile " <> build n+        FromFile    n f   -> "FromFile "    <> build n <> " " <> build f+        Discover          -> "Discover"+      where+        m (Just x) = "(Just " <> build x <> ")"+        m Nothing  = "Nothing"++instance Show Credentials where+    show = BS8.unpack . toBS . build++-- | An error thrown when attempting to read AuthN/AuthZ information.+data AuthError+    = RetrievalError   HttpException+    | MissingEnvError  Text+    | MissingFileError FilePath+    | InvalidFileError Text+    | InvalidIAMError  Text+      deriving (Show, Typeable)++instance Exception AuthError++instance ToLog AuthError where+    build = \case+        RetrievalError   e -> build e+        MissingEnvError  e -> "[MissingEnvError]  { message = " <> build e <> "}"+        MissingFileError f -> "[MissingFileError] { path = "    <> build f <> "}"+        InvalidFileError e -> "[InvalidFileError] { message = " <> build e <> "}"+        InvalidIAMError  e -> "[InvalidIAMError]  { message = " <> build e <> "}"++class AsAuthError a where+    -- | A general authentication error.+    _AuthError        :: Prism' a AuthError+    {-# MINIMAL _AuthError #-}++    -- | An error occured while communicating over HTTP with+    -- the local metadata endpoint.+    _RetrievalError   :: Prism' a HttpException++    -- | An error occured looking up a named environment variable.+    _MissingEnvError  :: Prism' a Text++    -- | The specified credentials file could not be found.+    _MissingFileError :: Prism' a FilePath++    -- | An error occured parsing the credentials file.+    _InvalidFileError :: Prism' a Text++    -- | The specified IAM profile could not be found or deserialised.+    _InvalidIAMError  :: Prism' a Text++    _RetrievalError   = _AuthError . _RetrievalError+    _MissingEnvError  = _AuthError . _MissingEnvError+    _MissingFileError = _AuthError . _MissingFileError+    _InvalidFileError = _AuthError . _InvalidFileError+    _InvalidIAMError  = _AuthError . _InvalidIAMError++instance AsAuthError SomeException where+    _AuthError = exception++instance AsAuthError AuthError where+    _AuthError = id++    _RetrievalError = prism RetrievalError $ \case+        RetrievalError   e -> Right e+        x                  -> Left  x++    _MissingEnvError = prism MissingEnvError $ \case+        MissingEnvError  e -> Right e+        x                  -> Left  x++    _MissingFileError = prism MissingFileError $ \case+        MissingFileError f -> Right f+        x                  -> Left  x++    _InvalidFileError = prism InvalidFileError $ \case+        InvalidFileError e -> Right e+        x                  -> Left  x++    _InvalidIAMError = prism InvalidIAMError $ \case+        InvalidIAMError  e -> Right e+        x                  -> Left  x++-- | Retrieve authentication information via the specified 'Credentials' mechanism.+--+-- Throws 'AuthError' when environment variables or IAM profiles cannot be read.+getAuth :: (Applicative m, MonadIO m, MonadCatch m)+        => Manager+        -> Credentials+        -> m Auth+getAuth m = \case+    FromKeys    a s   -> return (fromKeys a s)+    FromSession a s t -> return (fromSession a s t)+    FromEnv     a s t -> fromEnvKeys a s t+    FromProfile n     -> fromProfileName m n+    FromFile    n f   -> fromFilePath n f+    Discover          ->+        -- Don't try and catch InvalidFileError, or InvalidIAMProfile,+        -- let both errors propagate.+        catching_ _MissingEnvError fromEnv $+            -- proceed, missing env keys+            catching _MissingFileError fromFile $ \f -> do+                -- proceed, missing credentials file+                p <- isEC2 m+                unless p $ throwingM _MissingFileError f+                fromProfile m++-- | Retrieve access key, secret key, and a session token from the default+-- environment variables.+--+-- Throws 'MissingEnvError' if either of the default environment variables+-- cannot be read, but not if the session token is absent.+--+-- /See:/ 'envAccessKey', 'envSecretKey', 'envSessionToken'+fromEnv :: (Applicative m, MonadIO m, MonadThrow m) => m Auth+fromEnv = fromEnvKeys envAccessKey envSecretKey (Just envSessionToken)++-- | Retrieve access key, secret key and a session token from specific+-- environment variables.+--+-- Throws 'MissingEnvError' if either of the specified key environment variables+-- cannot be read, but not if the session token is absent.+fromEnvKeys :: (Applicative m, MonadIO m, MonadThrow m)+            => Text       -- ^ Access key environment variable.+            -> Text       -- ^ Secret key environment variable.+            -> Maybe Text -- ^ Session token environment variable.+            -> m Auth+fromEnvKeys a s t = fmap Auth $ AuthEnv+    <$> (req a <&> AccessKey)+    <*> (req s <&> SecretKey)+    <*> (opt t <&> fmap SessionToken)+    <*> pure Nothing+  where+    req k = do+        m <- opt (Just k)+        maybe (throwM . MissingEnvError $ "Unable to read ENV variable: " <> k)+              return+              m++    opt Nothing  = return Nothing+    opt (Just k) = fmap BS8.pack <$> liftIO (lookupEnv (Text.unpack k))++-- | Loads the default @credentials@ INI file using the default profile name.+--+-- Throws 'MissingFileError' if 'credFile' is missing, or 'InvalidFileError'+-- if an error occurs during parsing.+--+-- /See:/ 'credProfile' and 'credFile'+fromFile :: (Applicative m, MonadIO m, MonadCatch m) => m Auth+fromFile = credFile >>= fromFilePath credProfile++-- | Retrieve the access, secret and session token from the specified section+-- (profile) in a valid INI @credentials@ file.+--+-- Throws 'MissingFileError' if the specified file is missing, or 'InvalidFileError'+-- if an error occurs during parsing.+fromFilePath :: (Applicative m, MonadIO m, MonadCatch m)+             => Text+             -> FilePath+             -> m Auth+fromFilePath n f = do+    p <- liftIO (doesFileExist f)+    unless p $ throwM (MissingFileError f)+    i <- either (throwM . invalidErr) return =<< liftIO (INI.readIniFile f)+    fmap Auth $ AuthEnv+        <$> (req credAccessKey i    <&> AccessKey)+        <*> (req credSecretKey i    <&> SecretKey)+        <*> (opt credSessionToken i <&> fmap SessionToken)+        <*> pure Nothing+  where+    req k i =+        either (throwM . invalidErr)+               (return . Text.encodeUtf8)+               (INI.lookupValue n k i)++    opt k i = return $+        either (const Nothing)+               (Just . Text.encodeUtf8)+               (INI.lookupValue n k i)++    invalidErr :: String -> AuthError+    invalidErr = InvalidFileError . Text.pack++-- | Retrieve the default IAM Profile from the local EC2 instance-data.+--+-- The default IAM profile is determined by Amazon as the first profile found+-- in the response from:+-- @http://169.254.169.254/latest/meta-data/iam/security-credentials/@+--+-- Throws 'RetrievalError' if the HTTP call fails, or 'InvalidIAMError' if+-- the default IAM profile cannot be read.+fromProfile :: (MonadIO m, MonadCatch m) => Manager -> m Auth+fromProfile m = do+    ls <- try $ metadata m (IAM (SecurityCredentials Nothing))+    case BS8.lines `liftM` ls of+        Right (x:_) -> fromProfileName m (Text.decodeUtf8 x)+        Left  e     -> throwM (RetrievalError e)+        _           -> throwM $+            InvalidIAMError "Unable to get default IAM Profile from EC2 metadata"++-- | Lookup a specific IAM Profile by name from the local EC2 instance-data.+--+-- The resulting IONewRef wrapper + timer is designed so that multiple concurrent+-- accesses of 'AuthEnv' from the 'AWS' environment are not required to calculate+-- expiry and sequentially queue to update it.+--+-- The forked timer ensures a singular owner and pre-emptive refresh of the+-- temporary session credentials.+--+-- A weak reference is used to ensure that the forked thread will eventually+-- terminate when 'Auth' is no longer referenced.+--+-- Throws 'RetrievalError' if the HTTP call fails, or 'InvalidIAMError' if+-- the specified IAM profile cannot be read.+fromProfileName :: (MonadIO m, MonadCatch m) => Manager -> Text -> m Auth+fromProfileName m name = auth >>= start+  where+    auth :: (MonadIO m, MonadCatch m) => m AuthEnv+    auth = do+        bs <- try $ metadata m (IAM . SecurityCredentials $ Just name)+        case bs of+            Left  e -> throwM (RetrievalError e)+            Right x ->+                either (throwM . invalidErr)+                       return+                       (eitherDecode' (LBS8.fromStrict x))++    invalidErr = InvalidIAMError+        . mappend ("Error parsing IAM profile '" <> name <> "' ")+        . Text.pack++    start :: MonadIO m => AuthEnv -> m Auth+    start !a = liftIO $+        case _authExpiry a of+            Nothing -> return (Auth a)+            Just x  -> do+                r <- newIORef a+                p <- myThreadId+                s <- timer r p x+                return (Ref s r)++    timer :: IORef AuthEnv -> ThreadId -> UTCTime -> IO ThreadId+    timer !r !p !x = forkIO $ do+        s <- myThreadId+        w <- mkWeakIORef r (killThread s)+        loop w p x++    loop :: Weak (IORef AuthEnv) -> ThreadId -> UTCTime -> IO ()+    loop w !p !x = do+        diff x <$> getCurrentTime >>= threadDelay+        ea <- try auth+        case ea of+            Left   e -> throwTo p (RetrievalError e)+            Right !a -> do+                 mr <- deRefWeak w+                 case mr of+                     Nothing -> return ()+                     Just  r -> do+                         atomicWriteIORef r a+                         maybe (return ()) (loop w p) (_authExpiry a)++    diff !x !y = (* 1000000) $ if n > 0 then n else 1+      where+        !n = truncate (diffUTCTime x y) - 60

@@ -0,0 +1,32 @@+-- |+-- Module      : Network.AWS.Data+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Re-exports some of the underlying textual and byte serialisation mechanisms+-- for convenience.+--+-- Many of the AWS identifiers like S3's 'ObjectVersionId' or 'ETag',+-- as well as any nullary sum types such as 'Network.AWS.Region' have 'ToText'+-- and 'ToByteString' instances, making it convenient to use the type classes+-- to convert a value to its textual representation.+module Network.AWS.Data+    (+    -- * Text+      FromText     (..)+    , fromText+    , ToText       (..)++    -- * ByteString+    , ToByteString (..)++    -- * Log Messages+    , ToLog        (..)+    ) where++import           Network.AWS.Data.ByteString+import           Network.AWS.Data.Log+import           Network.AWS.Data.Text

@@ -1,55 +1,58 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE LambdaCase         #-}+{-# LANGUAGE OverloadedStrings  #-} +-- | -- Module      : Network.AWS.EC2.Metadata--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0. -- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental+-- Stability   : provisional -- Portability : non-portable (GHC extensions)---- | Retrieve an EC2 instance's local metadata.+--+-- This module contains functions for retrieving various EC2 metadata from an+-- instance's local metadata endpoint using 'MonadIO' and not one of the AWS+-- specific transformers.+--+-- It is intended to be used when you need to make metadata calls prior to+-- initialisation of the 'Network.AWS.Env.Env'.+-- If you wish to retrieve instance metadata during normal operations+-- and are using either the 'Network.AWS.AWS' or 'Control.Monad.Trans.AWS.AWST'+-- monads, then prefer one of the 'Control.Monad.Trans.AWS.metadata' related+-- functions available there, as the functions in this module do not use the+-- underlying 'FreeT' 'Network.AWS.Free.Command' DSL. module Network.AWS.EC2.Metadata     (-    -- * Requests-    -- ** Running on EC2+    -- * EC2 Instance Check       isEC2 -    -- ** Dynamic-    , Dynamic   (..)+    -- * Retrieving Instance Data     , dynamic+    , metadata+    , userdata -    -- ** Metadata+    -- ** Path Constructors+    , Dynamic   (..)     , Metadata  (..)     , Mapping   (..)     , Info      (..)     , Interface (..)-    , metadata--    -- ** User data-    , userdata     ) where -import           Control.Applicative-import           Control.Exception import           Control.Monad-import           Control.Monad.Error        (catchError, throwError)+import           Control.Monad.Catch import           Control.Monad.IO.Class-import           Control.Monad.Trans.Except-import           Data.ByteString            (ByteString)-import qualified Data.ByteString.Char8      as BS-import qualified Data.ByteString.Lazy       as LBS-import           Data.Maybe+import qualified Data.ByteString.Char8  as BS8+import qualified Data.ByteString.Lazy   as LBS import           Data.Monoid-import           Data.Text                  (Text)-import qualified Data.Text                  as Text-import           Network.AWS.Data+import qualified Data.Text              as Text+import           Network.AWS.Prelude    hiding (request) import           Network.HTTP.Conduit +import           Prelude+ data Dynamic     = FWS     -- ^ Value showing whether the customer has enabled detailed one-minute@@ -63,13 +66,14 @@     -- ^ Used to verify the document's authenticity and content against the     -- signature.     | Signature+      deriving (Eq, Ord, Show, Typeable) -instance ToPath Dynamic where-    toPath x = case x of-       FWS       -> "fws/instance-monitoring"-       Document  -> "instance-identity/document"-       PKCS7     -> "instance-identity/pkcs7"-       Signature -> "instance-identity/signature"+instance ToText Dynamic where+    toText = \case+       FWS       -> "dynamic/fws/instance-monitoring"+       Document  -> "dynamic/instance-identity/document"+       PKCS7     -> "dynamic/instance-identity/pkcs7"+       Signature -> "dynamic/instance-identity/signature"  data Metadata     = AMIId@@ -138,33 +142,33 @@     -- ^ ID of the reservation.     | SecurityGroups     -- ^ The names of the security groups applied to the instance.-      deriving (Eq, Ord, Show)+      deriving (Eq, Ord, Show, Typeable) -instance ToPath Metadata where-    toPath x = case x of-        AMIId            -> "ami-id"-        AMILaunchIndex   -> "ami-launch-index"-        AMIManifestPath  -> "ami-manifest-path"-        AncestorAMIIds   -> "ancestor-ami-ids"-        BlockDevice m    -> "block-device-mapping/" <> toPath m-        Hostname         -> "hostname"-        IAM m            -> "iam/" <> toPath m-        InstanceAction   -> "instance-action"-        InstanceId       -> "instance-id"-        InstanceType     -> "instance-type"-        KernelId         -> "kernel-id"-        LocalHostname    -> "local-hostname"-        LocalIPV4        -> "local-ipv4"-        MAC              -> "mac"-        Network n m      -> "network/interfaces/macs/" <> n <> "/" <> toPath m-        AvailabilityZone -> "placement/availability-zone"-        ProductCodes     -> "product-codes"-        PublicHostname   -> "public-hostname"-        PublicIPV4       -> "public-ipv4"-        OpenSSHKey       -> "public-keys/0/openssh-key"-        RAMDiskId        -> "ramdisk-id"-        ReservationId    -> "reservation-id"-        SecurityGroups   -> "security-groups"+instance ToText Metadata where+    toText = \case+        AMIId            -> "meta-data/ami-id"+        AMILaunchIndex   -> "meta-data/ami-launch-index"+        AMIManifestPath  -> "meta-data/ami-manifest-path"+        AncestorAMIIds   -> "meta-data/ancestor-ami-ids"+        BlockDevice m    -> "meta-data/block-device-mapping/" <> toText m+        Hostname         -> "meta-data/hostname"+        IAM m            -> "meta-data/iam/" <> toText m+        InstanceAction   -> "meta-data/instance-action"+        InstanceId       -> "meta-data/instance-id"+        InstanceType     -> "meta-data/instance-type"+        KernelId         -> "meta-data/kernel-id"+        LocalHostname    -> "meta-data/local-hostname"+        LocalIPV4        -> "meta-data/local-ipv4"+        MAC              -> "meta-data/mac"+        Network n m      -> "meta-data/network/interfaces/macs/" <> toText n <> "/" <> toText m+        AvailabilityZone -> "meta-data/placement/availability-zone"+        ProductCodes     -> "meta-data/product-codes"+        PublicHostname   -> "meta-data/public-hostname"+        PublicIPV4       -> "meta-data/public-ipv4"+        OpenSSHKey       -> "meta-data/public-keys/0/openssh-key"+        RAMDiskId        -> "meta-data/ramdisk-id"+        ReservationId    -> "meta-data/reservation-id"+        SecurityGroups   -> "meta-data/security-groups"  data Mapping     = AMI@@ -182,10 +186,10 @@     -- is associated with the given instance.     | Swap     -- ^ The virtual devices associated with swap. Not always present.-      deriving (Eq, Ord, Show)+      deriving (Eq, Ord, Show, Typeable) -instance ToPath Mapping where-    toPath x = case x of+instance ToText Mapping where+    toText = \case         AMI         -> "ami"         EBS       n -> "ebs"       <> toText n         Ephemeral n -> "ephemeral" <> toText n@@ -237,12 +241,12 @@     | IVPCIPV4_CIDRBlock     -- ^ The CIDR block of the VPC in which the interface resides. Returned only     -- for instances launched into a VPC.-      deriving (Eq, Ord, Show)+      deriving (Eq, Ord, Show, Typeable) -instance ToPath Interface where-    toPath x = case x of+instance ToText Interface where+    toText = \case         IDeviceNumber         -> "device-number"-        IIPV4Associations ip  -> "ipv4-associations/" <> ip+        IIPV4Associations ip  -> "ipv4-associations/" <> toText ip         ILocalHostname        -> "local-hostname"         ILocalIPV4s           -> "local-ipv4s"         IMAC                  -> "mac"@@ -257,7 +261,7 @@         IVPCIPV4_CIDRBlock    -> "vpc-ipv4-cidr-block"  data Info-    = Info+    = Info'     -- ^ Returns information about the last time the instance profile was updated,     -- including the instance's LastUpdated date, InstanceProfileArn,     -- and InstanceProfileId.@@ -266,15 +270,19 @@     -- Returns the temporary security credentials.     --     -- See: 'Auth' for JSON deserialisation.-      deriving (Eq, Ord, Show)+      deriving (Eq, Ord, Show, Typeable) -instance ToPath Info where-    toPath x = case x of-        Info                  -> "info"-        SecurityCredentials r -> "security-credentials/" <> fromMaybe "" r+instance ToText Info where+    toText = \case+        Info'                 -> "info"+        SecurityCredentials r -> "security-credentials/" <> maybe mempty toText r --- | Test whether the host is running on EC2 by requesting the instance-data.-isEC2 :: Manager -> IO Bool+latest :: Text+latest = "http://169.254.169.254/latest/"++-- | Test whether the underlying host is running on EC2 by+-- making an HTTP request to @http://instance-data/latest@.+isEC2 :: MonadIO m => Manager -> m Bool isEC2 m = liftIO (req `catch` err)   where     req = do@@ -284,43 +292,37 @@     err :: HttpException -> IO Bool     err = const (return False) -dynamic :: MonadIO m-        => Manager-        -> Dynamic-        -> ExceptT HttpException m ByteString-dynamic m = get m . mappend "http://169.254.169.254/latest/dynamic/" . toPath+-- | Retrieve the specified 'Dynamic' data.+--+-- Throws 'HttpException' if HTTP communication fails.+dynamic :: (MonadIO m, MonadThrow m) => Manager -> Dynamic -> m ByteString+dynamic m = get m . mappend latest . toText -metadata :: MonadIO m-         => Manager-         -> Metadata-         -> ExceptT HttpException m ByteString-metadata m = get m . mappend "http://169.254.169.254/latest/meta-data/" . toPath+-- | Retrieve the specified 'Metadata'.+--+-- Throws 'HttpException' if HTTP communication fails.+metadata :: (MonadIO m, MonadThrow m) => Manager -> Metadata -> m ByteString+metadata m = get m . mappend latest . toText -userdata :: MonadIO m-         => Manager-         -> ExceptT HttpException m (Maybe ByteString)-userdata m = Just-    `liftM` get m "http://169.254.169.254/latest/user-data"-    `catchError` err-  where-    err (StatusCodeException s _ _) | fromEnum s == 404-          = return Nothing-    err e = throwError e+-- | Retrieve the user data. Returns 'Nothing' if no user data is assigned+-- to the instance.+--+-- Throws 'HttpException' if HTTP communication fails.+userdata :: (MonadIO m, MonadCatch m) => Manager -> m (Maybe ByteString)+userdata m = do+    x <- try $ get m (latest <> "user-data")+    case x of+        Right b                 -> return (Just b)+        Left (StatusCodeException s _ _)+            | fromEnum s == 404 -> return Nothing+        Left e                  -> throwM e -get :: MonadIO m-    => Manager-    -> Text-    -> ExceptT HttpException m ByteString-get m url = ExceptT . liftIO $ req `catch` err+get :: (MonadIO m, MonadThrow m) => Manager -> Text -> m ByteString+get m url = liftIO (strip `liftM` request m url)   where-    req = Right . strip <$> request m url-     strip bs-        | BS.isSuffixOf "\n" bs = BS.init bs-        | otherwise             = bs--    err :: HttpException -> IO (Either HttpException a)-    err = return . Left+        | BS8.isSuffixOf "\n" bs = BS8.init bs+        | otherwise              = bs  request :: Manager -> Text -> IO ByteString request m url = do

@@ -0,0 +1,168 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+{-# LANGUAGE RecordWildCards   #-}++-- |+-- Module      : Network.AWS.Env+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Environment and AWS specific configuration for the+-- 'Network.AWS.AWS' and 'Control.Monad.Trans.AWS.AWST' monads.+module Network.AWS.Env+    (+    -- * Creating the Environment+      newEnv+    , newEnvWith++    , Env    (..)+    , HasEnv (..)++    -- * Scoped Actions+    , within+    , once+    , timeout+    ) where++import           Control.Applicative+import           Control.Lens+import           Control.Monad+import           Control.Monad.Catch+import           Control.Monad.IO.Class+import           Control.Monad.Reader+import           Control.Retry+import           Data.IORef+import           Data.Monoid+import           Network.AWS.Auth+import           Network.AWS.Internal.Logger+import           Network.AWS.Types+import           Network.HTTP.Conduit++import           Prelude++-- | 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+    }++-- Note: The strictness annotations aobe are applied to ensure+-- total field initialisation.++class HasEnv a where+    environment    :: Lens' a Env+    {-# MINIMAL environment #-}++    -- | The current region.+    envRegion      :: Lens' a Region++    -- | The function used to output log messages.+    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)++    -- | 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 'Manager' used to create and manage open HTTP connections.+    envManager     :: Lens' a Manager++    -- | The credentials used to sign requests for authentication with AWS.+    envAuth        :: Lens' a Auth++    -- | A memoised predicate for whether the underlying host is an EC2 instance.+    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++instance HasEnv Env where+    environment = id++instance ToLog Env where+    build Env{..} = b <> "\n" <> build _envAuth+      where+        b = buildLines+            [ "[Amazonka Env] {"+            , "  region      = " <> build _envRegion+            , "  retry (n=0) = " <> build (join $ ($ 0) . getRetryPolicy <$> _envRetryPolicy)+            , "  timeout     = " <> build _envTimeout+            , "}"+            ]++-- | Scope an action within the specific 'Region'.+within :: (MonadReader r m, HasEnv r) => Region -> m a -> m a+within r = local (envRegion .~ r)++-- | 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)++-- | Scope an action such that any HTTP response will use this timeout value.+timeout :: (MonadReader r m, HasEnv r) => Seconds -> m a -> m a+timeout s = local (envTimeout ?~ s)++-- | Creates a new environment with a new 'Manager' without debug logging+-- and uses 'getAuth' to expand/discover the supplied 'Credentials'.+-- Lenses from 'HasEnv' can be used to further configure the resulting 'Env'.+--+-- Throws 'AuthError' when environment variables or IAM profiles cannot be read.+--+-- /See:/ 'newEnvWith'.+newEnv :: (Applicative m, MonadIO m, MonadCatch m)+       => Region      -- ^ Initial region to operate in.+       -> Credentials -- ^ Credential discovery mechanism.+       -> m Env+newEnv r c = liftIO (newManager conduitManagerSettings)+    >>= newEnvWith r c Nothing++-- | /See:/ 'newEnv'+--+-- 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.+           -> Manager+           -> m Env+newEnvWith r c p m = Env r logger check Nothing Nothing m+    <$> liftIO (newIORef p)+    <*> getAuth m c+  where+    logger _ _ = return ()+    -- FIXME: verify the usage of check.+    check  _ _ = return True

@@ -0,0 +1,196 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE RankNTypes        #-}++-- |+-- Module      : Network.AWS.Free+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Defines the core AST, logic and interpreters for AWS behaviour.+module Network.AWS.Free where++import           Control.Applicative+import           Control.Monad.Reader+import           Control.Monad.Trans.Free.Church+import           Data.Conduit                    (Source, yield)+import           Network.AWS.EC2.Metadata        (Dynamic, Metadata)+import           Network.AWS.Pager+import           Network.AWS.Prelude+import           Network.AWS.Request             (requestURL)+import           Network.AWS.Types+import           Network.AWS.Waiter++#if MIN_VERSION_free(4,12,0)+#else+import           Control.Monad.Catch+import           Control.Monad.Trans.Free        (FreeT (..))+#endif++import           Prelude++data Command r where+    CheckF ::             (Bool             -> r) -> Command r+    DynF   :: Dynamic  -> (ByteString       -> r) -> Command r+    MetaF  :: Metadata -> (ByteString       -> r) -> Command r+    UserF  ::             (Maybe ByteString -> r) -> Command r++    SignF  :: (AWSPresigner (Sg s), AWSRequest a)+           => Service s+           -> UTCTime+           -> Seconds+           -> a+           -> (ClientRequest -> r)+           -> Command r++    SendF  :: (AWSSigner (Sg s), AWSRequest a)+           => Service s+           -> a+           -> (Rs a -> r)+           -> Command r++    AwaitF :: (AWSSigner (Sg s), AWSRequest a)+           => Service s+           -> Wait a+           -> a+           -> (Rs a -> r)+           -> Command r++instance Functor Command where+    fmap f = \case+        CheckF         k -> CheckF         (fmap f k)+        DynF         x k -> DynF         x (fmap f k)+        MetaF        x k -> MetaF        x (fmap f k)+        UserF          k -> UserF          (fmap f k)+        SignF  s t e x k -> SignF  s t e x (fmap f k)+        SendF  s     x k -> SendF  s     x (fmap f k)+        AwaitF s w   x k -> AwaitF s w   x (fmap f k)++#if MIN_VERSION_free(4,12,0)+#else+instance MonadThrow m => MonadThrow (FreeT Command m) where+    throwM = lift . throwM++instance MonadCatch m => MonadCatch (FreeT Command m) where+    catch (FreeT m) f = FreeT $+        liftM (fmap (`catch` f)) m `catch` (runFreeT . f)+#endif++-- | Send a request, returning the associated response if successful.+--+-- /See:/ 'sendWith'+send :: (MonadFree Command 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.+sendWith :: (MonadFree Command m, AWSSigner (Sg s), AWSRequest a)+         => (Service (Sv a) -> Service s) -- ^ Modify the default service configuration.+         -> a                             -- ^ Request.+         -> m (Rs a)+sendWith f x = liftF (SendF (f (serviceOf x)) x id)++-- | Repeatedly send a request, automatically setting markers and+-- paginating over multiple responses while available.+--+-- /See:/ 'paginateWith'+paginate :: (MonadFree Command 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.+paginateWith :: (MonadFree Command 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 rq = go rq+  where+    go !x = do+        !y <- lift $ liftF (SendF s x id)+        yield y+        maybe (pure ())+              go+              (page x y)++    !s = f (serviceOf rq)++-- | Poll the API with the supplied request until a specific 'Wait' condition+-- is fulfilled.+--+-- /See:/ 'awaitWith'+await :: (MonadFree Command m, AWSRequest a)+      => Wait a+      -> a+      -> m (Rs a)+await = awaitWith id++-- | A variant of 'await' that allows modifying the default 'Service' definition+-- used to configure the request.+awaitWith :: (MonadFree Command 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 (Rs a)+awaitWith f w x = liftF (AwaitF (f (serviceOf x)) w x id)++-- | Presign an URL that is valid from the specified time until the+-- number of seconds expiry has elapsed.+--+-- /See:/ 'presign', 'presignWith'+presignURL :: (MonadFree Command m, AWSPresigner (Sg (Sv a)), AWSRequest a)+           => UTCTime     -- ^ Signing time.+           -> Seconds     -- ^ Expiry time.+           -> a           -- ^ Request to presign.+           -> m ByteString+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 :: (MonadFree Command m, 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 :: (MonadFree Command m, 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 = liftF (SignF (f (serviceOf x)) ts ex x id)++-- | Test whether the underlying host is running on EC2.+-- For 'IO' based interpretations of 'FreeT' 'Command', this is memoised and+-- any external check occurs for the first call only.+isEC2 :: MonadFree Command m => m Bool+isEC2 = liftF (CheckF id)++-- | Retrieve the specified 'Dynamic' data.+dynamic :: MonadFree Command m => Dynamic -> m ByteString+dynamic d = liftF (DynF d id)++-- | Retrieve the specified 'Metadata'.+metadata :: MonadFree Command m => Metadata -> m ByteString+metadata m = liftF (MetaF m id)++-- | Retrieve the user data. Returns 'Nothing' if no user data is assigned+-- to the instance.+userdata :: MonadFree Command m => m (Maybe ByteString)+userdata = liftF (UserF id)

@@ -1,194 +0,0 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns      #-}---- Module      : Network.AWS.Internal.Auth--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental--- Portability : non-portable (GHC extensions)---- | Explicitly specify your Amazon AWS security credentials, or retrieve them--- from the underlying OS.-module Network.AWS.Internal.Auth where--import           Control.Applicative-import           Control.Concurrent-import           Control.Monad-import           Control.Monad.Error        (catchError, throwError)-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Except-import qualified Data.ByteString.Char8      as BS-import qualified Data.ByteString.Lazy.Char8 as LBS-import           Data.IORef-import           Data.Monoid-import           Data.Text                  (Text)-import qualified Data.Text                  as Text-import qualified Data.Text.Encoding         as Text-import           Data.Time                  (diffUTCTime, getCurrentTime)-import           Network.AWS.Data-import           Network.AWS.EC2.Metadata-import           Network.AWS.Types-import           Network.HTTP.Conduit-import           System.Environment-import           System.Mem.Weak---- | Default access key environment variable.-accessKey :: Text -- ^ 'AWS_ACCESS_KEY'-accessKey = "AWS_ACCESS_KEY"---- | Default secret key environment variable.-secretKey :: Text -- ^ 'AWS_SECRET_KEY'-secretKey = "AWS_SECRET_KEY"---- | Explicit access and secret keys.-fromKeys :: AccessKey -> SecretKey -> Auth-fromKeys a s = Auth (AuthEnv a s Nothing Nothing)---- | A session containing the access key, secret key, and a security token.-fromSession :: AccessKey -> SecretKey -> SecurityToken -> Auth-fromSession a s t = Auth (AuthEnv a s (Just t) Nothing)---- | Determines how authentication information is retrieved.-data Credentials-    = FromKeys AccessKey SecretKey-      -- ^ Explicit access and secret keys.-      -- /Note:/ you can achieve the same result purely using 'fromKeys' without-      -- having to use the impure 'getAuth'.-    | FromSession AccessKey SecretKey SecurityToken-      -- ^ A session containing the access key, secret key, and a security token.-      -- /Note:/ you can achieve the same result purely using 'fromSession'-      -- without having to use the impure 'getAuth'.-    | FromProfile Text-      -- ^ An IAM Profile name to lookup from the local EC2 instance-data.-    | FromEnv Text Text-      -- ^ Environment variables to lookup for the access and secret keys.-    | Discover-      -- ^ Attempt to read the default access and secret keys from the environment,-      -- falling back to the first available IAM profile if they are not set.-      ---      -- /Note:/ This attempts to resolve <http://instance-data> rather than directly-      -- retrieving <http://169.254.169.254> for IAM profile information to ensure-      -- the dns lookup terminates promptly if not running on EC2.-      deriving (Eq)--instance ToBuilder Credentials where-    build = \case-        FromKeys    a _   -> "FromKeys "    <> build a <> " ****"-        FromSession a _ _ -> "FromSession " <> build a <> " **** ****"-        FromProfile n     -> "FromProfile " <> build n-        FromEnv     a s   -> "FromEnv "     <> build a <> " " <> build s-        Discover          -> "Discover"--instance Show Credentials where-    show = LBS.unpack . buildBS---- | Retrieve authentication information using the specified 'Credentials' style.-getAuth :: (Functor m, MonadIO m)-        => Manager-        -> Credentials-        -> ExceptT String m Auth-getAuth m = \case-    FromKeys    a s   -> return (fromKeys a s)-    FromSession a s t -> return (fromSession a s t)-    FromProfile n     -> show `withExceptT` fromProfileName m n-    FromEnv     a s   -> fromEnvVars a s-    Discover          -> fromEnv `catchError` const (iam `catchError` const err)-      where-        iam = show `withExceptT` fromProfile m-        err = throwError "Unable to read environment variables or IAM profile."---- | Retrieve access and secret keys from the default environment variables.------ /See:/ 'accessKey' and 'secretKey'-fromEnv :: (Functor m, MonadIO m) => ExceptT String m Auth-fromEnv = fromEnvVars accessKey secretKey---- | Retrieve access and secret keys from specific environment variables.-fromEnvVars :: (Functor m, MonadIO m) => Text -> Text -> ExceptT String m Auth-fromEnvVars a s = fmap Auth $ AuthEnv-    <$> (AccessKey <$> key a)-    <*> (SecretKey <$> key s)-    <*> pure Nothing-    <*> pure Nothing-  where-    key (Text.unpack -> k) = ExceptT $ do-        m <- liftIO (lookupEnv k)-        return $-            maybe (Left $ "Unable to read ENV variable: " ++ k)-                  (Right . BS.pack)-                  m---- | Retrieve the default IAM Profile from the local EC2 instance-data.------ This determined by Amazon as the first IAM profile found in the response from:--- @http://169.254.169.254/latest/meta-data/iam/security-credentials/@-fromProfile :: MonadIO m => Manager -> ExceptT HttpException m Auth-fromProfile m = do-    !ls <- BS.lines `liftM` metadata m (IAM $ SecurityCredentials Nothing)-    case ls of-        (x:_) -> fromProfileName m (Text.decodeUtf8 x)-        _     -> throwError $-           HttpParserException "Unable to get default IAM Profile from EC2 metadata"---- | Lookup a specific IAM Profile by name from the local EC2 instance-data.------ The resulting IONewRef wrapper + timer is designed so that multiple concurrent--- accesses of 'AuthEnv' from the 'AWS' environment are not required to calculate--- expiry and sequentially queue to update it.------ The forked timer ensures a singular owner and pre-emptive refresh of the--- temporary session credentials.------ A weak reference is used to ensure that the forked thread will eventually--- terminate when 'Auth' is no longer referenced.-fromProfileName :: MonadIO m-                => Manager-                -> Text-                -> ExceptT HttpException m Auth-fromProfileName m name = auth >>= start-  where-    auth :: MonadIO m => ExceptT HttpException m AuthEnv-    auth = do-        !lbs <- LBS.fromStrict `liftM` metadata m-            (IAM . SecurityCredentials $ Just name)-        either (throwError . HttpParserException)-               return-               (eitherDecode' lbs)--    start !a = ExceptT . liftM Right . liftIO $-        case _authExpiry a of-            Nothing -> return (Auth a)-            Just x  -> do-                r <- newIORef a-                p <- myThreadId-                s <- timer r p x-                return (Ref s r)--    timer r p x = forkIO $ do-        s <- myThreadId-        w <- mkWeakIORef r (killThread s)-        loop w p x--    loop w p x = do-        diff x <$> getCurrentTime >>= threadDelay-        ea <- runExceptT auth-        case ea of-            Left   e -> throwTo p e-            Right !a -> do-                 mr <- deRefWeak w-                 case mr of-                     Nothing -> return ()-                     Just  r -> do-                         atomicWriteIORef r a-                         maybe (return ()) (loop w p) (_authExpiry a)--    diff x y = (* 1000000) $-        let n = truncate (diffUTCTime x y) - 60-         in if n > 0 then n else 1

@@ -1,29 +1,29 @@+-- | -- Module      : Network.AWS.Internal.Body--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0. -- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental+-- Stability   : provisional -- Portability : non-portable (GHC extensions)-+-- module Network.AWS.Internal.Body where  import           Control.Applicative+import           Control.Monad import           Control.Monad.IO.Class+import           Control.Monad.Morph import           Control.Monad.Trans.Resource-import           Crypto.Hash-import qualified Crypto.Hash.Conduit          as Conduit-import           Data.ByteString              (ByteString) import           Data.Conduit import qualified Data.Conduit.Binary          as Conduit import           Data.Int-import           Network.AWS.Data+import           Network.AWS.Prelude+import qualified Network.HTTP.Client          as Client import           Network.HTTP.Conduit import           System.IO --- | Unsafely construct a 'RqBody' from a source, manually specifying the+import           Prelude++-- | Construct a 'RqBody' from a source, manually specifying the -- SHA256 hash and file size. sourceBody :: Digest SHA256            -> Int64@@ -31,24 +31,47 @@            -> RqBody sourceBody h n = RqBody h . requestBodySource n --- | Unsafely construct a 'RqBody' from a 'Handle', manually specifying the+-- | Construct a 'RqBody' from a 'Handle', manually specifying the -- SHA256 hash and file size. sourceHandle :: Digest SHA256 -> Int64 -> Handle -> RqBody sourceHandle h n = sourceBody h n . Conduit.sourceHandle --- | Unsafely construct a 'RqBody' from a 'FilePath', manually specifying the+-- | Construct a 'RqBody' from a 'FilePath', manually specifying the -- SHA256 hash and file size. sourceFile :: Digest SHA256 -> Int64 -> FilePath -> RqBody sourceFile h n = sourceBody h n . Conduit.sourceFile --- | Safely construct a 'RqBody' from a 'FilePath', calculating the SHA256 hash+-- | Construct a 'RqBody' from a 'FilePath', calculating the SHA256 hash -- and file size. ----- /Note:/ While this function will perform in constant space, it will read the+-- /Note:/ While this function will perform in constant space, it will enumerate the -- entirety of the file contents _twice_. Firstly to calculate the SHA256 and -- lastly to stream the contents to the socket during sending. sourceFileIO :: MonadIO m => FilePath -> m RqBody-sourceFileIO f = liftIO $ sourceFile-    <$> runResourceT (Conduit.sourceFile f $$ Conduit.sinkHash)-    <*> fmap fromIntegral (withBinaryFile f ReadMode hFileSize)-    <*> pure f+sourceFileIO f = liftIO $+    RqBody <$> runResourceT (Conduit.sourceFile f $$ sinkSHA256)+           <*> Client.streamFile f++-- | Convenience function for obtaining the size of a file.+getFileSize :: MonadIO m => FilePath -> m Int64+getFileSize f = liftIO $ fromIntegral `liftM` withBinaryFile f ReadMode hFileSize++-- | Connect a 'Sink' to a reponse body.+sinkBody :: MonadResource m => RsBody -> Sink ByteString m a -> m a+sinkBody (RsBody src) sink = hoist liftResourceT src $$+- sink++sinkMD5 :: Monad m => Consumer ByteString m (Digest MD5)+sinkMD5 = sinkHash++sinkSHA256 :: Monad m => Consumer ByteString m (Digest SHA256)+sinkSHA256 = sinkHash++-- | A cryptonite compatible incremental hash sink.+sinkHash :: (Monad m, HashAlgorithm a) => Consumer ByteString m (Digest a)+sinkHash = sink hashInit+  where+    sink ctx = do+        b <- await+        case b of+            Nothing -> return $! hashFinalize ctx+            Just bs -> sink $! hashUpdate ctx bs

@@ -1,80 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}-{-# LANGUAGE RecordWildCards   #-}---- Module      : Network.AWS.Internal.Env--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental--- Portability : non-portable (GHC extensions)--module Network.AWS.Internal.Env where--import           Control.Lens-import           Control.Retry-import qualified Data.ByteString.Lazy.Char8 as LBS-import           Data.List                  (intersperse)-import           Data.Monoid-import           Network.AWS.Data           (ToBuilder(..), buildBS)-import           Network.AWS.Types-import           Network.HTTP.Conduit---- | 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-    , _envManager     :: Manager-    , _envAuth        :: Auth-    }---- | The current region.-envRegion :: Lens' Env Region-envRegion = lens _envRegion (\s a -> s { _envRegion = a })-{-# INLINE envRegion #-}---- | The function used to output log messages.-envLogger :: Lens' Env Logger-envLogger = lens _envLogger (\s a -> s { _envLogger = a })-{-# INLINE envLogger #-}---- | The function used to determine if an 'HttpException' should be retried.-envRetryCheck :: Lens' Env (Int -> HttpException -> IO Bool)-envRetryCheck = lens _envRetryCheck (\s a -> s { _envRetryCheck = a })-{-# INLINE envRetryCheck #-}---- | The 'RetryPolicy' used to determine backoff/on and retry delay/growth.-envRetryPolicy :: Lens' Env (Maybe RetryPolicy)-envRetryPolicy = lens _envRetryPolicy (\s a -> s { _envRetryPolicy = a })-{-# INLINE envRetryPolicy #-}---- | The 'Manager' used to create and manage open HTTP connections.-envManager :: Lens' Env Manager-envManager = lens _envManager (\s a -> s { _envManager = a })-{-# INLINE envManager #-}---- | The credentials used to sign requests for authentication with AWS.-envAuth :: Lens' Env Auth-envAuth = lens _envAuth (\s a -> s { _envAuth = a })-{-# INLINE envAuth #-}--instance ToBuilder Env where-    build Env{..} = mconcat $ intersperse "\n"-        [ "[Amazonka Env] {"-        , "  region      = " <> build _envRegion-        , "  retry (n=0) = " <> maybe "Nothing" policy _envRetryPolicy-        , build . indent $ buildBS _envAuth-        , "}"-        ]-      where-        policy (RetryPolicy f) = "Just " <> build (f 0)--        indent = mappend "  "-               . LBS.concat-               . intersperse "\n  "-               . LBS.lines

@@ -0,0 +1,143 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TypeFamilies      #-}++-- |+-- Module      : Network.AWS.Internal.HTTP+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+module Network.AWS.Internal.HTTP+    ( perform+    , retrier+    , waiter+    ) where++import           Control.Monad+import           Control.Monad.Catch+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Resource+import           Control.Retry+import           Data.List                    (intersperse)+import           Data.Monoid+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           Prelude++perform :: (MonadCatch m, MonadResource m, AWSSigner (Sg s), AWSRequest a)+        => Env+        -> Service s+        -> Request a+        -> m (Either Error (Response a))+perform e@Env{..} svc x = catches go handlers+  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))+        ]++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+      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++        Left e | Just x <- e ^? _ServiceError . to _retryCheck . _Just ->+            msg x n >> return True++        _ -> return False++    msg x n = logDebug _envLogger+        . mconcat+        . intersperse " "+        $ [ "[Retry " <> build x <> "]"+          , " after "+          , build (n + 1)+          , "attempts."+          ]++    Exponential{..} = _svcRetry++waiter :: MonadIO m+       => Env+       -> Wait a+       -> Request a+       -> m (Either Error (Response a))+       -> m (Either Error (Response a))+waiter Env{..} w@Wait{..} rq = retrying policy check+  where+    policy = limitRetries _waitAttempts+          <> constantDelay (microseconds _waitDelay)++    check n rs = do+        let a = fromMaybe AcceptRetry (accept w rq rs)+        msg n a >> return (retry a)++    retry AcceptSuccess = False+    retry AcceptFailure = False+    retry AcceptRetry   = True++    msg n a = logDebug _envLogger+        . mconcat+        . intersperse " "+        $ [ "[Await " <> build _waitName <> "]"+          , build a+          , " after "+          , build (n + 1)+          , "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)

@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- Module      : Network.AWS.Internal.Log--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental--- Portability : non-portable (GHC extensions)---- | Types and functions for optional logging machinery used during the--- request, response, and signing life-cycles.-module Network.AWS.Internal.Log where--import Control.Monad-import Control.Monad.IO.Class-import Data.ByteString.Builder-import Data.Monoid-import Network.AWS.Data-import Network.AWS.Types-import System.IO---- | This is a primitive logger which can be used to log messages to a 'Handle'.--- A more sophisticated logging library such as tinylog or FastLogger should be--- used in production code.-newLogger :: MonadIO m => LogLevel -> Handle -> m Logger-newLogger x hd = liftIO $ do-    hSetBinaryMode hd True-    hSetBuffering  hd LineBuffering-    return $ \y b ->-        when (x >= y) $-            hPutBuilder hd (b <> "\n")--info :: (MonadIO m, ToBuilder a) => Logger -> a -> m ()-info f = liftIO . f Info . build-{-# INLINE info #-}--debug :: (MonadIO m, ToBuilder a) => Logger -> a -> m ()-debug f = liftIO . f Debug . build-{-# INLINE debug #-}--trace :: (MonadIO m, ToBuilder a) => Logger -> a -> m ()-trace f = liftIO . f Trace . build-{-# INLINE trace #-}

@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : Network.AWS.Internal.Logger+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Types and functions for constructing loggers and emitting log messages.+module Network.AWS.Internal.Logger+    (+    -- * Constructing a Logger+      Logger+    , newLogger++    -- * Levels+    , LogLevel (..)+    , logError+    , logInfo+    , logDebug+    , logTrace++    -- * Building Messages+    , ToLog    (..)+    , buildLines+    ) where++import           Control.Monad+import           Control.Monad.IO.Class+import qualified Data.ByteString.Lazy.Builder as Build+import           Data.Monoid+import           Network.AWS.Data.Log+import           Network.AWS.Types+import           System.IO++import           Prelude++-- | This is a primitive logger which can be used to log builds to a 'Handle'.+--+-- /Note:/ A more sophisticated logging library such as+-- <http://hackage.haskell.org/package/tinylog tinylog> or+-- <http://hackage.haskell.org/package/FastLogger fast-logger>+-- should be used in production code.+newLogger :: MonadIO m => LogLevel -> Handle -> m Logger+newLogger x hd = liftIO $ do+    hSetBinaryMode hd True+    hSetBuffering  hd LineBuffering+    return $ \y b ->+        when (x >= y) $+            Build.hPutBuilder hd (b <> "\n")++logError, logInfo, logDebug, logTrace+ :: (MonadIO m, ToLog a) => Logger -> a -> m ()+logError f = liftIO . f Error . build+logInfo  f = liftIO . f Info  . build+logDebug f = liftIO . f Debug . build+logTrace f = liftIO . f Trace . build

@@ -1,91 +0,0 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}---- Module      : Network.AWS.Internal.Retry--- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental--- Portability : non-portable (GHC extensions)--module Network.AWS.Internal.Retry-    ( retrier-    , waiter-    ) where--import Control.Monad-import Control.Monad.IO.Class-import Control.Retry-import Data.List                (intersperse)-import Data.Monoid-import Network.AWS.Internal.Env-import Network.AWS.Internal.Log-import Network.AWS.Prelude-import Network.AWS.Types-import Network.AWS.Waiters--retrier :: (MonadIO m, AWSService (Sv a))-        => Env-        -> Request a-        -> m (Response' a)-        -> m (Response' a)-retrier Env{..} rq = retrying (fromMaybe policy _envRetryPolicy) check-  where-    policy = limitRetries _retryAttempts-       <> RetryPolicy (const $ listToMaybe [0 | not stream])-       <> RetryPolicy delay-      where-        !stream = isStreaming (_rqBody rq)--        delay n-            | n > 0     = Just $ truncate (grow * 1000000)-            | otherwise = Nothing-          where-            grow = _retryBase * (fromIntegral _retryGrowth ^^ (n - 1))--    check n = \case-        Left (ServiceError _ s e)-            | _retryCheck s e -> msg n >> return True-        Left (HttpError e)    -> do-            p <- liftIO (_envRetryCheck n e)-            when p (msg n) >> return p-        _                     -> return False--    msg n = debug _envLogger $-        "[Retrying] after " <> build (n + 1) <> " attempts."--    Exponential{..} = _svcRetry (serviceOf rq)--waiter :: MonadIO m-       => Env-       -> Wait a-       -> Request a-       -> m (Response' a)-       -> m (Response' a)-waiter Env{..} w@Wait{..} rq = retrying policy check-  where-    policy = limitRetries _waitAttempts <> constantDelay (_waitDelay * 1000000)--    check n rs = do-        let a = fromMaybe AcceptRetry (accept w rq rs)-        msg n a >> return (retry a)--    retry AcceptSuccess = False-    retry AcceptFailure = False-    retry AcceptRetry   = True--    msg n a = debug _envLogger-        . mconcat-        . intersperse " "-        $ [ "[Await " <> build _waitName <> "]"-          , build a-          , " after "-          , build (n + 1)-          , "attempts."-          ]

@@ -0,0 +1,75 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module      : Network.AWS.Presign+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- This module contains functions for presigning requests using 'MonadIO' and+-- not one of the AWS specific transformers.+--+-- It is intended for use directly with "Network.AWS.Auth" when only presigning+-- and no other AWS actions are required.+-- If you wish to presign requests and are using either the 'Network.AWS.AWS'+-- or 'Control.Monad.Trans.AWS.AWST' monads, then prefer one of the relevant+-- 'Control.Monad.Trans.AWS.presign'ing functions available there, as the+-- functions in this module do not use the underlying 'FreeT'+-- 'Network.AWS.Free.Command' DSL.+module Network.AWS.Presign where++import           Control.Lens+import           Control.Monad+import           Control.Monad.IO.Class+import           Network.AWS.Data.Time+import           Network.AWS.Prelude+import           Network.AWS.Request    (requestURL)+import           Network.AWS.Types++import           Prelude++-- | Presign an URL that is valid from the specified time until the+-- number of seconds expiry has elapsed.+--+-- /See:/ 'presign', 'presignWith'+presignURL :: (MonadIO m, AWSPresigner (Sg (Sv a)), AWSRequest a)+           => Auth+           -> Region+           -> UTCTime     -- ^ Signing time.+           -> Seconds     -- ^ Expiry time.+           -> a           -- ^ Request to presign.+           -> m ByteString+presignURL a r e ts = liftM requestURL . presign a r e ts++-- | 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)+        => 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++-- | 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.+            -> Auth+            -> Region+            -> UTCTime                       -- ^ Signing time.+            -> Seconds                       -- ^ Expiry time.+            -> a                             -- ^ Request to presign.+            -> m ClientRequest+presignWith s a r ts ex x =+    withAuth a $ \ae ->+        return . view sgRequest $+            presigned ae r ts ex (s (serviceOf x)) (request x)

@@ -0,0 +1,16 @@+-- Module      : Main+-- Copyright   : (c) 2013-2015 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)++module Main (main) where++import           Test.Tasty++main :: IO ()+main = defaultMain $+    testGroup "amazonka"+        [+        ]