{-# 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.CertificateManager.ResendValidationEmail
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resends the email that requests domain ownership validation. The domain
-- owner or an authorized representative must approve the ACM certificate
-- before it can be issued. The certificate can be approved by clicking a
-- link in the mail to navigate to the Amazon certificate approval website
-- and then clicking __I Approve__. However, the validation email can be
-- blocked by spam filters. Therefore, if you do not receive the original
-- mail, you can request that the mail be resent within 72 hours of
-- requesting the ACM certificate. If more than 72 hours have elapsed since
-- your original request or since your last attempt to resend validation
-- mail, you must request a new certificate. For more information about
-- setting up your contact email addresses, see
-- <https://docs.aws.amazon.com/acm/latest/userguide/setup-email.html Configure Email for your Domain>.
module Amazonka.CertificateManager.ResendValidationEmail
  ( -- * Creating a Request
    ResendValidationEmail (..),
    newResendValidationEmail,

    -- * Request Lenses
    resendValidationEmail_certificateArn,
    resendValidationEmail_domain,
    resendValidationEmail_validationDomain,

    -- * Destructuring the Response
    ResendValidationEmailResponse (..),
    newResendValidationEmailResponse,
  )
where

import Amazonka.CertificateManager.Types
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

-- | /See:/ 'newResendValidationEmail' smart constructor.
data ResendValidationEmail = ResendValidationEmail'
  { -- | String that contains the ARN of the requested certificate. The
    -- certificate ARN is generated and returned by the RequestCertificate
    -- action as soon as the request is made. By default, using this parameter
    -- causes email to be sent to all top-level domains you specified in the
    -- certificate request. The ARN must be of the form:
    --
    -- @arn:aws:acm:us-east-1:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
    ResendValidationEmail -> Text
certificateArn :: Prelude.Text,
    -- | The fully qualified domain name (FQDN) of the certificate that needs to
    -- be validated.
    ResendValidationEmail -> Text
domain :: Prelude.Text,
    -- | The base validation domain that will act as the suffix of the email
    -- addresses that are used to send the emails. This must be the same as the
    -- @Domain@ value or a superdomain of the @Domain@ value. For example, if
    -- you requested a certificate for @site.subdomain.example.com@ and specify
    -- a __ValidationDomain__ of @subdomain.example.com@, ACM sends email to
    -- the domain registrant, technical contact, and administrative contact in
    -- WHOIS and the following five addresses:
    --
    -- -   admin\@subdomain.example.com
    --
    -- -   administrator\@subdomain.example.com
    --
    -- -   hostmaster\@subdomain.example.com
    --
    -- -   postmaster\@subdomain.example.com
    --
    -- -   webmaster\@subdomain.example.com
    ResendValidationEmail -> Text
validationDomain :: Prelude.Text
  }
  deriving (ResendValidationEmail -> ResendValidationEmail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResendValidationEmail -> ResendValidationEmail -> Bool
$c/= :: ResendValidationEmail -> ResendValidationEmail -> Bool
== :: ResendValidationEmail -> ResendValidationEmail -> Bool
$c== :: ResendValidationEmail -> ResendValidationEmail -> Bool
Prelude.Eq, ReadPrec [ResendValidationEmail]
ReadPrec ResendValidationEmail
Int -> ReadS ResendValidationEmail
ReadS [ResendValidationEmail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResendValidationEmail]
$creadListPrec :: ReadPrec [ResendValidationEmail]
readPrec :: ReadPrec ResendValidationEmail
$creadPrec :: ReadPrec ResendValidationEmail
readList :: ReadS [ResendValidationEmail]
$creadList :: ReadS [ResendValidationEmail]
readsPrec :: Int -> ReadS ResendValidationEmail
$creadsPrec :: Int -> ReadS ResendValidationEmail
Prelude.Read, Int -> ResendValidationEmail -> ShowS
[ResendValidationEmail] -> ShowS
ResendValidationEmail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResendValidationEmail] -> ShowS
$cshowList :: [ResendValidationEmail] -> ShowS
show :: ResendValidationEmail -> String
$cshow :: ResendValidationEmail -> String
showsPrec :: Int -> ResendValidationEmail -> ShowS
$cshowsPrec :: Int -> ResendValidationEmail -> ShowS
Prelude.Show, forall x. Rep ResendValidationEmail x -> ResendValidationEmail
forall x. ResendValidationEmail -> Rep ResendValidationEmail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResendValidationEmail x -> ResendValidationEmail
$cfrom :: forall x. ResendValidationEmail -> Rep ResendValidationEmail x
Prelude.Generic)

