{-# 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.DeletePermission
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Revokes permissions on a private CA granted to the Certificate Manager
-- (ACM) service principal (acm.amazonaws.com).
--
-- These permissions allow ACM to issue and renew ACM certificates that
-- reside in the same Amazon Web Services account as the CA. If you revoke
-- these permissions, ACM will no longer renew the affected certificates
-- automatically.
--
-- Permissions can be granted with the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_CreatePermission.html CreatePermission>
-- action and listed with the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListPermissions.html ListPermissions>
-- action.
--
-- __About Permissions__
--
-- -   If the private CA and the certificates it issues reside in the same
--     account, you can use @CreatePermission@ to grant permissions for ACM
--     to carry out automatic certificate renewals.
--
-- -   For automatic certificate renewal to succeed, the ACM service
--     principal needs permissions to create, retrieve, and list
--     certificates.
--
-- -   If the private CA and the ACM certificates reside in different
--     accounts, then permissions cannot be used to enable automatic
--     renewals. Instead, the ACM certificate owner must set up a
--     resource-based policy to enable cross-account issuance and renewals.
--     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>.
module Amazonka.CertificateManagerPCA.DeletePermission
  ( -- * Creating a Request
    DeletePermission (..),
    newDeletePermission,

    -- * Request Lenses
    deletePermission_sourceAccount,
    deletePermission_certificateAuthorityArn,
    deletePermission_principal,

    -- * Destructuring the Response
    DeletePermissionResponse (..),
    newDeletePermissionResponse,
  )
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:/ 'newDeletePermission' smart constructor.
data DeletePermission = DeletePermission'
  { -- | The Amazon Web Services account that calls this action.
    DeletePermission -> Maybe Text
sourceAccount :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Number (ARN) of the private CA that issued the
    -- permissions. You can find the CA\'s ARN by calling the
    -- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
    -- action. This must have the following form:
    --
    -- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
    DeletePermission -> Text
certificateAuthorityArn :: Prelude.Text,
    -- | The Amazon Web Services service or identity that will have its CA
    -- permissions revoked. At this time, the only valid service principal is
    -- @acm.amazonaws.com@
    DeletePermission -> Text
principal :: Prelude.Text
  }
  deriving (DeletePermission -> DeletePermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePermission -> DeletePermission -> Bool
$c/= :: DeletePermission -> DeletePermission -> Bool
== :: DeletePermission -> DeletePermission -> Bool
$c== :: DeletePermission -> DeletePermission -> Bool
Prelude.Eq, ReadPrec [DeletePermission]
ReadPrec DeletePermission
Int -> ReadS DeletePermission
ReadS [DeletePermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePermission]
$creadListPrec :: ReadPrec [DeletePermission]
readPrec :: ReadPrec DeletePermission
$creadPrec :: ReadPrec DeletePermission
readList :: ReadS [DeletePermission]
$creadList :: ReadS [DeletePermission]
readsPrec :: Int -> ReadS DeletePermission
$creadsPrec :: Int -> ReadS DeletePermission
Prelude.Read, Int -> DeletePermission -> ShowS
[DeletePermission] -> ShowS
DeletePermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePermission] -> ShowS
$cshowList :: [DeletePermission] -> ShowS
show :: DeletePermission -> String
$cshow :: DeletePermission -> String
showsPrec :: Int -> DeletePermission -> ShowS
$cshowsPrec :: Int -> DeletePermission -> ShowS
Prelude.Show, forall x. Rep DeletePermission x -> DeletePermission
forall x. DeletePermission -> Rep DeletePermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePermission x -> DeletePermission
$cfrom :: forall x. DeletePermission -> Rep DeletePermission x
Prelude.Generic)

-- |
-- Create a value of 'DeletePermission' 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:
--
-- 'sourceAccount', 'deletePermission_sourceAccount' - The Amazon Web Services account that calls this action.
--
-- 'certificateAuthorityArn', 'deletePermission_certificateAuthorityArn' - The Amazon Resource Number (ARN) of the private CA that issued the
-- permissions. You can find the CA\'s ARN by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action. This must have the following form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
--
-- 'principal', 'deletePermission_principal' - The Amazon Web Services service or identity that will have its CA
-- permissions revoked. At this time, the only valid service principal is
-- @acm.amazonaws.com@
newDeletePermission ::
  -- | 'certificateAuthorityArn'
  Prelude.Text ->
  -- | 'principal'
  Prelude.Text ->
  DeletePermission
