{-# 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.UpdateIdentityPool
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an identity pool.
--
-- You must use AWS Developer credentials to call this API.
module Amazonka.CognitoIdentity.UpdateIdentityPool
  ( -- * Creating a Request
    UpdateIdentityPool (..),
    newUpdateIdentityPool,

    -- * Request Lenses
    updateIdentityPool_allowClassicFlow,
    updateIdentityPool_cognitoIdentityProviders,
    updateIdentityPool_developerProviderName,
    updateIdentityPool_identityPoolTags,
    updateIdentityPool_openIdConnectProviderARNs,
    updateIdentityPool_samlProviderARNs,
    updateIdentityPool_supportedLoginProviders,
    updateIdentityPool_identityPoolId,
    updateIdentityPool_identityPoolName,
    updateIdentityPool_allowUnauthenticatedIdentities,

    -- * Destructuring the Response
    IdentityPool (..),
    newIdentityPool,

    -- * Response Lenses
    identityPool_allowClassicFlow,
    identityPool_cognitoIdentityProviders,
    identityPool_developerProviderName,
    identityPool_identityPoolTags,
    identityPool_openIdConnectProviderARNs,
    identityPool_samlProviderARNs,
    identityPool_supportedLoginProviders,
    identityPool_identityPoolId,
    identityPool_identityPoolName,
    identityPool_allowUnauthenticatedIdentities,
  )
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

-- | An object representing an Amazon Cognito identity pool.
--
-- /See:/ 'newUpdateIdentityPool' smart constructor.
data UpdateIdentityPool = UpdateIdentityPool'
  { -- | Enables or disables the Basic (Classic) authentication flow. For more
    -- information, see
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/authentication-flow.html Identity Pools (Federated Identities) Authentication Flow>
    -- in the /Amazon Cognito Developer Guide/.
    UpdateIdentityPool -> Maybe Bool
allowClassicFlow :: Prelude.Maybe Prelude.Bool,
    -- | A list representing an Amazon Cognito user pool and its client ID.
    UpdateIdentityPool -> Maybe [CognitoIdentityProvider]
cognitoIdentityProviders :: Prelude.Maybe [CognitoIdentityProvider],
    -- | The \"domain\" by which Cognito will refer to your users.
    UpdateIdentityPool -> Maybe Text
developerProviderName :: Prelude.Maybe Prelude.Text,
    -- | The tags that are assigned to the identity pool. A tag is a label that
    -- you can apply to identity pools to categorize and manage them in
    -- different ways, such as by purpose, owner, environment, or other
    -- criteria.
    UpdateIdentityPool -> Maybe (HashMap Text Text)
identityPoolTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ARNs of the OpenID Connect providers.
    UpdateIdentityPool -> Maybe [Text]
openIdConnectProviderARNs :: Prelude.Maybe [Prelude.Text],
    -- | An array of Amazon Resource Names (ARNs) of the SAML provider for your
    -- identity pool.
    UpdateIdentityPool -> Maybe [Text]
samlProviderARNs :: Prelude.Maybe [Prelude.Text],
    -- | Optional key:value pairs mapping provider names to provider app IDs.
    UpdateIdentityPool -> Maybe (HashMap Text Text)
supportedLoginProviders :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | An identity pool ID in the format REGION:GUID.
    UpdateIdentityPool -> Text
identityPoolId :: Prelude.Text,
    -- | A string that you provide.
    UpdateIdentityPool -> Text
identityPoolName :: Prelude.Text,
    -- | TRUE if the identity pool supports unauthenticated logins.
    UpdateIdentityPool -> Bool
allowUnauthenticatedIdentities :: Prelude.Bool
  }
  deriving (UpdateIdentityPool -> UpdateIdentityPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIdentityPool -> UpdateIdentityPool -> Bool
$c/= :: UpdateIdentityPool -> UpdateIdentityPool -> Bool
== :: UpdateIdentityPool -> UpdateIdentityPool -> Bool
$c== :: UpdateIdentityPool -> UpdateIdentityPool -> Bool
Prelude.Eq, ReadPrec [UpdateIdentityPool]
ReadPrec UpdateIdentityPool
Int -> ReadS UpdateIdentityPool
ReadS [UpdateIdentityPool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateIdentityPool]
$creadListPrec :: ReadPrec [UpdateIdentityPool]
readPrec :: ReadPrec UpdateIdentityPool
$creadPrec :: ReadPrec UpdateIdentityPool
readList :: ReadS [UpdateIdentityPool]
$creadList :: ReadS [UpdateIdentityPool]
readsPrec :: Int -> ReadS UpdateIdentityPool
$creadsPrec :: Int -> ReadS UpdateIdentityPool
Prelude.Read, Int -> UpdateIdentityPool -> ShowS
[UpdateIdentityPool] -> ShowS
UpdateIdentityPool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIdentityPool] -> ShowS
$cshowList :: [UpdateIdentityPool] -> ShowS
show :: UpdateIdentityPool -> String
$cshow :: UpdateIdentityPool -> String
showsPrec :: Int -> UpdateIdentityPool -> ShowS
$cshowsPrec :: Int -> UpdateIdentityPool -> ShowS
Prelude.Show, forall x. Rep UpdateIdentityPool x -> UpdateIdentityPool
forall x. UpdateIdentityPool -> Rep UpdateIdentityPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateIdentityPool x -> UpdateIdentityPool
$cfrom :: forall x. UpdateIdentityPool -> Rep UpdateIdentityPool x
Prelude.Generic)

