{-# 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.CognitoIdentity.GetPrincipalTagAttributeMap
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use @GetPrincipalTagAttributeMap@ to list all mappings between
-- @PrincipalTags@ and user attributes.
module Amazonka.CognitoIdentity.GetPrincipalTagAttributeMap
  ( -- * Creating a Request
    GetPrincipalTagAttributeMap (..),
    newGetPrincipalTagAttributeMap,

    -- * Request Lenses
    getPrincipalTagAttributeMap_identityPoolId,
    getPrincipalTagAttributeMap_identityProviderName,

    -- * Destructuring the Response
    GetPrincipalTagAttributeMapResponse (..),
    newGetPrincipalTagAttributeMapResponse,

    -- * Response Lenses
    getPrincipalTagAttributeMapResponse_identityPoolId,
    getPrincipalTagAttributeMapResponse_identityProviderName,
    getPrincipalTagAttributeMapResponse_principalTags,
    getPrincipalTagAttributeMapResponse_useDefaults,
    getPrincipalTagAttributeMapResponse_httpStatus,
  )
where

import Amazonka.CognitoIdentity.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:/ 'newGetPrincipalTagAttributeMap' smart constructor.
data GetPrincipalTagAttributeMap = GetPrincipalTagAttributeMap'
  { -- | You can use this operation to get the ID of the Identity Pool you setup
    -- attribute mappings for.
    GetPrincipalTagAttributeMap -> Text
identityPoolId :: Prelude.Text,
    -- | You can use this operation to get the provider name.
    GetPrincipalTagAttributeMap -> Text
identityProviderName :: Prelude.Text
  }
  deriving (GetPrincipalTagAttributeMap -> GetPrincipalTagAttributeMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPrincipalTagAttributeMap -> GetPrincipalTagAttributeMap -> Bool
$c/= :: GetPrincipalTagAttributeMap -> GetPrincipalTagAttributeMap -> Bool
== :: GetPrincipalTagAttributeMap -> GetPrincipalTagAttributeMap -> Bool
$c== :: GetPrincipalTagAttributeMap -> GetPrincipalTagAttributeMap -> Bool
Prelude.Eq, ReadPrec [GetPrincipalTagAttributeMap]
ReadPrec GetPrincipalTagAttributeMap
Int -> ReadS GetPrincipalTagAttributeMap
ReadS [GetPrincipalTagAttributeMap]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPrincipalTagAttributeMap]
$creadListPrec :: ReadPrec [GetPrincipalTagAttributeMap]
readPrec :: ReadPrec GetPrincipalTagAttributeMap
$creadPrec :: ReadPrec GetPrincipalTagAttributeMap
readList :: ReadS [GetPrincipalTagAttributeMap]
$creadList :: ReadS [GetPrincipalTagAttributeMap]
readsPrec :: Int -> ReadS GetPrincipalTagAttributeMap
$creadsPrec :: Int -> ReadS GetPrincipalTagAttributeMap
Prelude.Read, Int -> GetPrincipalTagAttributeMap -> ShowS
[GetPrincipalTagAttributeMap] -> ShowS
GetPrincipalTagAttributeMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPrincipalTagAttributeMap] -> ShowS
$cshowList :: [GetPrincipalTagAttributeMap] -> ShowS
show :: GetPrincipalTagAttributeMap -> String
$cshow :: GetPrincipalTagAttributeMap -> String
showsPrec :: Int -> GetPrincipalTagAttributeMap -> ShowS
$cshowsPrec :: Int -> GetPrincipalTagAttributeMap -> ShowS
Prelude.Show, forall x.
Rep GetPrincipalTagAttributeMap x -> GetPrincipalTagAttributeMap
forall x.
GetPrincipalTagAttributeMap -> Rep GetPrincipalTagAttributeMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPrincipalTagAttributeMap x -> GetPrincipalTagAttributeMap
$cfrom :: forall x.
GetPrincipalTagAttributeMap -> Rep GetPrincipalTagAttributeMap x
Prelude.Generic)

