{-# 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.SetPrincipalTagAttributeMap
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You can use this operation to use default (username and clientID)
-- attribute or custom attribute mappings.
module Amazonka.CognitoIdentity.SetPrincipalTagAttributeMap
  ( -- * Creating a Request
    SetPrincipalTagAttributeMap (..),
    newSetPrincipalTagAttributeMap,

    -- * Request Lenses
    setPrincipalTagAttributeMap_principalTags,
    setPrincipalTagAttributeMap_useDefaults,
    setPrincipalTagAttributeMap_identityPoolId,
    setPrincipalTagAttributeMap_identityProviderName,

    -- * Destructuring the Response
    SetPrincipalTagAttributeMapResponse (..),
    newSetPrincipalTagAttributeMapResponse,

    -- * Response Lenses
    setPrincipalTagAttributeMapResponse_identityPoolId,
    setPrincipalTagAttributeMapResponse_identityProviderName,
    setPrincipalTagAttributeMapResponse_principalTags,
    setPrincipalTagAttributeMapResponse_useDefaults,
    setPrincipalTagAttributeMapResponse_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:/ 'newSetPrincipalTagAttributeMap' smart constructor.
data SetPrincipalTagAttributeMap = SetPrincipalTagAttributeMap'
  { -- | You can use this operation to add principal tags.
    SetPrincipalTagAttributeMap -> Maybe (HashMap Text Text)
principalTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | You can use this operation to use default (username and clientID)
    -- attribute mappings.
    SetPrincipalTagAttributeMap -> Maybe Bool
useDefaults :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Identity Pool you want to set attribute mappings for.
    SetPrincipalTagAttributeMap -> Text
identityPoolId :: Prelude.Text,
    -- | The provider name you want to use for attribute mappings.
    SetPrincipalTagAttributeMap -> Text
identityProviderName :: Prelude.Text
  }
  deriving (SetPrincipalTagAttributeMap -> SetPrincipalTagAttributeMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetPrincipalTagAttributeMap -> SetPrincipalTagAttributeMap -> Bool
$c/= :: SetPrincipalTagAttributeMap -> SetPrincipalTagAttributeMap -> Bool
== :: SetPrincipalTagAttributeMap -> SetPrincipalTagAttributeMap -> Bool
$c== :: SetPrincipalTagAttributeMap -> SetPrincipalTagAttributeMap -> Bool
Prelude.Eq, ReadPrec [SetPrincipalTagAttributeMap]
ReadPrec SetPrincipalTagAttributeMap
Int -> ReadS SetPrincipalTagAttributeMap
ReadS [SetPrincipalTagAttributeMap]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetPrincipalTagAttributeMap]
$creadListPrec :: ReadPrec [SetPrincipalTagAttributeMap]
readPrec :: ReadPrec SetPrincipalTagAttributeMap
$creadPrec :: ReadPrec SetPrincipalTagAttributeMap
readList :: ReadS [SetPrincipalTagAttributeMap]
$creadList :: ReadS [SetPrincipalTagAttributeMap]
readsPrec :: Int -> ReadS SetPrincipalTagAttributeMap
$creadsPrec :: Int -> ReadS SetPrincipalTagAttributeMap
Prelude.Read, Int -> SetPrincipalTagAttributeMap -> ShowS
[SetPrincipalTagAttributeMap] -> ShowS
SetPrincipalTagAttributeMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetPrincipalTagAttributeMap] -> ShowS
$cshowList :: [SetPrincipalTagAttributeMap] -> ShowS
show :: SetPrincipalTagAttributeMap -> String
$cshow :: SetPrincipalTagAttributeMap -> String
showsPrec :: Int -> SetPrincipalTagAttributeMap -> ShowS
$cshowsPrec :: Int -> SetPrincipalTagAttributeMap -> ShowS
Prelude.Show, forall x.
Rep SetPrincipalTagAttributeMap x -> SetPrincipalTagAttributeMap
forall x.
SetPrincipalTagAttributeMap -> Rep SetPrincipalTagAttributeMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetPrincipalTagAttributeMap x -> SetPrincipalTagAttributeMap
$cfrom :: forall x.
SetPrincipalTagAttributeMap -> Rep SetPrincipalTagAttributeMap x
Prelude.Generic)

