{-# 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.VerifyDomainIdentity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a domain to the list of identities for your Amazon SES account in
-- the current AWS Region and attempts to verify it. For more information
-- about verifying domains, see
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/verify-addresses-and-domains.html Verifying Email Addresses and Domains>
-- in the /Amazon SES Developer Guide./
--
-- You can execute this operation no more than once per second.
module Amazonka.SES.VerifyDomainIdentity
  ( -- * Creating a Request
    VerifyDomainIdentity (..),
    newVerifyDomainIdentity,

    -- * Request Lenses
    verifyDomainIdentity_domain,

    -- * Destructuring the Response
    VerifyDomainIdentityResponse (..),
    newVerifyDomainIdentityResponse,

    -- * Response Lenses
    verifyDomainIdentityResponse_httpStatus,
    verifyDomainIdentityResponse_verificationToken,
  )
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 begin Amazon SES domain verification and to
-- generate the TXT records that you must publish to the DNS server of your
-- domain to complete the verification. For information about domain
-- verification, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/verify-domains.html Amazon SES Developer Guide>.
--
-- /See:/ 'newVerifyDomainIdentity' smart constructor.
data VerifyDomainIdentity = VerifyDomainIdentity'
  { -- | The domain to be verified.
    VerifyDomainIdentity -> Text
domain :: Prelude.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
Prelude.Eq, ReadPrec [VerifyDomainIdentity]
ReadPrec VerifyDomainIdentity
Int -> ReadS VerifyDomainIdentity
ReadS [VerifyDomainIdentity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VerifyDomainIdentity]
$creadListPrec :: ReadPrec [VerifyDomainIdentity]
readPrec :: ReadPrec VerifyDomainIdentity
$creadPrec :: ReadPrec VerifyDomainIdentity
readList :: ReadS [VerifyDomainIdentity]
$creadList :: ReadS [VerifyDomainIdentity]
readsPrec :: Int -> ReadS VerifyDomainIdentity
$creadsPrec :: Int -> ReadS VerifyDomainIdentity
Prelude.Read, 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
Prelude.Show, forall x. Rep VerifyDomainIdentity x -> VerifyDomainIdentity
forall x. VerifyDomainIdentity -> Rep VerifyDomainIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerifyDomainIdentity x -> VerifyDomainIdentity
$cfrom :: forall x. VerifyDomainIdentity -> Rep VerifyDomainIdentity x
Prelude.Generic)

-- |
-- Create a value of 'VerifyDomainIdentity' 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:
--
-- 'domain', 'verifyDomainIdentity_domain' - The domain to be verified.
newVerifyDomainIdentity ::
  -- | 'domain'
  Prelude.Text ->
  VerifyDomainIdentity
newVerifyDomainIdentity :: Text -> VerifyDomainIdentity
newVerifyDomainIdentity Text
pDomain_ =
  VerifyDomainIdentity' {$sel:domain:VerifyDomainIdentity' :: Text
domain = Text
pDomain_}

-- | The domain to be verified.
verifyDomainIdentity_domain :: Lens.Lens' VerifyDomainIdentity Prelude.Text
verifyDomainIdentity_domain :: Lens' VerifyDomainIdentity Text
verifyDomainIdentity_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyDomainIdentity' {Text
domain :: Text
$sel:domain:VerifyDomainIdentity' :: VerifyDomainIdentity -> Text
domain} -> Text
domain) (\s :: VerifyDomainIdentity
s@VerifyDomainIdentity' {} Text
a -> VerifyDomainIdentity
s {$sel:domain:VerifyDomainIdentity' :: Text
domain = Text
a} :: VerifyDomainIdentity)

instance Core.AWSRequest VerifyDomainIdentity where
  type
    AWSResponse VerifyDomainIdentity =
      VerifyDomainIdentityResponse
  request :: (Service -> Service)
-> VerifyDomainIdentity -> Request VerifyDomainIdentity
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 VerifyDomainIdentity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse VerifyDomainIdentity)))
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
"VerifyDomainIdentityResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> Text -> VerifyDomainIdentityResponse
VerifyDomainIdentityResponse'
            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 a
Data..@ Text
"VerificationToken")
      )

instance Prelude.Hashable VerifyDomainIdentity where
  hashWithSalt :: Int -> VerifyDomainIdentity -> Int
hashWithSalt Int
_salt VerifyDomainIdentity' {Text
domain :: Text
$sel:domain:VerifyDomainIdentity' :: VerifyDomainIdentity -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain

instance Prelude.NFData VerifyDomainIdentity where
  rnf :: VerifyDomainIdentity -> ()
rnf VerifyDomainIdentity' {Text
domain :: Text
$sel:domain:VerifyDomainIdentity' :: VerifyDomainIdentity -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
domain

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

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

