{-# 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.GetContextKeysForCustomPolicy
-- 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 the input policies.
-- The policies are supplied as a list of one or more strings. To get the
-- context keys from policies associated with an IAM user, group, or role,
-- use GetContextKeysForPrincipalPolicy.
--
-- 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 specified in an
-- IAM policy. Use @GetContextKeysForCustomPolicy@ to understand what key
-- names and values you must supply when you call SimulateCustomPolicy.
-- 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.
module Amazonka.IAM.GetContextKeysForCustomPolicy
  ( -- * Creating a Request
    GetContextKeysForCustomPolicy (..),
    newGetContextKeysForCustomPolicy,

    -- * Request Lenses
    getContextKeysForCustomPolicy_policyInputList,

    -- * 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:/ 'newGetContextKeysForCustomPolicy' smart constructor.
data GetContextKeysForCustomPolicy = GetContextKeysForCustomPolicy'
  { -- | A list of policies for which you want the list of context keys
    -- referenced in those policies. Each document is specified as a string
    -- containing the complete, valid JSON text of an IAM policy.
    --
    -- 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@)
    GetContextKeysForCustomPolicy -> [Text]
policyInputList :: [Prelude.Text]
  }
  deriving (GetContextKeysForCustomPolicy
-> GetContextKeysForCustomPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContextKeysForCustomPolicy
-> GetContextKeysForCustomPolicy -> Bool
$c/= :: GetContextKeysForCustomPolicy
-> GetContextKeysForCustomPolicy -> Bool
== :: GetContextKeysForCustomPolicy
-> GetContextKeysForCustomPolicy -> Bool
$c== :: GetContextKeysForCustomPolicy
-> GetContextKeysForCustomPolicy -> Bool
Prelude.Eq, ReadPrec [GetContextKeysForCustomPolicy]
ReadPrec GetContextKeysForCustomPolicy
Int -> ReadS GetContextKeysForCustomPolicy
ReadS [GetContextKeysForCustomPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContextKeysForCustomPolicy]
$creadListPrec :: ReadPrec [GetContextKeysForCustomPolicy]
readPrec :: ReadPrec GetContextKeysForCustomPolicy
$creadPrec :: ReadPrec GetContextKeysForCustomPolicy
readList :: ReadS [GetContextKeysForCustomPolicy]
$creadList :: ReadS [GetContextKeysForCustomPolicy]
readsPrec :: Int -> ReadS GetContextKeysForCustomPolicy
$creadsPrec :: Int -> ReadS GetContextKeysForCustomPolicy
Prelude.Read, Int -> GetContextKeysForCustomPolicy -> ShowS
[GetContextKeysForCustomPolicy] -> ShowS
GetContextKeysForCustomPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContextKeysForCustomPolicy] -> ShowS
$cshowList :: [GetContextKeysForCustomPolicy] -> ShowS
show :: GetContextKeysForCustomPolicy -> String
$cshow :: GetContextKeysForCustomPolicy -> String
showsPrec :: Int -> GetContextKeysForCustomPolicy -> ShowS
$cshowsPrec :: Int -> GetContextKeysForCustomPolicy -> ShowS
Prelude.Show, forall x.
Rep GetContextKeysForCustomPolicy x
-> GetContextKeysForCustomPolicy
forall x.
GetContextKeysForCustomPolicy
-> Rep GetContextKeysForCustomPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContextKeysForCustomPolicy x
-> GetContextKeysForCustomPolicy
$cfrom :: forall x.
GetContextKeysForCustomPolicy
-> Rep GetContextKeysForCustomPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetContextKeysForCustomPolicy' 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', 'getContextKeysForCustomPolicy_policyInputList' - A list of policies for which you want the list of context keys
-- referenced in those policies. Each document is specified as a string
-- containing the complete, valid JSON text of an IAM policy.
--
-- 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@)
newGetContextKeysForCustomPolicy ::
  GetContextKeysForCustomPolicy
newGetContextKeysForCustomPolicy :: GetContextKeysForCustomPolicy
newGetContextKeysForCustomPolicy =
  GetContextKeysForCustomPolicy'
    { $sel:policyInputList:GetContextKeysForCustomPolicy' :: [Text]
policyInputList =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | A list of policies for which you want the list of context keys
-- referenced in those policies. Each document is specified as a string
-- containing the complete, valid JSON text of an IAM policy.
--
-- 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@)
getContextKeysForCustomPolicy_policyInputList :: Lens.Lens' GetContextKeysForCustomPolicy [Prelude.Text]
getContextKeysForCustomPolicy_policyInputList :: Lens' GetContextKeysForCustomPolicy [Text]
getContextKeysForCustomPolicy_policyInputList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContextKeysForCustomPolicy' {[Text]
policyInputList :: [Text]
$sel:policyInputList:GetContextKeysForCustomPolicy' :: GetContextKeysForCustomPolicy -> [Text]
policyInputList} -> [Text]
policyInputList) (\s :: GetContextKeysForCustomPolicy
s@GetContextKeysForCustomPolicy' {} [Text]
a -> GetContextKeysForCustomPolicy
s {$sel:policyInputList:GetContextKeysForCustomPolicy' :: [Text]
policyInputList = [Text]
a} :: GetContextKeysForCustomPolicy) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Core.AWSRequest
    GetContextKeysForCustomPolicy
  where
  type
    AWSResponse GetContextKeysForCustomPolicy =
      GetContextKeysForPolicyResponse
  request :: (Service -> Service)
-> GetContextKeysForCustomPolicy
-> Request GetContextKeysForCustomPolicy
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 GetContextKeysForCustomPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetContextKeysForCustomPolicy)))
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
"GetContextKeysForCustomPolicyResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

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

instance Prelude.NFData GetContextKeysForCustomPolicy where
  rnf :: GetContextKeysForCustomPolicy -> ()
rnf GetContextKeysForCustomPolicy' {[Text]
policyInputList :: [Text]
$sel:policyInputList:GetContextKeysForCustomPolicy' :: GetContextKeysForCustomPolicy -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
policyInputList

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

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

instance Data.ToQuery GetContextKeysForCustomPolicy where
  toQuery :: GetContextKeysForCustomPolicy -> QueryString
toQuery GetContextKeysForCustomPolicy' {[Text]
policyInputList :: [Text]
$sel:policyInputList:GetContextKeysForCustomPolicy' :: GetContextKeysForCustomPolicy -> [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"GetContextKeysForCustomPolicy" ::
                      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.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
policyInputList
      ]