{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Galley.Aws
( Env,
mkEnv,
awsEnv,
eventQueue,
QueueUrl (..),
Amazon,
execute,
enqueue,
Error (..),
)
where
import Amazonka qualified as AWS
import Amazonka.SQS qualified as SQS
import Amazonka.SQS.Lens qualified as SQS
import Control.Lens hiding ((.=))
import Control.Monad.Catch
import Control.Monad.Trans.Resource
import Control.Retry (exponentialBackoff, limitRetries, retrying)
import Data.ByteString.Base64 qualified as B64
import Data.ByteString.Builder (toLazyByteString)
import Data.ProtoLens.Encoding
import Data.Text.Encoding (decodeLatin1)
import Data.UUID (toText)
import Data.UUID.V4
import Galley.Options
import Imports
import Network.HTTP.Client
( HttpException (..),
HttpExceptionContent (..),
Manager,
)
import Network.TLS qualified as TLS
import Proto.TeamEvents qualified as E
import System.Logger qualified as Logger
import System.Logger.Class
import Util.Options hiding (endpoint)
newtype QueueUrl = QueueUrl Text
deriving (Int -> QueueUrl -> ShowS
[QueueUrl] -> ShowS
QueueUrl -> String
(Int -> QueueUrl -> ShowS)
-> (QueueUrl -> String) -> ([QueueUrl] -> ShowS) -> Show QueueUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueueUrl -> ShowS
showsPrec :: Int -> QueueUrl -> ShowS
$cshow :: QueueUrl -> String
show :: QueueUrl -> String
$cshowList :: [QueueUrl] -> ShowS
showList :: [QueueUrl] -> ShowS
Show)
data Error where
GeneralError :: (Show e, AWS.AsError e) => e -> Error
deriving instance Show Error
deriving instance Typeable Error
instance Exception Error
data Env = Env
{ Env -> Env
_awsEnv :: !AWS.Env,
Env -> Logger
_logger :: !Logger,
Env -> QueueUrl
_eventQueue :: !QueueUrl
}
makeLenses ''Env
newtype Amazon a = Amazon
{ forall a. Amazon a -> ReaderT Env (ResourceT IO) a
unAmazon :: ReaderT Env (ResourceT IO) a
}
deriving
( (forall a b. (a -> b) -> Amazon a -> Amazon b)
-> (forall a b. a -> Amazon b -> Amazon a) -> Functor Amazon
forall a b. a -> Amazon b -> Amazon a
forall a b. (a -> b) -> Amazon a -> Amazon b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Amazon a -> Amazon b
fmap :: forall a b. (a -> b) -> Amazon a -> Amazon b
$c<$ :: forall a b. a -> Amazon b -> Amazon a
<$ :: forall a b. a -> Amazon b -> Amazon a
Functor,
Functor Amazon
Functor Amazon =>
(forall a. a -> Amazon a)
-> (forall a b. Amazon (a -> b) -> Amazon a -> Amazon b)
-> (forall a b c.
(a -> b -> c) -> Amazon a -> Amazon b -> Amazon c)
-> (forall a b. Amazon a -> Amazon b -> Amazon b)
-> (forall a b. Amazon a -> Amazon b -> Amazon a)
-> Applicative Amazon
forall a. a -> Amazon a
forall a b. Amazon a -> Amazon b -> Amazon a
forall a b. Amazon a -> Amazon b -> Amazon b
forall a b. Amazon (a -> b) -> Amazon a -> Amazon b
forall a b c. (a -> b -> c) -> Amazon a -> Amazon b -> Amazon c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Amazon a
pure :: forall a. a -> Amazon a
$c<*> :: forall a b. Amazon (a -> b) -> Amazon a -> Amazon b
<*> :: forall a b. Amazon (a -> b) -> Amazon a -> Amazon b
$cliftA2 :: forall a b c. (a -> b -> c) -> Amazon a -> Amazon b -> Amazon c
liftA2 :: forall a b c. (a -> b -> c) -> Amazon a -> Amazon b -> Amazon c
$c*> :: forall a b. Amazon a -> Amazon b -> Amazon b
*> :: forall a b. Amazon a -> Amazon b -> Amazon b
$c<* :: forall a b. Amazon a -> Amazon b -> Amazon a
<* :: forall a b. Amazon a -> Amazon b -> Amazon a
Applicative,
Applicative Amazon
Applicative Amazon =>
(forall a b. Amazon a -> (a -> Amazon b) -> Amazon b)
-> (forall a b. Amazon a -> Amazon b -> Amazon b)
-> (forall a. a -> Amazon a)
-> Monad Amazon
forall a. a -> Amazon a
forall a b. Amazon a -> Amazon b -> Amazon b
forall a b. Amazon a -> (a -> Amazon b) -> Amazon b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Amazon a -> (a -> Amazon b) -> Amazon b
>>= :: forall a b. Amazon a -> (a -> Amazon b) -> Amazon b
$c>> :: forall a b. Amazon a -> Amazon b -> Amazon b
>> :: forall a b. Amazon a -> Amazon b -> Amazon b
$creturn :: forall a. a -> Amazon a
return :: forall a. a -> Amazon a
Monad,
Monad Amazon
Monad Amazon => (forall a. IO a -> Amazon a) -> MonadIO Amazon
forall a. IO a -> Amazon a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Amazon a
liftIO :: forall a. IO a -> Amazon a
MonadIO,
Monad Amazon
Monad Amazon =>
(forall e a. (HasCallStack, Exception e) => e -> Amazon a)
-> MonadThrow Amazon
forall e a. (HasCallStack, Exception e) => e -> Amazon a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> Amazon a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Amazon a
MonadThrow,
MonadThrow Amazon
MonadThrow Amazon =>
(forall e a.
(HasCallStack, Exception e) =>
Amazon a -> (e -> Amazon a) -> Amazon a)
-> MonadCatch Amazon
forall e a.
(HasCallStack, Exception e) =>
Amazon a -> (e -> Amazon a) -> Amazon a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
Amazon a -> (e -> Amazon a) -> Amazon a
catch :: forall e a.
(HasCallStack, Exception e) =>
Amazon a -> (e -> Amazon a) -> Amazon a
MonadCatch,
MonadCatch Amazon
MonadCatch Amazon =>
(forall b.
HasCallStack =>
((forall a. Amazon a -> Amazon a) -> Amazon b) -> Amazon b)
-> (forall b.
HasCallStack =>
((forall a. Amazon a -> Amazon a) -> Amazon b) -> Amazon b)
-> (forall a b c.
HasCallStack =>
Amazon a
-> (a -> ExitCase b -> Amazon c)
-> (a -> Amazon b)
-> Amazon (b, c))
-> MonadMask Amazon
forall b.
HasCallStack =>
((forall a. Amazon a -> Amazon a) -> Amazon b) -> Amazon b
forall a b c.
HasCallStack =>
Amazon a
-> (a -> ExitCase b -> Amazon c)
-> (a -> Amazon b)
-> Amazon (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. Amazon a -> Amazon a) -> Amazon b) -> Amazon b
mask :: forall b.
HasCallStack =>
((forall a. Amazon a -> Amazon a) -> Amazon b) -> Amazon b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Amazon a -> Amazon a) -> Amazon b) -> Amazon b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Amazon a -> Amazon a) -> Amazon b) -> Amazon b
$cgeneralBracket :: forall a b c.
HasCallStack =>
Amazon a
-> (a -> ExitCase b -> Amazon c)
-> (a -> Amazon b)
-> Amazon (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Amazon a
-> (a -> ExitCase b -> Amazon c)
-> (a -> Amazon b)
-> Amazon (b, c)
MonadMask,
MonadReader Env,
MonadIO Amazon
MonadIO Amazon =>
(forall a. ResourceT IO a -> Amazon a) -> MonadResource Amazon
forall a. ResourceT IO a -> Amazon a
forall (m :: * -> *).
MonadIO m =>
(forall a. ResourceT IO a -> m a) -> MonadResource m
$cliftResourceT :: forall a. ResourceT IO a -> Amazon a
liftResourceT :: forall a. ResourceT IO a -> Amazon a
MonadResource,
MonadIO Amazon
MonadIO Amazon =>
(forall b. ((forall a. Amazon a -> IO a) -> IO b) -> Amazon b)
-> MonadUnliftIO Amazon
forall b. ((forall a. Amazon a -> IO a) -> IO b) -> Amazon b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. Amazon a -> IO a) -> IO b) -> Amazon b
withRunInIO :: forall b. ((forall a. Amazon a -> IO a) -> IO b) -> Amazon b
MonadUnliftIO
)
instance MonadLogger Amazon where
log :: Level -> (Msg -> Msg) -> Amazon ()
log Level
l Msg -> Msg
m = Getting Logger Env Logger -> Amazon Logger
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Logger Env Logger
Lens' Env Logger
logger Amazon Logger -> (Logger -> Amazon ()) -> Amazon ()
forall a b. Amazon a -> (a -> Amazon b) -> Amazon b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Logger
g -> Logger -> Level -> (Msg -> Msg) -> Amazon ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
Logger.log Logger
g Level
l Msg -> Msg
m
mkEnv :: Logger -> Manager -> JournalOpts -> IO Env
mkEnv :: Logger -> Manager -> JournalOpts -> IO Env
mkEnv Logger
lgr Manager
mgr JournalOpts
opts = do
let g :: Logger
g = Maybe Text -> Logger -> Logger
Logger.clone (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aws.galley") Logger
lgr
Env
e <- Logger -> IO Env
mkAwsEnv Logger
g
QueueUrl
q <- Env -> Text -> IO QueueUrl
getQueueUrl Env
e (JournalOpts
opts JournalOpts -> Getting Text JournalOpts Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text JournalOpts Text
Lens' JournalOpts Text
queueName)
Env -> IO Env
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> Logger -> QueueUrl -> Env
Env Env
e Logger
g QueueUrl
q)
where
sqs :: AWSEndpoint -> Service
sqs AWSEndpoint
e = Bool -> ByteString -> Int -> Service -> Service
AWS.setEndpoint (AWSEndpoint
e AWSEndpoint -> Getting Bool AWSEndpoint Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool AWSEndpoint Bool
Lens' AWSEndpoint Bool
awsSecure) (AWSEndpoint
e AWSEndpoint
-> Getting ByteString AWSEndpoint ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString AWSEndpoint ByteString
Lens' AWSEndpoint ByteString
awsHost) (AWSEndpoint
e AWSEndpoint -> Getting Int AWSEndpoint Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int AWSEndpoint Int
Lens' AWSEndpoint Int
awsPort) Service
SQS.defaultService
mkAwsEnv :: Logger -> IO Env
mkAwsEnv Logger
g = do
Env
baseEnv <-
(EnvNoAuth -> IO Env) -> IO Env
forall (m :: * -> *). MonadIO m => (EnvNoAuth -> m Env) -> m Env
AWS.newEnv EnvNoAuth -> IO Env
forall (m :: * -> *) (withAuth :: * -> *).
(MonadCatch m, MonadIO m, Foldable withAuth) =>
Env' withAuth -> m Env
AWS.discover
IO Env -> (Env -> Env) -> IO Env
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Service -> Env -> Env
forall (withAuth :: * -> *).
Service -> Env' withAuth -> Env' withAuth
AWS.configureService (AWSEndpoint -> Service
sqs (JournalOpts
opts JournalOpts
-> Getting AWSEndpoint JournalOpts AWSEndpoint -> AWSEndpoint
forall s a. s -> Getting a s a -> a
^. Getting AWSEndpoint JournalOpts AWSEndpoint
Lens' JournalOpts AWSEndpoint
endpoint))
Env -> IO Env
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> IO Env) -> Env -> IO Env
forall a b. (a -> b) -> a -> b
$
Env
baseEnv
{ AWS.logger = awsLogger g,
AWS.retryCheck = retryCheck,
AWS.manager = mgr
}
awsLogger :: Logger -> LogLevel -> Builder -> m ()
awsLogger Logger
g LogLevel
l = Logger -> Level -> (Msg -> Msg) -> m ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
Logger.log Logger
g (LogLevel -> Level
mapLevel LogLevel
l) ((Msg -> Msg) -> m ())
-> (Builder -> Msg -> Msg) -> Builder -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Logger.msg (ByteString -> Msg -> Msg)
-> (Builder -> ByteString) -> Builder -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
mapLevel :: LogLevel -> Level
mapLevel LogLevel
AWS.Info = Level
Logger.Info
mapLevel LogLevel
AWS.Debug = Level
Logger.Trace
mapLevel LogLevel
AWS.Trace = Level
Logger.Trace
mapLevel LogLevel
AWS.Error = Level
Logger.Debug
retryCheck :: a -> HttpException -> Bool
retryCheck a
_ InvalidUrlException {} = Bool
False
retryCheck a
n (HttpExceptionRequest Request
_ HttpExceptionContent
ex) = case HttpExceptionContent
ex of
HttpExceptionContent
_ | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
3 -> Bool
False
HttpExceptionContent
NoResponseDataReceived -> Bool
True
HttpExceptionContent
ConnectionTimeout -> Bool
True
HttpExceptionContent
ConnectionClosed -> Bool
True
ConnectionFailure SomeException
_ -> Bool
True
InternalException SomeException
x -> case SomeException -> Maybe TLSException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x of
Just TLS.HandshakeFailed {} -> Bool
True
Maybe TLSException
_ -> Bool
False
HttpExceptionContent
_ -> Bool
False
getQueueUrl :: AWS.Env -> Text -> IO QueueUrl
getQueueUrl :: Env -> Text -> IO QueueUrl
getQueueUrl Env
e Text
q = do
Either Error GetQueueUrlResponse
x <-
ResourceT IO (Either Error GetQueueUrlResponse)
-> IO (Either Error GetQueueUrlResponse)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Either Error GetQueueUrlResponse)
-> IO (Either Error GetQueueUrlResponse))
-> ResourceT IO (Either Error GetQueueUrlResponse)
-> IO (Either Error GetQueueUrlResponse)
forall a b. (a -> b) -> a -> b
$
Getting (First Error) SomeException Error
-> ResourceT IO GetQueueUrlResponse
-> ResourceT IO (Either Error GetQueueUrlResponse)
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m (Either a r)
AWS.trying Getting (First Error) SomeException Error
forall a. AsError a => Prism' a Error
Prism' SomeException Error
AWS._Error (ResourceT IO GetQueueUrlResponse
-> ResourceT IO (Either Error GetQueueUrlResponse))
-> ResourceT IO GetQueueUrlResponse
-> ResourceT IO (Either Error GetQueueUrlResponse)
forall a b. (a -> b) -> a -> b
$
Env -> GetQueueUrl -> ResourceT IO (AWSResponse GetQueueUrl)
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a,
Typeable (AWSResponse a)) =>
Env -> a -> m (AWSResponse a)
AWS.send Env
e (Text -> GetQueueUrl
SQS.newGetQueueUrl Text
q)
(Error -> IO QueueUrl)
-> (GetQueueUrlResponse -> IO QueueUrl)
-> Either Error GetQueueUrlResponse
-> IO QueueUrl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(Error -> IO QueueUrl
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (Error -> IO QueueUrl) -> (Error -> Error) -> Error -> IO QueueUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Error
forall e. (Show e, AsError e) => e -> Error
GeneralError)
(QueueUrl -> IO QueueUrl
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueueUrl -> IO QueueUrl)
-> (GetQueueUrlResponse -> QueueUrl)
-> GetQueueUrlResponse
-> IO QueueUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QueueUrl
QueueUrl (Text -> QueueUrl)
-> (GetQueueUrlResponse -> Text) -> GetQueueUrlResponse -> QueueUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text GetQueueUrlResponse Text
-> GetQueueUrlResponse -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text GetQueueUrlResponse Text
Lens' GetQueueUrlResponse Text
SQS.getQueueUrlResponse_queueUrl)
Either Error GetQueueUrlResponse
x
execute :: (MonadIO m) => Env -> Amazon a -> m a
execute :: forall (m :: * -> *) a. MonadIO m => Env -> Amazon a -> m a
execute Env
e Amazon a
m = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ResourceT IO a -> IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ReaderT Env (ResourceT IO) a -> Env -> ResourceT IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Amazon a -> ReaderT Env (ResourceT IO) a
forall a. Amazon a -> ReaderT Env (ResourceT IO) a
unAmazon Amazon a
m) Env
e)
enqueue :: E.TeamEvent -> Amazon ()
enqueue :: TeamEvent -> Amazon ()
enqueue TeamEvent
e = do
QueueUrl Text
url <- Getting QueueUrl Env QueueUrl -> Amazon QueueUrl
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting QueueUrl Env QueueUrl
Lens' Env QueueUrl
eventQueue
UUID
rnd <- IO UUID -> Amazon UUID
forall a. IO a -> Amazon a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
Env
amaznkaEnv <- Getting Env Env Env -> Amazon Env
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Env Env Env
Lens' Env Env
awsEnv
Either Error SendMessageResponse
res <- RetryPolicyM Amazon
-> (RetryStatus -> Either Error SendMessageResponse -> Amazon Bool)
-> (RetryStatus -> Amazon (Either Error SendMessageResponse))
-> Amazon (Either Error SendMessageResponse)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying (Int -> RetryPolicy
limitRetries Int
5 RetryPolicyM Amazon -> RetryPolicyM Amazon -> RetryPolicyM Amazon
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicyM Amazon
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
exponentialBackoff Int
1000000) ((Either Error SendMessageResponse -> Amazon Bool)
-> RetryStatus -> Either Error SendMessageResponse -> Amazon Bool
forall a b. a -> b -> a
const Either Error SendMessageResponse -> Amazon Bool
forall (m :: * -> *) a. MonadIO m => Either Error a -> m Bool
canRetry) ((RetryStatus -> Amazon (Either Error SendMessageResponse))
-> Amazon (Either Error SendMessageResponse))
-> (RetryStatus -> Amazon (Either Error SendMessageResponse))
-> Amazon (Either Error SendMessageResponse)
forall a b. (a -> b) -> a -> b
$ Amazon (Either Error SendMessageResponse)
-> RetryStatus -> Amazon (Either Error SendMessageResponse)
forall a b. a -> b -> a
const (Env
-> SendMessage -> Amazon (Either Error (AWSResponse SendMessage))
forall r.
(AWSRequest r, Typeable r, Typeable (AWSResponse r)) =>
Env -> r -> Amazon (Either Error (AWSResponse r))
sendCatch Env
amaznkaEnv (Text -> UUID -> SendMessage
req Text
url UUID
rnd))
(Error -> Amazon ())
-> (SendMessageResponse -> Amazon ())
-> Either Error SendMessageResponse
-> Amazon ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Error -> Amazon ()
forall e a. (HasCallStack, Exception e) => e -> Amazon a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (Error -> Amazon ()) -> (Error -> Error) -> Error -> Amazon ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Error
forall e. (Show e, AsError e) => e -> Error
GeneralError) (Amazon () -> SendMessageResponse -> Amazon ()
forall a b. a -> b -> a
const (() -> Amazon ()
forall a. a -> Amazon a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) Either Error SendMessageResponse
res
where
event :: Text
event = ByteString -> Text
decodeLatin1 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TeamEvent -> ByteString
forall msg. Message msg => msg -> ByteString
encodeMessage TeamEvent
e
req :: Text -> UUID -> SendMessage
req Text
url UUID
dedup =
Text -> Text -> SendMessage
SQS.newSendMessage Text
url Text
event
SendMessage -> (SendMessage -> SendMessage) -> SendMessage
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> SendMessage -> Identity SendMessage
Lens' SendMessage (Maybe Text)
SQS.sendMessage_messageGroupId ((Maybe Text -> Identity (Maybe Text))
-> SendMessage -> Identity SendMessage)
-> Text -> SendMessage -> SendMessage
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"team.events"
SendMessage -> (SendMessage -> SendMessage) -> SendMessage
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> SendMessage -> Identity SendMessage
Lens' SendMessage (Maybe Text)
SQS.sendMessage_messageDeduplicationId ((Maybe Text -> Identity (Maybe Text))
-> SendMessage -> Identity SendMessage)
-> Text -> SendMessage -> SendMessage
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ UUID -> Text
toText UUID
dedup
sendCatch ::
( AWS.AWSRequest r,
Typeable r,
Typeable (AWS.AWSResponse r)
) =>
AWS.Env ->
r ->
Amazon (Either AWS.Error (AWS.AWSResponse r))
sendCatch :: forall r.
(AWSRequest r, Typeable r, Typeable (AWSResponse r)) =>
Env -> r -> Amazon (Either Error (AWSResponse r))
sendCatch Env
e = Getting (First Error) SomeException Error
-> Amazon (AWSResponse r) -> Amazon (Either Error (AWSResponse r))
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m (Either a r)
AWS.trying Getting (First Error) SomeException Error
forall a. AsError a => Prism' a Error
Prism' SomeException Error
AWS._Error (Amazon (AWSResponse r) -> Amazon (Either Error (AWSResponse r)))
-> (r -> Amazon (AWSResponse r))
-> r
-> Amazon (Either Error (AWSResponse r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> r -> Amazon (AWSResponse r)
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a,
Typeable (AWSResponse a)) =>
Env -> a -> m (AWSResponse a)
AWS.send Env
e
canRetry :: (MonadIO m) => Either AWS.Error a -> m Bool
canRetry :: forall (m :: * -> *) a. MonadIO m => Either Error a -> m Bool
canRetry (Right a
_) = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
canRetry (Left Error
e) = case Error
e of
AWS.TransportError (HttpExceptionRequest Request
_ HttpExceptionContent
ResponseTimeout) -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
AWS.ServiceError ServiceError
se | ServiceError
se ServiceError
-> Getting ErrorCode ServiceError ErrorCode -> ErrorCode
forall s a. s -> Getting a s a -> a
^. Getting ErrorCode ServiceError ErrorCode
Lens' ServiceError ErrorCode
AWS.serviceError_code ErrorCode -> ErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ErrorCode
AWS.ErrorCode Text
"RequestThrottled" -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Error
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False