module Aws.Sqs.Commands.Message
(
-- * User Message Attributes
  UserMessageAttributeCustomType
, UserMessageAttributeValue(..)
, UserMessageAttributeName
, UserMessageAttribute

-- * Send Message
, SendMessage(..)
, SendMessageResponse(..)

-- * Delete Message
, DeleteMessage(..)
, DeleteMessageResponse(..)

-- * Receive Message
, Message(..)
, ReceiveMessage(..)
, ReceiveMessageResponse(..)

-- * Change Message Visiblity
, ChangeMessageVisibility(..)
, ChangeMessageVisibilityResponse(..)
) where

import Aws.Core
import Aws.Sqs.Core
import Control.Applicative
import Control.Monad.Trans.Resource (throwM)
import Data.Maybe
import Data.Monoid
import Text.XML.Cursor (($/), ($//), (&/), (&|))
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Scientific
import qualified Network.HTTP.Types as HTTP
import Text.Read (readEither)
import qualified Text.XML.Cursor as Cu
import Prelude

-- -------------------------------------------------------------------------- --
-- User Message Attributes

-- | You can append a custom type label to the supported data types (String,
-- Number, and Binary) to create custom data types. This capability is similar
-- to type traits in programming languages. For example, if you have an
-- application that needs to know which type of number is being sent in the
-- message, then you could create custom types similar to the following:
-- Number.byte, Number.short, Number.int, and Number.float. Another example
-- using the binary data type is to use Binary.gif and Binary.png to
-- distinguish among different image file types in a message or batch of
-- messages. The appended data is optional and opaque to Amazon SQS, which
-- means that the appended data is not interpreted, validated, or used by
-- Amazon SQS. The Custom Type extension has the same restrictions on allowed
-- characters as the message body.
--
type UserMessageAttributeCustomType = T.Text

-- | Message Attribute Value
--
-- The user-specified message attribute value. For string data types, the value
-- attribute has the same restrictions on the content as the message body. For
-- more information, see SendMessage.
--
-- Name, type, and value must not be empty or null. In addition, the message
-- body should not be empty or null. All parts of the message attribute,
-- including name, type, and value, are included in the message size
-- restriction, which is currently 256 KB (262,144 bytes).
--
-- The supported message attribute data types are String, Number, and Binary.
-- You can also provide custom information on the type. The data type has the
-- same restrictions on the content as the message body. The data type is case
-- sensitive, and it can be up to 256 bytes long.
--
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/2012-11-05/APIReference/API_MessageAttributeValue.html>
--
data UserMessageAttributeValue
    = UserMessageAttributeString (Maybe UserMessageAttributeCustomType) T.Text
    -- ^ Strings are Unicode with UTF-8 binary encoding.

    | UserMessageAttributeNumber (Maybe UserMessageAttributeCustomType) Scientific
    -- ^ Numbers are positive or negative integers or floating point numbers.
    -- Numbers have sufficient range and precision to encompass most of the
    -- possible values that integers, floats, and doubles typically support. A
    -- number can have up to 38 digits of precision, and it can be between
    -- 10^-128 to 10^+126. Leading and trailing zeroes are trimmed.

    | UserMessageAttributeBinary (Maybe UserMessageAttributeCustomType) B.ByteString
    -- ^ Binary type attributes can store any binary data, for example,
    -- compressed data, encrypted data, or images.

    -- UserMessageAttributesStringList (Maybe UserMessageAttributeCustomType) [T.Text]
    -- -- ^ Not implemented. Reserved for future use.

    -- UserMessageAttributeBinaryList (Maybe UserMessageAttributeCustomType) [B.ByteString]
    -- -- ^ Not implemented. Reserved for future use.

    deriving (Int -> UserMessageAttributeValue -> ShowS
[UserMessageAttributeValue] -> ShowS
UserMessageAttributeValue -> String
(Int -> UserMessageAttributeValue -> ShowS)
-> (UserMessageAttributeValue -> String)
-> ([UserMessageAttributeValue] -> ShowS)
-> Show UserMessageAttributeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserMessageAttributeValue -> ShowS
showsPrec :: Int -> UserMessageAttributeValue -> ShowS
$cshow :: UserMessageAttributeValue -> String
show :: UserMessageAttributeValue -> String
$cshowList :: [UserMessageAttributeValue] -> ShowS
showList :: [UserMessageAttributeValue] -> ShowS
Show, ReadPrec [UserMessageAttributeValue]
ReadPrec UserMessageAttributeValue
Int -> ReadS UserMessageAttributeValue
ReadS [UserMessageAttributeValue]
(Int -> ReadS UserMessageAttributeValue)
-> ReadS [UserMessageAttributeValue]
-> ReadPrec UserMessageAttributeValue
-> ReadPrec [UserMessageAttributeValue]
-> Read UserMessageAttributeValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UserMessageAttributeValue
readsPrec :: Int -> ReadS UserMessageAttributeValue
$creadList :: ReadS [UserMessageAttributeValue]
readList :: ReadS [UserMessageAttributeValue]
$creadPrec :: ReadPrec UserMessageAttributeValue
readPrec :: ReadPrec UserMessageAttributeValue
$creadListPrec :: ReadPrec [UserMessageAttributeValue]
readListPrec :: ReadPrec [UserMessageAttributeValue]
Read, UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
(UserMessageAttributeValue -> UserMessageAttributeValue -> Bool)
-> (UserMessageAttributeValue -> UserMessageAttributeValue -> Bool)
-> Eq UserMessageAttributeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
== :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
$c/= :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
/= :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
Eq, Eq UserMessageAttributeValue
Eq UserMessageAttributeValue =>
(UserMessageAttributeValue
 -> UserMessageAttributeValue -> Ordering)
-> (UserMessageAttributeValue -> UserMessageAttributeValue -> Bool)
-> (UserMessageAttributeValue -> UserMessageAttributeValue -> Bool)
-> (UserMessageAttributeValue -> UserMessageAttributeValue -> Bool)
-> (UserMessageAttributeValue -> UserMessageAttributeValue -> Bool)
-> (UserMessageAttributeValue
    -> UserMessageAttributeValue -> UserMessageAttributeValue)
-> (UserMessageAttributeValue
    -> UserMessageAttributeValue -> UserMessageAttributeValue)
-> Ord UserMessageAttributeValue
UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
UserMessageAttributeValue -> UserMessageAttributeValue -> Ordering
UserMessageAttributeValue
-> UserMessageAttributeValue -> UserMessageAttributeValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UserMessageAttributeValue -> UserMessageAttributeValue -> Ordering
compare :: UserMessageAttributeValue -> UserMessageAttributeValue -> Ordering
$c< :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
< :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
$c<= :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
<= :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
$c> :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
> :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
$c>= :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
>= :: UserMessageAttributeValue -> UserMessageAttributeValue -> Bool
$cmax :: UserMessageAttributeValue
-> UserMessageAttributeValue -> UserMessageAttributeValue
max :: UserMessageAttributeValue
-> UserMessageAttributeValue -> UserMessageAttributeValue
$cmin :: UserMessageAttributeValue
-> UserMessageAttributeValue -> UserMessageAttributeValue
min :: UserMessageAttributeValue
-> UserMessageAttributeValue -> UserMessageAttributeValue
Ord)

-- | The message attribute name can contain the following characters: A-Z, a-z,
-- 0-9, underscore(_), hyphen(-), and period (.). The name must not start or
-- end with a period, and it should not have successive periods. The name is
-- case sensitive and must be unique among all attribute names for the message.
-- The name can be up to 256 characters long. The name cannot start with "AWS."
-- or "Amazon." (or any variations in casing) because these prefixes are
-- reserved for use by Amazon Web Services.
--
type UserMessageAttributeName = T.Text

-- | Message Attribute
--
-- Name, type, and value must not be empty or null. In addition, the message
-- body should not be empty or null. All parts of the message attribute,
-- including name, type, and value, are included in the message size
-- restriction, which is currently 256 KB (262,144 bytes).
--
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/SQSMessageAttributes.html#SQSMessageAttributes.DataTypes>
--
-- /NOTE/
--
-- The Amazon SQS API reference calls this /MessageAttribute/. The Haskell
-- bindings use this term for what the Amazon documentation calls just
-- /Attributes/. In order to limit backward compatibility issues we keep the
-- terminology of the Haskell bindings and call this type
-- /UserMessageAttributes/.
--
type UserMessageAttribute = (UserMessageAttributeName, UserMessageAttributeValue)

userMessageAttributesQuery :: [UserMessageAttribute] -> HTTP.Query
userMessageAttributesQuery :: [UserMessageAttribute] -> Query
userMessageAttributesQuery = [Query] -> Query
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Query] -> Query)
-> ([UserMessageAttribute] -> [Query])
-> [UserMessageAttribute]
-> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> UserMessageAttribute -> Query)
-> [Int] -> [UserMessageAttribute] -> [Query]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> UserMessageAttribute -> Query
forall {a}. Show a => a -> UserMessageAttribute -> Query
msgAttrQuery [Int
1 :: Int ..]
  where
    msgAttrQuery :: a -> UserMessageAttribute -> Query
msgAttrQuery a
i (Text
name, UserMessageAttributeValue
value) =
        [ ( ByteString
pre ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"Name", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
name )
        , ( ByteString
pre ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"Value.DataType", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
typ )
        , ( ByteString
pre ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"Value." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
valueKey, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
encodedValue )
        ]
      where
        pre :: ByteString
