{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.CertificateAuthority
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.CertificateManagerPCA.Types.CertificateAuthority where

import Amazonka.CertificateManagerPCA.Types.CertificateAuthorityConfiguration
import Amazonka.CertificateManagerPCA.Types.CertificateAuthorityStatus
import Amazonka.CertificateManagerPCA.Types.CertificateAuthorityType
import Amazonka.CertificateManagerPCA.Types.CertificateAuthorityUsageMode
import Amazonka.CertificateManagerPCA.Types.FailureReason
import Amazonka.CertificateManagerPCA.Types.KeyStorageSecurityStandard
import Amazonka.CertificateManagerPCA.Types.RevocationConfiguration
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

-- | Contains information about your private certificate authority (CA). Your
-- private CA can issue and revoke X.509 digital certificates. Digital
-- certificates verify that the entity named in the certificate __Subject__
-- field owns or controls the public key contained in the __Subject Public
-- Key Info__ field. Call the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_CreateCertificateAuthority.html CreateCertificateAuthority>
-- action to create your private CA. You must then call the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_GetCertificateAuthorityCertificate.html GetCertificateAuthorityCertificate>
-- action to retrieve a private CA certificate signing request (CSR). Sign
-- the CSR with your Amazon Web Services Private CA-hosted or on-premises
-- root or subordinate CA certificate. Call the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ImportCertificateAuthorityCertificate.html ImportCertificateAuthorityCertificate>
-- action to import the signed certificate into Certificate Manager (ACM).
--
-- /See:/ 'newCertificateAuthority' smart constructor.
data CertificateAuthority = CertificateAuthority'
  { -- | Amazon Resource Name (ARN) for your private certificate authority (CA).
    -- The format is @ @/@12345678-1234-1234-1234-123456789012@/@ @.
    CertificateAuthority -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | Your private CA configuration.
    CertificateAuthority -> Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration :: Prelude.Maybe CertificateAuthorityConfiguration,
    -- | Date and time at which your private CA was created.
    CertificateAuthority -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | Reason the request to create your private CA failed.
    CertificateAuthority -> Maybe FailureReason
failureReason :: Prelude.Maybe FailureReason,
    -- | Defines a cryptographic key management compliance standard used for
    -- handling CA keys.
    --
    -- Default: FIPS_140_2_LEVEL_3_OR_HIGHER
    --
    -- Note: Amazon Web Services Region ap-northeast-3 supports only
    -- FIPS_140_2_LEVEL_2_OR_HIGHER. You must explicitly specify this parameter
    -- and value when creating a CA in that Region. Specifying a different
    -- value (or no value) results in an @InvalidArgsException@ with the
    -- message \"A certificate authority cannot be created in this region with
    -- the specified security standard.\"
    CertificateAuthority -> Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard :: Prelude.Maybe KeyStorageSecurityStandard,
    -- | Date and time at which your private CA was last updated.
    CertificateAuthority -> Maybe POSIX
lastStateChangeAt :: Prelude.Maybe Data.POSIX,
    -- | Date and time after which your private CA certificate is not valid.
    CertificateAuthority -> Maybe POSIX
notAfter :: Prelude.Maybe Data.POSIX,
    -- | Date and time before which your private CA certificate is not valid.
    CertificateAuthority -> Maybe POSIX
notBefore :: Prelude.Maybe Data.POSIX,
    -- | The Amazon Web Services account ID that owns the certificate authority.
    CertificateAuthority -> Maybe Text
ownerAccount :: Prelude.Maybe Prelude.Text,
    -- | The period during which a deleted CA can be restored. For more
    -- information, see the @PermanentDeletionTimeInDays@ parameter of the
    -- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_DeleteCertificateAuthorityRequest.html DeleteCertificateAuthorityRequest>
    -- action.
    CertificateAuthority -> Maybe POSIX
restorableUntil :: Prelude.Maybe Data.POSIX,
    -- | Information about the Online Certificate Status Protocol (OCSP)
    -- configuration or certificate revocation list (CRL) created and
    -- maintained by your private CA.
    CertificateAuthority -> Maybe RevocationConfiguration
revocationConfiguration :: Prelude.Maybe RevocationConfiguration,
    -- | Serial number of your private CA.
    CertificateAuthority -> Maybe Text
serial :: Prelude.Maybe Prelude.Text,
    -- | Status of your private CA.
    CertificateAuthority -> Maybe CertificateAuthorityStatus
status :: Prelude.Maybe CertificateAuthorityStatus,
    -- | Type of your private CA.
    CertificateAuthority -> Maybe CertificateAuthorityType
type' :: Prelude.Maybe CertificateAuthorityType,
    -- | Specifies whether the CA issues general-purpose certificates that
    -- typically require a revocation mechanism, or short-lived certificates
    -- that may optionally omit revocation because they expire quickly.
    -- Short-lived certificate validity is limited to seven days.
    --
    -- The default value is GENERAL_PURPOSE.
    CertificateAuthority -> Maybe CertificateAuthorityUsageMode
usageMode :: Prelude.Maybe CertificateAuthorityUsageMode
  }
  deriving (CertificateAuthority -> CertificateAuthority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateAuthority -> CertificateAuthority -> Bool
$c/= :: CertificateAuthority -> CertificateAuthority -> Bool
== :: CertificateAuthority -> CertificateAuthority -> Bool
$c== :: CertificateAuthority -> CertificateAuthority -> Bool
Prelude.Eq, ReadPrec [CertificateAuthority]
ReadPrec CertificateAuthority
Int -> ReadS CertificateAuthority
ReadS [CertificateAuthority]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CertificateAuthority]
$creadListPrec :: ReadPrec [CertificateAuthority]
readPrec :: ReadPrec CertificateAuthority
$creadPrec :: ReadPrec CertificateAuthority
readList :: ReadS [CertificateAuthority]
$creadList :: ReadS [CertificateAuthority]
readsPrec :: Int -> ReadS CertificateAuthority
$creadsPrec :: Int -> ReadS CertificateAuthority
Prelude.Read, Int -> CertificateAuthority -> ShowS
[CertificateAuthority] -> ShowS
CertificateAuthority -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateAuthority] -> ShowS
$cshowList :: [CertificateAuthority] -> ShowS
show :: CertificateAuthority -> String
$cshow :: CertificateAuthority -> String
showsPrec :: Int -> CertificateAuthority -> ShowS
$cshowsPrec :: Int -> CertificateAuthority -> ShowS
Prelude.Show, forall x. Rep CertificateAuthority x -> CertificateAuthority
forall x. CertificateAuthority -> Rep CertificateAuthority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CertificateAuthority x -> CertificateAuthority
$cfrom :: forall x. CertificateAuthority -> Rep CertificateAuthority x
Prelude.Generic)

