{-# 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.CertificateManagerPCA.IssueCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uses your private certificate authority (CA), or one that has been
-- shared with you, to issue a client certificate. This action returns the
-- Amazon Resource Name (ARN) of the certificate. You can retrieve the
-- certificate by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_GetCertificate.html GetCertificate>
-- action and specifying the ARN.
--
-- You cannot use the ACM __ListCertificateAuthorities__ action to retrieve
-- the ARNs of the certificates that you issue by using Amazon Web Services
-- Private CA.
module Amazonka.CertificateManagerPCA.IssueCertificate
  ( -- * Creating a Request
    IssueCertificate (..),
    newIssueCertificate,

    -- * Request Lenses
    issueCertificate_apiPassthrough,
    issueCertificate_idempotencyToken,
    issueCertificate_templateArn,
    issueCertificate_validityNotBefore,
    issueCertificate_certificateAuthorityArn,
    issueCertificate_csr,
    issueCertificate_signingAlgorithm,
    issueCertificate_validity,

    -- * Destructuring the Response
    IssueCertificateResponse (..),
    newIssueCertificateResponse,

    -- * Response Lenses
    issueCertificateResponse_certificateArn,
    issueCertificateResponse_httpStatus,
  )
where

import Amazonka.CertificateManagerPCA.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:/ 'newIssueCertificate' smart constructor.
data IssueCertificate = IssueCertificate'
  { -- | Specifies X.509 certificate information to be included in the issued
    -- certificate. An @APIPassthrough@ or @APICSRPassthrough@ template variant
    -- must be selected, or else this parameter is ignored. For more
    -- information about using these templates, see
    -- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html Understanding Certificate Templates>.
    --
    -- If conflicting or duplicate certificate information is supplied during
    -- certificate issuance, Amazon Web Services Private CA applies
    -- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html#template-order-of-operations order of operation rules>
    -- to determine what information is used.
    IssueCertificate -> Maybe ApiPassthrough
apiPassthrough :: Prelude.Maybe ApiPassthrough,
    -- | Alphanumeric string that can be used to distinguish between calls to the
    -- __IssueCertificate__ action. Idempotency tokens for __IssueCertificate__
    -- time out after one minute. Therefore, if you call __IssueCertificate__
    -- multiple times with the same idempotency token within one minute, Amazon
    -- Web Services Private CA recognizes that you are requesting only one
    -- certificate and will issue only one. If you change the idempotency token
    -- for each call, Amazon Web Services Private CA recognizes that you are
    -- requesting multiple certificates.
    IssueCertificate -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies a custom configuration template to use when issuing a
    -- certificate. If this parameter is not provided, Amazon Web Services
    -- Private CA defaults to the @EndEntityCertificate\/V1@ template. For CA
    -- certificates, you should choose the shortest path length that meets your
    -- needs. The path length is indicated by the PathLen/N/ portion of the
    -- ARN, where /N/ is the
    -- <https://docs.aws.amazon.com/privateca/latest/userguide/PcaTerms.html#terms-cadepth CA depth>.
    --
    -- Note: The CA depth configured on a subordinate CA certificate must not
    -- exceed the limit set by its parents in the CA hierarchy.
    --
    -- For a list of @TemplateArn@ values supported by Amazon Web Services
    -- Private CA, see
    -- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html Understanding Certificate Templates>.
    IssueCertificate -> Maybe Text
templateArn :: Prelude.Maybe Prelude.Text,
    -- | Information describing the start of the validity period of the
    -- certificate. This parameter sets the “Not Before\" date for the
    -- certificate.
    --
    -- By default, when issuing a certificate, Amazon Web Services Private CA
    -- sets the \"Not Before\" date to the issuance time minus 60 minutes. This
    -- compensates for clock inconsistencies across computer systems. The
    -- @ValidityNotBefore@ parameter can be used to customize the “Not Before”
    -- value.
    --
    -- Unlike the @Validity@ parameter, the @ValidityNotBefore@ parameter is
    -- optional.
    --
    -- The @ValidityNotBefore@ value is expressed as an explicit date and time,
    -- using the @Validity@ type value @ABSOLUTE@. For more information, see
    -- <https://docs.aws.amazon.com/acm-pca/latest/APIReference/API_Validity.html Validity>
    -- in this API reference and
    -- <https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.5 Validity>
    -- in RFC 5280.
    IssueCertificate -> Maybe Validity
validityNotBefore :: Prelude.Maybe Validity,
    -- | The Amazon Resource Name (ARN) that was returned when you called
    -- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_CreateCertificateAuthority.html CreateCertificateAuthority>.
    -- This must be of the form:
    --
    -- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @
    IssueCertificate -> Text
certificateAuthorityArn :: Prelude.Text,
    -- | The certificate signing request (CSR) for the certificate you want to
    -- issue. As an example, you can use the following OpenSSL command to
    -- create the CSR and a 2048 bit RSA private key.
    --
    -- @openssl req -new -newkey rsa:2048 -days 365 -keyout private\/test_cert_priv_key.pem -out csr\/test_cert_.csr@
    --
    -- If you have a configuration file, you can then use the following OpenSSL
    -- command. The @usr_cert@ block in the configuration file contains your
    -- X509 version 3 extensions.
    --
    -- @openssl req -new -config openssl_rsa.cnf -extensions usr_cert -newkey rsa:2048 -days 365 -keyout private\/test_cert_priv_key.pem -out csr\/test_cert_.csr@
    --
    -- Note: A CSR must provide either a /subject name/ or a /subject
    -- alternative name/ or the request will be rejected.
    IssueCertificate -> Base64
csr :: Data.Base64,
    -- | The name of the algorithm that will be used to sign the certificate to
    -- be issued.
    --
    -- This parameter should not be confused with the @SigningAlgorithm@
    -- parameter used to sign a CSR in the @CreateCertificateAuthority@ action.
    --
    -- The specified signing algorithm family (RSA or ECDSA) much match the
    -- algorithm family of the CA\'s secret key.
    IssueCertificate -> SigningAlgorithm
signingAlgorithm :: SigningAlgorithm,
    -- | Information describing the end of the validity period of the
    -- certificate. This parameter sets the “Not After” date for the
    -- certificate.
    --
    -- Certificate validity is the period of time during which a certificate is
    -- valid. Validity can be expressed as an explicit date and time when the
    -- certificate expires, or as a span of time after issuance, stated in
    -- days, months, or years. For more information, see
    -- <https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.5 Validity>
    -- in RFC 5280.
    --
    -- This value is unaffected when @ValidityNotBefore@ is also specified. For
    -- example, if @Validity@ is set to 20 days in the future, the certificate
    -- will expire 20 days from issuance time regardless of the
    -- @ValidityNotBefore@ value.
    --
    -- The end of the validity period configured on a certificate must not
    -- exceed the limit set on its parents in the CA hierarchy.
    IssueCertificate -> Validity
validity :: Validity
  }
  deriving (IssueCertificate -> IssueCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueCertificate -> IssueCertificate -> Bool
$c/= :: IssueCertificate -> IssueCertificate -> Bool
== :: IssueCertificate -> IssueCertificate -> Bool
$c== :: IssueCertificate -> IssueCertificate -> Bool
Prelude.Eq, ReadPrec [IssueCertificate]
ReadPrec IssueCertificate
Int -> ReadS IssueCertificate
ReadS [IssueCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IssueCertificate]
$creadListPrec :: ReadPrec [IssueCertificate]
readPrec :: ReadPrec IssueCertificate
$creadPrec :: ReadPrec IssueCertificate
readList :: ReadS [IssueCertificate]
$creadList :: ReadS [IssueCertificate]
readsPrec :: Int -> ReadS IssueCertificate
$creadsPrec :: Int -> ReadS IssueCertificate
Prelude.Read, Int -> IssueCertificate -> ShowS
[IssueCertificate] -> ShowS
IssueCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueCertificate] -> ShowS
$cshowList :: [IssueCertificate] -> ShowS
show :: IssueCertificate -> String
$cshow :: IssueCertificate -> String
showsPrec :: Int -> IssueCertificate -> ShowS
$cshowsPrec :: Int -> IssueCertificate -> ShowS
Prelude.Show, forall x. Rep IssueCertificate x -> IssueCertificate
forall x. IssueCertificate -> Rep IssueCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IssueCertificate x -> IssueCertificate
$cfrom :: forall x. IssueCertificate -> Rep IssueCertificate x
Prelude.Generic)