pre = ByteString
"MessageAttribute." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack (a -> String
forall a. Show a => a -> String
show a
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."
        customType :: Maybe Text -> Text -> ByteString
customType Maybe Text
Nothing Text
t = Text -> ByteString
TE.encodeUtf8 Text
t
        customType (Just Text
c) Text
t = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c
        (ByteString
typ, ByteString
valueKey, ByteString
encodedValue) = case UserMessageAttributeValue
value of
            UserMessageAttributeString Maybe Text
c Text
t ->
                (Maybe Text -> Text -> ByteString
customType Maybe Text
c Text
"String", ByteString
"StringValue", Text -> ByteString
TE.encodeUtf8 Text
t)
            UserMessageAttributeNumber Maybe Text
c Scientific
n ->
                (Maybe Text -> Text -> ByteString
customType Maybe Text
c Text
"Number", ByteString
"StringValue", String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Scientific -> String
forall a. Show a => a -> String
show Scientific
n)
            UserMessageAttributeBinary  Maybe Text
c ByteString
b ->
                (Maybe Text -> Text -> ByteString
customType Maybe Text
c Text
"Binary", ByteString
"BinaryValue", ByteString
b)

-- -------------------------------------------------------------------------- --
-- Send Message

-- | Delivers a message to the specified queue. With Amazon SQS, you now have
-- the ability to send large payload messages that are up to 256KB (262,144
-- bytes) in size. To send large payloads, you must use an AWS SDK that
-- supports SigV4 signing. To verify whether SigV4 is supported for an AWS SDK,
-- check the SDK release notes.
--
-- /IMPORTANT/
--
-- The following list shows the characters (in Unicode) allowed in your
-- message, according to the W3C XML specification. For more information, go to
-- <http://www.w3.org/TR/REC-xml/#charsets> If you send any characters not
-- included in the list, your request will be rejected.
--
-- > #x9 | #xA | #xD | [#x20 to #xD7FF] | [#xE000 to #xFFFD] | [#x10000 to #x10FFFF]
--
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/2012-11-05/APIReference/API_SendMessage.html>
--
data SendMessage = SendMessage
    { SendMessage -> Text
smMessage :: !T.Text
    -- ^ The message to send. String maximum 256 KB in size.

    , SendMessage -> QueueName
smQueueName :: !QueueName
    -- ^ The URL of the Amazon SQS queue to take action on.

    , SendMessage -> [UserMessageAttribute]
smAttributes :: ![UserMessageAttribute]
    -- ^ Each message attribute consists of a Name, Type, and Value.

    , SendMessage -> Maybe Int
smDelaySeconds :: !(Maybe Int)
    -- ^ The number of seconds (0 to 900 - 15 minutes) to delay a specific
    -- message. Messages with a positive DelaySeconds value become available for
    -- processing after the delay time is finished. If you don't specify a value,
    -- the default value for the queue applies.
    }
    deriving (Int -> SendMessage -> ShowS
[SendMessage] -> ShowS
SendMessage -> String
(Int -> SendMessage -> ShowS)
-> (SendMessage -> String)
-> ([SendMessage] -> ShowS)
-> Show SendMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SendMessage -> ShowS
showsPrec :: Int -> SendMessage -> ShowS
$cshow :: SendMessage -> String
show :: SendMessage -> String
$cshowList :: [SendMessage] -> ShowS
showList :: [SendMessage] -> ShowS
Show, ReadPrec [SendMessage]
ReadPrec SendMessage
Int -> ReadS SendMessage
ReadS [SendMessage]
(Int -> ReadS SendMessage)
-> ReadS [SendMessage]
-> ReadPrec SendMessage
-> ReadPrec [SendMessage]
-> Read SendMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SendMessage
readsPrec :: Int -> ReadS SendMessage
$creadList :: ReadS [SendMessage]
readList :: ReadS [SendMessage]
$creadPrec :: ReadPrec SendMessage
readPrec :: ReadPrec SendMessage
$creadListPrec :: ReadPrec [SendMessage]
readListPrec :: ReadPrec [SendMessage]
Read, SendMessage -> SendMessage -> Bool
(SendMessage -> SendMessage -> Bool)
-> (SendMessage -> SendMessage -> Bool) -> Eq SendMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SendMessage -> SendMessage -> Bool
== :: SendMessage -> SendMessage -> Bool
$c/= :: SendMessage -> SendMessage -> Bool
/= :: SendMessage -> SendMessage -> Bool
Eq, Eq SendMessage
Eq SendMessage =>
(SendMessage -> SendMessage -> Ordering)
-> (SendMessage -> SendMessage -> Bool)
-> (SendMessage -> SendMessage -> Bool)
-> (SendMessage -> SendMessage -> Bool)
-> (SendMessage -> SendMessage -> Bool)
-> (SendMessage -> SendMessage -> SendMessage)
-> (SendMessage -> SendMessage -> SendMessage)
-> Ord SendMessage
SendMessage -> SendMessage -> Bool
SendMessage -> SendMessage -> Ordering
SendMessage -> SendMessage -> SendMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SendMessage -> SendMessage -> Ordering
compare :: SendMessage -> SendMessage -> Ordering
$c< :: SendMessage -> SendMessage -> Bool
< :: SendMessage -> SendMessage -> Bool
$c<= :: SendMessage -> SendMessage -> Bool
<= :: SendMessage -> SendMessage -> Bool
$c> :: SendMessage -> SendMessage -> Bool
> :: SendMessage -> SendMessage -> Bool
$c>= :: SendMessage -> SendMessage -> Bool
>= :: SendMessage -> SendMessage -> Bool
$cmax :: SendMessage -> SendMessage -> SendMessage
max :: SendMessage -> SendMessage -> SendMessage
$cmin :: SendMessage -> SendMessage -> SendMessage
min :: SendMessage -> SendMessage -> SendMessage
Ord)

-- | At
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/2012-11-05/APIReference/API_SendMessageResult.html>
-- all fields of @SendMessageResult@ are denoted as optional.
-- At
-- <http://queue.amazonaws.com/doc/2012-11-05/QueueService.wsdl>
-- all fields are specified as required.
--
-- The actual service seems to treat at least 'smrMD5OfMessageAttributes'
-- as optional.
--
data SendMessageResponse = SendMessageResponse
    { SendMessageResponse -> Text
smrMD5OfMessageBody :: !T.Text
    -- ^ An MD5 digest of the non-URL-encoded message body string. This can be
    -- used to verify that Amazon SQS received the message correctly. Amazon SQS
    -- first URL decodes the message before creating the MD5 digest. For
    -- information about MD5, go to <http://www.faqs.org/rfcs/rfc1321.html>.

    , SendMessageResponse -> MessageId
smrMessageId :: !MessageId
    -- ^ An element containing the message ID of the message sent to the queue.

    , SendMessageResponse -> Maybe Text
smrMD5OfMessageAttributes :: !(Maybe T.Text)
    -- ^ An MD5 digest of the non-URL-encoded message attribute string. This can
    -- be used to verify that Amazon SQS received the message correctly. Amazon
    -- SQS first URL decodes the message before creating the MD5 digest. For
    -- information about MD5, go to <http://www.faqs.org/rfcs/rfc1321.html>.
    }
    deriving (Int -> SendMessageResponse -> ShowS
[SendMessageResponse] -> ShowS
SendMessageResponse -> String
(Int -> SendMessageResponse -> ShowS)
-> (SendMessageResponse -> String)
-> ([SendMessageResponse] -> ShowS)
-> Show SendMessageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SendMessageResponse -> ShowS
showsPrec :: Int -> SendMessageResponse -> ShowS
$cshow :: SendMessageResponse -> String
show :: SendMessageResponse -> String
$cshowList :: [SendMessageResponse] -> ShowS
showList :: [SendMessageResponse] -> ShowS
Show, ReadPrec [SendMessageResponse]
ReadPrec SendMessageResponse
Int -> ReadS SendMessageResponse
ReadS [SendMessageResponse]
(Int -> ReadS SendMessageResponse)
-> ReadS [SendMessageResponse]
-> ReadPrec SendMessageResponse
-> ReadPrec [SendMessageResponse]
-> Read SendMessageResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SendMessageResponse
readsPrec :: Int -> ReadS SendMessageResponse
$creadList :: ReadS [SendMessageResponse]
readList :: ReadS [SendMessageResponse]
$creadPrec :: ReadPrec SendMessageResponse
readPrec :: ReadPrec SendMessageResponse
$creadListPrec :: ReadPrec [SendMessageResponse]
readListPrec :: ReadPrec [SendMessageResponse]
Read, SendMessageResponse -> SendMessageResponse -> Bool
(SendMessageResponse -> SendMessageResponse -> Bool)
-> (SendMessageResponse -> SendMessageResponse -> Bool)
-> Eq SendMessageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SendMessageResponse -> SendMessageResponse -> Bool
== :: SendMessageResponse -> SendMessageResponse -> Bool
$c/= :: SendMessageResponse -> SendMessageResponse -> Bool
/= :: SendMessageResponse -> SendMessageResponse -> Bool
Eq, Eq SendMessageResponse
Eq SendMessageResponse =>
(SendMessageResponse -> SendMessageResponse -> Ordering)
-> (SendMessageResponse -> SendMessageResponse -> Bool)
-> (SendMessageResponse -> SendMessageResponse -> Bool)
-> (SendMessageResponse -> SendMessageResponse -> Bool)
-> (SendMessageResponse -> SendMessageResponse -> Bool)
-> (SendMessageResponse
    -> SendMessageResponse -> SendMessageResponse)
-> (SendMessageResponse
    -> SendMessageResponse -> SendMessageResponse)
-> Ord SendMessageResponse
SendMessageResponse -> SendMessageResponse -> Bool
SendMessageResponse -> SendMessageResponse -> Ordering
SendMessageResponse -> SendMessageResponse -> SendMessageResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SendMessageResponse -> SendMessageResponse -> Ordering
compare :: SendMessageResponse -> SendMessageResponse -> Ordering
$c< :: SendMessageResponse -> SendMessageResponse -> Bool
< :: SendMessageResponse -> SendMessageResponse -> Bool
$c<= :: SendMessageResponse -> SendMessageResponse -> Bool
<= :: SendMessageResponse -> SendMessageResponse -> Bool
$c> :: SendMessageResponse -> SendMessageResponse -> Bool
> :: SendMessageResponse -> SendMessageResponse -> Bool
$c>= :: SendMessageResponse -> SendMessageResponse -> Bool
>= :: SendMessageResponse -> SendMessageResponse -> Bool
$cmax :: SendMessageResponse -> SendMessageResponse -> SendMessageResponse
max :: SendMessageResponse -> SendMessageResponse -> SendMessageResponse
$cmin :: SendMessageResponse -> SendMessageResponse -> SendMessageResponse
min :: SendMessageResponse -> SendMessageResponse -> SendMessageResponse
Ord)

instance ResponseConsumer r SendMessageResponse where
    type ResponseMetadata SendMessageResponse = SqsMetadata
    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata SendMessageResponse)