-- |
-- Create a value of 'GetPrincipalTagAttributeMap' 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:
--
-- 'identityPoolId', 'getPrincipalTagAttributeMap_identityPoolId' - You can use this operation to get the ID of the Identity Pool you setup
-- attribute mappings for.
--
-- 'identityProviderName', 'getPrincipalTagAttributeMap_identityProviderName' - You can use this operation to get the provider name.
newGetPrincipalTagAttributeMap ::
  -- | 'identityPoolId'
  Prelude.Text ->
  -- | 'identityProviderName'
  Prelude.Text ->
  GetPrincipalTagAttributeMap
newGetPrincipalTagAttributeMap :: Text -> Text -> GetPrincipalTagAttributeMap
newGetPrincipalTagAttributeMap
  Text
pIdentityPoolId_
  Text
pIdentityProviderName_ =
    GetPrincipalTagAttributeMap'
      { $sel:identityPoolId:GetPrincipalTagAttributeMap' :: Text
identityPoolId =
          Text
pIdentityPoolId_,
        $sel:identityProviderName:GetPrincipalTagAttributeMap' :: Text
identityProviderName = Text
pIdentityProviderName_
      }

-- | You can use this operation to get the ID of the Identity Pool you setup
-- attribute mappings for.
getPrincipalTagAttributeMap_identityPoolId :: Lens.Lens' GetPrincipalTagAttributeMap Prelude.Text
getPrincipalTagAttributeMap_identityPoolId :: Lens' GetPrincipalTagAttributeMap Text
getPrincipalTagAttributeMap_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPrincipalTagAttributeMap' {Text
identityPoolId :: Text
$sel:identityPoolId:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
identityPoolId} -> Text
identityPoolId) (\s :: GetPrincipalTagAttributeMap
s@GetPrincipalTagAttributeMap' {} Text
a -> GetPrincipalTagAttributeMap
s {$sel:identityPoolId:GetPrincipalTagAttributeMap' :: Text
identityPoolId = Text
a} :: GetPrincipalTagAttributeMap)

-- | You can use this operation to get the provider name.
getPrincipalTagAttributeMap_identityProviderName :: Lens.Lens' GetPrincipalTagAttributeMap Prelude.Text
getPrincipalTagAttributeMap_identityProviderName :: Lens' GetPrincipalTagAttributeMap Text
getPrincipalTagAttributeMap_identityProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPrincipalTagAttributeMap' {Text
identityProviderName :: Text
$sel:identityProviderName:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
identityProviderName} -> Text
identityProviderName) (\s :: GetPrincipalTagAttributeMap
s@GetPrincipalTagAttributeMap' {} Text
a -> GetPrincipalTagAttributeMap
s {$sel:identityProviderName:GetPrincipalTagAttributeMap' :: Text
identityProviderName = Text
a} :: GetPrincipalTagAttributeMap)

instance Core.AWSRequest GetPrincipalTagAttributeMap where
  type
    AWSResponse GetPrincipalTagAttributeMap =
      GetPrincipalTagAttributeMapResponse
  request :: (Service -> Service)
-> GetPrincipalTagAttributeMap
-> Request GetPrincipalTagAttributeMap
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 GetPrincipalTagAttributeMap
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetPrincipalTagAttributeMap)))
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 ->
          Maybe Text
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Bool
-> Int
-> GetPrincipalTagAttributeMapResponse
GetPrincipalTagAttributeMapResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"IdentityPoolId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"IdentityProviderName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PrincipalTags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UseDefaults")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetPrincipalTagAttributeMap where
  hashWithSalt :: Int -> GetPrincipalTagAttributeMap -> Int
hashWithSalt Int
_salt GetPrincipalTagAttributeMap' {Text
identityProviderName :: Text
identityPoolId :: Text
$sel:identityProviderName:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
$sel:identityPoolId:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityProviderName

instance Prelude.NFData GetPrincipalTagAttributeMap where
  rnf :: GetPrincipalTagAttributeMap -> ()