-- |
-- Create a value of 'IssueCertificate' 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:
--
-- 'apiPassthrough', 'issueCertificate_apiPassthrough' - Specifies X.509 certificate information to be included in the issued
-- certificate. An @APIPassthrough@ or @APICSRPassthrough@ template variant
-- must be selected, or else this parameter is ignored. For more
-- information about using these templates, see
-- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html Understanding Certificate Templates>.
--
-- If conflicting or duplicate certificate information is supplied during
-- certificate issuance, Amazon Web Services Private CA applies
-- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html#template-order-of-operations order of operation rules>
-- to determine what information is used.
--
-- 'idempotencyToken', 'issueCertificate_idempotencyToken' - Alphanumeric string that can be used to distinguish between calls to the
-- __IssueCertificate__ action. Idempotency tokens for __IssueCertificate__
-- time out after one minute. Therefore, if you call __IssueCertificate__
-- multiple times with the same idempotency token within one minute, Amazon
-- Web Services Private CA recognizes that you are requesting only one
-- certificate and will issue only one. If you change the idempotency token
-- for each call, Amazon Web Services Private CA recognizes that you are
-- requesting multiple certificates.
--
-- 'templateArn', 'issueCertificate_templateArn' - Specifies a custom configuration template to use when issuing a
-- certificate. If this parameter is not provided, Amazon Web Services
-- Private CA defaults to the @EndEntityCertificate\/V1@ template. For CA
-- certificates, you should choose the shortest path length that meets your
-- needs. The path length is indicated by the PathLen/N/ portion of the
-- ARN, where /N/ is the
-- <https://docs.aws.amazon.com/privateca/latest/userguide/PcaTerms.html#terms-cadepth CA depth>.
--
-- Note: The CA depth configured on a subordinate CA certificate must not
-- exceed the limit set by its parents in the CA hierarchy.
--
-- For a list of @TemplateArn@ values supported by Amazon Web Services
-- Private CA, see
-- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html Understanding Certificate Templates>.
--
-- 'validityNotBefore', 'issueCertificate_validityNotBefore' - Information describing the start of the validity period of the
-- certificate. This parameter sets the “Not Before\" date for the
-- certificate.
--
-- By default, when issuing a certificate, Amazon Web Services Private CA
-- sets the \"Not Before\" date to the issuance time minus 60 minutes. This
-- compensates for clock inconsistencies across computer systems. The
-- @ValidityNotBefore@ parameter can be used to customize the “Not Before”
-- value.
--
-- Unlike the @Validity@ parameter, the @ValidityNotBefore@ parameter is
-- optional.
--
-- The @ValidityNotBefore@ value is expressed as an explicit date and time,
-- using the @Validity@ type value @ABSOLUTE@. For more information, see
-- <https://docs.aws.amazon.com/acm-pca/latest/APIReference/API_Validity.html Validity>
-- in this API reference and
-- <https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.5 Validity>
-- in RFC 5280.
--
-- 'certificateAuthorityArn', 'issueCertificate_certificateAuthorityArn' - The Amazon Resource Name (ARN) that was returned when you called
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_CreateCertificateAuthority.html CreateCertificateAuthority>.
-- This must be of the form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @
--
-- 'csr', 'issueCertificate_csr' - The certificate signing request (CSR) for the certificate you want to
-- issue. As an example, you can use the following OpenSSL command to
-- create the CSR and a 2048 bit RSA private key.
--
-- @openssl req -new -newkey rsa:2048 -days 365 -keyout private\/test_cert_priv_key.pem -out csr\/test_cert_.csr@
--
-- If you have a configuration file, you can then use the following OpenSSL
-- command. The @usr_cert@ block in the configuration file contains your
-- X509 version 3 extensions.
--
-- @openssl req -new -config openssl_rsa.cnf -extensions usr_cert -newkey rsa:2048 -days 365 -keyout private\/test_cert_priv_key.pem -out csr\/test_cert_.csr@
--
-- Note: A CSR must provide either a /subject name/ or a /subject
-- alternative name/ or the request will be rejected.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'signingAlgorithm', 'issueCertificate_signingAlgorithm' - The name of the algorithm that will be used to sign the certificate to
-- be issued.
--
-- This parameter should not be confused with the @SigningAlgorithm@
-- parameter used to sign a CSR in the @CreateCertificateAuthority@ action.
--
-- The specified signing algorithm family (RSA or ECDSA) much match the
-- algorithm family of the CA\'s secret key.
--
-- 'validity', 'issueCertificate_validity' - Information describing the end of the validity period of the
-- certificate. This parameter sets the “Not After” date for the
-- certificate.
--
-- Certificate validity is the period of time during which a certificate is
-- valid. Validity can be expressed as an explicit date and time when the
-- certificate expires, or as a span of time after issuance, stated in
-- days, months, or years. For more information, see
-- <https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.5 Validity>
-- in RFC 5280.
--
-- This value is unaffected when @ValidityNotBefore@ is also specified. For
-- example, if @Validity@ is set to 20 days in the future, the certificate
-- will expire 20 days from issuance time regardless of the
-- @ValidityNotBefore@ value.
--
-- The end of the validity period configured on a certificate must not
-- exceed the limit set on its parents in the CA hierarchy.
newIssueCertificate ::
  -- | 'certificateAuthorityArn'
  Prelude.Text ->
  -- | 'csr'
  Prelude.ByteString ->
  -- | 'signingAlgorithm'
  SigningAlgorithm ->
  -- | 'validity'
  Validity ->
  IssueCertificate
