{-# 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.IAM.GetContextKeysForPrincipalPolicy
-- 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 of the context keys referenced in all the IAM
-- policies that are attached to the specified IAM entity. The entity can
-- be an IAM user, group, or role. If you specify a user, then the request
-- also includes all of the policies attached to groups that the user is a
-- member of.
--
-- You can optionally include a list of one or more additional policies,
-- specified as strings. If you want to include /only/ a list of policies
-- by string, use GetContextKeysForCustomPolicy instead.
--
-- __Note:__ This operation discloses information about the permissions
-- granted to other users. If you do not want users to see other user\'s
-- permissions, then consider allowing them to use
-- GetContextKeysForCustomPolicy instead.
--
-- Context keys are variables maintained by Amazon Web Services and its
-- services that provide details about the context of an API query request.
-- Context keys can be evaluated by testing against a value in an IAM
-- policy. Use GetContextKeysForPrincipalPolicy to understand what key
-- names and values you must supply when you call SimulatePrincipalPolicy.
module Amazonka.IAM.GetContextKeysForPrincipalPolicy
  ( -- * Creating a Request
    GetContextKeysForPrincipalPolicy (..),
    newGetContextKeysForPrincipalPolicy,

    -- * Request Lenses
    getContextKeysForPrincipalPolicy_policyInputList,
    getContextKeysForPrincipalPolicy_policySourceArn,

    -- * Destructuring the Response
    GetContextKeysForPolicyResponse (..),
    newGetContextKeysForPolicyResponse,

    -- * Response Lenses
    getContextKeysForPolicyResponse_contextKeyNames,
  )
where

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

-- | /See:/ 'newGetContextKeysForPrincipalPolicy' smart constructor.
data GetContextKeysForPrincipalPolicy = GetContextKeysForPrincipalPolicy'
  { -- | An optional list of additional policies for which you want the list of
    -- context keys that are referenced.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
    -- this parameter is a string of characters consisting of the following:
    --
    -- -   Any printable ASCII character ranging from the space character
    --     (@\\u0020@) through the end of the ASCII character range
    --
    -- -   The printable characters in the Basic Latin and Latin-1 Supplement
    --     character set (through @\\u00FF@)
    --
    -- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
    --     carriage return (@\\u000D@)
    GetContextKeysForPrincipalPolicy -> Maybe [Text]
policyInputList :: Prelude.Maybe [Prelude.Text],
    -- | The ARN of a user, group, or role whose policies contain the context
    -- keys that you want listed. If you specify a user, the list includes
    -- context keys that are found in all policies that are attached to the
    -- user. The list also includes all groups that the user is a member of. If
    -- you pick a group or a role, then it includes only those context keys
    -- that are found in policies attached to that entity. Note that all
    -- parameters are shown in unencoded form here for clarity, but must be URL
    -- encoded to be included as a part of a real HTML request.
    --
    -- For more information about ARNs, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- in the /Amazon Web Services General Reference/.
    GetContextKeysForPrincipalPolicy -> Text
policySourceArn :: Prelude.Text
  }
  deriving (GetContextKeysForPrincipalPolicy
-> GetContextKeysForPrincipalPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContextKeysForPrincipalPolicy
-> GetContextKeysForPrincipalPolicy -> Bool
$c/= :: GetContextKeysForPrincipalPolicy
-> GetContextKeysForPrincipalPolicy -> Bool
== :: GetContextKeysForPrincipalPolicy
-> GetContextKeysForPrincipalPolicy -> Bool
$c== :: GetContextKeysForPrincipalPolicy
-> GetContextKeysForPrincipalPolicy -> Bool
Prelude.Eq, ReadPrec [GetContextKeysForPrincipalPolicy]
ReadPrec GetContextKeysForPrincipalPolicy
Int -> ReadS GetContextKeysForPrincipalPolicy
ReadS [GetContextKeysForPrincipalPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContextKeysForPrincipalPolicy]
$creadListPrec :: ReadPrec [GetContextKeysForPrincipalPolicy]
readPrec :: ReadPrec GetContextKeysForPrincipalPolicy
$creadPrec :: ReadPrec GetContextKeysForPrincipalPolicy
readList :: ReadS [GetContextKeysForPrincipalPolicy]
$creadList :: ReadS [GetContextKeysForPrincipalPolicy]
readsPrec :: Int -> ReadS GetContextKeysForPrincipalPolicy
$creadsPrec :: Int -> ReadS GetContextKeysForPrincipalPolicy
Prelude.Read, Int -> GetContextKeysForPrincipalPolicy -> ShowS
[GetContextKeysForPrincipalPolicy] -> ShowS
GetContextKeysForPrincipalPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContextKeysForPrincipalPolicy] -> ShowS
$cshowList :: [GetContextKeysForPrincipalPolicy] -> ShowS
show :: GetContextKeysForPrincipalPolicy -> String
$cshow :: GetContextKeysForPrincipalPolicy -> String
showsPrec :: Int -> GetContextKeysForPrincipalPolicy -> ShowS
$cshowsPrec :: Int -> GetContextKeysForPrincipalPolicy -> ShowS
Prelude.Show, forall x.
Rep GetContextKeysForPrincipalPolicy x
-> GetContextKeysForPrincipalPolicy
forall x.
GetContextKeysForPrincipalPolicy
-> Rep GetContextKeysForPrincipalPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContextKeysForPrincipalPolicy x
-> GetContextKeysForPrincipalPolicy
$cfrom :: forall x.
GetContextKeysForPrincipalPolicy
-> Rep GetContextKeysForPrincipalPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetContextKeysForPrincipalPolicy' 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:
--
-- 'policyInputList', 'getContextKeysForPrincipalPolicy_policyInputList' - An optional list of additional policies for which you want the list of
-- context keys that are referenced.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
--
-- 'policySourceArn', 'getContextKeysForPrincipalPolicy_policySourceArn' - The ARN of a user, group, or role whose policies contain the context
-- keys that you want listed. If you specify a user, the list includes
-- context keys that are found in all policies that are attached to the
-- user. The list also includes all groups that the user is a member of. If
-- you pick a group or a role, then it includes only those context keys
-- that are found in policies attached to that entity. Note that all
-- parameters are shown in unencoded form here for clarity, but must be URL
-- encoded to be included as a part of a real HTML request.
--
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
newGetContextKeysForPrincipalPolicy ::
  -- | 'policySourceArn'
  Prelude.Text ->
  GetContextKeysForPrincipalPolicy
newGetContextKeysForPrincipalPolicy :: Text -> GetContextKeysForPrincipalPolicy
newGetContextKeysForPrincipalPolicy Text
pPolicySourceArn_ =
  GetContextKeysForPrincipalPolicy'
    { $sel:policyInputList:GetContextKeysForPrincipalPolicy' :: Maybe [Text]
policyInputList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:policySourceArn:GetContextKeysForPrincipalPolicy' :: Text
policySourceArn = Text
pPolicySourceArn_
    }

-- | An optional list of additional policies for which you want the list of
-- context keys that are referenced.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
getContextKeysForPrincipalPolicy_policyInputList :: Lens.Lens' GetContextKeysForPrincipalPolicy (Prelude.Maybe [Prelude.Text])
getContextKeysForPrincipalPolicy_policyInputList :: Lens' GetContextKeysForPrincipalPolicy (Maybe [Text])
getContextKeysForPrincipalPolicy_policyInputList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContextKeysForPrincipalPolicy' {Maybe [Text]
policyInputList :: Maybe [Text]
$sel:policyInputList:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Maybe [Text]
policyInputList} -> Maybe [Text]
policyInputList) (\s :: GetContextKeysForPrincipalPolicy
s@GetContextKeysForPrincipalPolicy' {} Maybe [Text]
a -> GetContextKeysForPrincipalPolicy
s {$sel:policyInputList:GetContextKeysForPrincipalPolicy' :: Maybe [Text]
policyInputList = Maybe [Text]
a} :: GetContextKeysForPrincipalPolicy) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ARN of a user, group, or role whose policies contain the context
-- keys that you want listed. If you specify a user, the list includes
-- context keys that are found in all policies that are attached to the
-- user. The list also includes all groups that the user is a member of. If
-- you pick a group or a role, then it includes only those context keys
-- that are found in policies attached to that entity. Note that all
-- parameters are shown in unencoded form here for clarity, but must be URL
-- encoded to be included as a part of a real HTML request.
--
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
getContextKeysForPrincipalPolicy_policySourceArn :: Lens.Lens' GetContextKeysForPrincipalPolicy Prelude.Text
getContextKeysForPrincipalPolicy_policySourceArn :: Lens' GetContextKeysForPrincipalPolicy Text
getContextKeysForPrincipalPolicy_policySourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContextKeysForPrincipalPolicy' {Text
policySourceArn :: Text
$sel:policySourceArn:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Text
policySourceArn} -> Text
policySourceArn) (\s :: GetContextKeysForPrincipalPolicy
s@GetContextKeysForPrincipalPolicy' {} Text
a -> GetContextKeysForPrincipalPolicy
s {$sel:policySourceArn:GetContextKeysForPrincipalPolicy' :: Text
policySourceArn = Text
a} :: GetContextKeysForPrincipalPolicy)

