{-# 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.RequestCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Requests an ACM certificate for use with other Amazon Web Services
-- services. To request an ACM certificate, you must specify a fully
-- qualified domain name (FQDN) in the @DomainName@ parameter. You can also
-- specify additional FQDNs in the @SubjectAlternativeNames@ parameter.
--
-- If you are requesting a private certificate, domain validation is not
-- required. If you are requesting a public certificate, each domain name
-- that you specify must be validated to verify that you own or control the
-- domain. You can use
-- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-dns.html DNS validation>
-- or
-- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-email.html email validation>.
-- We recommend that you use DNS validation. ACM issues public certificates
-- after receiving approval from the domain owner.
--
-- ACM behavior differs from the
-- <https://datatracker.ietf.org/doc/html/rfc6125#appendix-B.2 RFC 6125>
-- specification of the certificate validation process. ACM first checks
-- for a Subject Alternative Name, and, if it finds one, ignores the common
-- name (CN).
--
-- After successful completion of the @RequestCertificate@ action, there is
-- a delay of several seconds before you can retrieve information about the
-- new certificate.
module Amazonka.CertificateManager.RequestCertificate
  ( -- * Creating a Request
    RequestCertificate (..),
    newRequestCertificate,

    -- * Request Lenses
    requestCertificate_certificateAuthorityArn,
    requestCertificate_domainValidationOptions,
    requestCertificate_idempotencyToken,
    requestCertificate_keyAlgorithm,
    requestCertificate_options,
    requestCertificate_subjectAlternativeNames,
    requestCertificate_tags,
    requestCertificate_validationMethod,
    requestCertificate_domainName,

    -- * Destructuring the Response
    RequestCertificateResponse (..),
    newRequestCertificateResponse,

    -- * Response Lenses
    requestCertificateResponse_certificateArn,
    requestCertificateResponse_httpStatus,
  )
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:/ 'newRequestCertificate' smart constructor.
data RequestCertificate = RequestCertificate'
  { -- | The Amazon Resource Name (ARN) of the private certificate authority (CA)
    -- that will be used to issue the certificate. If you do not provide an ARN
    -- and you are trying to request a private certificate, ACM will attempt to
    -- issue a public certificate. For more information about private CAs, see
    -- the
    -- <https://docs.aws.amazon.com/privateca/latest/userguide/PcaWelcome.html Amazon Web Services Private Certificate Authority>
    -- user guide. The ARN must have the following form:
    --
    -- @arn:aws:acm-pca:region:account:certificate-authority\/12345678-1234-1234-1234-123456789012@
    RequestCertificate -> Maybe Text
certificateAuthorityArn :: Prelude.Maybe Prelude.Text,
    -- | The domain name that you want ACM to use to send you emails so that you
    -- can validate domain ownership.
    RequestCertificate -> Maybe (NonEmpty DomainValidationOption)
domainValidationOptions :: Prelude.Maybe (Prelude.NonEmpty DomainValidationOption),
    -- | Customer chosen string that can be used to distinguish between calls to
    -- @RequestCertificate@. Idempotency tokens time out after one hour.
    -- Therefore, if you call @RequestCertificate@ multiple times with the same
    -- idempotency token within one hour, ACM recognizes that you are
    -- requesting only one certificate and will issue only one. If you change
    -- the idempotency token for each call, ACM recognizes that you are
    -- requesting multiple certificates.
    RequestCertificate -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies the algorithm of the public and private key pair that your
    -- certificate uses to encrypt data. RSA is the default key algorithm for
    -- ACM certificates. Elliptic Curve Digital Signature Algorithm (ECDSA)
    -- keys are smaller, offering security comparable to RSA keys but with
    -- greater computing efficiency. However, ECDSA is not supported by all
    -- network clients. Some AWS services may require RSA keys, or only support
    -- ECDSA keys of a particular size, while others allow the use of either
    -- RSA and ECDSA keys to ensure that compatibility is not broken. Check the
    -- requirements for the AWS service where you plan to deploy your
    -- certificate.
    --
    -- Default: RSA_2048
    RequestCertificate -> Maybe KeyAlgorithm
keyAlgorithm :: Prelude.Maybe KeyAlgorithm,
    -- | Currently, you can use this parameter to specify whether to add the
    -- certificate to a certificate transparency log. Certificate transparency
    -- makes it possible to detect SSL\/TLS certificates that have been
    -- mistakenly or maliciously issued. Certificates that have not been logged
    -- typically produce an error message in a browser. For more information,
    -- see
    -- <https://docs.aws.amazon.com/acm/latest/userguide/acm-bestpractices.html#best-practices-transparency Opting Out of Certificate Transparency Logging>.
    RequestCertificate -> Maybe CertificateOptions
options :: Prelude.Maybe CertificateOptions,
    -- | Additional FQDNs to be included in the Subject Alternative Name
    -- extension of the ACM certificate. For example, add the name
    -- www.example.net to a certificate for which the @DomainName@ field is
    -- www.example.com if users can reach your site by using either name. The
    -- maximum number of domain names that you can add to an ACM certificate is
    -- 100. However, the initial quota is 10 domain names. If you need more
    -- than 10 names, you must request a quota increase. For more information,
    -- see
    -- <https://docs.aws.amazon.com/acm/latest/userguide/acm-limits.html Quotas>.
    --
    -- The maximum length of a SAN DNS name is 253 octets. The name is made up
    -- of multiple labels separated by periods. No label can be longer than 63
    -- octets. Consider the following examples:
    --
    -- -   @(63 octets).(63 octets).(63 octets).(61 octets)@ is legal because
    --     the total length is 253 octets (63+1+63+1+63+1+61) and no label
    --     exceeds 63 octets.
    --
    -- -   @(64 octets).(63 octets).(63 octets).(61 octets)@ is not legal
    --     because the total length exceeds 253 octets (64+1+63+1+63+1+61) and
    --     the first label exceeds 63 octets.
    --
    -- -   @(63 octets).(63 octets).(63 octets).(62 octets)@ is not legal
    --     because the total length of the DNS name (63+1+63+1+63+1+62) exceeds
    --     253 octets.
    RequestCertificate -> Maybe (NonEmpty Text)
subjectAlternativeNames :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | One or more resource tags to associate with the certificate.
    RequestCertificate -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The method you want to use if you are requesting a public certificate to
    -- validate that you own or control domain. You can
    -- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-dns.html validate with DNS>
    -- or
    -- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-email.html validate with email>.
    -- We recommend that you use DNS validation.
    RequestCertificate -> Maybe ValidationMethod
validationMethod :: Prelude.Maybe ValidationMethod,
    -- | Fully qualified domain name (FQDN), such as www.example.com, that you
    -- want to secure with an ACM certificate. Use an asterisk (*) to create a
    -- wildcard certificate that protects several sites in the same domain. For
    -- example, *.example.com protects www.example.com, site.example.com, and
    -- images.example.com.
    --
    -- In compliance with
    -- <https://datatracker.ietf.org/doc/html/rfc5280 RFC 5280>, the length of
    -- the domain name (technically, the Common Name) that you provide cannot
    -- exceed 64 octets (characters), including periods. To add a longer domain
    -- name, specify it in the Subject Alternative Name field, which supports
    -- names up to 253 octets in length.
    RequestCertificate -> Text
domainName :: Prelude.Text
  }
  deriving (RequestCertificate -> RequestCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestCertificate -> RequestCertificate -> Bool
$c/= :: RequestCertificate -> RequestCertificate -> Bool
== :: RequestCertificate -> RequestCertificate -> Bool
$c== :: RequestCertificate -> RequestCertificate -> Bool
Prelude.Eq, ReadPrec [RequestCertificate]
ReadPrec RequestCertificate
Int -> ReadS RequestCertificate
ReadS [RequestCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestCertificate]
$creadListPrec :: ReadPrec [RequestCertificate]
readPrec :: ReadPrec RequestCertificate
$creadPrec :: ReadPrec RequestCertificate
readList :: ReadS [RequestCertificate]
$creadList :: ReadS [RequestCertificate]
readsPrec :: Int -> ReadS RequestCertificate
$creadsPrec :: Int -> ReadS RequestCertificate
Prelude.Read, Int -> RequestCertificate -> ShowS
[RequestCertificate] -> ShowS
RequestCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestCertificate] -> ShowS
$cshowList :: [RequestCertificate] -> ShowS
show :: RequestCertificate -> String
$cshow :: RequestCertificate -> String
showsPrec :: Int -> RequestCertificate -> ShowS
$cshowsPrec :: Int -> RequestCertificate -> ShowS
Prelude.Show, forall x. Rep RequestCertificate x -> RequestCertificate
forall x. RequestCertificate -> Rep RequestCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestCertificate x -> RequestCertificate
$cfrom :: forall x. RequestCertificate -> Rep RequestCertificate x
Prelude.Generic)

