{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SES.GetIdentityVerificationAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Given a list of identities (email addresses and\/or domains), returns
-- the verification status and (for domain identities) the verification
-- token for each identity.
--
-- The verification status of an email address is \"Pending\" until the
-- email address owner clicks the link within the verification email that
-- Amazon SES sent to that address. If the email address owner clicks the
-- link within 24 hours, the verification status of the email address
-- changes to \"Success\". If the link is not clicked within 24 hours, the
-- verification status changes to \"Failed.\" In that case, if you still
-- want to verify the email address, you must restart the verification
-- process from the beginning.
--
-- For domain identities, the domain\'s verification status is \"Pending\"
-- as Amazon SES searches for the required TXT record in the DNS settings
-- of the domain. When Amazon SES detects the record, the domain\'s
-- verification status changes to \"Success\". If Amazon SES is unable to
-- detect the record within 72 hours, the domain\'s verification status
-- changes to \"Failed.\" In that case, if you still want to verify the
-- domain, you must restart the verification process from the beginning.
--
-- This operation is throttled at one request per second and can only get
-- verification attributes for up to 100 identities at a time.
module Amazonka.SES.GetIdentityVerificationAttributes
  ( -- * Creating a Request
    GetIdentityVerificationAttributes (..),
    newGetIdentityVerificationAttributes,

    -- * Request Lenses
    getIdentityVerificationAttributes_identities,

    -- * Destructuring the Response
    GetIdentityVerificationAttributesResponse (..),
    newGetIdentityVerificationAttributesResponse,

    -- * Response Lenses
    getIdentityVerificationAttributesResponse_httpStatus,
    getIdentityVerificationAttributesResponse_verificationAttributes,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SES.Types

-- | Represents a request to return the Amazon SES verification status of a
-- list of identities. For domain identities, this request also returns the
-- verification token. For information about verifying identities with
-- Amazon SES, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/verify-addresses-and-domains.html Amazon SES Developer Guide>.
--
-- /See:/ 'newGetIdentityVerificationAttributes' smart constructor.
data GetIdentityVerificationAttributes = GetIdentityVerificationAttributes'
  { -- | A list of identities.
    GetIdentityVerificationAttributes -> [Text]
identities :: [Prelude.Text]
  }
  deriving (GetIdentityVerificationAttributes
-> GetIdentityVerificationAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIdentityVerificationAttributes
-> GetIdentityVerificationAttributes -> Bool
$c/= :: GetIdentityVerificationAttributes
-> GetIdentityVerificationAttributes -> Bool
== :: GetIdentityVerificationAttributes
-> GetIdentityVerificationAttributes -> Bool
$c== :: GetIdentityVerificationAttributes
-> GetIdentityVerificationAttributes -> Bool
Prelude.Eq, ReadPrec [GetIdentityVerificationAttributes]
ReadPrec GetIdentityVerificationAttributes
Int -> ReadS GetIdentityVerificationAttributes
ReadS [GetIdentityVerificationAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIdentityVerificationAttributes]
$creadListPrec :: ReadPrec [GetIdentityVerificationAttributes]
readPrec :: ReadPrec GetIdentityVerificationAttributes
$creadPrec :: ReadPrec GetIdentityVerificationAttributes
readList :: ReadS [GetIdentityVerificationAttributes]
$creadList :: ReadS [GetIdentityVerificationAttributes]
readsPrec :: Int -> ReadS GetIdentityVerificationAttributes
$creadsPrec :: Int -> ReadS GetIdentityVerificationAttributes
Prelude.Read, Int -> GetIdentityVerificationAttributes -> ShowS
[GetIdentityVerificationAttributes] -> ShowS
GetIdentityVerificationAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIdentityVerificationAttributes] -> ShowS
$cshowList :: [GetIdentityVerificationAttributes] -> ShowS
show :: GetIdentityVerificationAttributes -> String
$cshow :: GetIdentityVerificationAttributes -> String
showsPrec :: Int -> GetIdentityVerificationAttributes -> ShowS
$cshowsPrec :: Int -> GetIdentityVerificationAttributes -> ShowS
Prelude.Show, forall x.
Rep GetIdentityVerificationAttributes x
-> GetIdentityVerificationAttributes
forall x.
GetIdentityVerificationAttributes
-> Rep GetIdentityVerificationAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetIdentityVerificationAttributes x
-> GetIdentityVerificationAttributes
$cfrom :: forall x.
GetIdentityVerificationAttributes
-> Rep GetIdentityVerificationAttributes x
Prelude.Generic)

-- |
-- Create a value of 'GetIdentityVerificationAttributes' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'identities', 'getIdentityVerificationAttributes_identities' - A list of identities.
newGetIdentityVerificationAttributes ::
  GetIdentityVerificationAttributes
newGetIdentityVerificationAttributes :: GetIdentityVerificationAttributes
newGetIdentityVerificationAttributes =
  GetIdentityVerificationAttributes'
    { $sel:identities:GetIdentityVerificationAttributes' :: [Text]
identities =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | A list of identities.
getIdentityVerificationAttributes_identities :: Lens.Lens' GetIdentityVerificationAttributes [Prelude.Text]
getIdentityVerificationAttributes_identities :: Lens' GetIdentityVerificationAttributes [Text]
getIdentityVerificationAttributes_identities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityVerificationAttributes' {[Text]
identities :: [Text]
$sel:identities:GetIdentityVerificationAttributes' :: GetIdentityVerificationAttributes -> [Text]
identities} -> [Text]
identities) (\s :: GetIdentityVerificationAttributes
s@GetIdentityVerificationAttributes' {} [Text]
a -> GetIdentityVerificationAttributes
s {$sel:identities:GetIdentityVerificationAttributes' :: [Text]
identities = [Text]
a} :: GetIdentityVerificationAttributes) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Core.AWSRequest
    GetIdentityVerificationAttributes
  where
  type
    AWSResponse GetIdentityVerificationAttributes =
      GetIdentityVerificationAttributesResponse
  request :: (Service -> Service)