instance
  Core.AWSRequest
    GetContextKeysForPrincipalPolicy
  where
  type
    AWSResponse GetContextKeysForPrincipalPolicy =
      GetContextKeysForPolicyResponse
  request :: (Service -> Service)
-> GetContextKeysForPrincipalPolicy
-> Request GetContextKeysForPrincipalPolicy
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetContextKeysForPrincipalPolicy
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetContextKeysForPrincipalPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetContextKeysForPrincipalPolicyResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance
  Prelude.Hashable
    GetContextKeysForPrincipalPolicy
  where
  hashWithSalt :: Int -> GetContextKeysForPrincipalPolicy -> Int
hashWithSalt
    Int
_salt
    GetContextKeysForPrincipalPolicy' {Maybe [Text]
Text
policySourceArn :: Text
policyInputList :: Maybe [Text]
$sel:policySourceArn:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Text
$sel:policyInputList:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Maybe [Text]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
policyInputList
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policySourceArn

instance
  Prelude.NFData
    GetContextKeysForPrincipalPolicy
  where
  rnf :: GetContextKeysForPrincipalPolicy -> ()
rnf GetContextKeysForPrincipalPolicy' {Maybe [Text]
Text
policySourceArn :: Text
policyInputList :: Maybe [Text]
$sel:policySourceArn:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Text
$sel:policyInputList:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
policyInputList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policySourceArn

instance
  Data.ToHeaders
    GetContextKeysForPrincipalPolicy
  where
  toHeaders :: GetContextKeysForPrincipalPolicy -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance
  Data.ToQuery
    GetContextKeysForPrincipalPolicy
  where
  toQuery :: GetContextKeysForPrincipalPolicy -> QueryString
toQuery GetContextKeysForPrincipalPolicy' {Maybe [Text]
Text
policySourceArn :: Text
policyInputList :: Maybe [Text]
$sel:policySourceArn:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Text
$sel:policyInputList:GetContextKeysForPrincipalPolicy' :: GetContextKeysForPrincipalPolicy -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"GetContextKeysForPrincipalPolicy" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"PolicyInputList"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
policyInputList
            ),
        ByteString
"PolicySourceArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
policySourceArn
      ]