-- |
-- Create a value of 'CertificateAuthority' 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:
--
-- 'arn', 'certificateAuthority_arn' - Amazon Resource Name (ARN) for your private certificate authority (CA).
-- The format is @ @/@12345678-1234-1234-1234-123456789012@/@ @.
--
-- 'certificateAuthorityConfiguration', 'certificateAuthority_certificateAuthorityConfiguration' - Your private CA configuration.
--
-- 'createdAt', 'certificateAuthority_createdAt' - Date and time at which your private CA was created.
--
-- 'failureReason', 'certificateAuthority_failureReason' - Reason the request to create your private CA failed.
--
-- 'keyStorageSecurityStandard', 'certificateAuthority_keyStorageSecurityStandard' - Defines a cryptographic key management compliance standard used for
-- handling CA keys.
--
-- Default: FIPS_140_2_LEVEL_3_OR_HIGHER
--
-- Note: Amazon Web Services Region ap-northeast-3 supports only
-- FIPS_140_2_LEVEL_2_OR_HIGHER. You must explicitly specify this parameter
-- and value when creating a CA in that Region. Specifying a different
-- value (or no value) results in an @InvalidArgsException@ with the
-- message \"A certificate authority cannot be created in this region with
-- the specified security standard.\"
--
-- 'lastStateChangeAt', 'certificateAuthority_lastStateChangeAt' - Date and time at which your private CA was last updated.
--
-- 'notAfter', 'certificateAuthority_notAfter' - Date and time after which your private CA certificate is not valid.
--
-- 'notBefore', 'certificateAuthority_notBefore' - Date and time before which your private CA certificate is not valid.
--
-- 'ownerAccount', 'certificateAuthority_ownerAccount' - The Amazon Web Services account ID that owns the certificate authority.
--
-- 'restorableUntil', 'certificateAuthority_restorableUntil' - The period during which a deleted CA can be restored. For more
-- information, see the @PermanentDeletionTimeInDays@ parameter of the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_DeleteCertificateAuthorityRequest.html DeleteCertificateAuthorityRequest>
-- action.
--
-- 'revocationConfiguration', 'certificateAuthority_revocationConfiguration' - Information about the Online Certificate Status Protocol (OCSP)
-- configuration or certificate revocation list (CRL) created and
-- maintained by your private CA.
--
-- 'serial', 'certificateAuthority_serial' - Serial number of your private CA.
--
-- 'status', 'certificateAuthority_status' - Status of your private CA.
--
-- 'type'', 'certificateAuthority_type' - Type of your private CA.
--
-- 'usageMode', 'certificateAuthority_usageMode' - Specifies whether the CA issues general-purpose certificates that
-- typically require a revocation mechanism, or short-lived certificates
-- that may optionally omit revocation because they expire quickly.
-- Short-lived certificate validity is limited to seven days.
--
-- The default value is GENERAL_PURPOSE.
newCertificateAuthority ::
  CertificateAuthority