newIssueCertificate :: Text
-> ByteString -> SigningAlgorithm -> Validity -> IssueCertificate
newIssueCertificate
  Text
pCertificateAuthorityArn_
  ByteString
pCsr_
  SigningAlgorithm
pSigningAlgorithm_
  Validity
pValidity_ =
    IssueCertificate'
      { $sel:apiPassthrough:IssueCertificate' :: Maybe ApiPassthrough
apiPassthrough = forall a. Maybe a
Prelude.Nothing,
        $sel:idempotencyToken:IssueCertificate' :: Maybe Text
idempotencyToken = forall a. Maybe a
Prelude.Nothing,
        $sel:templateArn:IssueCertificate' :: Maybe Text
templateArn = forall a. Maybe a
Prelude.Nothing,
        $sel:validityNotBefore:IssueCertificate' :: Maybe Validity
validityNotBefore = forall a. Maybe a
Prelude.Nothing,
        $sel:certificateAuthorityArn:IssueCertificate' :: Text
certificateAuthorityArn = Text
pCertificateAuthorityArn_,
        $sel:csr:IssueCertificate' :: Base64
csr = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pCsr_,
        $sel:signingAlgorithm:IssueCertificate' :: SigningAlgorithm
signingAlgorithm = SigningAlgorithm
pSigningAlgorithm_,
        $sel:validity:IssueCertificate' :: Validity
validity = Validity
pValidity_
      }

