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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$c/= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
== :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$c== :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
Eq, Eq 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
min :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
$cmin :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
max :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
$cmax :: VerifyEmailIdentity -> VerifyEmailIdentity -> VerifyEmailIdentity
>= :: VerifyEmailIdentity -> VerifyEmailIdentity -> Bool
$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
compare :: VerifyEmailIdentity -> VerifyEmailIdentity -> Ordering
$ccompare :: VerifyEmailIdentity -> VerifyEmailIdentity -> Ordering
Ord, Int -> VerifyEmailIdentity -> ShowS
[VerifyEmailIdentity] -> ShowS
VerifyEmailIdentity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifyEmailIdentity] -> ShowS
$cshowList :: [VerifyEmailIdentity] -> ShowS
show :: VerifyEmailIdentity -> String
$cshow :: VerifyEmailIdentity -> String
showsPrec :: Int -> VerifyEmailIdentity -> ShowS
$cshowsPrec :: Int -> 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) =
        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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$c/= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
== :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$c== :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
Eq, Eq 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
min :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
$cmin :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
max :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
$cmax :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse
>= :: VerifyEmailIdentityResponse -> VerifyEmailIdentityResponse -> Bool
$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
compare :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> Ordering
$ccompare :: VerifyEmailIdentityResponse
-> VerifyEmailIdentityResponse -> Ordering
Ord, Int -> VerifyEmailIdentityResponse -> ShowS
[VerifyEmailIdentityResponse] -> ShowS
VerifyEmailIdentityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifyEmailIdentityResponse] -> ShowS
$cshowList :: [VerifyEmailIdentityResponse] -> ShowS
show :: VerifyEmailIdentityResponse -> String
$cshow :: VerifyEmailIdentityResponse -> String
showsPrec :: Int -> VerifyEmailIdentityResponse -> ShowS
$cshowsPrec :: Int -> VerifyEmailIdentityResponse -> ShowS
Show, Typeable)


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