newCertificateAuthority :: CertificateAuthority
newCertificateAuthority =
  CertificateAuthority'
    { $sel:arn:CertificateAuthority' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:certificateAuthorityConfiguration:CertificateAuthority' :: Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:CertificateAuthority' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:CertificateAuthority' :: Maybe FailureReason
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:keyStorageSecurityStandard:CertificateAuthority' :: Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard = forall a. Maybe a
Prelude.Nothing,
      $sel:lastStateChangeAt:CertificateAuthority' :: Maybe POSIX
lastStateChangeAt = forall a. Maybe a
Prelude.Nothing,
      $sel:notAfter:CertificateAuthority' :: Maybe POSIX
notAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:notBefore:CertificateAuthority' :: Maybe POSIX
notBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerAccount:CertificateAuthority' :: Maybe Text
ownerAccount = forall a. Maybe a
Prelude.Nothing,
      $sel:restorableUntil:CertificateAuthority' :: Maybe POSIX
restorableUntil = forall a. Maybe a
Prelude.Nothing,
      $sel:revocationConfiguration:CertificateAuthority' :: Maybe RevocationConfiguration
revocationConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:serial:CertificateAuthority' :: Maybe Text
serial = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CertificateAuthority' :: Maybe CertificateAuthorityStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:type':CertificateAuthority' :: Maybe CertificateAuthorityType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:usageMode:CertificateAuthority' :: Maybe CertificateAuthorityUsageMode
usageMode = forall a. Maybe a
Prelude.Nothing
    }

-- | Amazon Resource Name (ARN) for your private certificate authority (CA).
-- The format is @ @/@12345678-1234-1234-1234-123456789012@/@ @.
certificateAuthority_arn :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.Text)
certificateAuthority_arn :: Lens' CertificateAuthority (Maybe Text)
certificateAuthority_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe Text
arn :: Maybe Text
$sel:arn:CertificateAuthority' :: CertificateAuthority -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe Text
a -> CertificateAuthority
s {$sel:arn:CertificateAuthority' :: Maybe Text
arn = Maybe Text
a} :: CertificateAuthority)

-- | Your private CA configuration.
certificateAuthority_certificateAuthorityConfiguration :: Lens.Lens' CertificateAuthority (Prelude.Maybe CertificateAuthorityConfiguration)
certificateAuthority_certificateAuthorityConfiguration :: Lens'
  CertificateAuthority (Maybe CertificateAuthorityConfiguration)
