module Aws.Sns.Commands.Publish
( SnsMessage(..)
, MessageId(..)
, snsMessage
, SqsNotification(..)
, Publish(..)
, PublishResponse(..)
, PublishErrors(..)
) where
import Aws.Core
import Aws.General
import Aws.Sns.Core
import Aws.Sns.Internal
import Control.Applicative
import Data.Aeson (ToJSON(..), FromJSON(..), (.:), withObject, encode)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Map as M
import Data.Monoid
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import Data.Typeable
import qualified Network.HTTP.Types as HTTP
import Text.XML.Cursor (($//), (&/))
import qualified Text.XML.Cursor as CU
publishAction :: SnsAction
publishAction = SnsActionPublish
data SnsMessage = SnsMessage
{ snsMessageDefault :: !T.Text
, snsMessageMap :: !(M.Map SnsProtocol T.Text)
}
deriving (Show, Read, Eq, Ord, Typeable)
snsMessageParameters :: SnsMessage -> (Method, HTTP.QueryText)
snsMessageParameters SnsMessage{..} = if M.null snsMessageMap
then (Get,)
[ ("Message", Just snsMessageDefault)
]
else (PostQuery,)
[ ("MessageStructure", Just "json")
, ("Message", (Just . T.decodeUtf8 . LB.toStrict) msg)
]
where
msg = encode
. M.insert "default" snsMessageDefault
. M.mapKeys (toText :: SnsProtocol -> String)
$ snsMessageMap
snsMessage :: T.Text -> SnsMessage
snsMessage t = SnsMessage t M.empty
newtype MessageId = MessageId { messageIdText :: T.Text }
deriving (Show, Read, Eq, Ord, Monoid, IsString, Typeable, FromJSON, ToJSON)
data SqsNotification = SqsNotification
{ sqsNotificationMessageId :: !MessageId
, sqsNotificationTopicArn :: !Arn
, sqsNotificationSubject :: !(Maybe T.Text)
, sqsNotificationMessage :: !T.Text
, sqsNotificationTimestamp :: !UTCTime
, sqsNotificationSignatureVersion :: !T.Text
, sqsNotificationSignature :: !T.Text
, sqsNotificationSigningCertURL :: !T.Text
, sqsNotificationUnsubscribeURL :: !T.Text
}
deriving (Show, Read, Eq, Ord, Typeable)
instance FromJSON SqsNotification where
parseJSON = withObject "SqsNotification" $ \o -> SqsNotification
<$> o .: "MessageId"
<*> o .: "TopicArn"
<*> o .: "Subject"
<*> o .: "Message"
<*> o .: "Timestamp"
<*> o .: "SignatureVersion"
<*> o .: "Signature"
<*> o .: "SigningCertURL"
<*> o .: "UnsubscribeURL"
<* (o .: "Type" >>= expectValue ("Notification" :: T.Text))
data Publish = Publish
{ publishMessage :: !SnsMessage
, publishMessageAttributes_entry_N :: Maybe ()
, publishSubject :: !(Maybe T.Text)
, publishArn :: !(Either Arn Arn)
}
deriving (Show, Read, Eq, Ord, Typeable)
data PublishResponse = PublishResponse
{ publishMessageId :: !MessageId
}
deriving (Show, Read, Eq, Ord, Typeable)
instance ResponseConsumer r PublishResponse where
type ResponseMetadata PublishResponse = SnsMetadata
responseConsumer _ = snsXmlResponseConsumer p
where
p el = PublishResponse . MessageId <$> arn el
arn el = force "Missing Message Id" $ el
$// CU.laxElement "PublishResult"
&/ CU.laxElement "MessageId"
&/ CU.content
instance SignQuery Publish where
type ServiceConfiguration Publish = SnsConfiguration
signQuery Publish{..} = snsSignQuery SnsQuery
{ snsQueryMethod = method
, snsQueryAction = publishAction
, snsQueryParameters = msgQuery <> subject <> arn <> entry
, snsQueryBody = Nothing
}
where
(method, msgQuery) = snsMessageParameters publishMessage
subject = maybe [] (\x -> [("Subject", Just x)]) publishSubject
arn = case publishArn of
Left a -> [("TopicArn", Just $ toText a)]
Right a -> [("TargetArn", Just $ toText a)]
entry = []
instance Transaction Publish PublishResponse
instance AsMemoryResponse PublishResponse where
type MemoryResponse PublishResponse = PublishResponse
loadToMemory = return
data PublishErrors
= PublishAuthorizationError
| PublishInternalError
| PublishInvalidParameter
| PublishEndpointDisabled
| PublishInvalidParameterValue
| PublishNotFound
| PublishApplicationDisabled
deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable)