module Aws.Ses.Commands.GetIdentityDkimAttributes
    ( GetIdentityDkimAttributes(..)
    , GetIdentityDkimAttributesResponse(..)
    , IdentityDkimAttributes(..)
    ) where

import qualified Data.ByteString.Char8 as BS
import           Data.Text             (Text)
import           Data.Text             as T (toCaseFold)
import           Data.Text.Encoding    as T (encodeUtf8)
import           Data.Typeable
import           Text.XML.Cursor       (laxElement, ($/), ($//), (&/), (&|))
import           Control.Applicative
import           Prelude

import           Aws.Core
import           Aws.Ses.Core

-- | Get notification settings for the given identities.
data GetIdentityDkimAttributes = GetIdentityDkimAttributes [Text]
    deriving (GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
(GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool)
-> (GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool)
-> Eq GetIdentityDkimAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
== :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
$c/= :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
/= :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
Eq, Eq GetIdentityDkimAttributes
Eq GetIdentityDkimAttributes =>
(GetIdentityDkimAttributes
 -> GetIdentityDkimAttributes -> Ordering)
-> (GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool)
-> (GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool)
-> (GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool)
-> (GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool)
-> (GetIdentityDkimAttributes
    -> GetIdentityDkimAttributes -> GetIdentityDkimAttributes)
-> (GetIdentityDkimAttributes
    -> GetIdentityDkimAttributes -> GetIdentityDkimAttributes)
-> Ord GetIdentityDkimAttributes
GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Ordering
GetIdentityDkimAttributes
-> GetIdentityDkimAttributes -> GetIdentityDkimAttributes
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 :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Ordering
compare :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Ordering
$c< :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
< :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
$c<= :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
<= :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
$c> :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
> :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
$c>= :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
>= :: GetIdentityDkimAttributes -> GetIdentityDkimAttributes -> Bool
$cmax :: GetIdentityDkimAttributes
-> GetIdentityDkimAttributes -> GetIdentityDkimAttributes
max :: GetIdentityDkimAttributes
-> GetIdentityDkimAttributes -> GetIdentityDkimAttributes
$cmin :: GetIdentityDkimAttributes
-> GetIdentityDkimAttributes -> GetIdentityDkimAttributes
min :: GetIdentityDkimAttributes
-> GetIdentityDkimAttributes -> GetIdentityDkimAttributes
Ord, Int -> GetIdentityDkimAttributes -> ShowS
[GetIdentityDkimAttributes] -> ShowS
GetIdentityDkimAttributes -> String
(Int -> GetIdentityDkimAttributes -> ShowS)
-> (GetIdentityDkimAttributes -> String)
-> ([GetIdentityDkimAttributes] -> ShowS)
-> Show GetIdentityDkimAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetIdentityDkimAttributes -> ShowS
showsPrec :: Int -> GetIdentityDkimAttributes -> ShowS
$cshow :: GetIdentityDkimAttributes -> String
show :: GetIdentityDkimAttributes -> String
$cshowList :: [GetIdentityDkimAttributes] -> ShowS
showList :: [GetIdentityDkimAttributes] -> ShowS
Show, Typeable)

-- | ServiceConfiguration: 'SesConfiguration'
instance SignQuery GetIdentityDkimAttributes where
    type ServiceConfiguration GetIdentityDkimAttributes = SesConfiguration
    signQuery :: forall queryType.
GetIdentityDkimAttributes
-> ServiceConfiguration GetIdentityDkimAttributes queryType
-> SignatureData
-> SignedQuery
signQuery (GetIdentityDkimAttributes [Text]
identities) =
        [(ByteString, ByteString)]
-> SesConfiguration queryType -> SignatureData -> SignedQuery
forall qt.
[(ByteString, ByteString)]
-> SesConfiguration qt -> SignatureData -> SignedQuery
sesSignQuery ([(ByteString, ByteString)]
 -> SesConfiguration queryType -> SignatureData -> SignedQuery)
-> [(ByteString, ByteString)]
-> SesConfiguration queryType
-> SignatureData
-> SignedQuery
forall a b. (a -> b) -> a -> b
$ (ByteString
"Action", ByteString
"GetIdentityDkimAttributes")
                     (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString] -> [(ByteString, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> ByteString
enumMember (Int -> ByteString) -> [Int] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1..]) (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
identities)
            where enumMember :: Int -> ByteString
enumMember (Int
n :: Int) = ByteString -> ByteString -> ByteString
BS.append ByteString
"Identities.member." (String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n)


data IdentityDkimAttributes =
    IdentityDkimAttributes
      { IdentityDkimAttributes -> Text
idIdentity                :: Text
      , IdentityDkimAttributes -> Bool
idDkimEnabled             :: Bool
      , IdentityDkimAttributes -> [Text]
idDkimTokens              :: [Text]
      , IdentityDkimAttributes -> Text
idDkimVerirficationStatus :: Text }
    deriving (IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
(IdentityDkimAttributes -> IdentityDkimAttributes -> Bool)
-> (IdentityDkimAttributes -> IdentityDkimAttributes -> Bool)
-> Eq IdentityDkimAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
== :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
$c/= :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
/= :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
Eq, Eq IdentityDkimAttributes
Eq IdentityDkimAttributes =>
(IdentityDkimAttributes -> IdentityDkimAttributes -> Ordering)
-> (IdentityDkimAttributes -> IdentityDkimAttributes -> Bool)
-> (IdentityDkimAttributes -> IdentityDkimAttributes -> Bool)
-> (IdentityDkimAttributes -> IdentityDkimAttributes -> Bool)
-> (IdentityDkimAttributes -> IdentityDkimAttributes -> Bool)
-> (IdentityDkimAttributes
    -> IdentityDkimAttributes -> IdentityDkimAttributes)
-> (IdentityDkimAttributes
    -> IdentityDkimAttributes -> IdentityDkimAttributes)
-> Ord IdentityDkimAttributes
IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
IdentityDkimAttributes -> IdentityDkimAttributes -> Ordering
IdentityDkimAttributes
-> IdentityDkimAttributes -> IdentityDkimAttributes
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 :: IdentityDkimAttributes -> IdentityDkimAttributes -> Ordering
compare :: IdentityDkimAttributes -> IdentityDkimAttributes -> Ordering
$c< :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
< :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
$c<= :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
<= :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
$c> :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
> :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
$c>= :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
>= :: IdentityDkimAttributes -> IdentityDkimAttributes -> Bool
$cmax :: IdentityDkimAttributes
-> IdentityDkimAttributes -> IdentityDkimAttributes
max :: IdentityDkimAttributes
-> IdentityDkimAttributes -> IdentityDkimAttributes
$cmin :: IdentityDkimAttributes
-> IdentityDkimAttributes -> IdentityDkimAttributes
min :: IdentityDkimAttributes
-> IdentityDkimAttributes -> IdentityDkimAttributes
Ord, Int -> IdentityDkimAttributes -> ShowS
[IdentityDkimAttributes] -> ShowS
IdentityDkimAttributes -> String
(Int -> IdentityDkimAttributes -> ShowS)
-> (IdentityDkimAttributes -> String)
-> ([IdentityDkimAttributes] -> ShowS)
-> Show IdentityDkimAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdentityDkimAttributes -> ShowS
showsPrec :: Int -> IdentityDkimAttributes -> ShowS
$cshow :: IdentityDkimAttributes -> String
show :: IdentityDkimAttributes -> String
$cshowList :: [IdentityDkimAttributes] -> ShowS
showList :: [IdentityDkimAttributes] -> ShowS
Show, Typeable)

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

instance ResponseConsumer GetIdentityDkimAttributes GetIdentityDkimAttributesResponse where
    type ResponseMetadata GetIdentityDkimAttributesResponse = SesMetadata
    responseConsumer :: Request
-> GetIdentityDkimAttributes
-> IORef (ResponseMetadata GetIdentityDkimAttributesResponse)
-> HTTPResponseConsumer GetIdentityDkimAttributesResponse
responseConsumer Request
_ GetIdentityDkimAttributes
_ = (Cursor -> Response SesMetadata GetIdentityDkimAttributesResponse)
-> IORef SesMetadata
-> HTTPResponseConsumer GetIdentityDkimAttributesResponse
forall a.
(Cursor -> Response SesMetadata a)
-> IORef SesMetadata -> HTTPResponseConsumer a
sesResponseConsumer ((Cursor -> Response SesMetadata GetIdentityDkimAttributesResponse)
 -> IORef SesMetadata
 -> HTTPResponseConsumer GetIdentityDkimAttributesResponse)
-> (Cursor
    -> Response SesMetadata GetIdentityDkimAttributesResponse)
-> IORef SesMetadata
-> HTTPResponseConsumer GetIdentityDkimAttributesResponse
forall a b. (a -> b) -> a -> b
$ \Cursor
cursor -> do
        let buildAttr :: Cursor -> m IdentityDkimAttributes
buildAttr Cursor
e = do
              Text
idIdentity <- String -> [Text] -> m Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Key" ([Text] -> m Text) -> [Text] -> m Text
forall a b. (a -> b) -> a -> b
$ Cursor
e Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Text]
elContent Text
"key"
              Text
enabled <- String -> [Text] -> m Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing DkimEnabled" ([Text] -> m Text) -> [Text] -> m Text
forall a b. (a -> b) -> a -> b
$ Cursor
e Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"DkimEnabled"
              Text
idDkimVerirficationStatus <- String -> [Text] -> m Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing status" ([Text] -> m Text) -> [Text] -> m Text
forall a b. (a -> b) -> a -> b
$
                                           Cursor
e Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"DkimVerificationStatus"
              let idDkimEnabled :: Bool
idDkimEnabled = Text -> Text
T.toCaseFold Text
enabled Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold Text
"true"
                  idDkimTokens :: [Text]
idDkimTokens = Cursor
e Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
laxElement Text
"DkimTokens" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Cursor -> [Text]
elContent Text
"member"
              IdentityDkimAttributes -> m IdentityDkimAttributes
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IdentityDkimAttributes{Bool
[Text]
Text
idIdentity :: Text
idDkimEnabled :: Bool
idDkimTokens :: [Text]
idDkimVerirficationStatus :: Text
idIdentity :: Text
idDkimVerirficationStatus :: Text
idDkimEnabled :: Bool
idDkimTokens :: [Text]
..}
        [IdentityDkimAttributes]
attributes <- [Response SesMetadata IdentityDkimAttributes]
-> Response SesMetadata [IdentityDkimAttributes]
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 SesMetadata IdentityDkimAttributes]
 -> Response SesMetadata [IdentityDkimAttributes])