rnf GetPrincipalTagAttributeMap' {Text
identityProviderName :: Text
identityPoolId :: Text
$sel:identityProviderName:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
$sel:identityPoolId:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identityPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityProviderName

instance Data.ToHeaders GetPrincipalTagAttributeMap where
  toHeaders :: GetPrincipalTagAttributeMap -> 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
"AWSCognitoIdentityService.GetPrincipalTagAttributeMap" ::
                          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 GetPrincipalTagAttributeMap where
  toJSON :: GetPrincipalTagAttributeMap -> Value
toJSON GetPrincipalTagAttributeMap' {Text
identityProviderName :: Text
identityPoolId :: Text
$sel:identityProviderName:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
$sel:identityPoolId:GetPrincipalTagAttributeMap' :: GetPrincipalTagAttributeMap -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityPoolId),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"IdentityProviderName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityProviderName
              )
          ]
      )

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

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

-- | /See:/ 'newGetPrincipalTagAttributeMapResponse' smart constructor.
data GetPrincipalTagAttributeMapResponse = GetPrincipalTagAttributeMapResponse'
  { -- | You can use this operation to get the ID of the Identity Pool you setup
    -- attribute mappings for.
    GetPrincipalTagAttributeMapResponse -> Maybe Text
identityPoolId :: Prelude.Maybe Prelude.Text,
    -- | You can use this operation to get the provider name.
    GetPrincipalTagAttributeMapResponse -> Maybe Text
identityProviderName :: Prelude.Maybe Prelude.Text,
    -- | You can use this operation to add principal tags. The
    -- @PrincipalTags@operation enables you to reference user attributes in
    -- your IAM permissions policy.
    GetPrincipalTagAttributeMapResponse -> Maybe (HashMap Text Text)
principalTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | You can use this operation to list
    GetPrincipalTagAttributeMapResponse -> Maybe Bool
useDefaults :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    GetPrincipalTagAttributeMapResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPrincipalTagAttributeMapResponse
-> GetPrincipalTagAttributeMapResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPrincipalTagAttributeMapResponse
-> GetPrincipalTagAttributeMapResponse -> Bool
$c/= :: GetPrincipalTagAttributeMapResponse
-> GetPrincipalTagAttributeMapResponse -> Bool
== :: GetPrincipalTagAttributeMapResponse
-> GetPrincipalTagAttributeMapResponse -> Bool
$c== :: GetPrincipalTagAttributeMapResponse
-> GetPrincipalTagAttributeMapResponse -> Bool
Prelude.Eq, ReadPrec [GetPrincipalTagAttributeMapResponse]
ReadPrec GetPrincipalTagAttributeMapResponse
Int -> ReadS GetPrincipalTagAttributeMapResponse
ReadS [GetPrincipalTagAttributeMapResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPrincipalTagAttributeMapResponse]
$creadListPrec :: ReadPrec [GetPrincipalTagAttributeMapResponse]
readPrec :: ReadPrec GetPrincipalTagAttributeMapResponse
$creadPrec :: ReadPrec GetPrincipalTagAttributeMapResponse
readList :: ReadS [GetPrincipalTagAttributeMapResponse]
$creadList :: ReadS [GetPrincipalTagAttributeMapResponse]
readsPrec :: Int -> ReadS GetPrincipalTagAttributeMapResponse
$creadsPrec :: Int -> ReadS GetPrincipalTagAttributeMapResponse
Prelude.Read, Int -> GetPrincipalTagAttributeMapResponse -> ShowS
[GetPrincipalTagAttributeMapResponse] -> ShowS
GetPrincipalTagAttributeMapResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPrincipalTagAttributeMapResponse] -> ShowS
$cshowList :: [GetPrincipalTagAttributeMapResponse] -> ShowS
show :: GetPrincipalTagAttributeMapResponse -> String
$cshow :: GetPrincipalTagAttributeMapResponse -> String
showsPrec :: Int -> GetPrincipalTagAttributeMapResponse -> ShowS
$cshowsPrec :: Int -> GetPrincipalTagAttributeMapResponse -> ShowS
Prelude.Show, forall x.
Rep GetPrincipalTagAttributeMapResponse x
-> GetPrincipalTagAttributeMapResponse
forall x.
GetPrincipalTagAttributeMapResponse
-> Rep GetPrincipalTagAttributeMapResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPrincipalTagAttributeMapResponse x
-> GetPrincipalTagAttributeMapResponse
$cfrom :: forall x.
GetPrincipalTagAttributeMapResponse
-> Rep GetPrincipalTagAttributeMapResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPrincipalTagAttributeMapResponse' 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:
--
-- 'identityPoolId', 'getPrincipalTagAttributeMapResponse_identityPoolId' - You can use this operation to get the ID of the Identity Pool you setup
-- attribute mappings for.
--
-- 'identityProviderName', 'getPrincipalTagAttributeMapResponse_identityProviderName' - You can use this operation to get the provider name.
--
-- 'principalTags', 'getPrincipalTagAttributeMapResponse_principalTags' - You can use this operation to add principal tags. The
-- @PrincipalTags@operation enables you to reference user attributes in
-- your IAM permissions policy.
--
-- 'useDefaults', 'getPrincipalTagAttributeMapResponse_useDefaults' - You can use this operation to list
--
-- 'httpStatus', 'getPrincipalTagAttributeMapResponse_httpStatus' - The response's http status code.
newGetPrincipalTagAttributeMapResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPrincipalTagAttributeMapResponse
newGetPrincipalTagAttributeMapResponse :: Int -> GetPrincipalTagAttributeMapResponse
newGetPrincipalTagAttributeMapResponse Int
pHttpStatus_ =
  GetPrincipalTagAttributeMapResponse'
    { $sel:identityPoolId:GetPrincipalTagAttributeMapResponse' :: Maybe Text
identityPoolId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityProviderName:GetPrincipalTagAttributeMapResponse' :: Maybe Text
identityProviderName = forall a. Maybe a
Prelude.Nothing,
      $sel:principalTags:GetPrincipalTagAttributeMapResponse' :: Maybe (HashMap Text Text)
principalTags = forall a. Maybe a
Prelude.Nothing,
      $sel:useDefaults:GetPrincipalTagAttributeMapResponse' :: Maybe Bool
useDefaults = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPrincipalTagAttributeMapResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | You can use this operation to get the ID of the Identity Pool you setup
-- attribute mappings for.
getPrincipalTagAttributeMapResponse_identityPoolId :: Lens.Lens' GetPrincipalTagAttributeMapResponse (Prelude.Maybe Prelude.Text)
getPrincipalTagAttributeMapResponse_identityPoolId :: Lens' GetPrincipalTagAttributeMapResponse (Maybe Text)
getPrincipalTagAttributeMapResponse_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPrincipalTagAttributeMapResponse' {Maybe Text
identityPoolId :: Maybe Text
$sel:identityPoolId:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe Text
identityPoolId} -> Maybe Text
identityPoolId) (\s :: GetPrincipalTagAttributeMapResponse
s@GetPrincipalTagAttributeMapResponse' {} Maybe Text
a -> GetPrincipalTagAttributeMapResponse
s {$sel:identityPoolId:GetPrincipalTagAttributeMapResponse' :: Maybe Text
identityPoolId = Maybe Text
a} :: GetPrincipalTagAttributeMapResponse)

-- | You can use this operation to get the provider name.
getPrincipalTagAttributeMapResponse_identityProviderName :: Lens.Lens' GetPrincipalTagAttributeMapResponse (Prelude.Maybe Prelude.Text)
getPrincipalTagAttributeMapResponse_identityProviderName :: Lens' GetPrincipalTagAttributeMapResponse (Maybe Text)
getPrincipalTagAttributeMapResponse_identityProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPrincipalTagAttributeMapResponse' {Maybe Text
identityProviderName :: Maybe Text
$sel:identityProviderName:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe Text
identityProviderName} -> Maybe Text
identityProviderName) (\s :: GetPrincipalTagAttributeMapResponse
s@GetPrincipalTagAttributeMapResponse' {} Maybe Text
a -> GetPrincipalTagAttributeMapResponse
s {$sel:identityProviderName:GetPrincipalTagAttributeMapResponse' :: Maybe Text
identityProviderName = Maybe Text
a} :: GetPrincipalTagAttributeMapResponse)

-- | You can use this operation to add principal tags. The
-- @PrincipalTags@operation enables you to reference user attributes in
-- your IAM permissions policy.
getPrincipalTagAttributeMapResponse_principalTags :: Lens.Lens' GetPrincipalTagAttributeMapResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getPrincipalTagAttributeMapResponse_principalTags :: Lens'
  GetPrincipalTagAttributeMapResponse (Maybe (HashMap Text Text))
