{-# 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.DeleteCertificateAuthority
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a private certificate authority (CA). You must provide the
-- Amazon Resource Name (ARN) of the private CA that you want to delete.
-- You can find the ARN by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action.
--
-- Deleting a CA will invalidate other CAs and certificates below it in
-- your CA hierarchy.
--
-- Before you can delete a CA that you have created and activated, you must
-- disable it. To do this, call the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_UpdateCertificateAuthority.html UpdateCertificateAuthority>
-- action and set the __CertificateAuthorityStatus__ parameter to
-- @DISABLED@.
--
-- Additionally, you can delete a CA if you are waiting for it to be
-- created (that is, the status of the CA is @CREATING@). You can also
-- delete it if the CA has been created but you haven\'t yet imported the
-- signed certificate into Amazon Web Services Private CA (that is, the
-- status of the CA is @PENDING_CERTIFICATE@).
--
-- When you successfully call
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_DeleteCertificateAuthority.html DeleteCertificateAuthority>,
-- the CA\'s status changes to @DELETED@. However, the CA won\'t be
-- permanently deleted until the restoration period has passed. By default,
-- if you do not set the @PermanentDeletionTimeInDays@ parameter, the CA
-- remains restorable for 30 days. You can set the parameter from 7 to 30
-- days. The
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_DescribeCertificateAuthority.html DescribeCertificateAuthority>
-- action returns the time remaining in the restoration window of a private
-- CA in the @DELETED@ state. To restore an eligible CA, call the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_RestoreCertificateAuthority.html RestoreCertificateAuthority>
-- action.
module Amazonka.CertificateManagerPCA.DeleteCertificateAuthority
  ( -- * Creating a Request
    DeleteCertificateAuthority (..),
    newDeleteCertificateAuthority,

    -- * Request Lenses
    deleteCertificateAuthority_permanentDeletionTimeInDays,
    deleteCertificateAuthority_certificateAuthorityArn,

    -- * Destructuring the Response
    DeleteCertificateAuthorityResponse (..),
    newDeleteCertificateAuthorityResponse,
  )
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:/ 'newDeleteCertificateAuthority' smart constructor.
data DeleteCertificateAuthority = DeleteCertificateAuthority'
  { -- | The number of days to make a CA restorable after it has been deleted.
    -- This can be anywhere from 7 to 30 days, with 30 being the default.
    DeleteCertificateAuthority -> Maybe Natural
permanentDeletionTimeInDays :: Prelude.Maybe Prelude.Natural,
    -- | 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 have the following form:
    --
    -- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
    DeleteCertificateAuthority -> Text
certificateAuthorityArn :: Prelude.Text
  }
  deriving (DeleteCertificateAuthority -> DeleteCertificateAuthority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCertificateAuthority -> DeleteCertificateAuthority -> Bool
$c/= :: DeleteCertificateAuthority -> DeleteCertificateAuthority -> Bool
== :: DeleteCertificateAuthority -> DeleteCertificateAuthority -> Bool
$c== :: DeleteCertificateAuthority -> DeleteCertificateAuthority -> Bool
Prelude.Eq, ReadPrec [DeleteCertificateAuthority]
ReadPrec DeleteCertificateAuthority
Int -> ReadS DeleteCertificateAuthority
ReadS [DeleteCertificateAuthority]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCertificateAuthority]
$creadListPrec :: ReadPrec [DeleteCertificateAuthority]
readPrec :: ReadPrec DeleteCertificateAuthority
$creadPrec :: ReadPrec DeleteCertificateAuthority
readList :: ReadS [DeleteCertificateAuthority]
$creadList :: ReadS [DeleteCertificateAuthority]
readsPrec :: Int -> ReadS DeleteCertificateAuthority
$creadsPrec :: Int -> ReadS DeleteCertificateAuthority
Prelude.Read, Int -> DeleteCertificateAuthority -> ShowS
[DeleteCertificateAuthority] -> ShowS
DeleteCertificateAuthority -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCertificateAuthority] -> ShowS
$cshowList :: [DeleteCertificateAuthority] -> ShowS
show :: DeleteCertificateAuthority -> String
$cshow :: DeleteCertificateAuthority -> String
showsPrec :: Int -> DeleteCertificateAuthority -> ShowS
$cshowsPrec :: Int -> DeleteCertificateAuthority -> ShowS
Prelude.Show, forall x.
Rep DeleteCertificateAuthority x -> DeleteCertificateAuthority
forall x.
DeleteCertificateAuthority -> Rep DeleteCertificateAuthority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteCertificateAuthority x -> DeleteCertificateAuthority
$cfrom :: forall x.
DeleteCertificateAuthority -> Rep DeleteCertificateAuthority x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCertificateAuthority' 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:
--
-- 'permanentDeletionTimeInDays', 'deleteCertificateAuthority_permanentDeletionTimeInDays' - The number of days to make a CA restorable after it has been deleted.
-- This can be anywhere from 7 to 30 days, with 30 being the default.
--
-- 'certificateAuthorityArn', 'deleteCertificateAuthority_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 have the following form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
newDeleteCertificateAuthority ::
  -- | 'certificateAuthorityArn'
  Prelude.Text ->
  DeleteCertificateAuthority
