{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module AWSLambda.Events.SNSEvent where
import Control.Applicative ((<|>))
import Control.Exception.Safe (MonadCatch)
import Control.Lens
import Control.Monad.IO.Class
import Data.Aeson
(FromJSON(..), genericParseJSON, withObject, (.!=), (.:), (.:?))
import Data.Aeson.Casing (aesonDrop, pascalCase)
import Data.Aeson.Embedded
import Data.Aeson.TextValue
import Data.ByteString (ByteString)
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import GHC.Generics (Generic)
import Network.AWS.Data.Base64
import Network.AWS.Data.Text (FromText)
import AWSLambda.Events.MessageAttribute
import AWSLambda.Events.Records
import AWSLambda.Handler (lambdaMain)
data SNSMessage message = SNSMessage
{ _smMessage :: !(TextValue message )
, _smMessageAttributes :: !(HashMap Text MessageAttribute)
, _smMessageId :: !Text
, _smSignature :: !Text
, _smSignatureVersion :: !Text
, _smSigningCertUrl :: !Text
, _smSubject :: !Text
, _smTimestamp :: !UTCTime
, _smTopicArn :: !Text
, _smType :: !Text
, _smUnsubscribeUrl :: !Text
} deriving (Eq, Show, Generic)
instance FromText message => FromJSON (SNSMessage message) where
parseJSON = withObject "SNSMessage'" $ \o ->
SNSMessage
<$> o .: "Message"
<*> o .:? "MessageAttributes" .!= mempty
<*> o .: "MessageId"
<*> o .: "Signature"
<*> o .: "SignatureVersion"
<*> do o .: "SigningCertUrl" <|> o .: "SigningCertURL"
<*> o .: "Subject"
<*> o .: "Timestamp"
<*> o .: "TopicArn"
<*> o .: "Type"
<*> do o .: "UnsubscribeUrl" <|> o .: "UnsubscribeURL"
$(makeLenses ''SNSMessage)
data SNSRecord message = SNSRecord
{ _srEventVersion :: !Text
, _srEventSubscriptionArn :: !Text
, _srEventSource :: !Text
, _srSns :: !(SNSMessage message)
} deriving (Eq, Show, Generic)
instance FromText message => FromJSON (SNSRecord message) where
parseJSON = genericParseJSON $ aesonDrop 3 pascalCase
$(makeLenses ''SNSRecord)
type SNSEvent message = RecordsEvent (SNSRecord message)
messages :: Traversal (SNSEvent message) (SNSEvent message') message message'
messages = reRecords . traverse . srSns . smMessage . unTextValue
embedded :: Traversal (SNSEvent (Embedded v)) (SNSEvent (Embedded v')) v v'
embedded = messages . unEmbed
binary :: Traversal' (SNSEvent Base64) ByteString
binary = messages . _Base64
traverseSns :: (FromJSON a, Applicative m) => (a -> m ()) -> SNSEvent (Embedded a) -> m ()
traverseSns act = traverseRecords $ \record ->
act $ record ^. srSns . smMessage . unTextValue . unEmbed
snsMain :: (FromJSON a, MonadCatch m, MonadIO m) => (a -> m ()) -> m ()
snsMain = lambdaMain . traverseSns