-- |
-- Create a value of 'ResendValidationEmail' 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:
--
-- 'certificateArn', 'resendValidationEmail_certificateArn' - String that contains the ARN of the requested certificate. The
-- certificate ARN is generated and returned by the RequestCertificate
-- action as soon as the request is made. By default, using this parameter
-- causes email to be sent to all top-level domains you specified in the
-- certificate request. The ARN must be of the form:
--
-- @arn:aws:acm:us-east-1:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
--
-- 'domain', 'resendValidationEmail_domain' - The fully qualified domain name (FQDN) of the certificate that needs to
-- be validated.
--
-- 'validationDomain', 'resendValidationEmail_validationDomain' - The base validation domain that will act as the suffix of the email
-- addresses that are used to send the emails. This must be the same as the
-- @Domain@ value or a superdomain of the @Domain@ value. For example, if
-- you requested a certificate for @site.subdomain.example.com@ and specify
-- a __ValidationDomain__ of @subdomain.example.com@, ACM sends email to
-- the domain registrant, technical contact, and administrative contact in
-- WHOIS and the following five addresses:
--
-- -   admin\@subdomain.example.com
--
-- -   administrator\@subdomain.example.com
--
-- -   hostmaster\@subdomain.example.com
--
-- -   postmaster\@subdomain.example.com
--
-- -   webmaster\@subdomain.example.com
newResendValidationEmail ::
  -- | 'certificateArn'
  Prelude.Text ->
  -- | 'domain'
  Prelude.Text ->
  -- | 'validationDomain'
  Prelude.Text ->
  ResendValidationEmail
newResendValidationEmail :: Text -> Text -> Text -> ResendValidationEmail
newResendValidationEmail
  Text
pCertificateArn_
  Text
pDomain_
  Text
pValidationDomain_ =
    ResendValidationEmail'
      { $sel:certificateArn:ResendValidationEmail' :: Text
certificateArn =
          Text
pCertificateArn_,
        $sel:domain:ResendValidationEmail' :: Text
domain = Text
pDomain_,
        $sel:validationDomain:ResendValidationEmail' :: Text
validationDomain = Text
pValidationDomain_
      }

-- | String that contains the ARN of the requested certificate. The
-- certificate ARN is generated and returned by the RequestCertificate
-- action as soon as the request is made. By default, using this parameter
-- causes email to be sent to all top-level domains you specified in the
-- certificate request. The ARN must be of the form:
--
-- @arn:aws:acm:us-east-1:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
resendValidationEmail_certificateArn :: Lens.Lens' ResendValidationEmail Prelude.Text
resendValidationEmail_certificateArn :: Lens' ResendValidationEmail Text
resendValidationEmail_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResendValidationEmail' {Text
certificateArn :: Text
$sel:certificateArn:ResendValidationEmail' :: ResendValidationEmail -> Text
certificateArn} -> Text
certificateArn) (\s :: ResendValidationEmail
s@ResendValidationEmail' {} Text
a -> ResendValidationEmail
s {$sel:certificateArn:ResendValidationEmail' :: Text
certificateArn = Text
a} :: ResendValidationEmail)

-- | The fully qualified domain name (FQDN) of the certificate that needs to
-- be validated.
resendValidationEmail_domain :: Lens.Lens' ResendValidationEmail Prelude.Text
resendValidationEmail_domain :: Lens' ResendValidationEmail Text
resendValidationEmail_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResendValidationEmail' {Text
domain :: Text
$sel:domain:ResendValidationEmail' :: ResendValidationEmail -> Text
domain} -> Text
domain) (\s :: ResendValidationEmail
s@ResendValidationEmail' {} Text
a -> ResendValidationEmail
s {$sel:domain:ResendValidationEmail' :: Text
domain = Text
a} :: ResendValidationEmail)

-- | The base validation domain that will act as the suffix of the email
-- addresses that are used to send the emails. This must be the same as the
-- @Domain@ value or a superdomain of the @Domain@ value. For example, if
-- you requested a certificate for @site.subdomain.example.com@ and specify
-- a __ValidationDomain__ of @subdomain.example.com@, ACM sends email to
-- the domain registrant, technical contact, and administrative contact in
-- WHOIS and the following five addresses:
--
-- -   admin\@subdomain.example.com
--
-- -   administrator\@subdomain.example.com
--
-- -   hostmaster\@subdomain.example.com
--
-- -   postmaster\@subdomain.example.com
--
-- -   webmaster\@subdomain.example.com
resendValidationEmail_validationDomain :: Lens.Lens' ResendValidationEmail Prelude.Text
resendValidationEmail_validationDomain :: Lens' ResendValidationEmail Text
resendValidationEmail_validationDomain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResendValidationEmail' {Text
validationDomain :: Text
$sel:validationDomain:ResendValidationEmail' :: ResendValidationEmail -> Text
validationDomain} -> Text
validationDomain) (\s :: ResendValidationEmail
s@ResendValidationEmail' {} Text
a -> ResendValidationEmail
s {$sel:validationDomain:ResendValidationEmail' :: Text
validationDomain = Text
a} :: ResendValidationEmail)