certificateAuthority_certificateAuthorityConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration :: Maybe CertificateAuthorityConfiguration
$sel:certificateAuthorityConfiguration:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration} -> Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe CertificateAuthorityConfiguration
a -> CertificateAuthority
s {$sel:certificateAuthorityConfiguration:CertificateAuthority' :: Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration = Maybe CertificateAuthorityConfiguration
a} :: CertificateAuthority)

-- | Date and time at which your private CA was created.
certificateAuthority_createdAt :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.UTCTime)
certificateAuthority_createdAt :: Lens' CertificateAuthority (Maybe UTCTime)
certificateAuthority_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe POSIX
a -> CertificateAuthority
s {$sel:createdAt:CertificateAuthority' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: CertificateAuthority) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Reason the request to create your private CA failed.
certificateAuthority_failureReason :: Lens.Lens' CertificateAuthority (Prelude.Maybe FailureReason)
certificateAuthority_failureReason :: Lens' CertificateAuthority (Maybe FailureReason)
certificateAuthority_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe FailureReason
failureReason :: Maybe FailureReason
$sel:failureReason:CertificateAuthority' :: CertificateAuthority -> Maybe FailureReason
failureReason} -> Maybe FailureReason
failureReason) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe FailureReason
a -> CertificateAuthority
s {$sel:failureReason:CertificateAuthority' :: Maybe FailureReason
failureReason = Maybe FailureReason
a} :: CertificateAuthority)

-- | Defines a cryptographic key management compliance standard used for
-- handling CA keys.
--
-- Default: FIPS_140_2_LEVEL_3_OR_HIGHER
--
-- Note: Amazon Web Services Region ap-northeast-3 supports only
-- FIPS_140_2_LEVEL_2_OR_HIGHER. You must explicitly specify this parameter
-- and value when creating a CA in that Region. Specifying a different
-- value (or no value) results in an @InvalidArgsException@ with the
-- message \"A certificate authority cannot be created in this region with
-- the specified security standard.\"
certificateAuthority_keyStorageSecurityStandard :: Lens.Lens' CertificateAuthority (Prelude.Maybe KeyStorageSecurityStandard)
certificateAuthority_keyStorageSecurityStandard :: Lens' CertificateAuthority (Maybe KeyStorageSecurityStandard)
certificateAuthority_keyStorageSecurityStandard = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard :: Maybe KeyStorageSecurityStandard
$sel:keyStorageSecurityStandard:CertificateAuthority' :: CertificateAuthority -> Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard} -> Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe KeyStorageSecurityStandard
a -> CertificateAuthority
s {$sel:keyStorageSecurityStandard:CertificateAuthority' :: Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard = Maybe KeyStorageSecurityStandard
a} :: CertificateAuthority)

