{-# 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.ListGrants
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a list of all grants for the specified KMS key.
--
-- You must specify the KMS key in all requests. You can filter the grant
-- list by grant ID or grantee principal.
--
-- 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>.
--
-- The @GranteePrincipal@ field in the @ListGrants@ response usually
-- contains the user or role designated as the grantee principal in the
-- grant. However, when the grantee principal in the grant is an Amazon Web
-- Services service, the @GranteePrincipal@ field contains the
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_policies_elements_principal.html#principal-services service principal>,
-- which might represent several different grantee principals.
--
-- __Cross-account use__: Yes. To perform this operation on a KMS key in a
-- different Amazon Web Services account, specify the key ARN in the value
-- of the @KeyId@ parameter.
--
-- __Required permissions__:
-- <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:ListGrants>
-- (key policy)
--
-- __Related operations:__
--
-- -   CreateGrant
--
-- -   ListRetirableGrants
--
-- -   RetireGrant
--
-- -   RevokeGrant
--
-- This operation returns paginated results.
module Amazonka.KMS.ListGrants
  ( -- * Creating a Request
    ListGrants (..),
    newListGrants,

    -- * Request Lenses
    listGrants_grantId,
    listGrants_granteePrincipal,
    listGrants_limit,
    listGrants_marker,
    listGrants_keyId,

    -- * Destructuring the Response
    ListGrantsResponse (..),
    newListGrantsResponse,

    -- * Response Lenses
    listGrantsResponse_grants,
    listGrantsResponse_nextMarker,
    listGrantsResponse_truncated,
  )
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:/ 'newListGrants' smart constructor.
data ListGrants = ListGrants'
  { -- | Returns only the grant with the specified grant ID. The grant ID
    -- uniquely identifies the grant.
    ListGrants -> Maybe Text
grantId :: Prelude.Maybe Prelude.Text,
    -- | Returns only grants where the specified principal is the grantee
    -- principal for the grant.
    ListGrants -> Maybe Text
granteePrincipal :: Prelude.Maybe Prelude.Text,
    -- | Use this parameter to specify the maximum number of items to return.
    -- When this value is present, KMS does not return more than the specified
    -- number of items, but it might return fewer.
    --
    -- This value is optional. If you include a value, it must be between 1 and
    -- 100, inclusive. If you do not include a value, it defaults to 50.
    ListGrants -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | Use this parameter in a subsequent request after you receive a response
    -- with truncated results. Set it to the value of @NextMarker@ from the
    -- truncated response you just received.
    ListGrants -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | Returns only grants for the specified KMS key. This parameter is
    -- required.
    --
    -- Specify the key ID or key ARN of the KMS key. To specify a KMS key in a
    -- different Amazon Web Services account, you must use the key ARN.
    --
    -- For example:
    --
    -- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Key ARN:
    --     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- To get the key ID and key ARN for a KMS key, use ListKeys or
    -- DescribeKey.
    ListGrants -> Text
keyId :: Prelude.Text
  }
  deriving (ListGrants -> ListGrants -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListGrants -> ListGrants -> Bool
$c/= :: ListGrants -> ListGrants -> Bool
== :: ListGrants -> ListGrants -> Bool
$c== :: ListGrants -> ListGrants -> Bool
Prelude.Eq, ReadPrec [ListGrants]
ReadPrec ListGrants
Int -> ReadS ListGrants
ReadS [ListGrants]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListGrants]
$creadListPrec :: ReadPrec [ListGrants]
readPrec :: ReadPrec ListGrants
$creadPrec :: ReadPrec ListGrants
readList :: ReadS [ListGrants]
$creadList :: ReadS [ListGrants]
readsPrec :: Int -> ReadS ListGrants
$creadsPrec :: Int -> ReadS ListGrants
Prelude.Read, Int -> ListGrants -> ShowS
[ListGrants] -> ShowS
ListGrants -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListGrants] -> ShowS
$cshowList :: [ListGrants] -> ShowS
show :: ListGrants -> String
$cshow :: ListGrants -> String
showsPrec :: Int -> ListGrants -> ShowS
$cshowsPrec :: Int -> ListGrants -> ShowS
Prelude.Show, forall x. Rep ListGrants x -> ListGrants
forall x. ListGrants -> Rep ListGrants x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListGrants x -> ListGrants
$cfrom :: forall x. ListGrants -> Rep ListGrants x
Prelude.Generic)