-- | Specifies X.509 certificate information to be included in the issued
-- certificate. An @APIPassthrough@ or @APICSRPassthrough@ template variant
-- must be selected, or else this parameter is ignored. For more
-- information about using these templates, see
-- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html Understanding Certificate Templates>.
--
-- If conflicting or duplicate certificate information is supplied during
-- certificate issuance, Amazon Web Services Private CA applies
-- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html#template-order-of-operations order of operation rules>
-- to determine what information is used.
issueCertificate_apiPassthrough :: Lens.Lens' IssueCertificate (Prelude.Maybe ApiPassthrough)
issueCertificate_apiPassthrough :: Lens' IssueCertificate (Maybe ApiPassthrough)
issueCertificate_apiPassthrough = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {Maybe ApiPassthrough
apiPassthrough :: Maybe ApiPassthrough
$sel:apiPassthrough:IssueCertificate' :: IssueCertificate -> Maybe ApiPassthrough
apiPassthrough} -> Maybe ApiPassthrough
apiPassthrough) (\s :: IssueCertificate
s@IssueCertificate' {} Maybe ApiPassthrough
a -> IssueCertificate
s {$sel:apiPassthrough:IssueCertificate' :: Maybe ApiPassthrough
apiPassthrough = Maybe ApiPassthrough
a} :: IssueCertificate)

