{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- | -- Module : Control.Monad.Trans.AWS -- Copyright : (c) 2013-2018 Brendan Hay -- License : Mozilla Public License, v. 2.0. -- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- -- The 'AWST' transformer provides the environment required to perform AWS -- operations. The transformer is intended to be used directly -- or embedded as a layer within a transformer stack. -- -- "Network.AWS" contains an 'IO' specialised version of 'AWST' with a typeclass -- to assist in automatically lifting operations. module Control.Monad.Trans.AWS ( -- * Running AWS Actions AWST , AWST' , runAWST , runResourceT , AWSConstraint -- * Authentication and Environment , newEnv , Env , HasEnv (..) -- ** Credential Discovery , Credentials (..) -- $discovery -- ** Supported Regions , Region (..) -- * Sending Requests -- $sending , send -- ** Pagination -- $pagination , paginate -- ** Waiters -- $waiters , await -- ** Service Configuration -- $service -- *** Overriding Defaults , configure , override -- *** Scoped Actions , reconfigure , within , once , timeout -- ** Streaming -- $streaming -- *** Request Bodies , ToHashedBody (..) , hashedFile , hashedBody -- *** Chunked Request Bodies , ToBody (..) , ChunkSize (..) , defaultChunkSize , chunkedFile , unsafeChunkedBody -- *** 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 -- ** Building Error Prisms , Error._MatchServiceError , Error.hasService , Error.hasStatus , Error.hasCode -- * Logging -- $logging , Logger , LogLevel (..) -- ** Constructing a Logger , newLogger -- ** Endpoints , Endpoint , setEndpoint -- * Re-exported Types , module Network.AWS.Types , module Network.AWS.Waiter , module Network.AWS.Pager , RqBody , HashedBody , ChunkedBody , RsBody ) where import Control.Applicative import Control.Monad.Base import Control.Monad.Catch import Control.Monad.Error.Class (MonadError (..)) import Control.Monad.IO.Unlift import Control.Monad.Morph import Control.Monad.Reader import Control.Monad.State.Class import Control.Monad.Trans.Control import Control.Monad.Trans.Resource import Control.Monad.Writer.Class import Data.Conduit hiding (await) import Data.Conduit.Lazy (MonadActive (..)) import Data.IORef import Data.Monoid import Network.AWS.Auth import Network.AWS.Env import Network.AWS.Internal.Body import Network.AWS.Internal.HTTP import Network.AWS.Internal.Logger import Network.AWS.Lens (catching, throwingM, trying, view) import Network.AWS.Pager (AWSPager (..)) import Network.AWS.Prelude as AWS import Network.AWS.Request (requestURL) import Network.AWS.Types hiding (LogLevel (..)) import Network.AWS.Waiter (Accept, Wait) import qualified Network.AWS.EC2.Metadata as EC2 import qualified Network.AWS.Error as Error import qualified Network.AWS.Presign as Sign type AWST = AWST' Env newtype AWST' r m a = AWST' { unAWST :: ReaderT r m a } deriving ( Functor , Applicative , Alternative , Monad , MonadPlus , MonadIO , MonadActive , MonadTrans ) instance MonadThrow m => MonadThrow (AWST' r m) where throwM = lift . throwM instance MonadCatch m => MonadCatch (AWST' r m) where catch (AWST' m) f = AWST' (catch m (unAWST . f)) instance MonadMask m => MonadMask (AWST' r m) where mask a = AWST' $ mask $ \u -> unAWST $ a (AWST' . u . unAWST) uninterruptibleMask a = AWST' $ uninterruptibleMask $ \u -> unAWST $ a (AWST' . u . unAWST) #if MIN_VERSION_exceptions(0,10,0) generalBracket acquire rel action = AWST' $ generalBracket (unAWST acquire) (\a ex -> unAWST $ rel a ex) (\a -> unAWST $ action a) #endif instance MonadBase b m => MonadBase b (AWST' r m) where liftBase = liftBaseDefault instance MonadTransControl (AWST' r) where type StT (AWST' r) a = StT (ReaderT r) a liftWith = defaultLiftWith AWST' unAWST restoreT = defaultRestoreT AWST' instance MonadBaseControl b m => MonadBaseControl b (AWST' r m) where type StM (AWST' r m) a = ComposeSt (AWST' r) m a liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM instance MonadUnliftIO m => MonadUnliftIO (AWST' r m) where askUnliftIO = AWST' $ (\(UnliftIO f) -> UnliftIO $ f . unAWST) <$> askUnliftIO instance MonadResource m => MonadResource (AWST' r m) where liftResourceT = lift . liftResourceT instance MonadError e m => MonadError e (AWST' r m) where throwError = lift . throwError catchError m f = AWST' (unAWST m `catchError` (unAWST . f)) instance Monad m => MonadReader r (AWST' r m) where ask = AWST' ask local f = AWST' . local f . unAWST reader = AWST' . reader instance MonadWriter w m => MonadWriter w (AWST' r m) where writer = lift . writer tell = lift . tell listen = AWST' . listen . unAWST pass = AWST' . pass . unAWST instance MonadState s m => MonadState s (AWST' r m) where get = lift get put = lift . put instance MFunctor (AWST' r) where hoist nat = AWST' . hoist nat . unAWST -- | Run an 'AWST' action with the specified environment. runAWST :: HasEnv r => r -> AWST' r m a -> m a runAWST r (AWST' m) = runReaderT m r -- | An alias for the constraints required to send requests, -- which 'AWST' implicitly fulfils. type AWSConstraint r m = ( MonadThrow m , MonadCatch m , MonadResource m , MonadReader r m , HasEnv r ) -- | Send a request, returning the associated response if successful. -- -- Throws 'Error'. send :: (AWSConstraint r m, AWSRequest a) => a -> m (Rs a) send = retrier >=> fmap snd . hoistError -- | Repeatedly send a request, automatically setting markers and -- paginating over multiple responses while available. -- -- Throws 'Error'. paginate :: (AWSConstraint r m, AWSPager a) => a -> ConduitM () (Rs a) m () paginate = go where go !x = do !y <- lift $ send x yield y maybe (pure ()) go (page x y) -- | Poll the API with the supplied request until a specific 'Wait' condition -- is fulfilled. -- -- Throws 'Error'. await :: (AWSConstraint r m, AWSRequest a) => Wait a -> a -> m Accept await w = waiter w >=> hoistError -- | Presign an URL that is valid from the specified time until the -- number of seconds expiry has elapsed. presignURL :: ( MonadIO m , MonadReader r m , HasEnv r , 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. presign :: ( MonadIO m , MonadReader r m , HasEnv r , AWSRequest a ) => UTCTime -- ^ Signing time. -> Seconds -- ^ Expiry time. -> a -- ^ Request to presign. -> m ClientRequest presign ts ex x = do Env{..} <- view environment Sign.presignWith (appEndo (getDual _envOverride)) _envAuth _envRegion ts ex x -- | Test whether the underlying host is running on EC2. -- This is memoised and any external check occurs for the first invocation only. isEC2 :: (MonadIO m, MonadReader r m, HasEnv r) => m Bool isEC2 = do ref <- view envEC2 mp <- liftIO (readIORef ref) case mp of Just p -> return p Nothing -> do m <- view envManager !p <- EC2.isEC2 m liftIO (atomicWriteIORef ref (Just p)) return p -- | Retrieve the specified 'Dynamic' data. -- -- Throws 'HttpException'. dynamic :: (MonadIO m, MonadThrow m, MonadReader r m, HasEnv r) => EC2.Dynamic -> m ByteString dynamic d = view envManager >>= flip EC2.dynamic d -- | Retrieve the specified 'Metadata'. -- -- Throws 'HttpException'. metadata :: (MonadIO m, MonadThrow m, MonadReader r m, HasEnv r) => EC2.Metadata -> m ByteString metadata m = view envManager >>= flip EC2.metadata m -- | Retrieve the user data. Returns 'Nothing' if no user data is assigned -- to the instance. -- -- Throws 'HttpException'. userdata :: (MonadIO m, MonadCatch m, MonadReader r m, HasEnv r) => m (Maybe ByteString) userdata = view envManager >>= EC2.userdata hoistError :: MonadThrow m => Either Error a -> m a hoistError = either (throwingM _Error) return {- $discovery AuthN/AuthZ information is handled similarly to other AWS SDKs. You can read some of the options available . 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 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 values such as the endpoint, retry strategy, timeout and error handlers are taken from the associated 'Service' for a request. For example, 'DynamoDB' will use the 'Network.AWS.DynamoDB.dynamoDB' configuration when sending 'PutItem', 'Query' and all other operations. You can modify a specific 'Service''s default configuration by using 'configure' or 'reconfigure'. To modify all configurations simultaneously, see 'override'. An example of how you might alter default configuration using these mechanisms is demonstrated below. Firstly, the default 'dynamoDB' service is configured to use non-SSL localhost as the endpoint: > let dynamo :: Service > dynamo = setEndpoint False "localhost" 8000 dynamoDB The updated configuration is then passed to the 'Env' during setup: > e <- newEnv Discover <&> configure dynamo > runResourceT . runAWS e $ do > -- This S3 operation will communicate with remote AWS APIs. > x <- send listBuckets > > -- DynamoDB operations will communicate with localhost:8000. > y <- send listTables > > -- Any operations for services other than DynamoDB, are not affected. > ... You can also scope the 'Endpoint' modifications (or any other 'Service' configuration) to specific actions: > e <- newEnv Discover > runResourceT . runAWS e $ do > -- Service operations here will communicate with AWS, even DynamoDB. > x <- send listTables > > reconfigure dynamo $ do > -- In here, DynamoDB operations will communicate with localhost:8000, > -- with operations for services not being affected. > ... Functions such as 'within', 'once', and 'timeout' likewise modify the underlying configuration for all service requests within their respective scope. -} {- $streaming Streaming comes in two flavours. 'HashedBody' represents a request that requires a precomputed 'SHA256' hash, or a 'ChunkedBody' type for those services that can perform incremental signing and do not require the entire payload to be hashed (such as 'S3'). The type signatures for request smart constructors advertise which respective body type is required, denoting the underlying signing capabilities. 'ToHashedBody' and 'ToBody' typeclass instances are available to construct the streaming bodies, automatically calculating any hash or size as needed for types such as 'Text', 'ByteString', or Aeson's 'Value' type. To read files and other 'IO' primitives, functions such as 'hashedFile', 'chunkedFile', or 'hashedBody' should be used. For responses that contain streaming bodies (such as 'GetObject'), you can use 'sinkBody' to connect the response body to a 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 . 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:/ -} {- $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 or . -}