-- |
-- Create a value of 'UpdateIdentityPool' 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:
--
-- 'allowClassicFlow', 'updateIdentityPool_allowClassicFlow' - Enables or disables the Basic (Classic) authentication flow. For more
-- information, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/authentication-flow.html Identity Pools (Federated Identities) Authentication Flow>
-- in the /Amazon Cognito Developer Guide/.
--
-- 'cognitoIdentityProviders', 'updateIdentityPool_cognitoIdentityProviders' - A list representing an Amazon Cognito user pool and its client ID.
--
-- 'developerProviderName', 'updateIdentityPool_developerProviderName' - The \"domain\" by which Cognito will refer to your users.
--
-- 'identityPoolTags', 'updateIdentityPool_identityPoolTags' - The tags that are assigned to the identity pool. A tag is a label that
-- you can apply to identity pools to categorize and manage them in
-- different ways, such as by purpose, owner, environment, or other
-- criteria.
--
-- 'openIdConnectProviderARNs', 'updateIdentityPool_openIdConnectProviderARNs' - The ARNs of the OpenID Connect providers.
--
-- 'samlProviderARNs', 'updateIdentityPool_samlProviderARNs' - An array of Amazon Resource Names (ARNs) of the SAML provider for your
-- identity pool.
--
-- 'supportedLoginProviders', 'updateIdentityPool_supportedLoginProviders' - Optional key:value pairs mapping provider names to provider app IDs.
--
-- 'identityPoolId', 'updateIdentityPool_identityPoolId' - An identity pool ID in the format REGION:GUID.
--
-- 'identityPoolName', 'updateIdentityPool_identityPoolName' - A string that you provide.
--
-- 'allowUnauthenticatedIdentities', 'updateIdentityPool_allowUnauthenticatedIdentities' - TRUE if the identity pool supports unauthenticated logins.
newUpdateIdentityPool ::
  -- | 'identityPoolId'
  Prelude.Text ->
  -- | 'identityPoolName'
  Prelude.Text ->
  -- | 'allowUnauthenticatedIdentities'
  Prelude.Bool ->
  UpdateIdentityPool
newUpdateIdentityPool :: Text -> Text -> Bool -> UpdateIdentityPool
newUpdateIdentityPool
  Text
pIdentityPoolId_
  Text
pIdentityPoolName_
  Bool