getPrincipalTagAttributeMapResponse_principalTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPrincipalTagAttributeMapResponse' {Maybe (HashMap Text Text)
principalTags :: Maybe (HashMap Text Text)
$sel:principalTags:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe (HashMap Text Text)
principalTags} -> Maybe (HashMap Text Text)
principalTags) (\s :: GetPrincipalTagAttributeMapResponse
s@GetPrincipalTagAttributeMapResponse' {} Maybe (HashMap Text Text)
a -> GetPrincipalTagAttributeMapResponse
s {$sel:principalTags:GetPrincipalTagAttributeMapResponse' :: Maybe (HashMap Text Text)
principalTags = Maybe (HashMap Text Text)
a} :: GetPrincipalTagAttributeMapResponse) 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

-- | You can use this operation to list
getPrincipalTagAttributeMapResponse_useDefaults :: Lens.Lens' GetPrincipalTagAttributeMapResponse (Prelude.Maybe Prelude.Bool)
getPrincipalTagAttributeMapResponse_useDefaults :: Lens' GetPrincipalTagAttributeMapResponse (Maybe Bool)
getPrincipalTagAttributeMapResponse_useDefaults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPrincipalTagAttributeMapResponse' {Maybe Bool
useDefaults :: Maybe Bool
$sel:useDefaults:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe Bool
useDefaults} -> Maybe Bool
useDefaults) (\s :: GetPrincipalTagAttributeMapResponse
s@GetPrincipalTagAttributeMapResponse' {} Maybe Bool
a -> GetPrincipalTagAttributeMapResponse
s {$sel:useDefaults:GetPrincipalTagAttributeMapResponse' :: Maybe Bool
useDefaults = Maybe Bool
a} :: GetPrincipalTagAttributeMapResponse)

-- | The response's http status code.
getPrincipalTagAttributeMapResponse_httpStatus :: Lens.Lens' GetPrincipalTagAttributeMapResponse Prelude.Int
getPrincipalTagAttributeMapResponse_httpStatus :: Lens' GetPrincipalTagAttributeMapResponse Int
getPrincipalTagAttributeMapResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPrincipalTagAttributeMapResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetPrincipalTagAttributeMapResponse
s@GetPrincipalTagAttributeMapResponse' {} Int
a -> GetPrincipalTagAttributeMapResponse
s {$sel:httpStatus:GetPrincipalTagAttributeMapResponse' :: Int
httpStatus = Int
a} :: GetPrincipalTagAttributeMapResponse)

instance
  Prelude.NFData
    GetPrincipalTagAttributeMapResponse
  where
  rnf :: GetPrincipalTagAttributeMapResponse -> ()
rnf GetPrincipalTagAttributeMapResponse' {Int
Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
httpStatus :: Int
useDefaults :: Maybe Bool
principalTags :: Maybe (HashMap Text Text)
identityProviderName :: Maybe Text
identityPoolId :: Maybe Text
$sel:httpStatus:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Int
$sel:useDefaults:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe Bool
$sel:principalTags:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe (HashMap Text Text)
$sel:identityProviderName:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe Text
$sel:identityPoolId:GetPrincipalTagAttributeMapResponse' :: GetPrincipalTagAttributeMapResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
identityPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
identityProviderName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
principalTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
useDefaults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus