Safe Haskell | None |
---|---|
Language | Haskell2010 |
Control.Monad.Trans.AWS
Contents
Description
A monad transformer built on top of functions from Network.AWS which encapsulates various common parameters, errors, and usage patterns.
- send :: (MonadCatch m, MonadResource m, MonadReader Env m, MonadError Error m, AWSRequest a) => a -> m (Rs a)
- send_ :: (MonadCatch m, MonadResource m, MonadReader Env m, MonadError Error m, AWSRequest a) => a -> m ()
- sendCatch :: (MonadCatch m, MonadResource m, MonadReader Env m, AWSRequest a) => a -> m (Response a)
- paginate :: (MonadCatch m, MonadResource m, MonadReader Env m, MonadError Error m, AWSPager a) => a -> Source m (Rs a)
- paginateCatch :: (MonadCatch m, MonadResource m, MonadReader Env m, AWSPager a) => a -> Source m (Response a)
- await :: (MonadCatch m, MonadResource m, MonadReader Env m, MonadError Error m, AWSRequest a) => Wait a -> a -> m (Rs a)
- awaitCatch :: (MonadCatch m, MonadResource m, MonadReader Env m, AWSRequest a) => Wait a -> a -> m (Response a)
- presign :: (MonadIO m, MonadReader Env m, AWSRequest a, AWSPresigner (Sg (Sv a))) => a -> UTCTime -> Integer -> m Request
- presignURL :: (MonadIO m, MonadReader Env m, AWSRequest a, AWSPresigner (Sg (Sv a))) => a -> UTCTime -> Integer -> m ByteString
- type AWS = AWST IO
- data AWST m a
- type MonadAWS m = (MonadBaseControl IO m, MonadCatch m, MonadResource m, MonadError Error m, MonadReader Env m)
- runAWST :: MonadBaseControl IO m => Env -> AWST m a -> m (Either Error a)
- data Region :: *
- within :: MonadReader Env m => Region -> m a -> m a
- once :: MonadReader Env m => m a -> m a
- data Env
- envRegion :: Lens' Env Region
- envLogger :: Lens' Env Logger
- envRetryCheck :: Lens' Env (Int -> HttpException -> IO Bool)
- envRetryPolicy :: Lens' Env (Maybe RetryPolicy)
- envManager :: Lens' Env Manager
- envAuth :: Lens' Env Auth
- newEnv :: (Functor m, MonadIO m) => Region -> Credentials -> Manager -> ExceptT String m Env
- getEnv :: Region -> Credentials -> IO Env
- data Credentials
- = FromKeys AccessKey SecretKey
- | FromSession AccessKey SecretKey SecurityToken
- | FromProfile Text
- | FromEnv Text Text
- | Discover
- fromKeys :: AccessKey -> SecretKey -> Auth
- fromSession :: AccessKey -> SecretKey -> SecurityToken -> Auth
- getAuth :: (Functor m, MonadIO m) => Manager -> Credentials -> ExceptT String m Auth
- accessKey :: Text
- secretKey :: Text
- newLogger :: MonadIO m => LogLevel -> Handle -> m Logger
- info :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m ()
- debug :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m ()
- trace :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m ()
- type Error = ServiceError String
- hoistEither :: (MonadError Error m, AWSError e) => Either e a -> m a
- throwAWSError :: (MonadError Error m, AWSError e) => e -> m a
- verify :: (AWSError e, MonadError Error m) => Prism' e a -> e -> m ()
- verifyWith :: (AWSError e, MonadError Error m) => Prism' e a -> (a -> Bool) -> e -> m ()
- sourceBody :: Digest SHA256 -> Int64 -> Source (ResourceT IO) ByteString -> RqBody
- sourceHandle :: Digest SHA256 -> Int64 -> Handle -> RqBody
- sourceFile :: Digest SHA256 -> Int64 -> FilePath -> RqBody
- sourceFileIO :: MonadIO m => FilePath -> m RqBody
- class ToBuilder a where
Requests
Synchronous
send :: (MonadCatch m, MonadResource m, MonadReader Env m, MonadError Error m, AWSRequest a) => a -> m (Rs a) Source
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 () Source
sendCatch :: (MonadCatch m, MonadResource m, MonadReader Env m, AWSRequest a) => a -> m (Response a) Source
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.
Paginated
paginate :: (MonadCatch m, MonadResource m, MonadReader Env m, MonadError Error m, AWSPager a) => a -> Source m (Rs a) Source
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
paginateCatch :: (MonadCatch m, MonadResource m, MonadReader Env m, AWSPager a) => a -> Source m (Response a) Source
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.
Eventual consistency
await :: (MonadCatch m, MonadResource m, MonadReader Env m, MonadError Error m, AWSRequest a) => Wait a -> a -> m (Rs a) Source
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
awaitCatch :: (MonadCatch m, MonadResource m, MonadReader Env m, AWSRequest a) => Wait a -> a -> m (Response a) Source
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.
Pre-signing URLs
Arguments
:: (MonadIO m, MonadReader Env m, AWSRequest a, AWSPresigner (Sg (Sv a))) | |
=> a | Request to presign. |
-> UTCTime | Signing time. |
-> Integer | Expiry time in seconds. |
-> m Request |
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.
Arguments
:: (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 |
Presign a URL that expires at the specified amount of time in the future.
See: presign
Transformer
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
.
Instances
MFunctor AWST | |
MMonad AWST | |
MonadTrans AWST | |
MonadTransControl AWST | |
MonadBaseControl b m => MonadBaseControl b (AWST m) | |
Monad m => MonadError Error (AWST m) | |
Monad m => MonadReader Env (AWST m) | |
MonadBase b m => MonadBase b (AWST m) | |
(Monad m, Functor m) => Alternative (AWST m) | |
Monad m => Monad (AWST m) | |
Functor m => Functor (AWST m) | |
Monad m => MonadPlus (AWST m) | |
(Monad m, Functor m) => Applicative (AWST m) | |
MonadThrow m => MonadThrow (AWST m) | |
MonadCatch m => MonadCatch (AWST m) | |
MonadIO m => MonadIO (AWST m) | |
(Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (AWST m) | |
type StT AWST a = StT (ExceptT Error) (StT (ReaderT (Env, InternalState)) a) | |
type StM (AWST m) a = ComposeSt AWST m a |
type MonadAWS m = (MonadBaseControl IO m, MonadCatch m, MonadResource m, MonadError Error m, MonadReader Env m) Source
Provides an alias for shortening type signatures if preferred.
Note: requires the ConstraintKinds
extension.
Running
Regionalisation
data Region :: *
Constructors
Ireland | |
Frankfurt | |
Tokyo | |
Singapore | |
Sydney | |
Beijing | |
NorthVirginia | |
NorthCalifornia | |
Oregon | |
GovCloud | |
GovCloudFIPS | |
SaoPaulo |
Instances
Eq Region | |
Ord Region | |
Read Region | |
Show Region | |
Generic Region | |
Default Region | |
Hashable Region | |
ToXML Region | |
FromXML Region | |
ToText Region | |
FromText Region | |
ToByteString Region | |
ToBuilder Region | |
type Rep Region = D1 D1Region ((:+:) ((:+:) ((:+:) (C1 C1_0Region U1) ((:+:) (C1 C1_1Region U1) (C1 C1_2Region U1))) ((:+:) (C1 C1_3Region U1) ((:+:) (C1 C1_4Region U1) (C1 C1_5Region U1)))) ((:+:) ((:+:) (C1 C1_6Region U1) ((:+:) (C1 C1_7Region U1) (C1 C1_8Region U1))) ((:+:) (C1 C1_9Region U1) ((:+:) (C1 C1_10Region U1) (C1 C1_11Region U1))))) |
within :: MonadReader Env m => Region -> m a -> m a Source
Scope a monadic action within the specific Region
.
Retries
once :: MonadReader Env m => m a -> m a Source
Scope a monadic action such that any retry logic for the Service
is
ignored and any requests will at most be sent once.
Environment
The environment containing the parameters required to make AWS requests.
Lenses
envRetryCheck :: Lens' Env (Int -> HttpException -> IO Bool) Source
The function used to determine if an HttpException
should be retried.
envRetryPolicy :: Lens' Env (Maybe RetryPolicy) Source
The RetryPolicy
used to determine backoffon and retry delaygrowth.
Creating the environment
newEnv :: (Functor m, MonadIO m) => Region -> Credentials -> Manager -> ExceptT String m Env Source
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.
Specifying credentials
data Credentials Source
Determines how authentication information is retrieved.
Constructors
FromKeys AccessKey SecretKey | Explicit access and secret keys.
Note: you can achieve the same result purely using |
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 |
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. |
Instances
fromSession :: AccessKey -> SecretKey -> SecurityToken -> Auth Source
A session containing the access key, secret key, and a security token.
getAuth :: (Functor m, MonadIO m) => Manager -> Credentials -> ExceptT String m Auth Source
Retrieve authentication information using the specified Credentials
style.
Logging
newLogger :: MonadIO m => LogLevel -> Handle -> m Logger Source
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.
info :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m () Source
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.
debug :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m () Source
Use the supplied logger from envLogger
to log debug messages.
trace :: (MonadIO m, MonadReader Env m, ToBuilder a) => a -> m () Source
Use the supplied logger from envLogger
to log trace messages.
Errors
hoistEither :: (MonadError Error m, AWSError e) => Either e a -> m a Source
throwAWSError :: (MonadError Error m, AWSError e) => e -> m a Source
Throw any AWSError
using throwError
.
verify :: (AWSError e, MonadError Error m) => Prism' e a -> e -> m () Source
Verify that an AWSError
matches the given Prism
, otherwise throw the
error using throwAWSError
.
verifyWith :: (AWSError e, MonadError Error m) => Prism' e a -> (a -> Bool) -> e -> m () Source
Streaming body helpers
sourceBody :: Digest SHA256 -> Int64 -> Source (ResourceT IO) ByteString -> RqBody Source
Unsafely construct a RqBody
from a source, manually specifying the
SHA256 hash and file size.
sourceHandle :: Digest SHA256 -> Int64 -> Handle -> RqBody Source
Unsafely construct a RqBody
from a Handle
, manually specifying the
SHA256 hash and file size.
sourceFile :: Digest SHA256 -> Int64 -> FilePath -> RqBody Source
Unsafely construct a RqBody
from a FilePath
, manually specifying the
SHA256 hash and file size.
sourceFileIO :: MonadIO m => FilePath -> m RqBody Source
Safely 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 entirety of the file contents _twice_. Firstly to calculate the SHA256 and lastly to stream the contents to the socket during sending.
Types
class ToBuilder a where
Minimal complete definition
Nothing
Instances
ToBuilder Bool | |
ToBuilder Char | |
ToBuilder Double | |
ToBuilder Int | |
ToBuilder Int64 | |
ToBuilder Integer | |
ToBuilder ByteString | |
ToBuilder Builder | |
ToBuilder Text | |
ToBuilder UTCTime | |
ToBuilder RequestBody | |
ToBuilder Request | |
ToBuilder StdMethod | |
ToBuilder HttpVersion | |
ToBuilder Natural | |
ToBuilder LazyByteString | |
ToBuilder RsBody | |
ToBuilder RqBody | |
ToBuilder Region | |
ToBuilder AuthEnv | |
ToBuilder Auth | |
ToBuilder AccessKey | |
ToBuilder Env | |
ToBuilder Accept | |
ToBuilder Credentials | |
ToBuilder [Char] | |
ToBuilder [Header] | |
ToBuilder a => ToBuilder (Maybe a) | |
ToBuilder a => ToBuilder (CI a) | |
ToBuilder (Digest a) | |
ToBuilder (Response a) | |
ToBuilder (Request a) | |
ToBuilder (Meta V4) | |
ToBuilder (Meta V2) |