{-# 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.KMS.RetireGrant
-- 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 grant. Typically, you retire a grant when you no longer need
-- its permissions. To identify the grant to retire, use a
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token grant token>,
-- or both the grant ID and a key identifier (key ID or key ARN) of the KMS
-- key. The CreateGrant operation returns both values.
--
-- This operation can be called by the /retiring principal/ for a grant, by
-- the /grantee principal/ if the grant allows the @RetireGrant@ operation,
-- and by the Amazon Web Services account in which the grant is created. It
-- can also be called by principals to whom permission for retiring a grant
-- is delegated. For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#grant-delete Retiring and revoking grants>
-- in the /Key Management Service Developer Guide/.
--
-- For detailed information about grants, including grant terminology, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html Grants in KMS>
-- in the //Key Management Service Developer Guide// . For examples of
-- working with grants in several programming languages, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/programming-grants.html Programming grants>.
--
-- __Cross-account use__: Yes. You can retire a grant on a KMS key in a
-- different Amazon Web Services account.
--
-- __Required permissions:__:Permission to retire a grant is determined
-- primarily by the grant. For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#grant-delete Retiring and revoking grants>
-- in the /Key Management Service Developer Guide/.
--
-- __Related operations:__
--
-- -   CreateGrant
--
-- -   ListGrants
--
-- -   ListRetirableGrants
--
-- -   RevokeGrant
module Amazonka.KMS.RetireGrant
  ( -- * Creating a Request
    RetireGrant (..),
    newRetireGrant,

    -- * Request Lenses
    retireGrant_grantId,
    retireGrant_grantToken,
    retireGrant_keyId,

    -- * Destructuring the Response
    RetireGrantResponse (..),
    newRetireGrantResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.KMS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newRetireGrant' smart constructor.
data RetireGrant = RetireGrant'
  { -- | Identifies the grant to retire. To get the grant ID, use CreateGrant,
    -- ListGrants, or ListRetirableGrants.
    --
    -- -   Grant ID Example -
    --     0123456789012345678901234567890123456789012345678901234567890123
    RetireGrant -> Maybe Text
grantId :: Prelude.Maybe Prelude.Text,
    -- | Identifies the grant to be retired. You can use a grant token to
    -- identify a new grant even before it has achieved eventual consistency.
    --
    -- Only the CreateGrant operation returns a grant token. For details, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
    -- and
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#terms-eventual-consistency Eventual consistency>
    -- in the /Key Management Service Developer Guide/.
    RetireGrant -> Maybe Text
grantToken :: Prelude.Maybe Prelude.Text,
    -- | The key ARN KMS key associated with the grant. To find the key ARN, use
    -- the ListKeys operation.
    --
    -- For example:
    -- @arn:aws:kms:us-east-2:444455556666:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    RetireGrant -> Maybe Text
keyId :: Prelude.Maybe Prelude.Text
  }
  deriving (RetireGrant -> RetireGrant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetireGrant -> RetireGrant -> Bool
$c/= :: RetireGrant -> RetireGrant -> Bool
== :: RetireGrant -> RetireGrant -> Bool
$c== :: RetireGrant -> RetireGrant -> Bool
Prelude.Eq, ReadPrec [RetireGrant]
ReadPrec RetireGrant
Int -> ReadS RetireGrant
ReadS [RetireGrant]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RetireGrant]
$creadListPrec :: ReadPrec [RetireGrant]
readPrec :: ReadPrec RetireGrant
$creadPrec :: ReadPrec RetireGrant
readList :: ReadS [RetireGrant]
$creadList :: ReadS [RetireGrant]
readsPrec :: Int -> ReadS RetireGrant
$creadsPrec :: Int -> ReadS RetireGrant
Prelude.Read, Int -> RetireGrant -> ShowS
[RetireGrant] -> ShowS
RetireGrant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetireGrant] -> ShowS
$cshowList :: [RetireGrant] -> ShowS
show :: RetireGrant -> String
$cshow :: RetireGrant -> String
showsPrec :: Int -> RetireGrant -> ShowS
$cshowsPrec :: Int -> RetireGrant -> ShowS
Prelude.Show, forall x. Rep RetireGrant x -> RetireGrant
forall x. RetireGrant -> Rep RetireGrant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RetireGrant x -> RetireGrant
$cfrom :: forall x. RetireGrant -> Rep RetireGrant x
Prelude.Generic)

-- |
-- Create a value of 'RetireGrant' 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:
--
-- 'grantId', 'retireGrant_grantId' - Identifies the grant to retire. To get the grant ID, use CreateGrant,
-- ListGrants, or ListRetirableGrants.
--
-- -   Grant ID Example -
--     0123456789012345678901234567890123456789012345678901234567890123
--
-- 'grantToken', 'retireGrant_grantToken' - Identifies the grant to be retired. You can use a grant token to
-- identify a new grant even before it has achieved eventual consistency.
--
-- Only the CreateGrant operation returns a grant token. For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#terms-eventual-consistency Eventual consistency>
-- in the /Key Management Service Developer Guide/.
--
-- 'keyId', 'retireGrant_keyId' - The key ARN KMS key associated with the grant. To find the key ARN, use
-- the ListKeys operation.
--
-- For example:
-- @arn:aws:kms:us-east-2:444455556666:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
newRetireGrant ::
  RetireGrant