newDeletePermission :: Text -> Text -> DeletePermission
newDeletePermission
  Text
pCertificateAuthorityArn_
  Text
pPrincipal_ =
    DeletePermission'
      { $sel:sourceAccount:DeletePermission' :: Maybe Text
sourceAccount = forall a. Maybe a
Prelude.Nothing,
        $sel:certificateAuthorityArn:DeletePermission' :: Text
certificateAuthorityArn = Text
pCertificateAuthorityArn_,
        $sel:principal:DeletePermission' :: Text
principal = Text
pPrincipal_
      }

-- | The Amazon Web Services account that calls this action.
deletePermission_sourceAccount :: Lens.Lens' DeletePermission (Prelude.Maybe Prelude.Text)
deletePermission_sourceAccount :: Lens' DeletePermission (Maybe Text)
deletePermission_sourceAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePermission' {Maybe Text
sourceAccount :: Maybe Text
$sel:sourceAccount:DeletePermission' :: DeletePermission -> Maybe Text
sourceAccount} -> Maybe Text
sourceAccount) (\s :: DeletePermission
s@DeletePermission' {} Maybe Text
a -> DeletePermission
s {$sel:sourceAccount:DeletePermission' :: Maybe Text
sourceAccount = Maybe Text
a} :: DeletePermission)

-- | The Amazon Resource Number (ARN) of the private CA that issued the
-- permissions. You can find the CA\'s ARN by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action. This must have the following form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
deletePermission_certificateAuthorityArn :: Lens.Lens' DeletePermission Prelude.Text
deletePermission_certificateAuthorityArn :: Lens' DeletePermission Text
deletePermission_certificateAuthorityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePermission' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:DeletePermission' :: DeletePermission -> Text
certificateAuthorityArn} -> Text
certificateAuthorityArn) (\s :: DeletePermission
s@DeletePermission' {} Text
a -> DeletePermission
s {$sel:certificateAuthorityArn:DeletePermission' :: Text
certificateAuthorityArn = Text
a} :: DeletePermission)

-- | The Amazon Web Services service or identity that will have its CA
-- permissions revoked. At this time, the only valid service principal is
-- @acm.amazonaws.com@
deletePermission_principal :: Lens.Lens' DeletePermission Prelude.Text
deletePermission_principal :: Lens' DeletePermission Text
deletePermission_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePermission' {Text
principal :: Text
$sel:principal:DeletePermission' :: DeletePermission -> Text
principal} -> Text
principal) (\s :: DeletePermission
s@DeletePermission' {} Text
a -> DeletePermission
s {$sel:principal:DeletePermission' :: Text
principal = Text
a} :: DeletePermission)

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

instance Prelude.Hashable DeletePermission where
  hashWithSalt :: Int -> DeletePermission -> Int
hashWithSalt Int
_salt DeletePermission' {Maybe Text
Text
principal :: Text
certificateAuthorityArn :: Text
sourceAccount :: Maybe Text
$sel:principal:DeletePermission' :: DeletePermission -> Text
$sel:certificateAuthorityArn:DeletePermission' :: DeletePermission -> Text
$sel:sourceAccount:DeletePermission' :: DeletePermission -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceAccount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateAuthorityArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
principal

instance Prelude.NFData DeletePermission where
  rnf :: DeletePermission -> ()
rnf DeletePermission' {Maybe Text
Text
principal :: Text
certificateAuthorityArn :: Text
sourceAccount :: Maybe Text
$sel:principal:DeletePermission' :: DeletePermission -> Text
$sel:certificateAuthorityArn:DeletePermission' :: DeletePermission -> Text
$sel:sourceAccount:DeletePermission' :: DeletePermission -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceAccount
      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 Text
principal

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

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

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

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

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

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