-- |
-- Create a value of 'ListGrants' 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', 'listGrants_grantId' - Returns only the grant with the specified grant ID. The grant ID
-- uniquely identifies the grant.
--
-- 'granteePrincipal', 'listGrants_granteePrincipal' - Returns only grants where the specified principal is the grantee
-- principal for the grant.
--
-- 'limit', 'listGrants_limit' - Use this parameter to specify the maximum number of items to return.
-- When this value is present, KMS does not return more than the specified
-- number of items, but it might return fewer.
--
-- This value is optional. If you include a value, it must be between 1 and
-- 100, inclusive. If you do not include a value, it defaults to 50.
--
-- 'marker', 'listGrants_marker' - Use this parameter in a subsequent request after you receive a response
-- with truncated results. Set it to the value of @NextMarker@ from the
-- truncated response you just received.
--
-- 'keyId', 'listGrants_keyId' - Returns only grants for the specified KMS key. This parameter is
-- required.
--
-- Specify the key ID or key ARN of the KMS key. To specify a KMS key in a
-- different Amazon Web Services account, you must use the key ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey.
newListGrants ::
  -- | 'keyId'
  Prelude.Text ->
  ListGrants
newListGrants :: Text -> ListGrants
newListGrants Text
pKeyId_ =
  ListGrants'
    { $sel:grantId:ListGrants' :: Maybe Text
grantId = forall a. Maybe a
Prelude.Nothing,
      $sel:granteePrincipal:ListGrants' :: Maybe Text
granteePrincipal = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ListGrants' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListGrants' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:keyId:ListGrants' :: Text
keyId = Text
pKeyId_
    }

-- | Returns only the grant with the specified grant ID. The grant ID
-- uniquely identifies the grant.
listGrants_grantId :: Lens.Lens' ListGrants (Prelude.Maybe Prelude.Text)
listGrants_grantId :: Lens' ListGrants (Maybe Text)
listGrants_grantId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListGrants' {Maybe Text
grantId :: Maybe Text
$sel:grantId:ListGrants' :: ListGrants -> Maybe Text
grantId} -> Maybe Text
grantId) (\s :: ListGrants
s@ListGrants' {} Maybe Text
a -> ListGrants
s {$sel:grantId:ListGrants' :: Maybe Text
grantId = Maybe Text
a} :: ListGrants)

-- | Returns only grants where the specified principal is the grantee
-- principal for the grant.
listGrants_granteePrincipal :: Lens.Lens' ListGrants (Prelude.Maybe Prelude.Text)
listGrants_granteePrincipal :: Lens' ListGrants (Maybe Text)
listGrants_granteePrincipal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListGrants' {Maybe Text
granteePrincipal :: Maybe Text
$sel:granteePrincipal:ListGrants' :: ListGrants -> Maybe Text
granteePrincipal} -> Maybe Text
granteePrincipal) (\s :: ListGrants
s@ListGrants' {} Maybe Text
a -> ListGrants
s {$sel:granteePrincipal:ListGrants' :: Maybe Text
granteePrincipal = Maybe Text
a} :: ListGrants)

-- | Use this parameter to specify the maximum number of items to return.
-- When this value is present, KMS does not return more than the specified
-- number of items, but it might return fewer.
--
-- This value is optional. If you include a value, it must be between 1 and
-- 100, inclusive. If you do not include a value, it defaults to 50.
listGrants_limit :: Lens.Lens' ListGrants (Prelude.Maybe Prelude.Natural)
listGrants_limit :: Lens' ListGrants (Maybe Natural)
listGrants_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListGrants' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListGrants' :: ListGrants -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListGrants
s@ListGrants' {} Maybe Natural
a -> ListGrants
s {$sel:limit:ListGrants' :: Maybe Natural
limit = Maybe Natural
a} :: ListGrants)

-- | Use this parameter in a subsequent request after you receive a response
-- with truncated results. Set it to the value of @NextMarker@ from the
-- truncated response you just received.
listGrants_marker :: Lens.Lens' ListGrants (Prelude.Maybe Prelude.Text)
listGrants_marker :: Lens' ListGrants (Maybe Text)
listGrants_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListGrants' {Maybe Text
marker :: Maybe Text
$sel:marker:ListGrants' :: ListGrants -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListGrants
s@ListGrants' {} Maybe Text
a -> ListGrants
s {$sel:marker:ListGrants' :: Maybe Text
marker = Maybe Text
a} :: ListGrants)