instance Core.AWSRequest ResendValidationEmail where
  type
    AWSResponse ResendValidationEmail =
      ResendValidationEmailResponse
  request :: (Service -> Service)
-> ResendValidationEmail -> Request ResendValidationEmail
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ResendValidationEmail
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResendValidationEmail)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull ResendValidationEmailResponse
ResendValidationEmailResponse'

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

instance Prelude.NFData ResendValidationEmail where
  rnf :: ResendValidationEmail -> ()
rnf ResendValidationEmail' {Text
validationDomain :: Text
domain :: Text
certificateArn :: Text
$sel:validationDomain:ResendValidationEmail' :: ResendValidationEmail -> Text
$sel:domain:ResendValidationEmail' :: ResendValidationEmail -> Text
$sel:certificateArn:ResendValidationEmail' :: ResendValidationEmail -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
certificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
validationDomain

instance Data.ToHeaders ResendValidationEmail where
  toHeaders :: ResendValidationEmail -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"CertificateManager.ResendValidationEmail" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ResendValidationEmail where
  toJSON :: ResendValidationEmail -> Value
toJSON ResendValidationEmail' {Text
validationDomain :: Text
domain :: Text
certificateArn :: Text
$sel:validationDomain:ResendValidationEmail' :: ResendValidationEmail -> Text
$sel:domain:ResendValidationEmail' :: ResendValidationEmail -> Text
$sel:certificateArn:ResendValidationEmail' :: ResendValidationEmail -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"CertificateArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domain),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ValidationDomain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
validationDomain)
          ]
      )

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

instance Data.ToQuery ResendValidationEmail where
  toQuery :: ResendValidationEmail -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newResendValidationEmailResponse' smart constructor.
data ResendValidationEmailResponse = ResendValidationEmailResponse'
  {
  }
  deriving (ResendValidationEmailResponse
-> ResendValidationEmailResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResendValidationEmailResponse
-> ResendValidationEmailResponse -> Bool
$c/= :: ResendValidationEmailResponse
-> ResendValidationEmailResponse -> Bool
== :: ResendValidationEmailResponse
-> ResendValidationEmailResponse -> Bool
$c== :: ResendValidationEmailResponse
-> ResendValidationEmailResponse -> Bool
Prelude.Eq, ReadPrec [ResendValidationEmailResponse]
ReadPrec ResendValidationEmailResponse
Int -> ReadS ResendValidationEmailResponse
ReadS [ResendValidationEmailResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResendValidationEmailResponse]
$creadListPrec :: ReadPrec [ResendValidationEmailResponse]
readPrec :: ReadPrec ResendValidationEmailResponse
$creadPrec :: ReadPrec ResendValidationEmailResponse
readList :: ReadS [ResendValidationEmailResponse]
$creadList :: ReadS [ResendValidationEmailResponse]
readsPrec :: Int -> ReadS ResendValidationEmailResponse
$creadsPrec :: Int -> ReadS ResendValidationEmailResponse
Prelude.Read, Int -> ResendValidationEmailResponse -> ShowS
[ResendValidationEmailResponse] -> ShowS
ResendValidationEmailResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResendValidationEmailResponse] -> ShowS
$cshowList :: [ResendValidationEmailResponse] -> ShowS
show :: ResendValidationEmailResponse -> String
$cshow :: ResendValidationEmailResponse -> String
showsPrec :: Int -> ResendValidationEmailResponse -> ShowS
$cshowsPrec :: Int -> ResendValidationEmailResponse -> ShowS
Prelude.Show, forall x.
Rep ResendValidationEmailResponse x
-> ResendValidationEmailResponse
forall x.
ResendValidationEmailResponse
-> Rep ResendValidationEmailResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResendValidationEmailResponse x
-> ResendValidationEmailResponse
$cfrom :: forall x.
ResendValidationEmailResponse
-> Rep ResendValidationEmailResponse x
Prelude.Generic)

-- |
-- Create a value of 'ResendValidationEmailResponse' 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.
newResendValidationEmailResponse ::
  ResendValidationEmailResponse
newResendValidationEmailResponse :: ResendValidationEmailResponse
newResendValidationEmailResponse =
  ResendValidationEmailResponse
ResendValidationEmailResponse'

instance Prelude.NFData ResendValidationEmailResponse where
  rnf :: ResendValidationEmailResponse -> ()
rnf ResendValidationEmailResponse
_ = ()