pAllowUnauthenticatedIdentities_ =
    UpdateIdentityPool'
      { $sel:allowClassicFlow:UpdateIdentityPool' :: Maybe Bool
allowClassicFlow =
          forall a. Maybe a
Prelude.Nothing,
        $sel:cognitoIdentityProviders:UpdateIdentityPool' :: Maybe [CognitoIdentityProvider]
cognitoIdentityProviders = forall a. Maybe a
Prelude.Nothing,
        $sel:developerProviderName:UpdateIdentityPool' :: Maybe Text
developerProviderName = forall a. Maybe a
Prelude.Nothing,
        $sel:identityPoolTags:UpdateIdentityPool' :: Maybe (HashMap Text Text)
identityPoolTags = forall a. Maybe a
Prelude.Nothing,
        $sel:openIdConnectProviderARNs:UpdateIdentityPool' :: Maybe [Text]
openIdConnectProviderARNs = forall a. Maybe a
Prelude.Nothing,
        $sel:samlProviderARNs:UpdateIdentityPool' :: Maybe [Text]
samlProviderARNs = forall a. Maybe a
Prelude.Nothing,
        $sel:supportedLoginProviders:UpdateIdentityPool' :: Maybe (HashMap Text Text)
supportedLoginProviders = forall a. Maybe a
Prelude.Nothing,
        $sel:identityPoolId:UpdateIdentityPool' :: Text
identityPoolId = Text
pIdentityPoolId_,
        $sel:identityPoolName:UpdateIdentityPool' :: Text
identityPoolName = Text
pIdentityPoolName_,
        $sel:allowUnauthenticatedIdentities:UpdateIdentityPool' :: Bool
allowUnauthenticatedIdentities =
          Bool
pAllowUnauthenticatedIdentities_
      }

-- | Enables or disables the Basic (Classic) authentication flow. For more
-- information, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/authentication-flow.html Identity Pools (Federated Identities) Authentication Flow>
-- in the /Amazon Cognito Developer Guide/.
updateIdentityPool_allowClassicFlow :: Lens.Lens' UpdateIdentityPool (Prelude.Maybe Prelude.Bool)
updateIdentityPool_allowClassicFlow :: Lens' UpdateIdentityPool (Maybe Bool)
updateIdentityPool_allowClassicFlow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Maybe Bool
allowClassicFlow :: Maybe Bool
$sel:allowClassicFlow:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Bool
allowClassicFlow} -> Maybe Bool
allowClassicFlow) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Maybe Bool
a -> UpdateIdentityPool
s {$sel:allowClassicFlow:UpdateIdentityPool' :: Maybe Bool
allowClassicFlow = Maybe Bool
a} :: UpdateIdentityPool)

-- | A list representing an Amazon Cognito user pool and its client ID.
updateIdentityPool_cognitoIdentityProviders :: Lens.Lens' UpdateIdentityPool (Prelude.Maybe [CognitoIdentityProvider])
updateIdentityPool_cognitoIdentityProviders :: Lens' UpdateIdentityPool (Maybe [CognitoIdentityProvider])
updateIdentityPool_cognitoIdentityProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Maybe [CognitoIdentityProvider]
cognitoIdentityProviders :: Maybe [CognitoIdentityProvider]
$sel:cognitoIdentityProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [CognitoIdentityProvider]
cognitoIdentityProviders} -> Maybe [CognitoIdentityProvider]
cognitoIdentityProviders) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Maybe [CognitoIdentityProvider]
a -> UpdateIdentityPool
s {$sel:cognitoIdentityProviders:UpdateIdentityPool' :: Maybe [CognitoIdentityProvider]
cognitoIdentityProviders = Maybe [CognitoIdentityProvider]
a} :: UpdateIdentityPool) 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 \"domain\" by which Cognito will refer to your users.
updateIdentityPool_developerProviderName :: Lens.Lens' UpdateIdentityPool (Prelude.Maybe Prelude.Text)
updateIdentityPool_developerProviderName :: Lens' UpdateIdentityPool (Maybe Text)
updateIdentityPool_developerProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Maybe Text
developerProviderName :: Maybe Text
$sel:developerProviderName:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Text
developerProviderName} -> Maybe Text
developerProviderName) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Maybe Text
a -> UpdateIdentityPool
s {$sel:developerProviderName:UpdateIdentityPool' :: Maybe Text
developerProviderName = Maybe Text
a} :: UpdateIdentityPool)