-- | Returns only grants for the specified KMS key. This parameter is
-- required.
--
-- Specify the key ID or key ARN of the KMS key. To specify a KMS key in a
-- different Amazon Web Services account, you must use the key ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey.
listGrants_keyId :: Lens.Lens' ListGrants Prelude.Text
listGrants_keyId :: Lens' ListGrants Text
listGrants_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListGrants' {Text
keyId :: Text
$sel:keyId:ListGrants' :: ListGrants -> Text
keyId} -> Text
keyId) (\s :: ListGrants
s@ListGrants' {} Text
a -> ListGrants
s {$sel:keyId:ListGrants' :: Text
keyId = Text
a} :: ListGrants)

instance Core.AWSPager ListGrants where
  page :: ListGrants -> AWSResponse ListGrants -> Maybe ListGrants
page ListGrants
rq AWSResponse ListGrants
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListGrants
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListGrantsResponse (Maybe Bool)
listGrantsResponse_truncated
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse ListGrants
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListGrantsResponse (Maybe Text)
listGrantsResponse_nextMarker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListGrants
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListGrants (Maybe Text)
listGrants_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListGrants
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListGrantsResponse (Maybe Text)
listGrantsResponse_nextMarker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListGrants where
  type AWSResponse ListGrants = ListGrantsResponse
  request :: (Service -> Service) -> ListGrants -> Request ListGrants
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 ListGrants
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListGrants)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      (\Int
s ResponseHeaders
h Object
x -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable ListGrants where
  hashWithSalt :: Int -> ListGrants -> Int
hashWithSalt Int
_salt ListGrants' {Maybe Natural
Maybe Text
Text
keyId :: Text
marker :: Maybe Text
limit :: Maybe Natural
granteePrincipal :: Maybe Text
grantId :: Maybe Text
$sel:keyId:ListGrants' :: ListGrants -> Text
$sel:marker:ListGrants' :: ListGrants -> Maybe Text
$sel:limit:ListGrants' :: ListGrants -> Maybe Natural
$sel:granteePrincipal:ListGrants' :: ListGrants -> Maybe Text
$sel:grantId:ListGrants' :: ListGrants -> 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
granteePrincipal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId

instance Prelude.NFData ListGrants where
  rnf :: ListGrants -> ()
rnf ListGrants' {Maybe Natural
Maybe Text
Text
keyId :: Text
marker :: Maybe Text
limit :: Maybe Natural
granteePrincipal :: Maybe Text
grantId :: Maybe Text
$sel:keyId:ListGrants' :: ListGrants -> Text
$sel:marker:ListGrants' :: ListGrants -> Maybe Text
$sel:limit:ListGrants' :: ListGrants -> Maybe Natural
$sel:granteePrincipal:ListGrants' :: ListGrants -> Maybe Text
$sel:grantId:ListGrants' :: ListGrants -> 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
granteePrincipal
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyId

instance Data.ToHeaders ListGrants where
  toHeaders :: ListGrants -> ResponseHeaders
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 -> ResponseHeaders
Data.=# (ByteString
"TrentService.ListGrants" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListGrants where
  toJSON :: ListGrants -> Value
toJSON ListGrants' {Maybe Natural
Maybe Text
Text
keyId :: Text
marker :: Maybe Text
limit :: Maybe Natural
granteePrincipal :: Maybe Text
grantId :: Maybe Text
$sel:keyId:ListGrants' :: ListGrants -> Text
$sel:marker:ListGrants' :: ListGrants -> Maybe Text
$sel:limit:ListGrants' :: ListGrants -> Maybe Natural
$sel:granteePrincipal:ListGrants' :: ListGrants -> Maybe Text
$sel:grantId:ListGrants' :: ListGrants -> 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
"GranteePrincipal" 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
granteePrincipal,
            (Key
"Limit" 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
limit,
            (Key
"Marker" 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
marker,
            forall a. a -> Maybe a
Prelude.Just (Key
"KeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyId)
          ]
      )

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

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