newRetireGrant :: RetireGrant
newRetireGrant =
  RetireGrant'
    { $sel:grantId:RetireGrant' :: Maybe Text
grantId = forall a. Maybe a
Prelude.Nothing,
      $sel:grantToken:RetireGrant' :: Maybe Text
grantToken = forall a. Maybe a
Prelude.Nothing,
      $sel:keyId:RetireGrant' :: Maybe Text
keyId = forall a. Maybe a
Prelude.Nothing
    }

-- | Identifies the grant to retire. To get the grant ID, use CreateGrant,
-- ListGrants, or ListRetirableGrants.
--
-- -   Grant ID Example -
--     0123456789012345678901234567890123456789012345678901234567890123
retireGrant_grantId :: Lens.Lens' RetireGrant (Prelude.Maybe Prelude.Text)
retireGrant_grantId :: Lens' RetireGrant (Maybe Text)
retireGrant_grantId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetireGrant' {Maybe Text
grantId :: Maybe Text
$sel:grantId:RetireGrant' :: RetireGrant -> Maybe Text
grantId} -> Maybe Text
grantId) (\s :: RetireGrant
s@RetireGrant' {} Maybe Text
a -> RetireGrant
s {$sel:grantId:RetireGrant' :: Maybe Text
grantId = Maybe Text
a} :: RetireGrant)

-- | Identifies the grant to be retired. You can use a grant token to
-- identify a new grant even before it has achieved eventual consistency.
--
-- Only the CreateGrant operation returns a grant token. For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#terms-eventual-consistency Eventual consistency>
-- in the /Key Management Service Developer Guide/.
retireGrant_grantToken :: Lens.Lens' RetireGrant (Prelude.Maybe Prelude.Text)
retireGrant_grantToken :: Lens' RetireGrant (Maybe Text)
retireGrant_grantToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetireGrant' {Maybe Text
grantToken :: Maybe Text
$sel:grantToken:RetireGrant' :: RetireGrant -> Maybe Text
grantToken} -> Maybe Text
grantToken) (\s :: RetireGrant
s@RetireGrant' {} Maybe Text
a -> RetireGrant
s {$sel:grantToken:RetireGrant' :: Maybe Text
grantToken = Maybe Text
a} :: RetireGrant)

-- | The key ARN KMS key associated with the grant. To find the key ARN, use
-- the ListKeys operation.
--
-- For example:
-- @arn:aws:kms:us-east-2:444455556666:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
retireGrant_keyId :: Lens.Lens' RetireGrant (Prelude.Maybe Prelude.Text)
retireGrant_keyId :: Lens' RetireGrant (Maybe Text)
retireGrant_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetireGrant' {Maybe Text
keyId :: Maybe Text
$sel:keyId:RetireGrant' :: RetireGrant -> Maybe Text
keyId} -> Maybe Text
keyId) (\s :: RetireGrant
s@RetireGrant' {} Maybe Text
a -> RetireGrant
s {$sel:keyId:RetireGrant' :: Maybe Text
keyId = Maybe Text
a} :: RetireGrant)

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

instance Prelude.Hashable RetireGrant where
  hashWithSalt :: Int -> RetireGrant -> Int
hashWithSalt Int
_salt RetireGrant' {Maybe Text
keyId :: Maybe Text
grantToken :: Maybe Text
grantId :: Maybe Text
$sel:keyId:RetireGrant' :: RetireGrant -> Maybe Text
$sel:grantToken:RetireGrant' :: RetireGrant -> Maybe Text
$sel:grantId:RetireGrant' :: RetireGrant -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
grantId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
grantToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyId

instance Prelude.NFData RetireGrant where
  rnf :: RetireGrant -> ()
rnf RetireGrant' {Maybe Text
keyId :: Maybe Text
grantToken :: Maybe Text
grantId :: Maybe Text
$sel:keyId:RetireGrant' :: RetireGrant -> Maybe Text
$sel:grantToken:RetireGrant' :: RetireGrant -> Maybe Text
$sel:grantId:RetireGrant' :: RetireGrant -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
grantId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
grantToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyId

instance Data.ToHeaders RetireGrant where
  toHeaders :: RetireGrant -> [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
"TrentService.RetireGrant" :: 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 RetireGrant where
  toJSON :: RetireGrant -> Value
toJSON RetireGrant' {Maybe Text
keyId :: Maybe Text
grantToken :: Maybe Text
grantId :: Maybe Text
$sel:keyId:RetireGrant' :: RetireGrant -> Maybe Text
$sel:grantToken:RetireGrant' :: RetireGrant -> Maybe Text
$sel:grantId:RetireGrant' :: RetireGrant -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GrantId" 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
grantId,
            (Key
"GrantToken" 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
grantToken,
            (Key
"KeyId" 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
keyId
          ]
      )

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

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

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

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

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