-- | The tags that are assigned to the identity pool. A tag is a label that
-- you can apply to identity pools to categorize and manage them in
-- different ways, such as by purpose, owner, environment, or other
-- criteria.
updateIdentityPool_identityPoolTags :: Lens.Lens' UpdateIdentityPool (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateIdentityPool_identityPoolTags :: Lens' UpdateIdentityPool (Maybe (HashMap Text Text))
updateIdentityPool_identityPoolTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Maybe (HashMap Text Text)
identityPoolTags :: Maybe (HashMap Text Text)
$sel:identityPoolTags:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
identityPoolTags} -> Maybe (HashMap Text Text)
identityPoolTags) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Maybe (HashMap Text Text)
a -> UpdateIdentityPool
s {$sel:identityPoolTags:UpdateIdentityPool' :: Maybe (HashMap Text Text)
identityPoolTags = Maybe (HashMap Text Text)
a} :: UpdateIdentityPool) 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 ARNs of the OpenID Connect providers.
updateIdentityPool_openIdConnectProviderARNs :: Lens.Lens' UpdateIdentityPool (Prelude.Maybe [Prelude.Text])
updateIdentityPool_openIdConnectProviderARNs :: Lens' UpdateIdentityPool (Maybe [Text])
updateIdentityPool_openIdConnectProviderARNs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Maybe [Text]
openIdConnectProviderARNs :: Maybe [Text]
$sel:openIdConnectProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
openIdConnectProviderARNs} -> Maybe [Text]
openIdConnectProviderARNs) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Maybe [Text]
a -> UpdateIdentityPool
s {$sel:openIdConnectProviderARNs:UpdateIdentityPool' :: Maybe [Text]
openIdConnectProviderARNs = Maybe [Text]
a} :: UpdateIdentityPool) 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

-- | An array of Amazon Resource Names (ARNs) of the SAML provider for your
-- identity pool.
updateIdentityPool_samlProviderARNs :: Lens.Lens' UpdateIdentityPool (Prelude.Maybe [Prelude.Text])
updateIdentityPool_samlProviderARNs :: Lens' UpdateIdentityPool (Maybe [Text])
updateIdentityPool_samlProviderARNs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Maybe [Text]
samlProviderARNs :: Maybe [Text]
$sel:samlProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
samlProviderARNs} -> Maybe [Text]
samlProviderARNs) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Maybe [Text]
a -> UpdateIdentityPool
s {$sel:samlProviderARNs:UpdateIdentityPool' :: Maybe [Text]
samlProviderARNs = Maybe [Text]
a} :: UpdateIdentityPool) 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

-- | Optional key:value pairs mapping provider names to provider app IDs.
updateIdentityPool_supportedLoginProviders :: Lens.Lens' UpdateIdentityPool (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateIdentityPool_supportedLoginProviders :: Lens' UpdateIdentityPool (Maybe (HashMap Text Text))
updateIdentityPool_supportedLoginProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Maybe (HashMap Text Text)
supportedLoginProviders :: Maybe (HashMap Text Text)
$sel:supportedLoginProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
supportedLoginProviders} -> Maybe (HashMap Text Text)
supportedLoginProviders) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Maybe (HashMap Text Text)
a -> UpdateIdentityPool
s {$sel:supportedLoginProviders:UpdateIdentityPool' :: Maybe (HashMap Text Text)
supportedLoginProviders = Maybe (HashMap Text Text)
a} :: UpdateIdentityPool) 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