-> GetIdentityVerificationAttributes
-> Request GetIdentityVerificationAttributes
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetIdentityVerificationAttributes
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetIdentityVerificationAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetIdentityVerificationAttributesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int
-> HashMap Text IdentityVerificationAttributes
-> GetIdentityVerificationAttributesResponse
GetIdentityVerificationAttributesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"VerificationAttributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall k v.
(Eq k, Hashable k, FromText k, FromXML v) =>
Text -> Text -> Text -> [Node] -> Either String (HashMap k v)
Data.parseXMLMap Text
"entry" Text
"key" Text
"value"
                        )
      )

instance
  Prelude.Hashable
    GetIdentityVerificationAttributes
  where
  hashWithSalt :: Int -> GetIdentityVerificationAttributes -> Int
hashWithSalt
    Int
_salt
    GetIdentityVerificationAttributes' {[Text]
identities :: [Text]
$sel:identities:GetIdentityVerificationAttributes' :: GetIdentityVerificationAttributes -> [Text]
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
identities

instance
  Prelude.NFData
    GetIdentityVerificationAttributes
  where
  rnf :: GetIdentityVerificationAttributes -> ()
rnf GetIdentityVerificationAttributes' {[Text]
identities :: [Text]
$sel:identities:GetIdentityVerificationAttributes' :: GetIdentityVerificationAttributes -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
identities

instance
  Data.ToHeaders
    GetIdentityVerificationAttributes
  where
  toHeaders :: GetIdentityVerificationAttributes -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance
  Data.ToPath
    GetIdentityVerificationAttributes
  where
  toPath :: GetIdentityVerificationAttributes -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance
  Data.ToQuery
    GetIdentityVerificationAttributes
  where
  toQuery :: GetIdentityVerificationAttributes -> QueryString
toQuery GetIdentityVerificationAttributes' {[Text]
identities :: [Text]
$sel:identities:GetIdentityVerificationAttributes' :: GetIdentityVerificationAttributes -> [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"GetIdentityVerificationAttributes" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"Identities"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
identities
      ]

-- | The Amazon SES verification status of a list of identities. For domain
-- identities, this response also contains the verification token.
--
-- /See:/ 'newGetIdentityVerificationAttributesResponse' smart constructor.
data GetIdentityVerificationAttributesResponse = GetIdentityVerificationAttributesResponse'
  { -- | The response's http status code.
    GetIdentityVerificationAttributesResponse -> Int
httpStatus :: Prelude.Int,
    -- | A map of Identities to IdentityVerificationAttributes objects.
    GetIdentityVerificationAttributesResponse
-> HashMap Text IdentityVerificationAttributes
verificationAttributes :: Prelude.HashMap Prelude.Text IdentityVerificationAttributes
  }
  deriving (GetIdentityVerificationAttributesResponse
-> GetIdentityVerificationAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIdentityVerificationAttributesResponse
-> GetIdentityVerificationAttributesResponse -> Bool
$c/= :: GetIdentityVerificationAttributesResponse
-> GetIdentityVerificationAttributesResponse -> Bool
== :: GetIdentityVerificationAttributesResponse
-> GetIdentityVerificationAttributesResponse -> Bool
$c== :: GetIdentityVerificationAttributesResponse
-> GetIdentityVerificationAttributesResponse -> Bool
Prelude.Eq, ReadPrec [GetIdentityVerificationAttributesResponse]
ReadPrec GetIdentityVerificationAttributesResponse
Int -> ReadS GetIdentityVerificationAttributesResponse
ReadS [GetIdentityVerificationAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIdentityVerificationAttributesResponse]
$creadListPrec :: ReadPrec [GetIdentityVerificationAttributesResponse]
readPrec :: ReadPrec GetIdentityVerificationAttributesResponse
$creadPrec :: ReadPrec GetIdentityVerificationAttributesResponse
readList :: ReadS [GetIdentityVerificationAttributesResponse]
$creadList :: ReadS [GetIdentityVerificationAttributesResponse]
readsPrec :: Int -> ReadS GetIdentityVerificationAttributesResponse
$creadsPrec :: Int -> ReadS GetIdentityVerificationAttributesResponse
Prelude.Read, Int -> GetIdentityVerificationAttributesResponse -> ShowS
[GetIdentityVerificationAttributesResponse] -> ShowS
GetIdentityVerificationAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIdentityVerificationAttributesResponse] -> ShowS
$cshowList :: [GetIdentityVerificationAttributesResponse] -> ShowS
show :: GetIdentityVerificationAttributesResponse -> String
$cshow :: GetIdentityVerificationAttributesResponse -> String
showsPrec :: Int -> GetIdentityVerificationAttributesResponse -> ShowS
$cshowsPrec :: Int -> GetIdentityVerificationAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep GetIdentityVerificationAttributesResponse x
-> GetIdentityVerificationAttributesResponse
forall x.
GetIdentityVerificationAttributesResponse
-> Rep GetIdentityVerificationAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetIdentityVerificationAttributesResponse x
-> GetIdentityVerificationAttributesResponse
$cfrom :: forall x.
GetIdentityVerificationAttributesResponse
-> Rep GetIdentityVerificationAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetIdentityVerificationAttributesResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'getIdentityVerificationAttributesResponse_httpStatus' - The response's http status code.
--
-- 'verificationAttributes', 'getIdentityVerificationAttributesResponse_verificationAttributes' - A map of Identities to IdentityVerificationAttributes objects.
newGetIdentityVerificationAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetIdentityVerificationAttributesResponse
newGetIdentityVerificationAttributesResponse :: Int -> GetIdentityVerificationAttributesResponse
newGetIdentityVerificationAttributesResponse
  Int