-- | Alphanumeric string that can be used to distinguish between calls to the
-- __IssueCertificate__ action. Idempotency tokens for __IssueCertificate__
-- time out after one minute. Therefore, if you call __IssueCertificate__
-- multiple times with the same idempotency token within one minute, Amazon
-- Web Services Private CA recognizes that you are requesting only one
-- certificate and will issue only one. If you change the idempotency token
-- for each call, Amazon Web Services Private CA recognizes that you are
-- requesting multiple certificates.
issueCertificate_idempotencyToken :: Lens.Lens' IssueCertificate (Prelude.Maybe Prelude.Text)
issueCertificate_idempotencyToken :: Lens' IssueCertificate (Maybe Text)
issueCertificate_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:IssueCertificate' :: IssueCertificate -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: IssueCertificate
s@IssueCertificate' {} Maybe Text
a -> IssueCertificate
s {$sel:idempotencyToken:IssueCertificate' :: Maybe Text
idempotencyToken = Maybe Text
a} :: IssueCertificate)

-- | Specifies a custom configuration template to use when issuing a
-- certificate. If this parameter is not provided, Amazon Web Services
-- Private CA defaults to the @EndEntityCertificate\/V1@ template. For CA
-- certificates, you should choose the shortest path length that meets your
-- needs. The path length is indicated by the PathLen/N/ portion of the
-- ARN, where /N/ is the
-- <https://docs.aws.amazon.com/privateca/latest/userguide/PcaTerms.html#terms-cadepth CA depth>.
--
-- Note: The CA depth configured on a subordinate CA certificate must not
-- exceed the limit set by its parents in the CA hierarchy.
--
-- For a list of @TemplateArn@ values supported by Amazon Web Services
-- Private CA, see
-- <https://docs.aws.amazon.com/privateca/latest/userguide/UsingTemplates.html Understanding Certificate Templates>.
issueCertificate_templateArn :: Lens.Lens' IssueCertificate (Prelude.Maybe Prelude.Text)
issueCertificate_templateArn :: Lens' IssueCertificate (Maybe Text)
issueCertificate_templateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {Maybe Text
templateArn :: Maybe Text
$sel:templateArn:IssueCertificate' :: IssueCertificate -> Maybe Text
templateArn} -> Maybe Text
templateArn) (\s :: IssueCertificate
s@IssueCertificate' {} Maybe Text
a -> IssueCertificate
s {$sel:templateArn:IssueCertificate' :: Maybe Text
templateArn = Maybe Text
a} :: IssueCertificate)

-- | Information describing the start of the validity period of the
-- certificate. This parameter sets the “Not Before\" date for the
-- certificate.
--
-- By default, when issuing a certificate, Amazon Web Services Private CA
-- sets the \"Not Before\" date to the issuance time minus 60 minutes. This
-- compensates for clock inconsistencies across computer systems. The
-- @ValidityNotBefore@ parameter can be used to customize the “Not Before”
-- value.
--
-- Unlike the @Validity@ parameter, the @ValidityNotBefore@ parameter is
-- optional.
--
-- The @ValidityNotBefore@ value is expressed as an explicit date and time,
-- using the @Validity@ type value @ABSOLUTE@. For more information, see
-- <https://docs.aws.amazon.com/acm-pca/latest/APIReference/API_Validity.html Validity>
-- in this API reference and
-- <https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.5 Validity>
-- in RFC 5280.
issueCertificate_validityNotBefore :: Lens.Lens' IssueCertificate (Prelude.Maybe Validity)
issueCertificate_validityNotBefore :: Lens' IssueCertificate (Maybe Validity)
issueCertificate_validityNotBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {Maybe Validity
validityNotBefore :: Maybe Validity
$sel:validityNotBefore:IssueCertificate' :: IssueCertificate -> Maybe Validity
validityNotBefore} -> Maybe Validity
validityNotBefore) (\s :: IssueCertificate
s@IssueCertificate' {} Maybe Validity
a -> IssueCertificate
s {$sel:validityNotBefore:IssueCertificate' :: Maybe Validity
validityNotBefore = Maybe Validity
a} :: IssueCertificate)

-- | The Amazon Resource Name (ARN) that was returned when you called
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_CreateCertificateAuthority.html CreateCertificateAuthority>.
-- This must be of the form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @
issueCertificate_certificateAuthorityArn :: Lens.Lens' IssueCertificate Prelude.Text
issueCertificate_certificateAuthorityArn :: Lens' IssueCertificate Text
issueCertificate_certificateAuthorityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:IssueCertificate' :: IssueCertificate -> Text
certificateAuthorityArn} -> Text
certificateAuthorityArn) (\s :: IssueCertificate
s@IssueCertificate' {} Text
a -> IssueCertificate
s {$sel:certificateAuthorityArn:IssueCertificate' :: Text
certificateAuthorityArn = Text
a} :: IssueCertificate)