-- | Date and time at which your private CA was last updated.
certificateAuthority_lastStateChangeAt :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.UTCTime)
certificateAuthority_lastStateChangeAt :: Lens' CertificateAuthority (Maybe UTCTime)
certificateAuthority_lastStateChangeAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe POSIX
lastStateChangeAt :: Maybe POSIX
$sel:lastStateChangeAt:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
lastStateChangeAt} -> Maybe POSIX
lastStateChangeAt) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe POSIX
a -> CertificateAuthority
s {$sel:lastStateChangeAt:CertificateAuthority' :: Maybe POSIX
lastStateChangeAt = Maybe POSIX
a} :: CertificateAuthority) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Date and time after which your private CA certificate is not valid.
certificateAuthority_notAfter :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.UTCTime)
certificateAuthority_notAfter :: Lens' CertificateAuthority (Maybe UTCTime)
certificateAuthority_notAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe POSIX
notAfter :: Maybe POSIX
$sel:notAfter:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
notAfter} -> Maybe POSIX
notAfter) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe POSIX
a -> CertificateAuthority
s {$sel:notAfter:CertificateAuthority' :: Maybe POSIX
notAfter = Maybe POSIX
a} :: CertificateAuthority) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Date and time before which your private CA certificate is not valid.
certificateAuthority_notBefore :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.UTCTime)
certificateAuthority_notBefore :: Lens' CertificateAuthority (Maybe UTCTime)
certificateAuthority_notBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe POSIX
notBefore :: Maybe POSIX
$sel:notBefore:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
notBefore} -> Maybe POSIX
notBefore) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe POSIX
a -> CertificateAuthority
s {$sel:notBefore:CertificateAuthority' :: Maybe POSIX
notBefore = Maybe POSIX
a} :: CertificateAuthority) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Amazon Web Services account ID that owns the certificate authority.
certificateAuthority_ownerAccount :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.Text)
certificateAuthority_ownerAccount :: Lens' CertificateAuthority (Maybe Text)
certificateAuthority_ownerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe Text
ownerAccount :: Maybe Text
$sel:ownerAccount:CertificateAuthority' :: CertificateAuthority -> Maybe Text
ownerAccount} -> Maybe Text
ownerAccount) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe Text
a -> CertificateAuthority
s {$sel:ownerAccount:CertificateAuthority' :: Maybe Text
ownerAccount = Maybe Text
a} :: CertificateAuthority)

-- | The period during which a deleted CA can be restored. For more
-- information, see the @PermanentDeletionTimeInDays@ parameter of the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_DeleteCertificateAuthorityRequest.html DeleteCertificateAuthorityRequest>
-- action.
certificateAuthority_restorableUntil :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.UTCTime)
certificateAuthority_restorableUntil :: Lens' CertificateAuthority (Maybe UTCTime)
certificateAuthority_restorableUntil = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe POSIX
restorableUntil :: Maybe POSIX
$sel:restorableUntil:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
restorableUntil} -> Maybe POSIX
restorableUntil) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe POSIX
a -> CertificateAuthority
s {$sel:restorableUntil:CertificateAuthority' :: Maybe POSIX
restorableUntil = Maybe POSIX
a} :: CertificateAuthority) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Information about the Online Certificate Status Protocol (OCSP)
-- configuration or certificate revocation list (CRL) created and
-- maintained by your private CA.
certificateAuthority_revocationConfiguration :: Lens.Lens' CertificateAuthority (Prelude.Maybe RevocationConfiguration)
certificateAuthority_revocationConfiguration :: Lens' CertificateAuthority (Maybe RevocationConfiguration)
certificateAuthority_revocationConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe RevocationConfiguration
revocationConfiguration :: Maybe RevocationConfiguration
$sel:revocationConfiguration:CertificateAuthority' :: CertificateAuthority -> Maybe RevocationConfiguration
revocationConfiguration} -> Maybe RevocationConfiguration
revocationConfiguration) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe RevocationConfiguration
a -> CertificateAuthority
s {$sel:revocationConfiguration:CertificateAuthority' :: Maybe RevocationConfiguration
revocationConfiguration = Maybe RevocationConfiguration
a} :: CertificateAuthority)

-- | Serial number of your private CA.
certificateAuthority_serial :: Lens.Lens' CertificateAuthority (Prelude.Maybe Prelude.Text)
certificateAuthority_serial :: Lens' CertificateAuthority (Maybe Text)
certificateAuthority_serial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe Text
serial :: Maybe Text
$sel:serial:CertificateAuthority' :: CertificateAuthority -> Maybe Text
serial} -> Maybe Text
serial) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe Text
a -> CertificateAuthority
s {$sel:serial:CertificateAuthority' :: Maybe Text
serial = Maybe Text
a} :: CertificateAuthority)

-- | Status of your private CA.
certificateAuthority_status :: Lens.Lens' CertificateAuthority (Prelude.Maybe CertificateAuthorityStatus)
certificateAuthority_status :: Lens' CertificateAuthority (Maybe CertificateAuthorityStatus)
certificateAuthority_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe CertificateAuthorityStatus
status :: Maybe CertificateAuthorityStatus
$sel:status:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityStatus
status} -> Maybe CertificateAuthorityStatus
status) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe CertificateAuthorityStatus
a -> CertificateAuthority
s {$sel:status:CertificateAuthority' :: Maybe CertificateAuthorityStatus
status = Maybe CertificateAuthorityStatus
a} :: CertificateAuthority)

