module Aws.Ses.Commands.VerifyDomainIdentity
    ( VerifyDomainIdentity(..)
    , VerifyDomainIdentityResponse(..)
    ) where

import Data.Text (Text)
import Data.Text.Encoding as T (encodeUtf8)
import Data.Typeable
import Aws.Core
import Aws.Ses.Core
import Text.XML.Cursor (($//))

-- | Verify ownership of a domain.
data VerifyDomainIdentity  = VerifyDomainIdentity Text
    deriving (VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
$c/= :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
== :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
$c== :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
Eq, Eq VerifyDomainIdentity
VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
VerifyDomainIdentity -> VerifyDomainIdentity -> Ordering
VerifyDomainIdentity
-> VerifyDomainIdentity -> VerifyDomainIdentity
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 :: VerifyDomainIdentity
-> VerifyDomainIdentity -> VerifyDomainIdentity
$cmin :: VerifyDomainIdentity
-> VerifyDomainIdentity -> VerifyDomainIdentity
max :: VerifyDomainIdentity
-> VerifyDomainIdentity -> VerifyDomainIdentity
$cmax :: VerifyDomainIdentity
-> VerifyDomainIdentity -> VerifyDomainIdentity
>= :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
$c>= :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
> :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
$c> :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
<= :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
$c<= :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
< :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
$c< :: VerifyDomainIdentity -> VerifyDomainIdentity -> Bool
compare :: VerifyDomainIdentity -> VerifyDomainIdentity -> Ordering
$ccompare :: VerifyDomainIdentity -> VerifyDomainIdentity -> Ordering
Ord, Int -> VerifyDomainIdentity -> ShowS
[VerifyDomainIdentity] -> ShowS
VerifyDomainIdentity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifyDomainIdentity] -> ShowS
$cshowList :: [VerifyDomainIdentity] -> ShowS
show :: VerifyDomainIdentity -> String
$cshow :: VerifyDomainIdentity -> String
showsPrec :: Int -> VerifyDomainIdentity -> ShowS
$cshowsPrec :: Int -> VerifyDomainIdentity -> ShowS
Show, Typeable)

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

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

instance ResponseConsumer VerifyDomainIdentity VerifyDomainIdentityResponse where
    type ResponseMetadata VerifyDomainIdentityResponse = SesMetadata
    responseConsumer :: Request
-> VerifyDomainIdentity
-> IORef (ResponseMetadata VerifyDomainIdentityResponse)
-> HTTPResponseConsumer VerifyDomainIdentityResponse
responseConsumer Request
_ VerifyDomainIdentity
_ =
      forall a.
(Cursor -> Response SesMetadata a)
-> IORef SesMetadata -> HTTPResponseConsumer a
sesResponseConsumer forall a b. (a -> b) -> a -> b
$ \Cursor
cursor -> do
        Text
token <- forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Verification token not found" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"VerificationToken"
        forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> VerifyDomainIdentityResponse
VerifyDomainIdentityResponse Text
token)

instance Transaction VerifyDomainIdentity VerifyDomainIdentityResponse where

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