instance Data.ToQuery VerifyDomainIdentity where
  toQuery :: VerifyDomainIdentity -> QueryString
toQuery VerifyDomainIdentity' {Text
domain :: Text
$sel:domain:VerifyDomainIdentity' :: VerifyDomainIdentity -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"VerifyDomainIdentity" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"Domain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domain
      ]

-- | Returns a TXT record that you must publish to the DNS server of your
-- domain to complete domain verification with Amazon SES.
--
-- /See:/ 'newVerifyDomainIdentityResponse' smart constructor.
data VerifyDomainIdentityResponse = VerifyDomainIdentityResponse'
  { -- | The response's http status code.
    VerifyDomainIdentityResponse -> Int
httpStatus :: Prelude.Int,
    -- | A TXT record that you must place in the DNS settings of the domain to
    -- complete domain verification with Amazon SES.
    --
    -- As Amazon SES searches for the TXT record, the domain\'s verification
    -- status is \"Pending\". 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.
    VerifyDomainIdentityResponse -> Text
verificationToken :: Prelude.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
Prelude.Eq, ReadPrec [VerifyDomainIdentityResponse]
ReadPrec VerifyDomainIdentityResponse
Int -> ReadS VerifyDomainIdentityResponse
ReadS [VerifyDomainIdentityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VerifyDomainIdentityResponse]
$creadListPrec :: ReadPrec [VerifyDomainIdentityResponse]
readPrec :: ReadPrec VerifyDomainIdentityResponse
$creadPrec :: ReadPrec VerifyDomainIdentityResponse
readList :: ReadS [VerifyDomainIdentityResponse]
$creadList :: ReadS [VerifyDomainIdentityResponse]
readsPrec :: Int -> ReadS VerifyDomainIdentityResponse
$creadsPrec :: Int -> ReadS VerifyDomainIdentityResponse
Prelude.Read, 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
Prelude.Show, forall x.
Rep VerifyDomainIdentityResponse x -> VerifyDomainIdentityResponse
forall x.
VerifyDomainIdentityResponse -> Rep VerifyDomainIdentityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep VerifyDomainIdentityResponse x -> VerifyDomainIdentityResponse
$cfrom :: forall x.
VerifyDomainIdentityResponse -> Rep VerifyDomainIdentityResponse x
Prelude.Generic)

-- |
-- Create a value of 'VerifyDomainIdentityResponse' 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', 'verifyDomainIdentityResponse_httpStatus' - The response's http status code.
--
-- 'verificationToken', 'verifyDomainIdentityResponse_verificationToken' - A TXT record that you must place in the DNS settings of the domain to
-- complete domain verification with Amazon SES.
--
-- As Amazon SES searches for the TXT record, the domain\'s verification
-- status is \"Pending\". 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.
newVerifyDomainIdentityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'verificationToken'
  Prelude.Text ->
  VerifyDomainIdentityResponse
newVerifyDomainIdentityResponse :: Int -> Text -> VerifyDomainIdentityResponse
newVerifyDomainIdentityResponse
  Int
pHttpStatus_
  Text
pVerificationToken_ =
    VerifyDomainIdentityResponse'
      { $sel:httpStatus:VerifyDomainIdentityResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:verificationToken:VerifyDomainIdentityResponse' :: Text
verificationToken = Text
pVerificationToken_
      }

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

-- | A TXT record that you must place in the DNS settings of the domain to
-- complete domain verification with Amazon SES.
--
-- As Amazon SES searches for the TXT record, the domain\'s verification
-- status is \"Pending\". 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.
verifyDomainIdentityResponse_verificationToken :: Lens.Lens' VerifyDomainIdentityResponse Prelude.Text
verifyDomainIdentityResponse_verificationToken :: Lens' VerifyDomainIdentityResponse Text
verifyDomainIdentityResponse_verificationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyDomainIdentityResponse' {Text
verificationToken :: Text
$sel:verificationToken:VerifyDomainIdentityResponse' :: VerifyDomainIdentityResponse -> Text
verificationToken} -> Text
verificationToken) (\s :: VerifyDomainIdentityResponse
s@VerifyDomainIdentityResponse' {} Text
a -> VerifyDomainIdentityResponse
s {$sel:verificationToken:VerifyDomainIdentityResponse' :: Text
verificationToken = Text
a} :: VerifyDomainIdentityResponse)

instance Prelude.NFData VerifyDomainIdentityResponse where
  rnf :: VerifyDomainIdentityResponse -> ()
rnf VerifyDomainIdentityResponse' {Int
Text
verificationToken :: Text
httpStatus :: Int
$sel:verificationToken:VerifyDomainIdentityResponse' :: VerifyDomainIdentityResponse -> Text
$sel:httpStatus:VerifyDomainIdentityResponse' :: VerifyDomainIdentityResponse -> 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 Text
verificationToken