-- | Type of your private CA.
certificateAuthority_type :: Lens.Lens' CertificateAuthority (Prelude.Maybe CertificateAuthorityType)
certificateAuthority_type :: Lens' CertificateAuthority (Maybe CertificateAuthorityType)
certificateAuthority_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe CertificateAuthorityType
type' :: Maybe CertificateAuthorityType
$sel:type':CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityType
type'} -> Maybe CertificateAuthorityType
type') (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe CertificateAuthorityType
a -> CertificateAuthority
s {$sel:type':CertificateAuthority' :: Maybe CertificateAuthorityType
type' = Maybe CertificateAuthorityType
a} :: CertificateAuthority)

-- | Specifies whether the CA issues general-purpose certificates that
-- typically require a revocation mechanism, or short-lived certificates
-- that may optionally omit revocation because they expire quickly.
-- Short-lived certificate validity is limited to seven days.
--
-- The default value is GENERAL_PURPOSE.
certificateAuthority_usageMode :: Lens.Lens' CertificateAuthority (Prelude.Maybe CertificateAuthorityUsageMode)
certificateAuthority_usageMode :: Lens' CertificateAuthority (Maybe CertificateAuthorityUsageMode)
certificateAuthority_usageMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CertificateAuthority' {Maybe CertificateAuthorityUsageMode
usageMode :: Maybe CertificateAuthorityUsageMode
$sel:usageMode:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityUsageMode
usageMode} -> Maybe CertificateAuthorityUsageMode
usageMode) (\s :: CertificateAuthority
s@CertificateAuthority' {} Maybe CertificateAuthorityUsageMode
a -> CertificateAuthority
s {$sel:usageMode:CertificateAuthority' :: Maybe CertificateAuthorityUsageMode
usageMode = Maybe CertificateAuthorityUsageMode
a} :: CertificateAuthority)

instance Data.FromJSON CertificateAuthority where
  parseJSON :: Value -> Parser CertificateAuthority
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"CertificateAuthority"
      ( \Object
x ->
          Maybe Text
-> Maybe CertificateAuthorityConfiguration
-> Maybe POSIX
-> Maybe FailureReason
-> Maybe KeyStorageSecurityStandard
-> Maybe POSIX
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe RevocationConfiguration
-> Maybe Text
-> Maybe CertificateAuthorityStatus
-> Maybe CertificateAuthorityType
-> Maybe CertificateAuthorityUsageMode
-> CertificateAuthority
CertificateAuthority'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CertificateAuthorityConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CreatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"FailureReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"KeyStorageSecurityStandard")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LastStateChangeAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"NotAfter")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"NotBefore")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"OwnerAccount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RestorableUntil")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RevocationConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Serial")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"UsageMode")
      )

instance Prelude.Hashable CertificateAuthority where
  hashWithSalt :: Int -> CertificateAuthority -> Int