-> [Response SesMetadata IdentityDkimAttributes]
-> Response SesMetadata [IdentityDkimAttributes]
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor
-> (Cursor -> [Response SesMetadata IdentityDkimAttributes])
-> [Response SesMetadata IdentityDkimAttributes]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
laxElement Text
"entry" Axis
-> (Cursor -> Response SesMetadata IdentityDkimAttributes)
-> Cursor
-> [Response SesMetadata IdentityDkimAttributes]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> Response SesMetadata IdentityDkimAttributes
forall {m :: * -> *}.
MonadThrow m =>
Cursor -> m IdentityDkimAttributes
buildAttr
        GetIdentityDkimAttributesResponse
-> Response SesMetadata GetIdentityDkimAttributesResponse
forall a. a -> Response SesMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetIdentityDkimAttributesResponse
 -> Response SesMetadata GetIdentityDkimAttributesResponse)
-> GetIdentityDkimAttributesResponse
-> Response SesMetadata GetIdentityDkimAttributesResponse
forall a b. (a -> b) -> a -> b
$ [IdentityDkimAttributes] -> GetIdentityDkimAttributesResponse
GetIdentityDkimAttributesResponse [IdentityDkimAttributes]
attributes

instance Transaction GetIdentityDkimAttributes GetIdentityDkimAttributesResponse where

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