-- | An identity pool ID in the format REGION:GUID.
updateIdentityPool_identityPoolId :: Lens.Lens' UpdateIdentityPool Prelude.Text
updateIdentityPool_identityPoolId :: Lens' UpdateIdentityPool Text
updateIdentityPool_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Text
identityPoolId :: Text
$sel:identityPoolId:UpdateIdentityPool' :: UpdateIdentityPool -> Text
identityPoolId} -> Text
identityPoolId) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Text
a -> UpdateIdentityPool
s {$sel:identityPoolId:UpdateIdentityPool' :: Text
identityPoolId = Text
a} :: UpdateIdentityPool)

-- | A string that you provide.
updateIdentityPool_identityPoolName :: Lens.Lens' UpdateIdentityPool Prelude.Text
updateIdentityPool_identityPoolName :: Lens' UpdateIdentityPool Text
updateIdentityPool_identityPoolName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Text
identityPoolName :: Text
$sel:identityPoolName:UpdateIdentityPool' :: UpdateIdentityPool -> Text
identityPoolName} -> Text
identityPoolName) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Text
a -> UpdateIdentityPool
s {$sel:identityPoolName:UpdateIdentityPool' :: Text
identityPoolName = Text
a} :: UpdateIdentityPool)

-- | TRUE if the identity pool supports unauthenticated logins.
updateIdentityPool_allowUnauthenticatedIdentities :: Lens.Lens' UpdateIdentityPool Prelude.Bool
updateIdentityPool_allowUnauthenticatedIdentities :: Lens' UpdateIdentityPool Bool
updateIdentityPool_allowUnauthenticatedIdentities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIdentityPool' {Bool
allowUnauthenticatedIdentities :: Bool
$sel:allowUnauthenticatedIdentities:UpdateIdentityPool' :: UpdateIdentityPool -> Bool
allowUnauthenticatedIdentities} -> Bool
allowUnauthenticatedIdentities) (\s :: UpdateIdentityPool
s@UpdateIdentityPool' {} Bool
a -> UpdateIdentityPool
s {$sel:allowUnauthenticatedIdentities:UpdateIdentityPool' :: Bool
allowUnauthenticatedIdentities = Bool
a} :: UpdateIdentityPool)

instance Core.AWSRequest UpdateIdentityPool where
  type AWSResponse UpdateIdentityPool = IdentityPool
  request :: (Service -> Service)
-> UpdateIdentityPool -> Request UpdateIdentityPool
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 UpdateIdentityPool
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateIdentityPool)))
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 UpdateIdentityPool where
  hashWithSalt :: Int -> UpdateIdentityPool -> Int
hashWithSalt Int
_salt UpdateIdentityPool' {Bool
Maybe Bool
Maybe [Text]
Maybe [CognitoIdentityProvider]
Maybe Text
Maybe (HashMap Text Text)
Text
allowUnauthenticatedIdentities :: Bool
identityPoolName :: Text
identityPoolId :: Text
supportedLoginProviders :: Maybe (HashMap Text Text)
samlProviderARNs :: Maybe [Text]
openIdConnectProviderARNs :: Maybe [Text]
identityPoolTags :: Maybe (HashMap Text Text)
developerProviderName :: Maybe Text
cognitoIdentityProviders :: Maybe [CognitoIdentityProvider]
allowClassicFlow :: Maybe Bool
$sel:allowUnauthenticatedIdentities:UpdateIdentityPool' :: UpdateIdentityPool -> Bool
$sel:identityPoolName:UpdateIdentityPool' :: UpdateIdentityPool -> Text
$sel:identityPoolId:UpdateIdentityPool' :: UpdateIdentityPool -> Text
$sel:supportedLoginProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
$sel:samlProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
$sel:openIdConnectProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
$sel:identityPoolTags:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
$sel:developerProviderName:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Text
$sel:cognitoIdentityProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [CognitoIdentityProvider]
$sel:allowClassicFlow:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowClassicFlow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CognitoIdentityProvider]
cognitoIdentityProviders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
developerProviderName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
identityPoolTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
openIdConnectProviderARNs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
samlProviderARNs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
supportedLoginProviders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
allowUnauthenticatedIdentities

instance Prelude.NFData UpdateIdentityPool where
  rnf :: UpdateIdentityPool -> ()