hashWithSalt Int
_salt CertificateAuthority' {Maybe Text
Maybe POSIX
Maybe CertificateAuthorityStatus
Maybe CertificateAuthorityType
Maybe CertificateAuthorityUsageMode
Maybe FailureReason
Maybe KeyStorageSecurityStandard
Maybe RevocationConfiguration
Maybe CertificateAuthorityConfiguration
usageMode :: Maybe CertificateAuthorityUsageMode
type' :: Maybe CertificateAuthorityType
status :: Maybe CertificateAuthorityStatus
serial :: Maybe Text
revocationConfiguration :: Maybe RevocationConfiguration
restorableUntil :: Maybe POSIX
ownerAccount :: Maybe Text
notBefore :: Maybe POSIX
notAfter :: Maybe POSIX
lastStateChangeAt :: Maybe POSIX
keyStorageSecurityStandard :: Maybe KeyStorageSecurityStandard
failureReason :: Maybe FailureReason
createdAt :: Maybe POSIX
certificateAuthorityConfiguration :: Maybe CertificateAuthorityConfiguration
arn :: Maybe Text
$sel:usageMode:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityUsageMode
$sel:type':CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityType
$sel:status:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityStatus
$sel:serial:CertificateAuthority' :: CertificateAuthority -> Maybe Text
$sel:revocationConfiguration:CertificateAuthority' :: CertificateAuthority -> Maybe RevocationConfiguration
$sel:restorableUntil:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:ownerAccount:CertificateAuthority' :: CertificateAuthority -> Maybe Text
$sel:notBefore:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:notAfter:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:lastStateChangeAt:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:keyStorageSecurityStandard:CertificateAuthority' :: CertificateAuthority -> Maybe KeyStorageSecurityStandard
$sel:failureReason:CertificateAuthority' :: CertificateAuthority -> Maybe FailureReason
$sel:createdAt:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:certificateAuthorityConfiguration:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityConfiguration
$sel:arn:CertificateAuthority' :: CertificateAuthority -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FailureReason
failureReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastStateChangeAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
notAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
notBefore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerAccount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
restorableUntil
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RevocationConfiguration
revocationConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serial
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateAuthorityStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateAuthorityType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateAuthorityUsageMode
usageMode

instance Prelude.NFData CertificateAuthority where
  rnf :: CertificateAuthority -> ()
rnf CertificateAuthority' {Maybe Text
Maybe POSIX
Maybe CertificateAuthorityStatus
Maybe CertificateAuthorityType
Maybe CertificateAuthorityUsageMode
Maybe FailureReason
Maybe KeyStorageSecurityStandard
Maybe RevocationConfiguration
Maybe CertificateAuthorityConfiguration
usageMode :: Maybe CertificateAuthorityUsageMode
type' :: Maybe CertificateAuthorityType
status :: Maybe CertificateAuthorityStatus
serial :: Maybe Text
revocationConfiguration :: Maybe RevocationConfiguration
restorableUntil :: Maybe POSIX
ownerAccount :: Maybe Text
notBefore :: Maybe POSIX
notAfter :: Maybe POSIX
lastStateChangeAt :: Maybe POSIX
keyStorageSecurityStandard :: Maybe KeyStorageSecurityStandard
failureReason :: Maybe FailureReason
createdAt :: Maybe POSIX
certificateAuthorityConfiguration :: Maybe CertificateAuthorityConfiguration
arn :: Maybe Text
$sel:usageMode:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityUsageMode
$sel:type':CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityType
$sel:status:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityStatus
$sel:serial:CertificateAuthority' :: CertificateAuthority -> Maybe Text
$sel:revocationConfiguration:CertificateAuthority' :: CertificateAuthority -> Maybe RevocationConfiguration
$sel:restorableUntil:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:ownerAccount:CertificateAuthority' :: CertificateAuthority -> Maybe Text
$sel:notBefore:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:notAfter:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:lastStateChangeAt:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:keyStorageSecurityStandard:CertificateAuthority' :: CertificateAuthority -> Maybe KeyStorageSecurityStandard
$sel:failureReason:CertificateAuthority' :: CertificateAuthority -> Maybe FailureReason
$sel:createdAt:CertificateAuthority' :: CertificateAuthority -> Maybe POSIX
$sel:certificateAuthorityConfiguration:CertificateAuthority' :: CertificateAuthority -> Maybe CertificateAuthorityConfiguration
$sel:arn:CertificateAuthority' :: CertificateAuthority -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateAuthorityConfiguration
certificateAuthorityConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FailureReason
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KeyStorageSecurityStandard
keyStorageSecurityStandard
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastStateChangeAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
notAfter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
notBefore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
restorableUntil
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RevocationConfiguration
revocationConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serial
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateAuthorityStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateAuthorityType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateAuthorityUsageMode
usageMode