-> HTTPResponseConsumer SendMessageResponse
responseConsumer Request
_ r
_ = (Cursor -> Response SqsMetadata SendMessageResponse)
-> IORef SqsMetadata -> HTTPResponseConsumer SendMessageResponse
forall a.
(Cursor -> Response SqsMetadata a)
-> IORef SqsMetadata -> HTTPResponseConsumer a
sqsXmlResponseConsumer Cursor -> Response SqsMetadata SendMessageResponse
forall {f :: * -> *}.
MonadThrow f =>
Cursor -> f SendMessageResponse
parse
      where
        parse :: Cursor -> f SendMessageResponse
parse Cursor
el = Text -> MessageId -> Maybe Text -> SendMessageResponse
SendMessageResponse
            (Text -> MessageId -> Maybe Text -> SendMessageResponse)
-> f Text -> f (MessageId -> Maybe Text -> SendMessageResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Text] -> f Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing MD5 Signature"
                (Cursor
el Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"MD5OfMessageBody" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content)
            f (MessageId -> Maybe Text -> SendMessageResponse)
-> f MessageId -> f (Maybe Text -> SendMessageResponse)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Text -> MessageId) -> f Text -> f MessageId
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> MessageId
MessageId (f Text -> f MessageId)
-> ([Text] -> f Text) -> [Text] -> f MessageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Text] -> f Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Message Id")
                (Cursor
el Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"MessageId" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content)
            f (Maybe Text -> SendMessageResponse)
-> f (Maybe Text) -> f SendMessageResponse
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Text -> f (Maybe Text)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> f (Maybe Text))
-> ([Text] -> Maybe Text) -> [Text] -> f (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe)
                (Cursor
el Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"MD5OfMessageAttributes" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content)

instance SignQuery SendMessage where
    type ServiceConfiguration SendMessage = SqsConfiguration
    signQuery :: forall queryType.
SendMessage
-> ServiceConfiguration SendMessage queryType
-> SignatureData
-> SignedQuery
signQuery SendMessage{[UserMessageAttribute]
Maybe Int
Text
QueueName
smMessage :: SendMessage -> Text
smQueueName :: SendMessage -> QueueName
smAttributes :: SendMessage -> [UserMessageAttribute]
smDelaySeconds :: SendMessage -> Maybe Int
smMessage :: Text
smQueueName :: QueueName
smAttributes :: [UserMessageAttribute]
smDelaySeconds :: Maybe Int
..} = SqsQuery
-> SqsConfiguration queryType -> SignatureData -> SignedQuery
forall qt.
SqsQuery -> SqsConfiguration qt -> SignatureData -> SignedQuery
sqsSignQuery SqsQuery
        { sqsQueueName :: Maybe QueueName
sqsQueueName = QueueName -> Maybe QueueName
forall a. a -> Maybe a
Just QueueName
smQueueName
        , sqsQuery :: Query
sqsQuery =
            [ (ByteString
"Action", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"SendMessage")
            , (ByteString
"MessageBody", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
smMessage)
            ]
            Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [UserMessageAttribute] -> Query
userMessageAttributesQuery [UserMessageAttribute]
smAttributes
            Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Maybe QueryItem -> Query
forall a. Maybe a -> [a]
maybeToList ((ByteString
"DelaySeconds",) (Maybe ByteString -> QueryItem)
-> (Int -> Maybe ByteString) -> Int -> QueryItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Int -> ByteString) -> Int -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> QueryItem) -> Maybe Int -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
smDelaySeconds)
        }

instance Transaction SendMessage SendMessageResponse

instance AsMemoryResponse SendMessageResponse where
    type MemoryResponse SendMessageResponse = SendMessageResponse
    loadToMemory :: SendMessageResponse
-> ResourceT IO (MemoryResponse SendMessageResponse)
loadToMemory = SendMessageResponse
-> ResourceT IO (MemoryResponse SendMessageResponse)
SendMessageResponse -> ResourceT IO SendMessageResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- -------------------------------------------------------------------------- --
-- Delete Message

-- | Deletes the specified message from the specified queue. You specify the
-- message by using the message's receipt handle and not the message ID you
-- received when you sent the message. Even if the message is locked by another
-- reader due to the visibility timeout setting, it is still deleted from the
-- queue. If you leave a message in the queue for longer than the queue's
-- configured retention period, Amazon SQS automatically deletes it.
--
-- /NOTE/
--
-- The receipt handle is associated with a specific instance of receiving the
-- message. If you receive a message more than once, the receipt handle you get
-- each time you receive the message is different. When you request
-- DeleteMessage, if you don't provide the most recently received receipt
-- handle for the message, the request will still succeed, but the message
-- might not be deleted.
--
-- /IMPORTANT/
--
-- It is possible you will receive a message even after you have deleted it.
-- This might happen on rare occasions if one of the servers storing a copy of
-- the message is unavailable when you request to delete the message. The copy
-- remains on the server and might be returned to you again on a subsequent
-- receive request. You should create your system to be idempotent so that
-- receiving a particular message more than once is not a problem.
--
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/2012-11-05/APIReference/API_DeleteMessage.html>
--
data DeleteMessage = DeleteMessage
    { DeleteMessage -> ReceiptHandle
dmReceiptHandle :: !ReceiptHandle
    -- ^ The receipt handle associated with the message to delete.
    , DeleteMessage -> QueueName
dmQueueName :: !QueueName
    -- ^ The URL of the Amazon SQS queue to take action on.
    }
    deriving (Int -> DeleteMessage -> ShowS
[DeleteMessage] -> ShowS
DeleteMessage -> String
(Int -> DeleteMessage -> ShowS)
-> (DeleteMessage -> String)
-> ([DeleteMessage] -> ShowS)
-> Show DeleteMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteMessage -> ShowS
showsPrec :: Int -> DeleteMessage -> ShowS
$cshow :: DeleteMessage -> String
show :: DeleteMessage -> String
$cshowList :: [DeleteMessage] -> ShowS
showList :: [DeleteMessage] -> ShowS
Show, ReadPrec [DeleteMessage]
ReadPrec DeleteMessage
Int -> ReadS DeleteMessage
ReadS [DeleteMessage]
(Int -> ReadS DeleteMessage)
-> ReadS [DeleteMessage]
-> ReadPrec DeleteMessage
-> ReadPrec [DeleteMessage]
-> Read DeleteMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DeleteMessage
readsPrec :: Int -> ReadS DeleteMessage
$creadList :: ReadS [DeleteMessage]
readList :: ReadS [DeleteMessage]
$creadPrec :: ReadPrec DeleteMessage
readPrec :: ReadPrec DeleteMessage
$creadListPrec :: ReadPrec [DeleteMessage]
readListPrec :: ReadPrec [DeleteMessage]
Read, DeleteMessage -> DeleteMessage -> Bool
(DeleteMessage -> DeleteMessage -> Bool)
-> (DeleteMessage -> DeleteMessage -> Bool) -> Eq DeleteMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteMessage -> DeleteMessage -> Bool
== :: DeleteMessage -> DeleteMessage -> Bool
$c/= :: DeleteMessage -> DeleteMessage -> Bool
/= :: DeleteMessage -> DeleteMessage -> Bool
Eq, Eq DeleteMessage
Eq DeleteMessage =>
(DeleteMessage -> DeleteMessage -> Ordering)
-> (DeleteMessage -> DeleteMessage -> Bool)
-> (DeleteMessage -> DeleteMessage -> Bool)
-> (DeleteMessage -> DeleteMessage -> Bool)
-> (DeleteMessage -> DeleteMessage -> Bool)
-> (DeleteMessage -> DeleteMessage -> DeleteMessage)
-> (DeleteMessage -> DeleteMessage -> DeleteMessage)
-> Ord DeleteMessage
DeleteMessage -> DeleteMessage -> Bool
DeleteMessage -> DeleteMessage -> Ordering
DeleteMessage -> DeleteMessage -> DeleteMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteMessage -> DeleteMessage -> Ordering
compare :: DeleteMessage -> DeleteMessage -> Ordering
$c< :: DeleteMessage -> DeleteMessage -> Bool
< :: DeleteMessage -> DeleteMessage -> Bool
$c<= :: DeleteMessage -> DeleteMessage -> Bool
<= :: DeleteMessage -> DeleteMessage -> Bool
$c> :: DeleteMessage -> DeleteMessage -> Bool
> :: DeleteMessage -> DeleteMessage -> Bool
$c>= :: DeleteMessage -> DeleteMessage -> Bool
>= :: DeleteMessage -> DeleteMessage -> Bool
$cmax :: DeleteMessage -> DeleteMessage -> DeleteMessage
max :: DeleteMessage -> DeleteMessage -> DeleteMessage
$cmin :: DeleteMessage -> DeleteMessage -> DeleteMessage
min :: DeleteMessage -> DeleteMessage -> DeleteMessage
Ord)