-- |
-- Create a value of 'SetPrincipalTagAttributeMap' 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:
--
-- 'principalTags', 'setPrincipalTagAttributeMap_principalTags' - You can use this operation to add principal tags.
--
-- 'useDefaults', 'setPrincipalTagAttributeMap_useDefaults' - You can use this operation to use default (username and clientID)
-- attribute mappings.
--
-- 'identityPoolId', 'setPrincipalTagAttributeMap_identityPoolId' - The ID of the Identity Pool you want to set attribute mappings for.
--
-- 'identityProviderName', 'setPrincipalTagAttributeMap_identityProviderName' - The provider name you want to use for attribute mappings.
newSetPrincipalTagAttributeMap ::
  -- | 'identityPoolId'
  Prelude.Text ->
  -- | 'identityProviderName'
  Prelude.Text ->
  SetPrincipalTagAttributeMap
newSetPrincipalTagAttributeMap :: Text -> Text -> SetPrincipalTagAttributeMap
newSetPrincipalTagAttributeMap
  Text
pIdentityPoolId_
  Text
pIdentityProviderName_ =
    SetPrincipalTagAttributeMap'
      { $sel:principalTags:SetPrincipalTagAttributeMap' :: Maybe (HashMap Text Text)
principalTags =
          forall a. Maybe a
Prelude.Nothing,
        $sel:useDefaults:SetPrincipalTagAttributeMap' :: Maybe Bool
useDefaults = forall a. Maybe a
Prelude.Nothing,
        $sel:identityPoolId:SetPrincipalTagAttributeMap' :: Text
identityPoolId = Text
pIdentityPoolId_,
        $sel:identityProviderName:SetPrincipalTagAttributeMap' :: Text
identityProviderName = Text
pIdentityProviderName_
      }

-- | You can use this operation to add principal tags.
setPrincipalTagAttributeMap_principalTags :: Lens.Lens' SetPrincipalTagAttributeMap (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
setPrincipalTagAttributeMap_principalTags :: Lens' SetPrincipalTagAttributeMap (Maybe (HashMap Text Text))
setPrincipalTagAttributeMap_principalTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMap' {Maybe (HashMap Text Text)
principalTags :: Maybe (HashMap Text Text)
$sel:principalTags:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe (HashMap Text Text)
principalTags} -> Maybe (HashMap Text Text)
principalTags) (\s :: SetPrincipalTagAttributeMap
s@SetPrincipalTagAttributeMap' {} Maybe (HashMap Text Text)
a -> SetPrincipalTagAttributeMap
s {$sel:principalTags:SetPrincipalTagAttributeMap' :: Maybe (HashMap Text Text)
principalTags = Maybe (HashMap Text Text)
a} :: SetPrincipalTagAttributeMap) 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 use default (username and clientID)
-- attribute mappings.
setPrincipalTagAttributeMap_useDefaults :: Lens.Lens' SetPrincipalTagAttributeMap (Prelude.Maybe Prelude.Bool)
setPrincipalTagAttributeMap_useDefaults :: Lens' SetPrincipalTagAttributeMap (Maybe Bool)
setPrincipalTagAttributeMap_useDefaults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMap' {Maybe Bool
useDefaults :: Maybe Bool
$sel:useDefaults:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe Bool
useDefaults} -> Maybe Bool
useDefaults) (\s :: SetPrincipalTagAttributeMap
s@SetPrincipalTagAttributeMap' {} Maybe Bool
a -> SetPrincipalTagAttributeMap
s {$sel:useDefaults:SetPrincipalTagAttributeMap' :: Maybe Bool
useDefaults = Maybe Bool
a} :: SetPrincipalTagAttributeMap)

-- | The ID of the Identity Pool you want to set attribute mappings for.
setPrincipalTagAttributeMap_identityPoolId :: Lens.Lens' SetPrincipalTagAttributeMap Prelude.Text
setPrincipalTagAttributeMap_identityPoolId :: Lens' SetPrincipalTagAttributeMap Text
setPrincipalTagAttributeMap_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMap' {Text
identityPoolId :: Text
$sel:identityPoolId:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
identityPoolId} -> Text
identityPoolId) (\s :: SetPrincipalTagAttributeMap
s@SetPrincipalTagAttributeMap' {} Text
a -> SetPrincipalTagAttributeMap
s {$sel:identityPoolId:SetPrincipalTagAttributeMap' :: Text
identityPoolId = Text
a} :: SetPrincipalTagAttributeMap)