-- | The certificate signing request (CSR) for the certificate you want to
-- issue. As an example, you can use the following OpenSSL command to
-- create the CSR and a 2048 bit RSA private key.
--
-- @openssl req -new -newkey rsa:2048 -days 365 -keyout private\/test_cert_priv_key.pem -out csr\/test_cert_.csr@
--
-- If you have a configuration file, you can then use the following OpenSSL
-- command. The @usr_cert@ block in the configuration file contains your
-- X509 version 3 extensions.
--
-- @openssl req -new -config openssl_rsa.cnf -extensions usr_cert -newkey rsa:2048 -days 365 -keyout private\/test_cert_priv_key.pem -out csr\/test_cert_.csr@
--
-- Note: A CSR must provide either a /subject name/ or a /subject
-- alternative name/ or the request will be rejected.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
issueCertificate_csr :: Lens.Lens' IssueCertificate Prelude.ByteString
issueCertificate_csr :: Lens' IssueCertificate ByteString
issueCertificate_csr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {Base64
csr :: Base64
$sel:csr:IssueCertificate' :: IssueCertificate -> Base64
csr} -> Base64
csr) (\s :: IssueCertificate
s@IssueCertificate' {} Base64
a -> IssueCertificate
s {$sel:csr:IssueCertificate' :: Base64
csr = Base64
a} :: IssueCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The name of the algorithm that will be used to sign the certificate to
-- be issued.
--
-- This parameter should not be confused with the @SigningAlgorithm@
-- parameter used to sign a CSR in the @CreateCertificateAuthority@ action.
--
-- The specified signing algorithm family (RSA or ECDSA) much match the
-- algorithm family of the CA\'s secret key.
issueCertificate_signingAlgorithm :: Lens.Lens' IssueCertificate SigningAlgorithm
issueCertificate_signingAlgorithm :: Lens' IssueCertificate SigningAlgorithm
issueCertificate_signingAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {SigningAlgorithm
signingAlgorithm :: SigningAlgorithm
$sel:signingAlgorithm:IssueCertificate' :: IssueCertificate -> SigningAlgorithm
signingAlgorithm} -> SigningAlgorithm
signingAlgorithm) (\s :: IssueCertificate
s@IssueCertificate' {} SigningAlgorithm
a -> IssueCertificate
s {$sel:signingAlgorithm:IssueCertificate' :: SigningAlgorithm
signingAlgorithm = SigningAlgorithm
a} :: IssueCertificate)

-- | Information describing the end of the validity period of the
-- certificate. This parameter sets the “Not After” date for the
-- certificate.
--
-- Certificate validity is the period of time during which a certificate is
-- valid. Validity can be expressed as an explicit date and time when the
-- certificate expires, or as a span of time after issuance, stated in
-- days, months, or years. For more information, see
-- <https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.5 Validity>
-- in RFC 5280.
--
-- This value is unaffected when @ValidityNotBefore@ is also specified. For
-- example, if @Validity@ is set to 20 days in the future, the certificate
-- will expire 20 days from issuance time regardless of the
-- @ValidityNotBefore@ value.
--
-- The end of the validity period configured on a certificate must not
-- exceed the limit set on its parents in the CA hierarchy.
issueCertificate_validity :: Lens.Lens' IssueCertificate Validity
issueCertificate_validity :: Lens' IssueCertificate Validity
issueCertificate_validity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificate' {Validity
validity :: Validity
$sel:validity:IssueCertificate' :: IssueCertificate -> Validity
validity} -> Validity
validity) (\s :: IssueCertificate
s@IssueCertificate' {} Validity
a -> IssueCertificate
s {$sel:validity:IssueCertificate' :: Validity
validity = Validity
a} :: IssueCertificate)

instance Core.AWSRequest IssueCertificate where
  type
    AWSResponse IssueCertificate =
      IssueCertificateResponse
  request :: (Service -> Service)
-> IssueCertificate -> Request IssueCertificate
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 IssueCertificate
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse IssueCertificate)))
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 -> IssueCertificateResponse
IssueCertificateResponse'
            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 IssueCertificate where
  hashWithSalt :: Int -> IssueCertificate -> Int
