{-# 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.DeletePolicy
-- 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 the resource-based policy attached to a private CA. Deletion
-- will remove any access that the policy has granted. If there is no
-- policy attached to the private CA, this action will return successful.
--
-- If you delete a policy that was applied through Amazon Web Services
-- Resource Access Manager (RAM), the CA will be removed from all shares in
-- which it was included.
--
-- The Certificate Manager Service Linked Role that the policy supports is
-- not affected when you delete the policy.
--
-- The current policy can be shown with
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_GetPolicy.html GetPolicy>
-- and updated with
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_PutPolicy.html PutPolicy>.
--
-- __About Policies__
--
-- -   A policy grants access on a private CA to an Amazon Web Services
--     customer account, to Amazon Web Services Organizations, or to an
--     Amazon Web Services Organizations unit. Policies are under the
--     control of a CA administrator. For more information, see
--     <https://docs.aws.amazon.com/privateca/latest/userguide/pca-rbp.html Using a Resource Based Policy with Amazon Web Services Private CA>.
--
-- -   A policy permits a user of Certificate Manager (ACM) to issue ACM
--     certificates signed by a CA in another account.
--
-- -   For ACM to manage automatic renewal of these certificates, the ACM
--     user must configure a Service Linked Role (SLR). The SLR allows the
--     ACM service to assume the identity of the user, subject to
--     confirmation against the Amazon Web Services Private CA policy. For
--     more information, see
--     <https://docs.aws.amazon.com/acm/latest/userguide/acm-slr.html Using a Service Linked Role with ACM>.
--
-- -   Updates made in Amazon Web Services Resource Manager (RAM) are
--     reflected in policies. For more information, see
--     <https://docs.aws.amazon.com/privateca/latest/userguide/pca-ram.html Attach a Policy for Cross-Account Access>.
module Amazonka.CertificateManagerPCA.DeletePolicy
  ( -- * Creating a Request
    DeletePolicy (..),
    newDeletePolicy,

    -- * Request Lenses
    deletePolicy_resourceArn,

    -- * Destructuring the Response
    DeletePolicyResponse (..),
    newDeletePolicyResponse,
  )
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:/ 'newDeletePolicy' smart constructor.
data DeletePolicy = DeletePolicy'
  { -- | The Amazon Resource Number (ARN) of the private CA that will have its
    -- policy deleted. You can find the CA\'s ARN by calling the
    -- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
    -- action. The ARN value must have the form
    -- @arn:aws:acm-pca:region:account:certificate-authority\/01234567-89ab-cdef-0123-0123456789ab@.
    DeletePolicy -> Text
resourceArn :: Prelude.Text
  }
  deriving (DeletePolicy -> DeletePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePolicy -> DeletePolicy -> Bool
$c/= :: DeletePolicy -> DeletePolicy -> Bool
== :: DeletePolicy -> DeletePolicy -> Bool
$c== :: DeletePolicy -> DeletePolicy -> Bool
Prelude.Eq, ReadPrec [DeletePolicy]
ReadPrec DeletePolicy
Int -> ReadS DeletePolicy
ReadS [DeletePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePolicy]
$creadListPrec :: ReadPrec [DeletePolicy]
readPrec :: ReadPrec DeletePolicy
$creadPrec :: ReadPrec DeletePolicy
readList :: ReadS [DeletePolicy]
$creadList :: ReadS [DeletePolicy]
readsPrec :: Int -> ReadS DeletePolicy
$creadsPrec :: Int -> ReadS DeletePolicy
Prelude.Read, Int -> DeletePolicy -> ShowS
[DeletePolicy] -> ShowS
DeletePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePolicy] -> ShowS
$cshowList :: [DeletePolicy] -> ShowS
show :: DeletePolicy -> String
$cshow :: DeletePolicy -> String
showsPrec :: Int -> DeletePolicy -> ShowS
$cshowsPrec :: Int -> DeletePolicy -> ShowS
Prelude.Show, forall x. Rep DeletePolicy x -> DeletePolicy
forall x. DeletePolicy -> Rep DeletePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePolicy x -> DeletePolicy
$cfrom :: forall x. DeletePolicy -> Rep DeletePolicy x
Prelude.Generic)

-- |
-- Create a value of 'DeletePolicy' 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:
--
-- 'resourceArn', 'deletePolicy_resourceArn' - The Amazon Resource Number (ARN) of the private CA that will have its
-- policy deleted. You can find the CA\'s ARN by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action. The ARN value must have the form
-- @arn:aws:acm-pca:region:account:certificate-authority\/01234567-89ab-cdef-0123-0123456789ab@.
newDeletePolicy ::
  -- | 'resourceArn'
  Prelude.Text ->
  DeletePolicy
newDeletePolicy :: Text -> DeletePolicy
newDeletePolicy Text
pResourceArn_ =
  DeletePolicy' {$sel:resourceArn:DeletePolicy' :: Text
resourceArn = Text
pResourceArn_}

-- | The Amazon Resource Number (ARN) of the private CA that will have its
-- policy deleted. You can find the CA\'s ARN by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action. The ARN value must have the form
-- @arn:aws:acm-pca:region:account:certificate-authority\/01234567-89ab-cdef-0123-0123456789ab@.
deletePolicy_resourceArn :: Lens.Lens' DeletePolicy Prelude.Text
deletePolicy_resourceArn :: Lens' DeletePolicy Text
deletePolicy_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePolicy' {Text
resourceArn :: Text
$sel:resourceArn:DeletePolicy' :: DeletePolicy -> Text
resourceArn} -> Text
resourceArn) (\s :: DeletePolicy
s@DeletePolicy' {} Text
a -> DeletePolicy
s {$sel:resourceArn:DeletePolicy' :: Text
resourceArn = Text
a} :: DeletePolicy)

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

instance Prelude.Hashable DeletePolicy where
  hashWithSalt :: Int -> DeletePolicy -> Int
hashWithSalt Int
_salt DeletePolicy' {Text
resourceArn :: Text
$sel:resourceArn:DeletePolicy' :: DeletePolicy -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn

instance Prelude.NFData DeletePolicy where
  rnf :: DeletePolicy -> ()
rnf DeletePolicy' {Text
resourceArn :: Text
$sel:resourceArn:DeletePolicy' :: DeletePolicy -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn

instance Data.ToHeaders DeletePolicy where
  toHeaders :: DeletePolicy -> [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.DeletePolicy" :: 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 DeletePolicy where
  toJSON :: DeletePolicy -> Value
toJSON DeletePolicy' {Text
resourceArn :: Text
$sel:resourceArn:DeletePolicy' :: DeletePolicy -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn)]
      )

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

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

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

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

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