-- |
-- Create a value of 'RequestCertificate' 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:
--
-- 'certificateAuthorityArn', 'requestCertificate_certificateAuthorityArn' - The Amazon Resource Name (ARN) of the private certificate authority (CA)
-- that will be used to issue the certificate. If you do not provide an ARN
-- and you are trying to request a private certificate, ACM will attempt to
-- issue a public certificate. For more information about private CAs, see
-- the
-- <https://docs.aws.amazon.com/privateca/latest/userguide/PcaWelcome.html Amazon Web Services Private Certificate Authority>
-- user guide. The ARN must have the following form:
--
-- @arn:aws:acm-pca:region:account:certificate-authority\/12345678-1234-1234-1234-123456789012@
--
-- 'domainValidationOptions', 'requestCertificate_domainValidationOptions' - The domain name that you want ACM to use to send you emails so that you
-- can validate domain ownership.
--
-- 'idempotencyToken', 'requestCertificate_idempotencyToken' - Customer chosen string that can be used to distinguish between calls to
-- @RequestCertificate@. Idempotency tokens time out after one hour.
-- Therefore, if you call @RequestCertificate@ multiple times with the same
-- idempotency token within one hour, ACM recognizes that you are
-- requesting only one certificate and will issue only one. If you change
-- the idempotency token for each call, ACM recognizes that you are
-- requesting multiple certificates.
--
-- 'keyAlgorithm', 'requestCertificate_keyAlgorithm' - Specifies the algorithm of the public and private key pair that your
-- certificate uses to encrypt data. RSA is the default key algorithm for
-- ACM certificates. Elliptic Curve Digital Signature Algorithm (ECDSA)
-- keys are smaller, offering security comparable to RSA keys but with
-- greater computing efficiency. However, ECDSA is not supported by all
-- network clients. Some AWS services may require RSA keys, or only support
-- ECDSA keys of a particular size, while others allow the use of either
-- RSA and ECDSA keys to ensure that compatibility is not broken. Check the
-- requirements for the AWS service where you plan to deploy your
-- certificate.
--
-- Default: RSA_2048
--
-- 'options', 'requestCertificate_options' - Currently, you can use this parameter to specify whether to add the
-- certificate to a certificate transparency log. Certificate transparency
-- makes it possible to detect SSL\/TLS certificates that have been
-- mistakenly or maliciously issued. Certificates that have not been logged
-- typically produce an error message in a browser. For more information,
-- see
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-bestpractices.html#best-practices-transparency Opting Out of Certificate Transparency Logging>.
--
-- 'subjectAlternativeNames', 'requestCertificate_subjectAlternativeNames' - Additional FQDNs to be included in the Subject Alternative Name
-- extension of the ACM certificate. For example, add the name
-- www.example.net to a certificate for which the @DomainName@ field is
-- www.example.com if users can reach your site by using either name. The
-- maximum number of domain names that you can add to an ACM certificate is
-- 100. However, the initial quota is 10 domain names. If you need more
-- than 10 names, you must request a quota increase. For more information,
-- see
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-limits.html Quotas>.
--
-- The maximum length of a SAN DNS name is 253 octets. The name is made up
-- of multiple labels separated by periods. No label can be longer than 63
-- octets. Consider the following examples:
--
-- -   @(63 octets).(63 octets).(63 octets).(61 octets)@ is legal because
--     the total length is 253 octets (63+1+63+1+63+1+61) and no label
--     exceeds 63 octets.
--
-- -   @(64 octets).(63 octets).(63 octets).(61 octets)@ is not legal
--     because the total length exceeds 253 octets (64+1+63+1+63+1+61) and
--     the first label exceeds 63 octets.
--
-- -   @(63 octets).(63 octets).(63 octets).(62 octets)@ is not legal
--     because the total length of the DNS name (63+1+63+1+63+1+62) exceeds
--     253 octets.
--
-- 'tags', 'requestCertificate_tags' - One or more resource tags to associate with the certificate.
--
-- 'validationMethod', 'requestCertificate_validationMethod' - The method you want to use if you are requesting a public certificate to
-- validate that you own or control domain. You can
-- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-dns.html validate with DNS>
-- or
-- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-email.html validate with email>.
-- We recommend that you use DNS validation.
--
-- 'domainName', 'requestCertificate_domainName' - Fully qualified domain name (FQDN), such as www.example.com, that you
-- want to secure with an ACM certificate. Use an asterisk (*) to create a
-- wildcard certificate that protects several sites in the same domain. For
-- example, *.example.com protects www.example.com, site.example.com, and
-- images.example.com.
--
-- In compliance with
-- <https://datatracker.ietf.org/doc/html/rfc5280 RFC 5280>, the length of
-- the domain name (technically, the Common Name) that you provide cannot
-- exceed 64 octets (characters), including periods. To add a longer domain
-- name, specify it in the Subject Alternative Name field, which supports
-- names up to 253 octets in length.
newRequestCertificate ::
  -- | 'domainName'
  Prelude.Text ->
  RequestCertificate