-- | The provider name you want to use for attribute mappings.
setPrincipalTagAttributeMap_identityProviderName :: Lens.Lens' SetPrincipalTagAttributeMap Prelude.Text
setPrincipalTagAttributeMap_identityProviderName :: Lens' SetPrincipalTagAttributeMap Text
setPrincipalTagAttributeMap_identityProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMap' {Text
identityProviderName :: Text
$sel:identityProviderName:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
identityProviderName} -> Text
identityProviderName) (\s :: SetPrincipalTagAttributeMap
s@SetPrincipalTagAttributeMap' {} Text
a -> SetPrincipalTagAttributeMap
s {$sel:identityProviderName:SetPrincipalTagAttributeMap' :: Text
identityProviderName = Text
a} :: SetPrincipalTagAttributeMap)

instance Core.AWSRequest SetPrincipalTagAttributeMap where
  type
    AWSResponse SetPrincipalTagAttributeMap =
      SetPrincipalTagAttributeMapResponse
  request :: (Service -> Service)
-> SetPrincipalTagAttributeMap
-> Request SetPrincipalTagAttributeMap
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 SetPrincipalTagAttributeMap
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetPrincipalTagAttributeMap)))
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
-> SetPrincipalTagAttributeMapResponse
SetPrincipalTagAttributeMapResponse'
            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 SetPrincipalTagAttributeMap where
  hashWithSalt :: Int -> SetPrincipalTagAttributeMap -> Int
hashWithSalt Int
_salt SetPrincipalTagAttributeMap' {Maybe Bool
Maybe (HashMap Text Text)
Text
identityProviderName :: Text
identityPoolId :: Text
useDefaults :: Maybe Bool
principalTags :: Maybe (HashMap Text Text)
$sel:identityProviderName:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
$sel:identityPoolId:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
$sel:useDefaults:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe Bool
$sel:principalTags:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
principalTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useDefaults
      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 SetPrincipalTagAttributeMap where
  rnf :: SetPrincipalTagAttributeMap -> ()
rnf SetPrincipalTagAttributeMap' {Maybe Bool
Maybe (HashMap Text Text)
Text
identityProviderName :: Text
identityPoolId :: Text
useDefaults :: Maybe Bool
principalTags :: Maybe (HashMap Text Text)
$sel:identityProviderName:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
$sel:identityPoolId:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
$sel:useDefaults:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe Bool
$sel:principalTags:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe (HashMap Text Text)
..} =
    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 Text
identityPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityProviderName

instance Data.ToHeaders SetPrincipalTagAttributeMap where
  toHeaders :: SetPrincipalTagAttributeMap -> 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.SetPrincipalTagAttributeMap" ::
                          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 SetPrincipalTagAttributeMap where
  toJSON :: SetPrincipalTagAttributeMap -> Value