data DeleteMessageResponse = DeleteMessageResponse {}
    deriving (Int -> DeleteMessageResponse -> ShowS
[DeleteMessageResponse] -> ShowS
DeleteMessageResponse -> String
(Int -> DeleteMessageResponse -> ShowS)
-> (DeleteMessageResponse -> String)
-> ([DeleteMessageResponse] -> ShowS)
-> Show DeleteMessageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteMessageResponse -> ShowS
showsPrec :: Int -> DeleteMessageResponse -> ShowS
$cshow :: DeleteMessageResponse -> String
show :: DeleteMessageResponse -> String
$cshowList :: [DeleteMessageResponse] -> ShowS
showList :: [DeleteMessageResponse] -> ShowS
Show, ReadPrec [DeleteMessageResponse]
ReadPrec DeleteMessageResponse
Int -> ReadS DeleteMessageResponse
ReadS [DeleteMessageResponse]
(Int -> ReadS DeleteMessageResponse)
-> ReadS [DeleteMessageResponse]
-> ReadPrec DeleteMessageResponse
-> ReadPrec [DeleteMessageResponse]
-> Read DeleteMessageResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DeleteMessageResponse
readsPrec :: Int -> ReadS DeleteMessageResponse
$creadList :: ReadS [DeleteMessageResponse]
readList :: ReadS [DeleteMessageResponse]
$creadPrec :: ReadPrec DeleteMessageResponse
readPrec :: ReadPrec DeleteMessageResponse
$creadListPrec :: ReadPrec [DeleteMessageResponse]
readListPrec :: ReadPrec [DeleteMessageResponse]
Read, DeleteMessageResponse -> DeleteMessageResponse -> Bool
(DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> Eq DeleteMessageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
== :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c/= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
/= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
Eq, Eq DeleteMessageResponse
Eq DeleteMessageResponse =>
(DeleteMessageResponse -> DeleteMessageResponse -> Ordering)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse -> DeleteMessageResponse -> Bool)
-> (DeleteMessageResponse
    -> DeleteMessageResponse -> DeleteMessageResponse)
-> (DeleteMessageResponse
    -> DeleteMessageResponse -> DeleteMessageResponse)
-> Ord DeleteMessageResponse
DeleteMessageResponse -> DeleteMessageResponse -> Bool
DeleteMessageResponse -> DeleteMessageResponse -> Ordering
DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeleteMessageResponse -> DeleteMessageResponse -> Ordering
compare :: DeleteMessageResponse -> DeleteMessageResponse -> Ordering
$c< :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
< :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c<= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
<= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c> :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
> :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$c>= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
>= :: DeleteMessageResponse -> DeleteMessageResponse -> Bool
$cmax :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
max :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
$cmin :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
min :: DeleteMessageResponse
-> DeleteMessageResponse -> DeleteMessageResponse
Ord)

instance ResponseConsumer r DeleteMessageResponse where
    type ResponseMetadata DeleteMessageResponse = SqsMetadata
    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata DeleteMessageResponse)
-> HTTPResponseConsumer DeleteMessageResponse
responseConsumer Request
_ r
_ = (Cursor -> Response SqsMetadata DeleteMessageResponse)
-> IORef SqsMetadata -> HTTPResponseConsumer DeleteMessageResponse
forall a.
(Cursor -> Response SqsMetadata a)
-> IORef SqsMetadata -> HTTPResponseConsumer a
sqsXmlResponseConsumer Cursor -> Response SqsMetadata DeleteMessageResponse
forall {m :: * -> *} {p}. Monad m => p -> m DeleteMessageResponse
parse
      where
        parse :: p -> m DeleteMessageResponse
parse p
_ = DeleteMessageResponse -> m DeleteMessageResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeleteMessageResponse {}

instance SignQuery DeleteMessage  where
    type ServiceConfiguration DeleteMessage = SqsConfiguration
    signQuery :: forall queryType.
DeleteMessage
-> ServiceConfiguration DeleteMessage queryType
-> SignatureData
-> SignedQuery
signQuery DeleteMessage{ReceiptHandle
QueueName
dmReceiptHandle :: DeleteMessage -> ReceiptHandle
dmQueueName :: DeleteMessage -> QueueName
dmReceiptHandle :: ReceiptHandle
dmQueueName :: QueueName
..} = SqsQuery
-> SqsConfiguration queryType -> SignatureData -> SignedQuery
forall qt.
SqsQuery -> SqsConfiguration qt -> SignatureData -> SignedQuery
sqsSignQuery SqsQuery
        { sqsQueueName :: Maybe QueueName
sqsQueueName = QueueName -> Maybe QueueName
forall a. a -> Maybe a
Just QueueName
dmQueueName
        , sqsQuery :: Query
sqsQuery =
            [ (ByteString
"Action", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"DeleteMessage")
            , (ByteString
"ReceiptHandle", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ReceiptHandle -> Text
printReceiptHandle ReceiptHandle
dmReceiptHandle)
            ]
        }

instance Transaction DeleteMessage DeleteMessageResponse

instance AsMemoryResponse DeleteMessageResponse where
    type MemoryResponse DeleteMessageResponse = DeleteMessageResponse
    loadToMemory :: DeleteMessageResponse
-> ResourceT IO (MemoryResponse DeleteMessageResponse)
loadToMemory = DeleteMessageResponse
-> ResourceT IO (MemoryResponse DeleteMessageResponse)
DeleteMessageResponse -> ResourceT IO DeleteMessageResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- -------------------------------------------------------------------------- --
-- Receive Message

-- | Retrieves one or more messages, with a maximum limit of 10 messages, from
-- the specified queue. Long poll support is enabled by using the
-- WaitTimeSeconds parameter. For more information, see
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-long-polling.html Amazon SQS Long Poll>
-- in the Amazon SQS Developer Guide.
--
-- Short poll is the default behavior where a weighted random set of machines
-- is sampled on a ReceiveMessage call. This means only the messages on the
-- sampled machines are returned. If the number of messages in the queue is
-- small (less than 1000), it is likely you will get fewer messages than you
-- requested per ReceiveMessage call. If the number of messages in the queue is
-- extremely small, you might not receive any messages in a particular
-- ReceiveMessage response; in which case you should repeat the request.
--
-- For each message returned, the response includes the following:
--
-- Message body
--
-- * MD5 digest of the message body. For information about MD5, go to
--   <http://www.faqs.org/rfcs/rfc1321.html>.
--
-- * Message ID you received when you sent the message to the queue.
--
-- * Receipt handle.
--
-- * Message attributes.
--
-- * MD5 digest of the message attributes.
--
-- The receipt handle is the identifier you must provide when deleting the
-- message. For more information, see Queue and Message Identifiers in the
-- Amazon SQS Developer Guide.
--
-- You can provide the VisibilityTimeout parameter in your request, which will
-- be applied to the messages that Amazon SQS returns in the response. If you
-- do not include the parameter, the overall visibility timeout for the queue
-- is used for the returned messages. For more information, see Visibility
-- Timeout in the Amazon SQS Developer Guide.
--
-- /NOTE/
--
-- Going forward, new attributes might be added. If you are writing code that
-- calls this action, we recommend that you structure your code so that it can
-- handle new attributes gracefully.
--
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/2012-11-05/APIReference/API_ReceiveMessage.html>
--
data ReceiveMessage = ReceiveMessage
    { ReceiveMessage -> Maybe Int
rmVisibilityTimeout :: !(Maybe Int)
    -- ^ The duration (in seconds) that the received messages are hidden from
    -- subsequent retrieve requests after being retrieved by a ReceiveMessage
    -- request.

    , ReceiveMessage -> [MessageAttribute]
rmAttributes :: ![MessageAttribute]
    -- ^ A list of attributes that need to be returned along with each message.
    --
    -- The following lists the names and descriptions of the attributes that can
    -- be returned:
    --
    -- * All - returns all values.
    --
    -- * ApproximateFirstReceiveTimestamp - returns the time when the message was
    --   first received (epoch time in milliseconds).
    --
    -- * ApproximateReceiveCount - returns the number of times a message has been
    --   received but not deleted.
    --
    -- * SenderId - returns the AWS account number (or the IP address, if
    --   anonymous access is allowed) of the sender.
    --
    -- * SentTimestamp - returns the time when the message was sent (epoch time
    --   in milliseconds).

    , ReceiveMessage -> Maybe Int
rmMaxNumberOfMessages :: !(Maybe Int)
    -- ^ The maximum number of messages to return. Amazon SQS never returns more
    -- messages than this value but may return fewer. Values can be from 1 to 10.
    -- Default is 1.
    --
    -- All of the messages are not necessarily returned.

    , ReceiveMessage -> [Text]
rmUserMessageAttributes :: ![UserMessageAttributeName]
    -- ^ The name of the message attribute, where N is the index. The message
    -- attribute name can contain the following characters: A-Z, a-z, 0-9,
    -- underscore (_), hyphen (-), and period (.). The name must not start or end
    -- with a period, and it should not have successive periods. The name is case
    -- sensitive and must be unique among all attribute names for the message.
    -- The name can be up to 256 characters long. The name cannot start with
    -- "AWS." or "Amazon." (or any variations in casing), because these prefixes
    -- are reserved for use by Amazon Web Services.
    --
    -- When using ReceiveMessage, you can send a list of attribute names to
    -- receive, or you can return all of the attributes by specifying "All" or
    -- ".*" in your request. You can also use "foo.*" to return all message
    -- attributes starting with the "foo" prefix.

    , ReceiveMessage -> QueueName
rmQueueName :: !QueueName
    -- ^The URL of the Amazon SQS queue to take action on.

    , ReceiveMessage -> Maybe Int
rmWaitTimeSeconds :: !(Maybe Int)
    -- ^ The duration (in seconds) for which the call will wait for a message to
    -- arrive in the queue before returning. If a message is available, the call
    -- will return sooner than WaitTimeSeconds.

    }
    deriving (Int -> ReceiveMessage -> ShowS
[ReceiveMessage] -> ShowS
ReceiveMessage -> String
(Int -> ReceiveMessage -> ShowS)
-> (ReceiveMessage -> String)
-> ([ReceiveMessage] -> ShowS)
-> Show ReceiveMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReceiveMessage -> ShowS
showsPrec :: Int -> ReceiveMessage -> ShowS
$cshow :: ReceiveMessage -> String
show :: ReceiveMessage -> String
$cshowList :: [ReceiveMessage] -> ShowS
showList :: [ReceiveMessage] -> ShowS
Show, ReadPrec [ReceiveMessage]
ReadPrec ReceiveMessage
Int -> ReadS ReceiveMessage
ReadS [ReceiveMessage]
(Int -> ReadS ReceiveMessage)
-> ReadS [ReceiveMessage]
-> ReadPrec ReceiveMessage
-> ReadPrec [ReceiveMessage]
-> Read ReceiveMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ReceiveMessage
readsPrec :: Int -> ReadS ReceiveMessage
$creadList :: ReadS [ReceiveMessage]
readList :: ReadS [ReceiveMessage]
$creadPrec :: ReadPrec ReceiveMessage
readPrec :: ReadPrec ReceiveMessage
$creadListPrec :: ReadPrec [ReceiveMessage]
readListPrec :: ReadPrec [ReceiveMessage]
Read, ReceiveMessage -> ReceiveMessage -> Bool
(ReceiveMessage -> ReceiveMessage -> Bool)
-> (ReceiveMessage -> ReceiveMessage -> Bool) -> Eq ReceiveMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReceiveMessage -> ReceiveMessage -> Bool
== :: ReceiveMessage -> ReceiveMessage -> Bool
$c/= :: ReceiveMessage -> ReceiveMessage -> Bool
/= :: ReceiveMessage -> ReceiveMessage -> Bool
Eq, Eq ReceiveMessage
Eq ReceiveMessage =>
(ReceiveMessage -> ReceiveMessage -> Ordering)
-> (ReceiveMessage -> ReceiveMessage -> Bool)
-> (ReceiveMessage -> ReceiveMessage -> Bool)
-> (ReceiveMessage -> ReceiveMessage -> Bool)
-> (ReceiveMessage -> ReceiveMessage -> Bool)
-> (ReceiveMessage -> ReceiveMessage -> ReceiveMessage)
-> (ReceiveMessage -> ReceiveMessage -> ReceiveMessage)
-> Ord ReceiveMessage
ReceiveMessage -> ReceiveMessage -> Bool
ReceiveMessage -> ReceiveMessage -> Ordering
ReceiveMessage -> ReceiveMessage -> ReceiveMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ReceiveMessage -> ReceiveMessage -> Ordering
compare :: ReceiveMessage -> ReceiveMessage -> Ordering
$c< :: ReceiveMessage -> ReceiveMessage -> Bool
< :: ReceiveMessage -> ReceiveMessage -> Bool
$c<= :: ReceiveMessage -> ReceiveMessage -> Bool
<= :: ReceiveMessage -> ReceiveMessage -> Bool
$c> :: ReceiveMessage -> ReceiveMessage -> Bool
> :: ReceiveMessage -> ReceiveMessage -> Bool
$c>= :: ReceiveMessage -> ReceiveMessage -> Bool
>= :: ReceiveMessage -> ReceiveMessage -> Bool
$cmax :: ReceiveMessage -> ReceiveMessage -> ReceiveMessage
max :: ReceiveMessage -> ReceiveMessage -> ReceiveMessage
$cmin :: ReceiveMessage -> ReceiveMessage -> ReceiveMessage
min :: ReceiveMessage -> ReceiveMessage -> ReceiveMessage
Ord)