newRequestCertificate :: Text -> RequestCertificate
newRequestCertificate Text
pDomainName_ =
  RequestCertificate'
    { $sel:certificateAuthorityArn:RequestCertificate' :: Maybe Text
certificateAuthorityArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainValidationOptions:RequestCertificate' :: Maybe (NonEmpty DomainValidationOption)
domainValidationOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:idempotencyToken:RequestCertificate' :: Maybe Text
idempotencyToken = forall a. Maybe a
Prelude.Nothing,
      $sel:keyAlgorithm:RequestCertificate' :: Maybe KeyAlgorithm
keyAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:options:RequestCertificate' :: Maybe CertificateOptions
options = forall a. Maybe a
Prelude.Nothing,
      $sel:subjectAlternativeNames:RequestCertificate' :: Maybe (NonEmpty Text)
subjectAlternativeNames = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:RequestCertificate' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:validationMethod:RequestCertificate' :: Maybe ValidationMethod
validationMethod = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:RequestCertificate' :: Text
domainName = Text
pDomainName_
    }

-- | The Amazon Resource Name (ARN) of the private certificate authority (CA)
-- that will be used to issue the certificate. If you do not provide an ARN
-- and you are trying to request a private certificate, ACM will attempt to
-- issue a public certificate. For more information about private CAs, see
-- the
-- <https://docs.aws.amazon.com/privateca/latest/userguide/PcaWelcome.html Amazon Web Services Private Certificate Authority>
-- user guide. The ARN must have the following form:
--
-- @arn:aws:acm-pca:region:account:certificate-authority\/12345678-1234-1234-1234-123456789012@
requestCertificate_certificateAuthorityArn :: Lens.Lens' RequestCertificate (Prelude.Maybe Prelude.Text)
requestCertificate_certificateAuthorityArn :: Lens' RequestCertificate (Maybe Text)
requestCertificate_certificateAuthorityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe Text
certificateAuthorityArn :: Maybe Text
$sel:certificateAuthorityArn:RequestCertificate' :: RequestCertificate -> Maybe Text
certificateAuthorityArn} -> Maybe Text
certificateAuthorityArn) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe Text
a -> RequestCertificate
s {$sel:certificateAuthorityArn:RequestCertificate' :: Maybe Text
certificateAuthorityArn = Maybe Text
a} :: RequestCertificate)