newDeleteCertificateAuthority :: Text -> DeleteCertificateAuthority
newDeleteCertificateAuthority
  Text
pCertificateAuthorityArn_ =
    DeleteCertificateAuthority'
      { $sel:permanentDeletionTimeInDays:DeleteCertificateAuthority' :: Maybe Natural
permanentDeletionTimeInDays =
          forall a. Maybe a
Prelude.Nothing,
        $sel:certificateAuthorityArn:DeleteCertificateAuthority' :: Text
certificateAuthorityArn =
          Text
pCertificateAuthorityArn_
      }

-- | The number of days to make a CA restorable after it has been deleted.
-- This can be anywhere from 7 to 30 days, with 30 being the default.
deleteCertificateAuthority_permanentDeletionTimeInDays :: Lens.Lens' DeleteCertificateAuthority (Prelude.Maybe Prelude.Natural)
deleteCertificateAuthority_permanentDeletionTimeInDays :: Lens' DeleteCertificateAuthority (Maybe Natural)
deleteCertificateAuthority_permanentDeletionTimeInDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCertificateAuthority' {Maybe Natural
permanentDeletionTimeInDays :: Maybe Natural
$sel:permanentDeletionTimeInDays:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Maybe Natural
permanentDeletionTimeInDays} -> Maybe Natural
permanentDeletionTimeInDays) (\s :: DeleteCertificateAuthority
s@DeleteCertificateAuthority' {} Maybe Natural
a -> DeleteCertificateAuthority
s {$sel:permanentDeletionTimeInDays:DeleteCertificateAuthority' :: Maybe Natural
permanentDeletionTimeInDays = Maybe Natural
a} :: DeleteCertificateAuthority)

-- | 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 have the following form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
deleteCertificateAuthority_certificateAuthorityArn :: Lens.Lens' DeleteCertificateAuthority Prelude.Text
deleteCertificateAuthority_certificateAuthorityArn :: Lens' DeleteCertificateAuthority Text
deleteCertificateAuthority_certificateAuthorityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCertificateAuthority' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Text
certificateAuthorityArn} -> Text
certificateAuthorityArn) (\s :: DeleteCertificateAuthority
s@DeleteCertificateAuthority' {} Text
a -> DeleteCertificateAuthority
s {$sel:certificateAuthorityArn:DeleteCertificateAuthority' :: Text
certificateAuthorityArn = Text
a} :: DeleteCertificateAuthority)

instance Core.AWSRequest DeleteCertificateAuthority where
  type
    AWSResponse DeleteCertificateAuthority =
      DeleteCertificateAuthorityResponse
  request :: (Service -> Service)
-> DeleteCertificateAuthority -> Request DeleteCertificateAuthority
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 DeleteCertificateAuthority
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteCertificateAuthority)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteCertificateAuthorityResponse
DeleteCertificateAuthorityResponse'

instance Prelude.Hashable DeleteCertificateAuthority where
  hashWithSalt :: Int -> DeleteCertificateAuthority -> Int
hashWithSalt Int
_salt DeleteCertificateAuthority' {Maybe Natural
Text
certificateAuthorityArn :: Text
permanentDeletionTimeInDays :: Maybe Natural
$sel:certificateAuthorityArn:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Text
$sel:permanentDeletionTimeInDays:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
permanentDeletionTimeInDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateAuthorityArn

instance Prelude.NFData DeleteCertificateAuthority where
  rnf :: DeleteCertificateAuthority -> ()
rnf DeleteCertificateAuthority' {Maybe Natural
Text
certificateAuthorityArn :: Text
permanentDeletionTimeInDays :: Maybe Natural
$sel:certificateAuthorityArn:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Text
$sel:permanentDeletionTimeInDays:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
permanentDeletionTimeInDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
certificateAuthorityArn

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

instance Data.ToJSON DeleteCertificateAuthority where
  toJSON :: DeleteCertificateAuthority -> Value
toJSON DeleteCertificateAuthority' {Maybe Natural
Text
certificateAuthorityArn :: Text
permanentDeletionTimeInDays :: Maybe Natural
$sel:certificateAuthorityArn:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Text
$sel:permanentDeletionTimeInDays:DeleteCertificateAuthority' :: DeleteCertificateAuthority -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"PermanentDeletionTimeInDays" 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 Natural
permanentDeletionTimeInDays,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"CertificateAuthorityArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateAuthorityArn
              )
          ]
      )

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

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

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

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

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