rnf UpdateIdentityPool' {Bool
Maybe Bool
Maybe [Text]
Maybe [CognitoIdentityProvider]
Maybe Text
Maybe (HashMap Text Text)
Text
allowUnauthenticatedIdentities :: Bool
identityPoolName :: Text
identityPoolId :: Text
supportedLoginProviders :: Maybe (HashMap Text Text)
samlProviderARNs :: Maybe [Text]
openIdConnectProviderARNs :: Maybe [Text]
identityPoolTags :: Maybe (HashMap Text Text)
developerProviderName :: Maybe Text
cognitoIdentityProviders :: Maybe [CognitoIdentityProvider]
allowClassicFlow :: Maybe Bool
$sel:allowUnauthenticatedIdentities:UpdateIdentityPool' :: UpdateIdentityPool -> Bool
$sel:identityPoolName:UpdateIdentityPool' :: UpdateIdentityPool -> Text
$sel:identityPoolId:UpdateIdentityPool' :: UpdateIdentityPool -> Text
$sel:supportedLoginProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
$sel:samlProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
$sel:openIdConnectProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
$sel:identityPoolTags:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
$sel:developerProviderName:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Text
$sel:cognitoIdentityProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [CognitoIdentityProvider]
$sel:allowClassicFlow:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowClassicFlow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CognitoIdentityProvider]
cognitoIdentityProviders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
developerProviderName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
identityPoolTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
openIdConnectProviderARNs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
samlProviderARNs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
supportedLoginProviders
      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
identityPoolName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
allowUnauthenticatedIdentities

instance Data.ToHeaders UpdateIdentityPool where
  toHeaders :: UpdateIdentityPool -> 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.UpdateIdentityPool" ::
                          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 UpdateIdentityPool where
  toJSON :: UpdateIdentityPool -> Value
toJSON UpdateIdentityPool' {Bool
Maybe Bool
Maybe [Text]
Maybe [CognitoIdentityProvider]
Maybe Text
Maybe (HashMap Text Text)
Text
allowUnauthenticatedIdentities :: Bool
identityPoolName :: Text
identityPoolId :: Text
supportedLoginProviders :: Maybe (HashMap Text Text)
samlProviderARNs :: Maybe [Text]
openIdConnectProviderARNs :: Maybe [Text]
identityPoolTags :: Maybe (HashMap Text Text)
developerProviderName :: Maybe Text
cognitoIdentityProviders :: Maybe [CognitoIdentityProvider]
allowClassicFlow :: Maybe Bool
$sel:allowUnauthenticatedIdentities:UpdateIdentityPool' :: UpdateIdentityPool -> Bool
$sel:identityPoolName:UpdateIdentityPool' :: UpdateIdentityPool -> Text
$sel:identityPoolId:UpdateIdentityPool' :: UpdateIdentityPool -> Text
$sel:supportedLoginProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
$sel:samlProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
$sel:openIdConnectProviderARNs:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [Text]
$sel:identityPoolTags:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe (HashMap Text Text)
$sel:developerProviderName:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Text
$sel:cognitoIdentityProviders:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe [CognitoIdentityProvider]
$sel:allowClassicFlow:UpdateIdentityPool' :: UpdateIdentityPool -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllowClassicFlow" 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
allowClassicFlow,
            (Key
"CognitoIdentityProviders" 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 [CognitoIdentityProvider]
cognitoIdentityProviders,
            (Key
"DeveloperProviderName" 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
developerProviderName,
            (Key
"IdentityPoolTags" 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)
identityPoolTags,
            (Key
"OpenIdConnectProviderARNs" 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]
openIdConnectProviderARNs,
            (Key
"SamlProviderARNs" 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]
samlProviderARNs,
            (Key
"SupportedLoginProviders" 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)
supportedLoginProviders,
            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
"IdentityPoolName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityPoolName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"AllowUnauthenticatedIdentities"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
allowUnauthenticatedIdentities
              )
          ]
      )

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

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