-- | The domain name that you want ACM to use to send you emails so that you
-- can validate domain ownership.
requestCertificate_domainValidationOptions :: Lens.Lens' RequestCertificate (Prelude.Maybe (Prelude.NonEmpty DomainValidationOption))
requestCertificate_domainValidationOptions :: Lens' RequestCertificate (Maybe (NonEmpty DomainValidationOption))
requestCertificate_domainValidationOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe (NonEmpty DomainValidationOption)
domainValidationOptions :: Maybe (NonEmpty DomainValidationOption)
$sel:domainValidationOptions:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty DomainValidationOption)
domainValidationOptions} -> Maybe (NonEmpty DomainValidationOption)
domainValidationOptions) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe (NonEmpty DomainValidationOption)
a -> RequestCertificate
s {$sel:domainValidationOptions:RequestCertificate' :: Maybe (NonEmpty DomainValidationOption)
domainValidationOptions = Maybe (NonEmpty DomainValidationOption)
a} :: RequestCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Customer chosen string that can be used to distinguish between calls to
-- @RequestCertificate@. Idempotency tokens time out after one hour.
-- Therefore, if you call @RequestCertificate@ multiple times with the same
-- idempotency token within one hour, ACM recognizes that you are
-- requesting only one certificate and will issue only one. If you change
-- the idempotency token for each call, ACM recognizes that you are
-- requesting multiple certificates.
requestCertificate_idempotencyToken :: Lens.Lens' RequestCertificate (Prelude.Maybe Prelude.Text)
requestCertificate_idempotencyToken :: Lens' RequestCertificate (Maybe Text)
requestCertificate_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:RequestCertificate' :: RequestCertificate -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe Text
a -> RequestCertificate
s {$sel:idempotencyToken:RequestCertificate' :: Maybe Text
idempotencyToken = Maybe Text
a} :: RequestCertificate)

-- | Specifies the algorithm of the public and private key pair that your
-- certificate uses to encrypt data. RSA is the default key algorithm for
-- ACM certificates. Elliptic Curve Digital Signature Algorithm (ECDSA)
-- keys are smaller, offering security comparable to RSA keys but with
-- greater computing efficiency. However, ECDSA is not supported by all
-- network clients. Some AWS services may require RSA keys, or only support
-- ECDSA keys of a particular size, while others allow the use of either
-- RSA and ECDSA keys to ensure that compatibility is not broken. Check the
-- requirements for the AWS service where you plan to deploy your
-- certificate.
--
-- Default: RSA_2048
requestCertificate_keyAlgorithm :: Lens.Lens' RequestCertificate (Prelude.Maybe KeyAlgorithm)
requestCertificate_keyAlgorithm :: Lens' RequestCertificate (Maybe KeyAlgorithm)
requestCertificate_keyAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe KeyAlgorithm
keyAlgorithm :: Maybe KeyAlgorithm
$sel:keyAlgorithm:RequestCertificate' :: RequestCertificate -> Maybe KeyAlgorithm
keyAlgorithm} -> Maybe KeyAlgorithm
keyAlgorithm) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe KeyAlgorithm
a -> RequestCertificate
s {$sel:keyAlgorithm:RequestCertificate' :: Maybe KeyAlgorithm
keyAlgorithm = Maybe KeyAlgorithm
a} :: RequestCertificate)

-- | Currently, you can use this parameter to specify whether to add the
-- certificate to a certificate transparency log. Certificate transparency
-- makes it possible to detect SSL\/TLS certificates that have been
-- mistakenly or maliciously issued. Certificates that have not been logged
-- typically produce an error message in a browser. For more information,
-- see
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-bestpractices.html#best-practices-transparency Opting Out of Certificate Transparency Logging>.
requestCertificate_options :: Lens.Lens' RequestCertificate (Prelude.Maybe CertificateOptions)
requestCertificate_options :: Lens' RequestCertificate (Maybe CertificateOptions)
requestCertificate_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe CertificateOptions
options :: Maybe CertificateOptions
$sel:options:RequestCertificate' :: RequestCertificate -> Maybe CertificateOptions
options} -> Maybe CertificateOptions
options) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe CertificateOptions
a -> RequestCertificate
s {$sel:options:RequestCertificate' :: Maybe CertificateOptions
options = Maybe CertificateOptions
a} :: RequestCertificate)

-- | Additional FQDNs to be included in the Subject Alternative Name
-- extension of the ACM certificate. For example, add the name
-- www.example.net to a certificate for which the @DomainName@ field is
-- www.example.com if users can reach your site by using either name. The
-- maximum number of domain names that you can add to an ACM certificate is
-- 100. However, the initial quota is 10 domain names. If you need more
-- than 10 names, you must request a quota increase. For more information,
-- see
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-limits.html Quotas>.
--
-- The maximum length of a SAN DNS name is 253 octets. The name is made up
-- of multiple labels separated by periods. No label can be longer than 63
-- octets. Consider the following examples:
--
-- -   @(63 octets).(63 octets).(63 octets).(61 octets)@ is legal because
--     the total length is 253 octets (63+1+63+1+63+1+61) and no label
--     exceeds 63 octets.
--
-- -   @(64 octets).(63 octets).(63 octets).(61 octets)@ is not legal
--     because the total length exceeds 253 octets (64+1+63+1+63+1+61) and
--     the first label exceeds 63 octets.
--
-- -   @(63 octets).(63 octets).(63 octets).(62 octets)@ is not legal
--     because the total length of the DNS name (63+1+63+1+63+1+62) exceeds
--     253 octets.
requestCertificate_subjectAlternativeNames :: Lens.Lens' RequestCertificate (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
requestCertificate_subjectAlternativeNames :: Lens' RequestCertificate (Maybe (NonEmpty Text))
requestCertificate_subjectAlternativeNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe (NonEmpty Text)
subjectAlternativeNames :: Maybe (NonEmpty Text)
$sel:subjectAlternativeNames:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Text)
subjectAlternativeNames} -> Maybe (NonEmpty Text)
subjectAlternativeNames) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe (NonEmpty Text)
a -> RequestCertificate
s {$sel:subjectAlternativeNames:RequestCertificate' :: Maybe (NonEmpty Text)
subjectAlternativeNames = Maybe (NonEmpty Text)
a} :: RequestCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | One or more resource tags to associate with the certificate.
requestCertificate_tags :: Lens.Lens' RequestCertificate (Prelude.Maybe (Prelude.NonEmpty Tag))
requestCertificate_tags :: Lens' RequestCertificate (Maybe (NonEmpty Tag))
requestCertificate_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe (NonEmpty Tag)
a -> RequestCertificate
s {$sel:tags:RequestCertificate' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: RequestCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The method you want to use if you are requesting a public certificate to
-- validate that you own or control domain. You can
-- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-dns.html validate with DNS>
-- or
-- <https://docs.aws.amazon.com/acm/latest/userguide/gs-acm-validate-email.html validate with email>.
-- We recommend that you use DNS validation.
requestCertificate_validationMethod :: Lens.Lens' RequestCertificate (Prelude.Maybe ValidationMethod)
requestCertificate_validationMethod :: Lens' RequestCertificate (Maybe ValidationMethod)
requestCertificate_validationMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Maybe ValidationMethod
validationMethod :: Maybe ValidationMethod
$sel:validationMethod:RequestCertificate' :: RequestCertificate -> Maybe ValidationMethod
validationMethod} -> Maybe ValidationMethod
validationMethod) (\s :: RequestCertificate
s@RequestCertificate' {} Maybe ValidationMethod
a -> RequestCertificate
s {$sel:validationMethod:RequestCertificate' :: Maybe ValidationMethod
validationMethod = Maybe ValidationMethod
a} :: RequestCertificate)

-- | Fully qualified domain name (FQDN), such as www.example.com, that you
-- want to secure with an ACM certificate. Use an asterisk (*) to create a
-- wildcard certificate that protects several sites in the same domain. For
-- example, *.example.com protects www.example.com, site.example.com, and
-- images.example.com.
--
-- In compliance with
-- <https://datatracker.ietf.org/doc/html/rfc5280 RFC 5280>, the length of
-- the domain name (technically, the Common Name) that you provide cannot
-- exceed 64 octets (characters), including periods. To add a longer domain
-- name, specify it in the Subject Alternative Name field, which supports
-- names up to 253 octets in length.
requestCertificate_domainName :: Lens.Lens' RequestCertificate Prelude.Text
requestCertificate_domainName :: Lens' RequestCertificate Text
requestCertificate_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificate' {Text
domainName :: Text
$sel:domainName:RequestCertificate' :: RequestCertificate -> Text
domainName} -> Text
domainName) (\s :: RequestCertificate
s@RequestCertificate' {} Text
a -> RequestCertificate
s {$sel:domainName:RequestCertificate' :: Text
domainName = Text
a} :: RequestCertificate)

instance Core.AWSRequest RequestCertificate where
  type
    AWSResponse RequestCertificate =
      RequestCertificateResponse
  request :: (Service -> Service)
-> RequestCertificate -> Request RequestCertificate
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 RequestCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RequestCertificate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> RequestCertificateResponse
RequestCertificateResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CertificateArn")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable RequestCertificate where
  hashWithSalt :: Int -> RequestCertificate -> Int
hashWithSalt Int
_salt RequestCertificate' {Maybe (NonEmpty Text)
Maybe (NonEmpty DomainValidationOption)
Maybe (NonEmpty Tag)
Maybe Text
Maybe CertificateOptions
Maybe KeyAlgorithm
Maybe ValidationMethod
Text
domainName :: Text
validationMethod :: Maybe ValidationMethod
tags :: Maybe (NonEmpty Tag)
subjectAlternativeNames :: Maybe (NonEmpty Text)
options :: Maybe CertificateOptions
keyAlgorithm :: Maybe KeyAlgorithm
idempotencyToken :: Maybe Text
domainValidationOptions :: Maybe (NonEmpty DomainValidationOption)
certificateAuthorityArn :: Maybe Text
$sel:domainName:RequestCertificate' :: RequestCertificate -> Text
$sel:validationMethod:RequestCertificate' :: RequestCertificate -> Maybe ValidationMethod
$sel:tags:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Tag)
$sel:subjectAlternativeNames:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Text)
$sel:options:RequestCertificate' :: RequestCertificate -> Maybe CertificateOptions
$sel:keyAlgorithm:RequestCertificate' :: RequestCertificate -> Maybe KeyAlgorithm
$sel:idempotencyToken:RequestCertificate' :: RequestCertificate -> Maybe Text
$sel:domainValidationOptions:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty DomainValidationOption)
$sel:certificateAuthorityArn:RequestCertificate' :: RequestCertificate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificateAuthorityArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty DomainValidationOption)
domainValidationOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KeyAlgorithm
keyAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateOptions
options
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
subjectAlternativeNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ValidationMethod
validationMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData RequestCertificate where
  rnf :: RequestCertificate -> ()
rnf RequestCertificate' {Maybe (NonEmpty Text)
Maybe (NonEmpty DomainValidationOption)
Maybe (NonEmpty Tag)
Maybe Text
Maybe CertificateOptions
Maybe KeyAlgorithm
Maybe ValidationMethod
Text
domainName :: Text
validationMethod :: Maybe ValidationMethod
tags :: Maybe (NonEmpty Tag)
subjectAlternativeNames :: Maybe (NonEmpty Text)
options :: Maybe CertificateOptions
keyAlgorithm :: Maybe KeyAlgorithm
idempotencyToken :: Maybe Text
domainValidationOptions :: Maybe (NonEmpty DomainValidationOption)
certificateAuthorityArn :: Maybe Text
$sel:domainName:RequestCertificate' :: RequestCertificate -> Text
$sel:validationMethod:RequestCertificate' :: RequestCertificate -> Maybe ValidationMethod
$sel:tags:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Tag)
$sel:subjectAlternativeNames:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Text)
$sel:options:RequestCertificate' :: RequestCertificate -> Maybe CertificateOptions
$sel:keyAlgorithm:RequestCertificate' :: RequestCertificate -> Maybe KeyAlgorithm
$sel:idempotencyToken:RequestCertificate' :: RequestCertificate -> Maybe Text
$sel:domainValidationOptions:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty DomainValidationOption)
$sel:certificateAuthorityArn:RequestCertificate' :: RequestCertificate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateAuthorityArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty DomainValidationOption)
domainValidationOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idempotencyToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KeyAlgorithm
keyAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateOptions
options
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
subjectAlternativeNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ValidationMethod
validationMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders RequestCertificate where
  toHeaders :: RequestCertificate -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"CertificateManager.RequestCertificate" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RequestCertificate where
  toJSON :: RequestCertificate -> Value