-- | An Amazon SQS message.
--
-- In
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/2012-11-05/APIReference/API_Message.html>
-- all elements are denoted as optional.
-- In
-- <http://queue.amazonaws.com/doc/2012-11-05/QueueService.wsdl>
-- all elements except for the attributes are specified as required.
-- At least for the field 'mMD5OfMessageAttributes' the the service
-- is not always returning a value and therefor we make this field optional.
--
data Message = Message
    { Message -> Text
mMessageId :: !T.Text
    -- ^ A unique identifier for the message. Message IDs are considered unique
    -- across all AWS accounts for an extended period of time.

    , Message -> ReceiptHandle
mReceiptHandle :: !ReceiptHandle
    -- ^ An identifier associated with the act of receiving the message. A new
    -- receipt handle is returned every time you receive a message. When deleting
    -- a message, you provide the last received receipt handle to delete the
    -- message.

    , Message -> Text
mMD5OfBody :: !T.Text
    -- ^ An MD5 digest of the non-URL-encoded message body string.

    , Message -> Text
mBody :: T.Text
    -- ^ The message's contents (not URL-encoded).

    , Message -> [(MessageAttribute, Text)]
mAttributes :: ![(MessageAttribute,T.Text)]
    -- ^ SenderId, SentTimestamp, ApproximateReceiveCount, and/or
    -- ApproximateFirstReceiveTimestamp. SentTimestamp and
    -- ApproximateFirstReceiveTimestamp are each returned as an integer
    -- representing the epoch time in milliseconds.

    , Message -> Maybe Text
mMD5OfMessageAttributes :: !(Maybe T.Text)
    -- ^ An MD5 digest of the non-URL-encoded message attribute string. This can
    -- be used to verify that Amazon SQS received the message correctly. Amazon
    -- SQS first URL decodes the message before creating the MD5 digest. For
    -- information about MD5, go to <http://www.faqs.org/rfcs/rfc1321.html>.

    , Message -> [UserMessageAttribute]
mUserMessageAttributes :: ![UserMessageAttribute]
    -- ^ Each message attribute consists of a Name, Type, and Value.
    }
    deriving(Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show, ReadPrec [Message]
ReadPrec Message
Int -> ReadS Message
ReadS [Message]
(Int -> ReadS Message)
-> ReadS [Message]
-> ReadPrec Message
-> ReadPrec [Message]
-> Read Message
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Message
readsPrec :: Int -> ReadS Message
$creadList :: ReadS [Message]
readList :: ReadS [Message]
$creadPrec :: ReadPrec Message
readPrec :: ReadPrec Message
$creadListPrec :: ReadPrec [Message]
readListPrec :: ReadPrec [Message]
Read, Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, Eq Message
Eq Message =>
(Message -> Message -> Ordering)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Message)
-> (Message -> Message -> Message)
-> Ord Message
Message -> Message -> Bool
Message -> Message -> Ordering
Message -> Message -> Message
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Message -> Message -> Ordering
compare :: Message -> Message -> Ordering
$c< :: Message -> Message -> Bool
< :: Message -> Message -> Bool
$c<= :: Message -> Message -> Bool
<= :: Message -> Message -> Bool
$c> :: Message -> Message -> Bool
> :: Message -> Message -> Bool
$c>= :: Message -> Message -> Bool
>= :: Message -> Message -> Bool
$cmax :: Message -> Message -> Message
max :: Message -> Message -> Message
$cmin :: Message -> Message -> Message
min :: Message -> Message -> Message
Ord)

data ReceiveMessageResponse = ReceiveMessageResponse
    { ReceiveMessageResponse -> [Message]
rmrMessages :: ![Message]
    }
    deriving (Int -> ReceiveMessageResponse -> ShowS
[ReceiveMessageResponse] -> ShowS
ReceiveMessageResponse -> String
(Int -> ReceiveMessageResponse -> ShowS)
-> (ReceiveMessageResponse -> String)
-> ([ReceiveMessageResponse] -> ShowS)
-> Show ReceiveMessageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReceiveMessageResponse -> ShowS
showsPrec :: Int -> ReceiveMessageResponse -> ShowS
$cshow :: ReceiveMessageResponse -> String
show :: ReceiveMessageResponse -> String
$cshowList :: [ReceiveMessageResponse] -> ShowS
showList :: [ReceiveMessageResponse] -> ShowS
Show, ReadPrec [ReceiveMessageResponse]
ReadPrec ReceiveMessageResponse
Int -> ReadS ReceiveMessageResponse
ReadS [ReceiveMessageResponse]
(Int -> ReadS ReceiveMessageResponse)
-> ReadS [ReceiveMessageResponse]
-> ReadPrec ReceiveMessageResponse
-> ReadPrec [ReceiveMessageResponse]
-> Read ReceiveMessageResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ReceiveMessageResponse
readsPrec :: Int -> ReadS ReceiveMessageResponse
$creadList :: ReadS [ReceiveMessageResponse]
readList :: ReadS [ReceiveMessageResponse]
$creadPrec :: ReadPrec ReceiveMessageResponse
readPrec :: ReadPrec ReceiveMessageResponse
$creadListPrec :: ReadPrec [ReceiveMessageResponse]
readListPrec :: ReadPrec [ReceiveMessageResponse]
Read, ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
(ReceiveMessageResponse -> ReceiveMessageResponse -> Bool)
-> (ReceiveMessageResponse -> ReceiveMessageResponse -> Bool)
-> Eq ReceiveMessageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
== :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
$c/= :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
/= :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
Eq, Eq ReceiveMessageResponse
Eq ReceiveMessageResponse =>
(ReceiveMessageResponse -> ReceiveMessageResponse -> Ordering)
-> (ReceiveMessageResponse -> ReceiveMessageResponse -> Bool)
-> (ReceiveMessageResponse -> ReceiveMessageResponse -> Bool)
-> (ReceiveMessageResponse -> ReceiveMessageResponse -> Bool)
-> (ReceiveMessageResponse -> ReceiveMessageResponse -> Bool)
-> (ReceiveMessageResponse
    -> ReceiveMessageResponse -> ReceiveMessageResponse)
-> (ReceiveMessageResponse
    -> ReceiveMessageResponse -> ReceiveMessageResponse)
-> Ord ReceiveMessageResponse
ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
ReceiveMessageResponse -> ReceiveMessageResponse -> Ordering
ReceiveMessageResponse
-> ReceiveMessageResponse -> ReceiveMessageResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ReceiveMessageResponse -> ReceiveMessageResponse -> Ordering
compare :: ReceiveMessageResponse -> ReceiveMessageResponse -> Ordering
$c< :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
< :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
$c<= :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
<= :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
$c> :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
> :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
$c>= :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
>= :: ReceiveMessageResponse -> ReceiveMessageResponse -> Bool
$cmax :: ReceiveMessageResponse
-> ReceiveMessageResponse -> ReceiveMessageResponse
max :: ReceiveMessageResponse
-> ReceiveMessageResponse -> ReceiveMessageResponse
$cmin :: ReceiveMessageResponse
-> ReceiveMessageResponse -> ReceiveMessageResponse
min :: ReceiveMessageResponse
-> ReceiveMessageResponse -> ReceiveMessageResponse
Ord)

readMessageAttribute
    :: Cu.Cursor
    -> Response SqsMetadata (MessageAttribute,T.Text)
readMessageAttribute :: Cursor -> Response SqsMetadata (MessageAttribute, Text)
readMessageAttribute Cursor
cursor = do
    Text
name <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Name" ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Name" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
    Text
value <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Value" ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Value" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
    MessageAttribute
parsedName <- Text -> Response SqsMetadata MessageAttribute
forall (m :: * -> *). MonadThrow m => Text -> m MessageAttribute
parseMessageAttribute Text
name
    (MessageAttribute, Text)
-> Response SqsMetadata (MessageAttribute, Text)
forall a. a -> Response SqsMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return (MessageAttribute
parsedName, Text
value)

readUserMessageAttribute
    :: Cu.Cursor
    -> Response SqsMetadata UserMessageAttribute
readUserMessageAttribute :: Cursor -> Response SqsMetadata UserMessageAttribute
readUserMessageAttribute Cursor
cursor = (,)
    (Text -> UserMessageAttributeValue -> UserMessageAttribute)
-> Response SqsMetadata Text
-> Response
     SqsMetadata (UserMessageAttributeValue -> UserMessageAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Name" (Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Name" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content)
    Response
  SqsMetadata (UserMessageAttributeValue -> UserMessageAttribute)
-> Response SqsMetadata UserMessageAttributeValue
-> Response SqsMetadata UserMessageAttribute
forall a b.
Response SqsMetadata (a -> b)
-> Response SqsMetadata a -> Response SqsMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cursor -> Response SqsMetadata UserMessageAttributeValue
readUserMessageAttributeValue Cursor
cursor

readUserMessageAttributeValue
    :: Cu.Cursor
    -> Response SqsMetadata UserMessageAttributeValue
readUserMessageAttributeValue :: Cursor -> Response SqsMetadata UserMessageAttributeValue
readUserMessageAttributeValue Cursor
cursor = do
    Text
typStr <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing DataType"
        ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"DataType" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
    case Text -> (Text, Maybe Text)
parseType Text
typStr of
        (Text
"String", Maybe Text
c) -> do
            Text
val <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing StringValue"
                ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"StringValue" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
            UserMessageAttributeValue
-> Response SqsMetadata UserMessageAttributeValue
forall a. a -> Response SqsMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return (UserMessageAttributeValue
 -> Response SqsMetadata UserMessageAttributeValue)
-> UserMessageAttributeValue
-> Response SqsMetadata UserMessageAttributeValue
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> UserMessageAttributeValue
UserMessageAttributeString Maybe Text
c Text
val

        (Text
"Number", Maybe Text
c) -> do
            Text
valStr <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing StringValue"
                ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"StringValue" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
            Scientific
val <- Either String Scientific -> Response SqsMetadata Scientific
forall {a}. Either String a -> Response SqsMetadata a
tryXml (Either String Scientific -> Response SqsMetadata Scientific)
-> (String -> Either String Scientific)
-> String
-> Response SqsMetadata Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Scientific
forall a. Read a => String -> Either String a
readEither (String -> Response SqsMetadata Scientific)
-> String -> Response SqsMetadata Scientific
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
valStr
            UserMessageAttributeValue
-> Response SqsMetadata UserMessageAttributeValue
forall a. a -> Response SqsMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return (UserMessageAttributeValue
 -> Response SqsMetadata UserMessageAttributeValue)
-> UserMessageAttributeValue
-> Response SqsMetadata UserMessageAttributeValue
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Scientific -> UserMessageAttributeValue
UserMessageAttributeNumber Maybe Text
c Scientific
val

        (Text
"Binary", Maybe Text
c) -> do
            Text
val64 <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing BinaryValue"
                ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"BinaryValue" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
            ByteString
val <- Either String ByteString -> Response SqsMetadata ByteString
forall {a}. Either String a -> Response SqsMetadata a
tryXml (Either String ByteString -> Response SqsMetadata ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Response SqsMetadata ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
B64.decode (ByteString -> Response SqsMetadata ByteString)
-> ByteString -> Response SqsMetadata ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
val64
            UserMessageAttributeValue
-> Response SqsMetadata UserMessageAttributeValue
forall a. a -> Response SqsMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return (UserMessageAttributeValue
 -> Response SqsMetadata UserMessageAttributeValue)
-> UserMessageAttributeValue
-> Response SqsMetadata UserMessageAttributeValue
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ByteString -> UserMessageAttributeValue
UserMessageAttributeBinary Maybe Text
c ByteString
val

        (Text
x, Maybe Text
_) -> XmlException -> Response SqsMetadata UserMessageAttributeValue
forall e a.
(HasCallStack, Exception e) =>
e -> Response SqsMetadata a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (XmlException -> Response SqsMetadata UserMessageAttributeValue)
-> (String -> XmlException)
-> String
-> Response SqsMetadata UserMessageAttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlException
XmlException
            (String -> Response SqsMetadata UserMessageAttributeValue)
-> String -> Response SqsMetadata UserMessageAttributeValue
forall a b. (a -> b) -> a -> b
$ String
"unkown data type for MessageAttributeValue: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
x
  where
    parseType :: Text -> (Text, Maybe Text)
parseType Text
s = case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
s of
        (Text
a, Text
"") -> (Text
a, Maybe Text
forall a. Maybe a
Nothing)
        (Text
a, Text
x) -> (Text
a, Text -> Maybe Text
forall a. a -> Maybe a
Just (HasCallStack => Text -> Text
Text -> Text
T.tail Text
x))
    tryXml :: Either String a -> Response SqsMetadata a
tryXml = (String -> Response SqsMetadata a)
-> (a -> Response SqsMetadata a)
-> Either String a
-> Response SqsMetadata a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (XmlException -> Response SqsMetadata a
forall e a.
(HasCallStack, Exception e) =>
e -> Response SqsMetadata a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (XmlException -> Response SqsMetadata a)
-> (String -> XmlException) -> String -> Response SqsMetadata a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlException
XmlException) a -> Response SqsMetadata a
forall a. a -> Response SqsMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return

readMessage :: Cu.Cursor -> Response SqsMetadata Message
readMessage :: Cursor -> Response SqsMetadata Message
readMessage Cursor
cursor = do
    Text
mid <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Message Id"
        ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"MessageId" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
    Text
rh <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Reciept Handle"
        ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"ReceiptHandle" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
    Text
md5 <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing MD5 Signature"
        ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"MD5OfBody" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
    Text
body <- String -> [Text] -> Response SqsMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Body"
        ([Text] -> Response SqsMetadata Text)
-> [Text] -> Response SqsMetadata Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"Body" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content
    [(MessageAttribute, Text)]
attributes <- [Response SqsMetadata (MessageAttribute, Text)]
-> Response SqsMetadata [(MessageAttribute, Text)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        ([Response SqsMetadata (MessageAttribute, Text)]
 -> Response SqsMetadata [(MessageAttribute, Text)])
-> [Response SqsMetadata (MessageAttribute, Text)]
-> Response SqsMetadata [(MessageAttribute, Text)]
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor
-> (Cursor -> [Response SqsMetadata (MessageAttribute, Text)])
-> [Response SqsMetadata (MessageAttribute, Text)]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"Attribute" Axis
-> (Cursor -> Response SqsMetadata (MessageAttribute, Text))
-> Cursor
-> [Response SqsMetadata (MessageAttribute, Text)]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Response SqsMetadata (MessageAttribute, Text)
readMessageAttribute
    [UserMessageAttribute]
userAttributes <- [Response SqsMetadata UserMessageAttribute]
-> Response SqsMetadata [UserMessageAttribute]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        ([Response SqsMetadata UserMessageAttribute]
 -> Response SqsMetadata [UserMessageAttribute])
-> [Response SqsMetadata UserMessageAttribute]
-> Response SqsMetadata [UserMessageAttribute]
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor
-> (Cursor -> [Response SqsMetadata UserMessageAttribute])
-> [Response SqsMetadata UserMessageAttribute]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"MessageAttribute" Axis
-> (Cursor -> Response SqsMetadata UserMessageAttribute)
-> Cursor
-> [Response SqsMetadata UserMessageAttribute]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Response SqsMetadata UserMessageAttribute
readUserMessageAttribute
    let md5OfMessageAttributes :: Maybe Text
md5OfMessageAttributes = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe
            ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"MD5OfMessageAttributes" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
Cu.content

    Message -> Response SqsMetadata Message
forall a. a -> Response SqsMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
        { mMessageId :: Text
mMessageId = Text
mid
        , mReceiptHandle :: ReceiptHandle
mReceiptHandle = Text -> ReceiptHandle
ReceiptHandle Text
rh
        , mMD5OfBody :: Text
mMD5OfBody = Text
md5
        , mBody :: Text
mBody = Text
body
        , mAttributes :: [(MessageAttribute, Text)]
mAttributes = [(MessageAttribute, Text)]
attributes
        , mMD5OfMessageAttributes :: Maybe Text
mMD5OfMessageAttributes = Maybe Text
md5OfMessageAttributes
        , mUserMessageAttributes :: [UserMessageAttribute]
mUserMessageAttributes = [UserMessageAttribute]
userAttributes
        }

formatMAttributes :: [MessageAttribute] -> HTTP.Query
formatMAttributes :: [MessageAttribute] -> Query
formatMAttributes [MessageAttribute]
attrs = case [MessageAttribute]
attrs of
    [MessageAttribute
attr] -> [(ByteString
"AttributeName", MessageAttribute -> Maybe ByteString
encodeAttr MessageAttribute
attr)]
    [MessageAttribute]
_ -> (Int -> MessageAttribute -> QueryItem)
-> [Int] -> [MessageAttribute] -> Query
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> MessageAttribute -> QueryItem
forall {a}. Show a => a -> MessageAttribute -> QueryItem
f [Int
1 :: Int ..] [MessageAttribute]
attrs
  where
    f :: a -> MessageAttribute -> QueryItem
f a
x MessageAttribute
y = (ByteString
"AttributeName." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack (a -> String
forall a. Show a => a -> String
show a
x), MessageAttribute -> Maybe ByteString
encodeAttr MessageAttribute
y)
    encodeAttr :: MessageAttribute -> Maybe ByteString
encodeAttr = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (MessageAttribute -> ByteString)
-> MessageAttribute
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> (MessageAttribute -> Text) -> MessageAttribute -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageAttribute -> Text
printMessageAttribute

formatUserMessageAttributes :: [UserMessageAttributeName] -> HTTP.Query
formatUserMessageAttributes :: [Text] -> Query
formatUserMessageAttributes [Text]
attrs = case [Text]
attrs of
    [Text
attr] -> [(ByteString
"MessageAttributeName", Text -> Maybe ByteString
encodeAttr Text
attr)]
    [Text]
_ -> (Int -> Text -> QueryItem) -> [Int] -> [Text] -> Query
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> QueryItem
forall {a}. Show a => a -> Text -> QueryItem
f [Int
1 :: Int ..] [Text]
attrs
  where
    f :: a -> Text -> QueryItem
f a
x Text
y = (ByteString
"MessageAttributeName." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B.pack (a -> String
forall a. Show a => a -> String
show a
x), Text -> Maybe ByteString
encodeAttr Text
y)
    encodeAttr :: Text -> Maybe ByteString
encodeAttr = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Text -> ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

instance ResponseConsumer r ReceiveMessageResponse where
    type ResponseMetadata ReceiveMessageResponse = SqsMetadata
    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata ReceiveMessageResponse)
-> HTTPResponseConsumer ReceiveMessageResponse
responseConsumer Request
_ r
_ = (Cursor -> Response SqsMetadata ReceiveMessageResponse)
-> IORef SqsMetadata -> HTTPResponseConsumer ReceiveMessageResponse
forall a.
(Cursor -> Response SqsMetadata a)
-> IORef SqsMetadata -> HTTPResponseConsumer a
sqsXmlResponseConsumer Cursor -> Response SqsMetadata ReceiveMessageResponse
parse
      where
        parse :: Cursor -> Response SqsMetadata ReceiveMessageResponse
parse Cursor
el = do
            Cursor
result <- String -> [Cursor] -> Response SqsMetadata Cursor
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing ReceiveMessageResult"
                ([Cursor] -> Response SqsMetadata Cursor)
-> [Cursor] -> Response SqsMetadata Cursor
forall a b. (a -> b) -> a -> b
$ Cursor
el Cursor -> Axis -> [Cursor]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"ReceiveMessageResult"
            [Message]
messages <- [Response SqsMetadata Message] -> Response SqsMetadata [Message]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
                ([Response SqsMetadata Message] -> Response SqsMetadata [Message])
-> [Response SqsMetadata Message] -> Response SqsMetadata [Message]
forall a b. (a -> b) -> a -> b
$ Cursor
result Cursor
-> (Cursor -> [Response SqsMetadata Message])
-> [Response SqsMetadata Message]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"Message" Axis
-> (Cursor -> Response SqsMetadata Message)
-> Cursor
-> [Response SqsMetadata Message]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Response SqsMetadata Message
readMessage
            ReceiveMessageResponse
-> Response SqsMetadata ReceiveMessageResponse
forall a. a -> Response SqsMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return ReceiveMessageResponse{ rmrMessages :: [Message]
rmrMessages = [Message]
messages }

instance SignQuery ReceiveMessage  where
    type ServiceConfiguration ReceiveMessage  = SqsConfiguration
    signQuery :: forall queryType.
ReceiveMessage
-> ServiceConfiguration ReceiveMessage queryType
-> SignatureData
-> SignedQuery
signQuery ReceiveMessage{[Text]
[MessageAttribute]
Maybe Int
QueueName
rmVisibilityTimeout :: ReceiveMessage -> Maybe Int
rmAttributes :: ReceiveMessage -> [MessageAttribute]
rmMaxNumberOfMessages :: ReceiveMessage -> Maybe Int
rmUserMessageAttributes :: ReceiveMessage -> [Text]
rmQueueName :: ReceiveMessage -> QueueName
rmWaitTimeSeconds :: ReceiveMessage -> Maybe Int
rmVisibilityTimeout :: Maybe Int
rmAttributes :: [MessageAttribute]
rmMaxNumberOfMessages :: Maybe Int
rmUserMessageAttributes :: [Text]
rmQueueName :: QueueName
rmWaitTimeSeconds :: Maybe Int
..} = SqsQuery
-> SqsConfiguration queryType -> SignatureData -> SignedQuery
forall qt.
SqsQuery -> SqsConfiguration qt -> SignatureData -> SignedQuery
sqsSignQuery SqsQuery
        { sqsQueueName :: Maybe QueueName
sqsQueueName = QueueName -> Maybe QueueName
forall a. a -> Maybe a
Just QueueName
rmQueueName
        , sqsQuery :: Query
sqsQuery = [ (ByteString
"Action", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"ReceiveMessage") ]
            Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [Maybe QueryItem] -> Query
forall a. [Maybe a] -> [a]
catMaybes
                [ (ByteString
"VisibilityTimeout",) (Maybe ByteString -> QueryItem)
-> Maybe (Maybe ByteString) -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Int
rmVisibilityTimeout of
                    Just Int
x -> Maybe ByteString -> Maybe (Maybe ByteString)
forall a. a -> Maybe a
Just (Maybe ByteString -> Maybe (Maybe ByteString))
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x
                    Maybe Int
Nothing -> Maybe (Maybe ByteString)
forall a. Maybe a
Nothing

                , (ByteString
"MaxNumberOfMessages",) (Maybe ByteString -> QueryItem)
-> Maybe (Maybe ByteString) -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Int
rmMaxNumberOfMessages of
                    Just Int
x -> Maybe ByteString -> Maybe (Maybe ByteString)
forall a. a -> Maybe a
Just (Maybe ByteString -> Maybe (Maybe ByteString))
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x
                    Maybe Int
Nothing -> Maybe (Maybe ByteString)
forall a. Maybe a
Nothing

                , (ByteString
"WaitTimeSeconds",) (Maybe ByteString -> QueryItem)
-> Maybe (Maybe ByteString) -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Int
rmWaitTimeSeconds of
                    Just Int
x -> Maybe ByteString -> Maybe (Maybe ByteString)
forall a. a -> Maybe a
Just (Maybe ByteString -> Maybe (Maybe ByteString))
-> Maybe ByteString -> Maybe (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x
                    Maybe Int
Nothing -> Maybe (Maybe ByteString)
forall a. Maybe a
Nothing
                ]
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [MessageAttribute] -> Query
formatMAttributes [MessageAttribute]
rmAttributes
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [Text] -> Query
formatUserMessageAttributes [Text]
rmUserMessageAttributes
        }

instance Transaction ReceiveMessage ReceiveMessageResponse

instance AsMemoryResponse ReceiveMessageResponse where
    type MemoryResponse ReceiveMessageResponse = ReceiveMessageResponse
    loadToMemory :: ReceiveMessageResponse
-> ResourceT IO (MemoryResponse ReceiveMessageResponse)
loadToMemory = ReceiveMessageResponse
-> ResourceT IO (MemoryResponse ReceiveMessageResponse)
ReceiveMessageResponse -> ResourceT IO ReceiveMessageResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- -------------------------------------------------------------------------- --
-- Change Message Visibility

-- | Changes the visibility timeout of a specified message in a queue to a new
-- value. The maximum allowed timeout value you can set the value to is 12
-- hours. This means you can't extend the timeout of a message in an existing
-- queue to more than a total visibility timeout of 12 hours. (For more
-- information visibility timeout, see Visibility Timeout in the Amazon SQS
-- Developer Guide.)
--
-- For example, let's say you have a message and its default message visibility
-- timeout is 30 minutes. You could call ChangeMessageVisiblity with a value of
-- two hours and the effective timeout would be two hours and 30 minutes. When
-- that time comes near you could again extend the time out by calling
-- ChangeMessageVisiblity, but this time the maximum allowed timeout would be 9
-- hours and 30 minutes.
--
-- /NOTE/
--
-- There is a 120,000 limit for the number of inflight messages per queue.
-- Messages are inflight after they have been received from the queue by a
-- consuming component, but have not yet been deleted from the queue. If you
-- reach the 120,000 limit, you will receive an OverLimit error message from
-- Amazon SQS. To help avoid reaching the limit, you should delete the messages
-- from the queue after they have been processed. You can also increase the
-- number of queues you use to process the messages.
--
-- /IMPORTANT/
--
-- If you attempt to set the VisibilityTimeout to an amount more than the
-- maximum time left, Amazon SQS returns an error. It will not automatically
-- recalculate and increase the timeout to the maximum time remaining.
--
-- /IMPORTANT/
--
-- Unlike with a queue, when you change the visibility timeout for a specific
-- message, that timeout value is applied immediately but is not saved in
-- memory for that message. If you don't delete a message after it is received,
-- the visibility timeout for the message the next time it is received reverts
-- to the original timeout value, not the value you set with the
-- ChangeMessageVisibility action.
--
-- <http://docs.aws.amazon.com/AWSSimpleQueueService/2012-11-05/APIReference/API_ChangeMessageVisibility.html>
--
data ChangeMessageVisibility = ChangeMessageVisibility
    { ChangeMessageVisibility -> ReceiptHandle
cmvReceiptHandle :: !ReceiptHandle
    -- ^ The receipt handle associated with the message whose visibility timeout
    -- should be changed. This parameter is returned by the ReceiveMessage
    -- action.

    , ChangeMessageVisibility -> Int
cmvVisibilityTimeout :: !Int
    -- ^ The new value (in seconds - from 0 to 43200 - maximum 12 hours) for the
    -- message's visibility timeout.

    , ChangeMessageVisibility -> QueueName
cmvQueueName :: !QueueName
    -- ^ The URL of the Amazon SQS queue to take action on.
    }
    deriving (Int -> ChangeMessageVisibility -> ShowS
[ChangeMessageVisibility] -> ShowS
ChangeMessageVisibility -> String
(Int -> ChangeMessageVisibility -> ShowS)
-> (ChangeMessageVisibility -> String)
-> ([ChangeMessageVisibility] -> ShowS)
-> Show ChangeMessageVisibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeMessageVisibility -> ShowS
showsPrec :: Int -> ChangeMessageVisibility -> ShowS
$cshow :: ChangeMessageVisibility -> String
show :: ChangeMessageVisibility -> String
$cshowList :: [ChangeMessageVisibility] -> ShowS
showList :: [ChangeMessageVisibility] -> ShowS
Show, ReadPrec [ChangeMessageVisibility]
ReadPrec ChangeMessageVisibility
Int -> ReadS ChangeMessageVisibility
ReadS [ChangeMessageVisibility]
(Int -> ReadS ChangeMessageVisibility)
-> ReadS [ChangeMessageVisibility]
-> ReadPrec ChangeMessageVisibility
-> ReadPrec [ChangeMessageVisibility]
-> Read ChangeMessageVisibility
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ChangeMessageVisibility
readsPrec :: Int -> ReadS ChangeMessageVisibility
$creadList :: ReadS [ChangeMessageVisibility]
readList :: ReadS [ChangeMessageVisibility]
$creadPrec :: ReadPrec ChangeMessageVisibility
readPrec :: ReadPrec ChangeMessageVisibility
$creadListPrec :: ReadPrec [ChangeMessageVisibility]
readListPrec :: ReadPrec [ChangeMessageVisibility]
Read, ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
(ChangeMessageVisibility -> ChangeMessageVisibility -> Bool)
-> (ChangeMessageVisibility -> ChangeMessageVisibility -> Bool)
-> Eq ChangeMessageVisibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
== :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
$c/= :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
/= :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
Eq, Eq ChangeMessageVisibility
Eq ChangeMessageVisibility =>
(ChangeMessageVisibility -> ChangeMessageVisibility -> Ordering)
-> (ChangeMessageVisibility -> ChangeMessageVisibility -> Bool)
-> (ChangeMessageVisibility -> ChangeMessageVisibility -> Bool)
-> (ChangeMessageVisibility -> ChangeMessageVisibility -> Bool)
-> (ChangeMessageVisibility -> ChangeMessageVisibility -> Bool)
-> (ChangeMessageVisibility
    -> ChangeMessageVisibility -> ChangeMessageVisibility)
-> (ChangeMessageVisibility
    -> ChangeMessageVisibility -> ChangeMessageVisibility)
-> Ord ChangeMessageVisibility
ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
ChangeMessageVisibility -> ChangeMessageVisibility -> Ordering
ChangeMessageVisibility
-> ChangeMessageVisibility -> ChangeMessageVisibility
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChangeMessageVisibility -> ChangeMessageVisibility -> Ordering
compare :: ChangeMessageVisibility -> ChangeMessageVisibility -> Ordering
$c< :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
< :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
$c<= :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
<= :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
$c> :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
> :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
$c>= :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
>= :: ChangeMessageVisibility -> ChangeMessageVisibility -> Bool
$cmax :: ChangeMessageVisibility
-> ChangeMessageVisibility -> ChangeMessageVisibility
max :: ChangeMessageVisibility
-> ChangeMessageVisibility -> ChangeMessageVisibility
$cmin :: ChangeMessageVisibility
-> ChangeMessageVisibility -> ChangeMessageVisibility
min :: ChangeMessageVisibility
-> ChangeMessageVisibility -> ChangeMessageVisibility
Ord)

data ChangeMessageVisibilityResponse = ChangeMessageVisibilityResponse {}
    deriving (Int -> ChangeMessageVisibilityResponse -> ShowS
[ChangeMessageVisibilityResponse] -> ShowS
ChangeMessageVisibilityResponse -> String
(Int -> ChangeMessageVisibilityResponse -> ShowS)
-> (ChangeMessageVisibilityResponse -> String)
-> ([ChangeMessageVisibilityResponse] -> ShowS)
-> Show ChangeMessageVisibilityResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeMessageVisibilityResponse -> ShowS
showsPrec :: Int -> ChangeMessageVisibilityResponse -> ShowS
$cshow :: ChangeMessageVisibilityResponse -> String
show :: ChangeMessageVisibilityResponse -> String
$cshowList :: [ChangeMessageVisibilityResponse] -> ShowS
showList :: [ChangeMessageVisibilityResponse] -> ShowS
Show, ReadPrec [ChangeMessageVisibilityResponse]
ReadPrec ChangeMessageVisibilityResponse
Int -> ReadS ChangeMessageVisibilityResponse
ReadS [ChangeMessageVisibilityResponse]
(Int -> ReadS ChangeMessageVisibilityResponse)
-> ReadS [ChangeMessageVisibilityResponse]
-> ReadPrec ChangeMessageVisibilityResponse
-> ReadPrec [ChangeMessageVisibilityResponse]
-> Read ChangeMessageVisibilityResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ChangeMessageVisibilityResponse
readsPrec :: Int -> ReadS ChangeMessageVisibilityResponse
$creadList :: ReadS [ChangeMessageVisibilityResponse]
readList :: ReadS [ChangeMessageVisibilityResponse]
$creadPrec :: ReadPrec ChangeMessageVisibilityResponse
readPrec :: ReadPrec ChangeMessageVisibilityResponse
$creadListPrec :: ReadPrec [ChangeMessageVisibilityResponse]
readListPrec :: ReadPrec [ChangeMessageVisibilityResponse]
Read, ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
(ChangeMessageVisibilityResponse
 -> ChangeMessageVisibilityResponse -> Bool)
-> (ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse -> Bool)
-> Eq ChangeMessageVisibilityResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
== :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
$c/= :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
/= :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
Eq, Eq ChangeMessageVisibilityResponse
Eq ChangeMessageVisibilityResponse =>
(ChangeMessageVisibilityResponse
 -> ChangeMessageVisibilityResponse -> Ordering)
-> (ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse -> Bool)
-> (ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse -> Bool)
-> (ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse -> Bool)
-> (ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse -> Bool)
-> (ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse)
-> (ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse
    -> ChangeMessageVisibilityResponse)
-> Ord ChangeMessageVisibilityResponse
ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Ordering
ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Ordering
compare :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Ordering
$c< :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
< :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
$c<= :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
<= :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
$c> :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
> :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
$c>= :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
>= :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse -> Bool
$cmax :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
max :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
$cmin :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
min :: ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
-> ChangeMessageVisibilityResponse
Ord)

instance ResponseConsumer r ChangeMessageVisibilityResponse where
    type ResponseMetadata ChangeMessageVisibilityResponse = SqsMetadata
    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata ChangeMessageVisibilityResponse)
-> HTTPResponseConsumer ChangeMessageVisibilityResponse
responseConsumer Request
_ r
_ = (Cursor -> Response SqsMetadata ChangeMessageVisibilityResponse)
-> IORef SqsMetadata
-> HTTPResponseConsumer ChangeMessageVisibilityResponse
forall a.
(Cursor -> Response SqsMetadata a)
-> IORef SqsMetadata -> HTTPResponseConsumer a
sqsXmlResponseConsumer Cursor -> Response SqsMetadata ChangeMessageVisibilityResponse
forall {m :: * -> *} {p}.
Monad m =>
p -> m ChangeMessageVisibilityResponse
parse
      where
        parse :: p -> m ChangeMessageVisibilityResponse
parse p
_ = ChangeMessageVisibilityResponse
-> m ChangeMessageVisibilityResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeMessageVisibilityResponse {}

-- | ServiceConfiguration: 'SqsConfiguration'
instance SignQuery ChangeMessageVisibility where
    type ServiceConfiguration ChangeMessageVisibility  = SqsConfiguration
    signQuery :: forall queryType.
ChangeMessageVisibility
-> ServiceConfiguration ChangeMessageVisibility queryType
-> SignatureData
-> SignedQuery
signQuery ChangeMessageVisibility {Int
ReceiptHandle
QueueName
cmvReceiptHandle :: ChangeMessageVisibility -> ReceiptHandle
cmvVisibilityTimeout :: ChangeMessageVisibility -> Int
cmvQueueName :: ChangeMessageVisibility -> QueueName
cmvReceiptHandle :: ReceiptHandle
cmvVisibilityTimeout :: Int
cmvQueueName :: QueueName
..} = SqsQuery
-> SqsConfiguration queryType -> SignatureData -> SignedQuery
forall qt.
SqsQuery -> SqsConfiguration qt -> SignatureData -> SignedQuery
sqsSignQuery SqsQuery
        { sqsQueueName :: Maybe QueueName
sqsQueueName = QueueName -> Maybe QueueName
forall a. a -> Maybe a
Just QueueName
cmvQueueName
        , sqsQuery :: Query
sqsQuery =
            [ (ByteString
"Action", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"ChangeMessageVisibility")
            , (ByteString
"ReceiptHandle", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Text -> ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ReceiptHandle -> Text
printReceiptHandle ReceiptHandle
cmvReceiptHandle)
            , (ByteString
"VisibilityTimeout", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack (String -> Maybe ByteString) -> String -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
cmvVisibilityTimeout)
            ]
        }

instance Transaction ChangeMessageVisibility ChangeMessageVisibilityResponse

instance AsMemoryResponse ChangeMessageVisibilityResponse where
    type MemoryResponse ChangeMessageVisibilityResponse = ChangeMessageVisibilityResponse
    loadToMemory :: ChangeMessageVisibilityResponse
-> ResourceT IO (MemoryResponse ChangeMessageVisibilityResponse)
loadToMemory = ChangeMessageVisibilityResponse
-> ResourceT IO (MemoryResponse ChangeMessageVisibilityResponse)
ChangeMessageVisibilityResponse
-> ResourceT IO ChangeMessageVisibilityResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return