toJSON SetPrincipalTagAttributeMap' {Maybe Bool
Maybe (HashMap Text Text)
Text
identityProviderName :: Text
identityPoolId :: Text
useDefaults :: Maybe Bool
principalTags :: Maybe (HashMap Text Text)
$sel:identityProviderName:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
$sel:identityPoolId:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Text
$sel:useDefaults:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe Bool
$sel:principalTags:SetPrincipalTagAttributeMap' :: SetPrincipalTagAttributeMap -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"PrincipalTags" 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 (HashMap Text Text)
principalTags,
            (Key
"UseDefaults" 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 Bool
useDefaults,
            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 SetPrincipalTagAttributeMap where
  toPath :: SetPrincipalTagAttributeMap -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newSetPrincipalTagAttributeMapResponse' smart constructor.
data SetPrincipalTagAttributeMapResponse = SetPrincipalTagAttributeMapResponse'
  { -- | The ID of the Identity Pool you want to set attribute mappings for.
    SetPrincipalTagAttributeMapResponse -> Maybe Text
identityPoolId :: Prelude.Maybe Prelude.Text,
    -- | The provider name you want to use for attribute mappings.
    SetPrincipalTagAttributeMapResponse -> 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.
    SetPrincipalTagAttributeMapResponse -> Maybe (HashMap Text Text)
principalTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | You can use this operation to select default (username and clientID)
    -- attribute mappings.
    SetPrincipalTagAttributeMapResponse -> Maybe Bool
useDefaults :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    SetPrincipalTagAttributeMapResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SetPrincipalTagAttributeMapResponse
-> SetPrincipalTagAttributeMapResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetPrincipalTagAttributeMapResponse
-> SetPrincipalTagAttributeMapResponse -> Bool
$c/= :: SetPrincipalTagAttributeMapResponse
-> SetPrincipalTagAttributeMapResponse -> Bool
== :: SetPrincipalTagAttributeMapResponse
-> SetPrincipalTagAttributeMapResponse -> Bool
$c== :: SetPrincipalTagAttributeMapResponse
-> SetPrincipalTagAttributeMapResponse -> Bool
Prelude.Eq, ReadPrec [SetPrincipalTagAttributeMapResponse]
ReadPrec SetPrincipalTagAttributeMapResponse
Int -> ReadS SetPrincipalTagAttributeMapResponse
ReadS [SetPrincipalTagAttributeMapResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetPrincipalTagAttributeMapResponse]
$creadListPrec :: ReadPrec [SetPrincipalTagAttributeMapResponse]
readPrec :: ReadPrec SetPrincipalTagAttributeMapResponse
$creadPrec :: ReadPrec SetPrincipalTagAttributeMapResponse
readList :: ReadS [SetPrincipalTagAttributeMapResponse]
$creadList :: ReadS [SetPrincipalTagAttributeMapResponse]
readsPrec :: Int -> ReadS SetPrincipalTagAttributeMapResponse
$creadsPrec :: Int -> ReadS SetPrincipalTagAttributeMapResponse
Prelude.Read, Int -> SetPrincipalTagAttributeMapResponse -> ShowS
[SetPrincipalTagAttributeMapResponse] -> ShowS
SetPrincipalTagAttributeMapResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetPrincipalTagAttributeMapResponse] -> ShowS
$cshowList :: [SetPrincipalTagAttributeMapResponse] -> ShowS
show :: SetPrincipalTagAttributeMapResponse -> String
$cshow :: SetPrincipalTagAttributeMapResponse -> String
showsPrec :: Int -> SetPrincipalTagAttributeMapResponse -> ShowS
$cshowsPrec :: Int -> SetPrincipalTagAttributeMapResponse -> ShowS
Prelude.Show, forall x.
Rep SetPrincipalTagAttributeMapResponse x
-> SetPrincipalTagAttributeMapResponse
forall x.
SetPrincipalTagAttributeMapResponse
-> Rep SetPrincipalTagAttributeMapResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetPrincipalTagAttributeMapResponse x
-> SetPrincipalTagAttributeMapResponse
$cfrom :: forall x.
SetPrincipalTagAttributeMapResponse
-> Rep SetPrincipalTagAttributeMapResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetPrincipalTagAttributeMapResponse' 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', 'setPrincipalTagAttributeMapResponse_identityPoolId' - The ID of the Identity Pool you want to set attribute mappings for.
--
-- 'identityProviderName', 'setPrincipalTagAttributeMapResponse_identityProviderName' - The provider name you want to use for attribute mappings.
--
-- 'principalTags', 'setPrincipalTagAttributeMapResponse_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', 'setPrincipalTagAttributeMapResponse_useDefaults' - You can use this operation to select default (username and clientID)
-- attribute mappings.
--
-- 'httpStatus', 'setPrincipalTagAttributeMapResponse_httpStatus' - The response's http status code.
newSetPrincipalTagAttributeMapResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SetPrincipalTagAttributeMapResponse
newSetPrincipalTagAttributeMapResponse :: Int -> SetPrincipalTagAttributeMapResponse
newSetPrincipalTagAttributeMapResponse Int
pHttpStatus_ =
  SetPrincipalTagAttributeMapResponse'
    { $sel:identityPoolId:SetPrincipalTagAttributeMapResponse' :: Maybe Text
identityPoolId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityProviderName:SetPrincipalTagAttributeMapResponse' :: Maybe Text
identityProviderName = forall a. Maybe a
Prelude.Nothing,
      $sel:principalTags:SetPrincipalTagAttributeMapResponse' :: Maybe (HashMap Text Text)
principalTags = forall a. Maybe a
Prelude.Nothing,
      $sel:useDefaults:SetPrincipalTagAttributeMapResponse' :: Maybe Bool
useDefaults = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SetPrincipalTagAttributeMapResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the Identity Pool you want to set attribute mappings for.
setPrincipalTagAttributeMapResponse_identityPoolId :: Lens.Lens' SetPrincipalTagAttributeMapResponse (Prelude.Maybe Prelude.Text)
setPrincipalTagAttributeMapResponse_identityPoolId :: Lens' SetPrincipalTagAttributeMapResponse (Maybe Text)
setPrincipalTagAttributeMapResponse_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMapResponse' {Maybe Text
identityPoolId :: Maybe Text
$sel:identityPoolId:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Maybe Text
identityPoolId} -> Maybe Text
identityPoolId) (\s :: SetPrincipalTagAttributeMapResponse
s@SetPrincipalTagAttributeMapResponse' {} Maybe Text
a -> SetPrincipalTagAttributeMapResponse
s {$sel:identityPoolId:SetPrincipalTagAttributeMapResponse' :: Maybe Text
identityPoolId = Maybe Text
a} :: SetPrincipalTagAttributeMapResponse)

-- | The provider name you want to use for attribute mappings.
setPrincipalTagAttributeMapResponse_identityProviderName :: Lens.Lens' SetPrincipalTagAttributeMapResponse (Prelude.Maybe Prelude.Text)
setPrincipalTagAttributeMapResponse_identityProviderName :: Lens' SetPrincipalTagAttributeMapResponse (Maybe Text)
setPrincipalTagAttributeMapResponse_identityProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMapResponse' {Maybe Text
identityProviderName :: Maybe Text
$sel:identityProviderName:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Maybe Text
identityProviderName} -> Maybe Text
identityProviderName) (\s :: SetPrincipalTagAttributeMapResponse
s@SetPrincipalTagAttributeMapResponse' {} Maybe Text
a -> SetPrincipalTagAttributeMapResponse
s {$sel:identityProviderName:SetPrincipalTagAttributeMapResponse' :: Maybe Text
identityProviderName = Maybe Text
a} :: SetPrincipalTagAttributeMapResponse)

-- | You can use this operation to add principal tags. The
-- @PrincipalTags@operation enables you to reference user attributes in
-- your IAM permissions policy.
setPrincipalTagAttributeMapResponse_principalTags :: Lens.Lens' SetPrincipalTagAttributeMapResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
setPrincipalTagAttributeMapResponse_principalTags :: Lens'
  SetPrincipalTagAttributeMapResponse (Maybe (HashMap Text Text))
setPrincipalTagAttributeMapResponse_principalTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMapResponse' {Maybe (HashMap Text Text)
principalTags :: Maybe (HashMap Text Text)
$sel:principalTags:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Maybe (HashMap Text Text)
principalTags} -> Maybe (HashMap Text Text)
principalTags) (\s :: SetPrincipalTagAttributeMapResponse
s@SetPrincipalTagAttributeMapResponse' {} Maybe (HashMap Text Text)
a -> SetPrincipalTagAttributeMapResponse
s {$sel:principalTags:SetPrincipalTagAttributeMapResponse' :: Maybe (HashMap Text Text)
principalTags = Maybe (HashMap Text Text)
a} :: SetPrincipalTagAttributeMapResponse) 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 select default (username and clientID)
-- attribute mappings.
setPrincipalTagAttributeMapResponse_useDefaults :: Lens.Lens' SetPrincipalTagAttributeMapResponse (Prelude.Maybe Prelude.Bool)
setPrincipalTagAttributeMapResponse_useDefaults :: Lens' SetPrincipalTagAttributeMapResponse (Maybe Bool)
setPrincipalTagAttributeMapResponse_useDefaults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPrincipalTagAttributeMapResponse' {Maybe Bool
useDefaults :: Maybe Bool
$sel:useDefaults:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Maybe Bool
useDefaults} -> Maybe Bool
useDefaults) (\s :: SetPrincipalTagAttributeMapResponse
s@SetPrincipalTagAttributeMapResponse' {} Maybe Bool
a -> SetPrincipalTagAttributeMapResponse
s {$sel:useDefaults:SetPrincipalTagAttributeMapResponse' :: Maybe Bool
useDefaults = Maybe Bool
a} :: SetPrincipalTagAttributeMapResponse)

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

instance
  Prelude.NFData
    SetPrincipalTagAttributeMapResponse
  where
  rnf :: SetPrincipalTagAttributeMapResponse -> ()
rnf SetPrincipalTagAttributeMapResponse' {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:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Int
$sel:useDefaults:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Maybe Bool
$sel:principalTags:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Maybe (HashMap Text Text)
$sel:identityProviderName:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> Maybe Text
$sel:identityPoolId:SetPrincipalTagAttributeMapResponse' :: SetPrincipalTagAttributeMapResponse -> 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