hashWithSalt Int
_salt IssueCertificate' {Maybe Text
Maybe ApiPassthrough
Maybe Validity
Text
Base64
SigningAlgorithm
Validity
validity :: Validity
signingAlgorithm :: SigningAlgorithm
csr :: Base64
certificateAuthorityArn :: Text
validityNotBefore :: Maybe Validity
templateArn :: Maybe Text
idempotencyToken :: Maybe Text
apiPassthrough :: Maybe ApiPassthrough
$sel:validity:IssueCertificate' :: IssueCertificate -> Validity
$sel:signingAlgorithm:IssueCertificate' :: IssueCertificate -> SigningAlgorithm
$sel:csr:IssueCertificate' :: IssueCertificate -> Base64
$sel:certificateAuthorityArn:IssueCertificate' :: IssueCertificate -> Text
$sel:validityNotBefore:IssueCertificate' :: IssueCertificate -> Maybe Validity
$sel:templateArn:IssueCertificate' :: IssueCertificate -> Maybe Text
$sel:idempotencyToken:IssueCertificate' :: IssueCertificate -> Maybe Text
$sel:apiPassthrough:IssueCertificate' :: IssueCertificate -> Maybe ApiPassthrough
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiPassthrough
apiPassthrough
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Validity
validityNotBefore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateAuthorityArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
csr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SigningAlgorithm
signingAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Validity
validity

instance Prelude.NFData IssueCertificate where
  rnf :: IssueCertificate -> ()
rnf IssueCertificate' {Maybe Text
Maybe ApiPassthrough
Maybe Validity
Text
Base64
SigningAlgorithm
Validity
validity :: Validity
signingAlgorithm :: SigningAlgorithm
csr :: Base64
certificateAuthorityArn :: Text
validityNotBefore :: Maybe Validity
templateArn :: Maybe Text
idempotencyToken :: Maybe Text
apiPassthrough :: Maybe ApiPassthrough
$sel:validity:IssueCertificate' :: IssueCertificate -> Validity
$sel:signingAlgorithm:IssueCertificate' :: IssueCertificate -> SigningAlgorithm
$sel:csr:IssueCertificate' :: IssueCertificate -> Base64
$sel:certificateAuthorityArn:IssueCertificate' :: IssueCertificate -> Text
$sel:validityNotBefore:IssueCertificate' :: IssueCertificate -> Maybe Validity
$sel:templateArn:IssueCertificate' :: IssueCertificate -> Maybe Text
$sel:idempotencyToken:IssueCertificate' :: IssueCertificate -> Maybe Text
$sel:apiPassthrough:IssueCertificate' :: IssueCertificate -> Maybe ApiPassthrough
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiPassthrough
apiPassthrough
      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 Text
templateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Validity
validityNotBefore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
certificateAuthorityArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
csr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SigningAlgorithm
signingAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Validity
validity

instance Data.ToHeaders IssueCertificate where
  toHeaders :: IssueCertificate -> 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
"ACMPrivateCA.IssueCertificate" ::
                          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 IssueCertificate where
  toJSON :: IssueCertificate -> Value
toJSON IssueCertificate' {Maybe Text
Maybe ApiPassthrough
Maybe Validity
Text
Base64
SigningAlgorithm
Validity
validity :: Validity
signingAlgorithm :: SigningAlgorithm
csr :: Base64
certificateAuthorityArn :: Text
validityNotBefore :: Maybe Validity
templateArn :: Maybe Text
idempotencyToken :: Maybe Text
apiPassthrough :: Maybe ApiPassthrough
$sel:validity:IssueCertificate' :: IssueCertificate -> Validity
$sel:signingAlgorithm:IssueCertificate' :: IssueCertificate -> SigningAlgorithm
$sel:csr:IssueCertificate' :: IssueCertificate -> Base64
$sel:certificateAuthorityArn:IssueCertificate' :: IssueCertificate -> Text
$sel:validityNotBefore:IssueCertificate' :: IssueCertificate -> Maybe Validity
$sel:templateArn:IssueCertificate' :: IssueCertificate -> Maybe Text
$sel:idempotencyToken:IssueCertificate' :: IssueCertificate -> Maybe Text
$sel:apiPassthrough:IssueCertificate' :: IssueCertificate -> Maybe ApiPassthrough
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ApiPassthrough" 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 ApiPassthrough
apiPassthrough,
            (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
"TemplateArn" 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
templateArn,
            (Key
"ValidityNotBefore" 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 Validity
validityNotBefore,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"CertificateAuthorityArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateAuthorityArn
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"Csr" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
csr),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SigningAlgorithm" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SigningAlgorithm
signingAlgorithm),
            forall a. a -> Maybe a