pHttpStatus_ =
    GetIdentityVerificationAttributesResponse'
      { $sel:httpStatus:GetIdentityVerificationAttributesResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:verificationAttributes:GetIdentityVerificationAttributesResponse' :: HashMap Text IdentityVerificationAttributes
verificationAttributes =
          forall a. Monoid a => a
Prelude.mempty
      }

-- | The response's http status code.
getIdentityVerificationAttributesResponse_httpStatus :: Lens.Lens' GetIdentityVerificationAttributesResponse Prelude.Int
getIdentityVerificationAttributesResponse_httpStatus :: Lens' GetIdentityVerificationAttributesResponse Int
getIdentityVerificationAttributesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityVerificationAttributesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetIdentityVerificationAttributesResponse' :: GetIdentityVerificationAttributesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetIdentityVerificationAttributesResponse
s@GetIdentityVerificationAttributesResponse' {} Int
a -> GetIdentityVerificationAttributesResponse
s {$sel:httpStatus:GetIdentityVerificationAttributesResponse' :: Int
httpStatus = Int
a} :: GetIdentityVerificationAttributesResponse)

-- | A map of Identities to IdentityVerificationAttributes objects.
getIdentityVerificationAttributesResponse_verificationAttributes :: Lens.Lens' GetIdentityVerificationAttributesResponse (Prelude.HashMap Prelude.Text IdentityVerificationAttributes)
getIdentityVerificationAttributesResponse_verificationAttributes :: Lens'
  GetIdentityVerificationAttributesResponse
  (HashMap Text IdentityVerificationAttributes)
getIdentityVerificationAttributesResponse_verificationAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityVerificationAttributesResponse' {HashMap Text IdentityVerificationAttributes
verificationAttributes :: HashMap Text IdentityVerificationAttributes
$sel:verificationAttributes:GetIdentityVerificationAttributesResponse' :: GetIdentityVerificationAttributesResponse
-> HashMap Text IdentityVerificationAttributes
verificationAttributes} -> HashMap Text IdentityVerificationAttributes
verificationAttributes) (\s :: GetIdentityVerificationAttributesResponse
s@GetIdentityVerificationAttributesResponse' {} HashMap Text IdentityVerificationAttributes
a -> GetIdentityVerificationAttributesResponse
s {$sel:verificationAttributes:GetIdentityVerificationAttributesResponse' :: HashMap Text IdentityVerificationAttributes
verificationAttributes = HashMap Text IdentityVerificationAttributes
a} :: GetIdentityVerificationAttributesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Prelude.NFData
    GetIdentityVerificationAttributesResponse
  where
  rnf :: GetIdentityVerificationAttributesResponse -> ()
rnf GetIdentityVerificationAttributesResponse' {Int
HashMap Text IdentityVerificationAttributes
verificationAttributes :: HashMap Text IdentityVerificationAttributes
httpStatus :: Int
$sel:verificationAttributes:GetIdentityVerificationAttributesResponse' :: GetIdentityVerificationAttributesResponse
-> HashMap Text IdentityVerificationAttributes
$sel:httpStatus:GetIdentityVerificationAttributesResponse' :: GetIdentityVerificationAttributesResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text IdentityVerificationAttributes
verificationAttributes