toJSON RequestCertificate' {Maybe (NonEmpty Text)
Maybe (NonEmpty DomainValidationOption)
Maybe (NonEmpty Tag)
Maybe Text
Maybe CertificateOptions
Maybe KeyAlgorithm
Maybe ValidationMethod
Text
domainName :: Text
validationMethod :: Maybe ValidationMethod
tags :: Maybe (NonEmpty Tag)
subjectAlternativeNames :: Maybe (NonEmpty Text)
options :: Maybe CertificateOptions
keyAlgorithm :: Maybe KeyAlgorithm
idempotencyToken :: Maybe Text
domainValidationOptions :: Maybe (NonEmpty DomainValidationOption)
certificateAuthorityArn :: Maybe Text
$sel:domainName:RequestCertificate' :: RequestCertificate -> Text
$sel:validationMethod:RequestCertificate' :: RequestCertificate -> Maybe ValidationMethod
$sel:tags:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Tag)
$sel:subjectAlternativeNames:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty Text)
$sel:options:RequestCertificate' :: RequestCertificate -> Maybe CertificateOptions
$sel:keyAlgorithm:RequestCertificate' :: RequestCertificate -> Maybe KeyAlgorithm
$sel:idempotencyToken:RequestCertificate' :: RequestCertificate -> Maybe Text
$sel:domainValidationOptions:RequestCertificate' :: RequestCertificate -> Maybe (NonEmpty DomainValidationOption)
$sel:certificateAuthorityArn:RequestCertificate' :: RequestCertificate -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CertificateAuthorityArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
certificateAuthorityArn,
            (Key
"DomainValidationOptions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty DomainValidationOption)
domainValidationOptions,
            (Key
"IdempotencyToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
idempotencyToken,
            (Key
"KeyAlgorithm" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe KeyAlgorithm
keyAlgorithm,
            (Key
"Options" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CertificateOptions
options,
            (Key
"SubjectAlternativeNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
subjectAlternativeNames,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
tags,
            (Key
"ValidationMethod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ValidationMethod
validationMethod,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName)
          ]
      )

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

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

-- | /See:/ 'newRequestCertificateResponse' smart constructor.
data RequestCertificateResponse = RequestCertificateResponse'
  { -- | String that contains the ARN of the issued certificate. This must be of
    -- the form:
    --
    -- @arn:aws:acm:us-east-1:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
    RequestCertificateResponse -> Maybe Text
certificateArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RequestCertificateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RequestCertificateResponse -> RequestCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestCertificateResponse -> RequestCertificateResponse -> Bool
$c/= :: RequestCertificateResponse -> RequestCertificateResponse -> Bool
== :: RequestCertificateResponse -> RequestCertificateResponse -> Bool
$c== :: RequestCertificateResponse -> RequestCertificateResponse -> Bool
Prelude.Eq, ReadPrec [RequestCertificateResponse]
ReadPrec RequestCertificateResponse
Int -> ReadS RequestCertificateResponse
ReadS [RequestCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestCertificateResponse]
$creadListPrec :: ReadPrec [RequestCertificateResponse]
readPrec :: ReadPrec RequestCertificateResponse
$creadPrec :: ReadPrec RequestCertificateResponse
readList :: ReadS [RequestCertificateResponse]
$creadList :: ReadS [RequestCertificateResponse]
readsPrec :: Int -> ReadS RequestCertificateResponse
$creadsPrec :: Int -> ReadS RequestCertificateResponse
Prelude.Read, Int -> RequestCertificateResponse -> ShowS
[RequestCertificateResponse] -> ShowS
RequestCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestCertificateResponse] -> ShowS
$cshowList :: [RequestCertificateResponse] -> ShowS
show :: RequestCertificateResponse -> String
$cshow :: RequestCertificateResponse -> String
showsPrec :: Int -> RequestCertificateResponse -> ShowS
$cshowsPrec :: Int -> RequestCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep RequestCertificateResponse x -> RequestCertificateResponse
forall x.
RequestCertificateResponse -> Rep RequestCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RequestCertificateResponse x -> RequestCertificateResponse
$cfrom :: forall x.
RequestCertificateResponse -> Rep RequestCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'RequestCertificateResponse' 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', 'requestCertificateResponse_certificateArn' - String that contains the ARN of the issued certificate. This must be of
-- the form:
--
-- @arn:aws:acm:us-east-1:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
--
-- 'httpStatus', 'requestCertificateResponse_httpStatus' - The response's http status code.
newRequestCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RequestCertificateResponse
newRequestCertificateResponse :: Int -> RequestCertificateResponse
newRequestCertificateResponse Int
pHttpStatus_ =
  RequestCertificateResponse'
    { $sel:certificateArn:RequestCertificateResponse' :: Maybe Text
certificateArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RequestCertificateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | String that contains the ARN of the issued certificate. This must be of
-- the form:
--
-- @arn:aws:acm:us-east-1:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
requestCertificateResponse_certificateArn :: Lens.Lens' RequestCertificateResponse (Prelude.Maybe Prelude.Text)
requestCertificateResponse_certificateArn :: Lens' RequestCertificateResponse (Maybe Text)
requestCertificateResponse_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestCertificateResponse' {Maybe Text
certificateArn :: Maybe Text
$sel:certificateArn:RequestCertificateResponse' :: RequestCertificateResponse -> Maybe Text
certificateArn} -> Maybe Text
certificateArn) (\s :: RequestCertificateResponse
s@RequestCertificateResponse' {} Maybe Text
a -> RequestCertificateResponse
s {$sel:certificateArn:RequestCertificateResponse' :: Maybe Text
certificateArn = Maybe Text
a} :: RequestCertificateResponse)

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

instance Prelude.NFData RequestCertificateResponse where
  rnf :: RequestCertificateResponse -> ()
rnf RequestCertificateResponse' {Int
Maybe Text
httpStatus :: Int
certificateArn :: Maybe Text
$sel:httpStatus:RequestCertificateResponse' :: RequestCertificateResponse -> Int
$sel:certificateArn:RequestCertificateResponse' :: RequestCertificateResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus