module Aws.Ses.Commands.VerifyEmailIdentity
    ( VerifyEmailIdentity(..)
    , VerifyEmailIdentityResponse(..)
    ) where

import Data.Text (Text)
import Data.Text.Encoding as T (encodeUtf8)
import Data.Typeable
import Aws.Core
import Aws.Ses.Core

-- | List email addresses and/or domains
data VerifyEmailIdentity  = VerifyEmailIdentity Text
    deriving (VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
(VerifyEmailIdentity -> VerifyEmailIdentity -> Bool)
-> (VerifyEmailIdentity -> VerifyEmailIdentity -> Bool)
-> Eq VerifyEmailIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
== :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$c/= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
/= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
Eq, Eq VerifyEmailIdentity
Eq VerifyEmailIdentity =>
(VerifyEmailIdentity -> VerifyEmailIdentity -> Ordering)
-> (VerifyEmailIdentity -> VerifyEmailIdentity -> Bool)
-> (VerifyEmailIdentity -> VerifyEmailIdentity -> Bool)
-> (VerifyEmailIdentity -> VerifyEmailIdentity -> Bool)
-> (VerifyEmailIdentity -> VerifyEmailIdentity -> Bool)
-> (VerifyEmailIdentity
    -> VerifyEmailIdentity -> VerifyEmailIdentity)
-> (VerifyEmailIdentity
    -> VerifyEmailIdentity -> VerifyEmailIdentity)
-> Ord VerifyEmailIdentity
VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
VerifyEmailIdentity -> VerifyEmailIdentity -> Ordering
VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
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 :: VerifyEmailIdentity -> VerifyEmailIdentity -> Ordering
compare :: VerifyEmailIdentity -> VerifyEmailIdentity -> Ordering
$c< :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
< :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$c<= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
<= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$c> :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
> :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$c>= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
>= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$cmax :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
max :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
$cmin :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
min :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
Ord, Int -> VerifyEmailIdentity -> ShowS
[VerifyEmailIdentity] -> ShowS
VerifyEmailIdentity -> String
(Int -> VerifyEmailIdentity -> ShowS)
-> (VerifyEmailIdentity -> String)
-> ([VerifyEmailIdentity] -> ShowS)
-> Show VerifyEmailIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerifyEmailIdentity -> ShowS
showsPrec :: Int -> VerifyEmailIdentity -> ShowS
$cshow :: VerifyEmailIdentity -> String
show :: VerifyEmailIdentity -> String
$cshowList :: [VerifyEmailIdentity] -> ShowS
showList :: [VerifyEmailIdentity] -> ShowS
Show, Typeable)

-- | ServiceConfiguration: 'SesConfiguration'
instance SignQuery VerifyEmailIdentity where
    type ServiceConfiguration VerifyEmailIdentity = SesConfiguration
    signQuery :: forall queryType.
VerifyEmailIdentity
-> ServiceConfiguration VerifyEmailIdentity queryType
-> SignatureData
-> SignedQuery
signQuery (VerifyEmailIdentity Text
address) =
        [(ByteString, ByteString)]
-> SesConfiguration queryType -> SignatureData -> SignedQuery
forall qt.
[(ByteString, ByteString)]
-> SesConfiguration qt -> SignatureData -> SignedQuery
sesSignQuery [ (ByteString
"Action", ByteString
"VerifyEmailIdentity")
                     , (ByteString
"EmailAddress", Text -> ByteString
T.encodeUtf8 Text
address)
                     ]

-- | The response sent back by Amazon SES after a
-- 'VerifyEmailIdentity' command.
data VerifyEmailIdentityResponse = VerifyEmailIdentityResponse
    deriving (VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
(VerifyEmailIdentityResponse
 -> VerifyEmailIdentityResponse -> Bool)
-> (VerifyEmailIdentityResponse
    -> VerifyEmailIdentityResponse -> Bool)
-> Eq VerifyEmailIdentityResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
== :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$c/= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
/= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
Eq, Eq VerifyEmailIdentityResponse
Eq VerifyEmailIdentityResponse =>
(VerifyEmailIdentityResponse
 -> VerifyEmailIdentityResponse -> Ordering)
-> (VerifyEmailIdentityResponse
    -> VerifyEmailIdentityResponse -> Bool)
-> (VerifyEmailIdentityResponse
    -> VerifyEmailIdentityResponse -> Bool)
-> (VerifyEmailIdentityResponse
    -> VerifyEmailIdentityResponse -> Bool)
-> (VerifyEmailIdentityResponse
    -> VerifyEmailIdentityResponse -> Bool)
-> (VerifyEmailIdentityResponse
    -> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse)
-> (VerifyEmailIdentityResponse
    -> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse)
-> Ord VerifyEmailIdentityResponse
VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> Ordering
VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
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 :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> Ordering
compare :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> Ordering
$c< :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
< :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$c<= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
<= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$c> :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
> :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$c>= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
>= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$cmax :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
max :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
$cmin :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
min :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
Ord, Int -> VerifyEmailIdentityResponse -> ShowS
[VerifyEmailIdentityResponse] -> ShowS
VerifyEmailIdentityResponse -> String
(Int -> VerifyEmailIdentityResponse -> ShowS)
-> (VerifyEmailIdentityResponse -> String)
-> ([VerifyEmailIdentityResponse] -> ShowS)
-> Show VerifyEmailIdentityResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerifyEmailIdentityResponse -> ShowS
showsPrec :: Int -> VerifyEmailIdentityResponse -> ShowS
$cshow :: VerifyEmailIdentityResponse -> String
show :: VerifyEmailIdentityResponse -> String
$cshowList :: [VerifyEmailIdentityResponse] -> ShowS
showList :: [VerifyEmailIdentityResponse] -> ShowS
Show, Typeable)


instance ResponseConsumer VerifyEmailIdentity VerifyEmailIdentityResponse where
    type ResponseMetadata VerifyEmailIdentityResponse = SesMetadata
    responseConsumer :: Request
-> VerifyEmailIdentity
-> IORef (ResponseMetadata VerifyEmailIdentityResponse)
-> HTTPResponseConsumer VerifyEmailIdentityResponse
responseConsumer Request
_ VerifyEmailIdentity
_
        = (Cursor -> Response SesMetadata VerifyEmailIdentityResponse)
-> IORef SesMetadata
-> HTTPResponseConsumer VerifyEmailIdentityResponse
forall a.
(Cursor -> Response SesMetadata a)
-> IORef SesMetadata -> HTTPResponseConsumer a
sesResponseConsumer ((Cursor -> Response SesMetadata VerifyEmailIdentityResponse)
 -> IORef SesMetadata
 -> HTTPResponseConsumer VerifyEmailIdentityResponse)
-> (Cursor -> Response SesMetadata VerifyEmailIdentityResponse)
-> IORef SesMetadata
-> HTTPResponseConsumer VerifyEmailIdentityResponse
forall a b. (a -> b) -> a -> b
$ \Cursor
_ -> VerifyEmailIdentityResponse
-> Response SesMetadata VerifyEmailIdentityResponse
forall a. a -> Response SesMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return VerifyEmailIdentityResponse
VerifyEmailIdentityResponse


instance Transaction VerifyEmailIdentity VerifyEmailIdentityResponse where

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