Prelude.Just (Key
"Validity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Validity
validity)
          ]
      )

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

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

-- | /See:/ 'newIssueCertificateResponse' smart constructor.
data IssueCertificateResponse = IssueCertificateResponse'
  { -- | The Amazon Resource Name (ARN) of the issued certificate and the
    -- certificate serial number. This is of the form:
    --
    -- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@\/certificate\/@/@286535153982981100925020015808220737245@/@ @
    IssueCertificateResponse -> Maybe Text
certificateArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    IssueCertificateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (IssueCertificateResponse -> IssueCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueCertificateResponse -> IssueCertificateResponse -> Bool
$c/= :: IssueCertificateResponse -> IssueCertificateResponse -> Bool
== :: IssueCertificateResponse -> IssueCertificateResponse -> Bool
$c== :: IssueCertificateResponse -> IssueCertificateResponse -> Bool
Prelude.Eq, ReadPrec [IssueCertificateResponse]
ReadPrec IssueCertificateResponse
Int -> ReadS IssueCertificateResponse
ReadS [IssueCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IssueCertificateResponse]
$creadListPrec :: ReadPrec [IssueCertificateResponse]
readPrec :: ReadPrec IssueCertificateResponse
$creadPrec :: ReadPrec IssueCertificateResponse
readList :: ReadS [IssueCertificateResponse]
$creadList :: ReadS [IssueCertificateResponse]
readsPrec :: Int -> ReadS IssueCertificateResponse
$creadsPrec :: Int -> ReadS IssueCertificateResponse
Prelude.Read, Int -> IssueCertificateResponse -> ShowS
[IssueCertificateResponse] -> ShowS
IssueCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueCertificateResponse] -> ShowS
$cshowList :: [IssueCertificateResponse] -> ShowS
show :: IssueCertificateResponse -> String
$cshow :: IssueCertificateResponse -> String
showsPrec :: Int -> IssueCertificateResponse -> ShowS
$cshowsPrec :: Int -> IssueCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep IssueCertificateResponse x -> IssueCertificateResponse
forall x.
IssueCertificateResponse -> Rep IssueCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep IssueCertificateResponse x -> IssueCertificateResponse
$cfrom :: forall x.
IssueCertificateResponse -> Rep IssueCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'IssueCertificateResponse' 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', 'issueCertificateResponse_certificateArn' - The Amazon Resource Name (ARN) of the issued certificate and the
-- certificate serial number. This is of the form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@\/certificate\/@/@286535153982981100925020015808220737245@/@ @
--
-- 'httpStatus', 'issueCertificateResponse_httpStatus' - The response's http status code.
newIssueCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  IssueCertificateResponse
newIssueCertificateResponse :: Int -> IssueCertificateResponse
newIssueCertificateResponse Int
pHttpStatus_ =
  IssueCertificateResponse'
    { $sel:certificateArn:IssueCertificateResponse' :: Maybe Text
certificateArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:IssueCertificateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the issued certificate and the
-- certificate serial number. This is of the form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@\/certificate\/@/@286535153982981100925020015808220737245@/@ @
issueCertificateResponse_certificateArn :: Lens.Lens' IssueCertificateResponse (Prelude.Maybe Prelude.Text)
issueCertificateResponse_certificateArn :: Lens' IssueCertificateResponse (Maybe Text)
issueCertificateResponse_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IssueCertificateResponse' {Maybe Text
certificateArn :: Maybe Text
$sel:certificateArn:IssueCertificateResponse' :: IssueCertificateResponse -> Maybe Text
certificateArn} -> Maybe Text
certificateArn) (\s :: IssueCertificateResponse
s@IssueCertificateResponse' {} Maybe Text
a -> IssueCertificateResponse
s {$sel:certificateArn:IssueCertificateResponse' :: Maybe Text
certificateArn = Maybe Text
a} :: IssueCertificateResponse)

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

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