{-# 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.CreateIdentityPool
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new identity pool. The identity pool is a store of user
-- identity information that is specific to your AWS account. The keys for
-- @SupportedLoginProviders@ are as follows:
--
-- -   Facebook: @graph.facebook.com@
--
-- -   Google: @accounts.google.com@
--
-- -   Amazon: @www.amazon.com@
--
-- -   Twitter: @api.twitter.com@
--
-- -   Digits: @www.digits.com@
--
-- You must use AWS Developer credentials to call this API.
module Amazonka.CognitoIdentity.CreateIdentityPool
  ( -- * Creating a Request
    CreateIdentityPool (..),
    newCreateIdentityPool,

    -- * Request Lenses
    createIdentityPool_allowClassicFlow,
    createIdentityPool_cognitoIdentityProviders,
    createIdentityPool_developerProviderName,
    createIdentityPool_identityPoolTags,
    createIdentityPool_openIdConnectProviderARNs,
    createIdentityPool_samlProviderARNs,
    createIdentityPool_supportedLoginProviders,
    createIdentityPool_identityPoolName,
    createIdentityPool_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

-- | Input to the CreateIdentityPool action.
--
-- /See:/ 'newCreateIdentityPool' smart constructor.
data CreateIdentityPool = CreateIdentityPool'
  { -- | 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/.
    CreateIdentityPool -> Maybe Bool
allowClassicFlow :: Prelude.Maybe Prelude.Bool,
    -- | An array of Amazon Cognito user pools and their client IDs.
    CreateIdentityPool -> Maybe [CognitoIdentityProvider]
cognitoIdentityProviders :: Prelude.Maybe [CognitoIdentityProvider],
    -- | The \"domain\" by which Cognito will refer to your users. This name acts
    -- as a placeholder that allows your backend and the Cognito service to
    -- communicate about the developer provider. For the
    -- @DeveloperProviderName@, you can use letters as well as period (@.@),
    -- underscore (@_@), and dash (@-@).
    --
    -- Once you have set a developer provider name, you cannot change it.
    -- Please take care in setting this parameter.
    CreateIdentityPool -> Maybe Text
developerProviderName :: Prelude.Maybe Prelude.Text,
    -- | Tags to assign 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.
    CreateIdentityPool -> Maybe (HashMap Text Text)
identityPoolTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The Amazon Resource Names (ARN) of the OpenID Connect providers.
    CreateIdentityPool -> Maybe [Text]
openIdConnectProviderARNs :: Prelude.Maybe [Prelude.Text],
    -- | An array of Amazon Resource Names (ARNs) of the SAML provider for your
    -- identity pool.
    CreateIdentityPool -> Maybe [Text]
samlProviderARNs :: Prelude.Maybe [Prelude.Text],
    -- | Optional key:value pairs mapping provider names to provider app IDs.
    CreateIdentityPool -> Maybe (HashMap Text Text)
supportedLoginProviders :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A string that you provide.
    CreateIdentityPool -> Text
identityPoolName :: Prelude.Text,
    -- | TRUE if the identity pool supports unauthenticated logins.
    CreateIdentityPool -> Bool
allowUnauthenticatedIdentities :: Prelude.Bool
  }
  deriving (CreateIdentityPool -> CreateIdentityPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIdentityPool -> CreateIdentityPool -> Bool
$c/= :: CreateIdentityPool -> CreateIdentityPool -> Bool
== :: CreateIdentityPool -> CreateIdentityPool -> Bool
$c== :: CreateIdentityPool -> CreateIdentityPool -> Bool
Prelude.Eq, ReadPrec [CreateIdentityPool]
ReadPrec CreateIdentityPool
Int -> ReadS CreateIdentityPool
ReadS [CreateIdentityPool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIdentityPool]
$creadListPrec :: ReadPrec [CreateIdentityPool]
readPrec :: ReadPrec CreateIdentityPool
$creadPrec :: ReadPrec CreateIdentityPool
readList :: ReadS [CreateIdentityPool]
$creadList :: ReadS [CreateIdentityPool]
readsPrec :: Int -> ReadS CreateIdentityPool
$creadsPrec :: Int -> ReadS CreateIdentityPool
Prelude.Read, Int -> CreateIdentityPool -> ShowS
[CreateIdentityPool] -> ShowS
CreateIdentityPool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIdentityPool] -> ShowS
$cshowList :: [CreateIdentityPool] -> ShowS
show :: CreateIdentityPool -> String
$cshow :: CreateIdentityPool -> String
showsPrec :: Int -> CreateIdentityPool -> ShowS
$cshowsPrec :: Int -> CreateIdentityPool -> ShowS
Prelude.Show, forall x. Rep CreateIdentityPool x -> CreateIdentityPool
forall x. CreateIdentityPool -> Rep CreateIdentityPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIdentityPool x -> CreateIdentityPool
$cfrom :: forall x. CreateIdentityPool -> Rep CreateIdentityPool x
Prelude.Generic)

-- |
-- Create a value of 'CreateIdentityPool' 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', 'createIdentityPool_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', 'createIdentityPool_cognitoIdentityProviders' - An array of Amazon Cognito user pools and their client IDs.
--
-- 'developerProviderName', 'createIdentityPool_developerProviderName' - The \"domain\" by which Cognito will refer to your users. This name acts
-- as a placeholder that allows your backend and the Cognito service to
-- communicate about the developer provider. For the
-- @DeveloperProviderName@, you can use letters as well as period (@.@),
-- underscore (@_@), and dash (@-@).
--
-- Once you have set a developer provider name, you cannot change it.
-- Please take care in setting this parameter.
--
-- 'identityPoolTags', 'createIdentityPool_identityPoolTags' - Tags to assign 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', 'createIdentityPool_openIdConnectProviderARNs' - The Amazon Resource Names (ARN) of the OpenID Connect providers.
--
-- 'samlProviderARNs', 'createIdentityPool_samlProviderARNs' - An array of Amazon Resource Names (ARNs) of the SAML provider for your
-- identity pool.
--
-- 'supportedLoginProviders', 'createIdentityPool_supportedLoginProviders' - Optional key:value pairs mapping provider names to provider app IDs.
--
-- 'identityPoolName', 'createIdentityPool_identityPoolName' - A string that you provide.
--
-- 'allowUnauthenticatedIdentities', 'createIdentityPool_allowUnauthenticatedIdentities' - TRUE if the identity pool supports unauthenticated logins.
newCreateIdentityPool ::
  -- | 'identityPoolName'
  Prelude.Text ->
  -- | 'allowUnauthenticatedIdentities'
  Prelude.Bool ->
  CreateIdentityPool
newCreateIdentityPool :: Text -> Bool -> CreateIdentityPool
newCreateIdentityPool
  Text
pIdentityPoolName_
  Bool
pAllowUnauthenticatedIdentities_ =
    CreateIdentityPool'
      { $sel:allowClassicFlow:CreateIdentityPool' :: Maybe Bool
allowClassicFlow =
          forall a. Maybe a
Prelude.Nothing,
        $sel:cognitoIdentityProviders:CreateIdentityPool' :: Maybe [CognitoIdentityProvider]
cognitoIdentityProviders = forall a. Maybe a
Prelude.Nothing,
        $sel:developerProviderName:CreateIdentityPool' :: Maybe Text
developerProviderName = forall a. Maybe a
Prelude.Nothing,
        $sel:identityPoolTags:CreateIdentityPool' :: Maybe (HashMap Text Text)
identityPoolTags = forall a. Maybe a
Prelude.Nothing,
        $sel:openIdConnectProviderARNs:CreateIdentityPool' :: Maybe [Text]
openIdConnectProviderARNs = forall a. Maybe a
Prelude.Nothing,
        $sel:samlProviderARNs:CreateIdentityPool' :: Maybe [Text]
samlProviderARNs = forall a. Maybe a
Prelude.Nothing,
        $sel:supportedLoginProviders:CreateIdentityPool' :: Maybe (HashMap Text Text)
supportedLoginProviders = forall a. Maybe a
Prelude.Nothing,
        $sel:identityPoolName:CreateIdentityPool' :: Text
identityPoolName = Text
pIdentityPoolName_,
        $sel:allowUnauthenticatedIdentities:CreateIdentityPool' :: 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/.
createIdentityPool_allowClassicFlow :: Lens.Lens' CreateIdentityPool (Prelude.Maybe Prelude.Bool)
createIdentityPool_allowClassicFlow :: Lens' CreateIdentityPool (Maybe Bool)
createIdentityPool_allowClassicFlow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIdentityPool' {Maybe Bool
allowClassicFlow :: Maybe Bool
$sel:allowClassicFlow:CreateIdentityPool' :: CreateIdentityPool -> Maybe Bool
allowClassicFlow} -> Maybe Bool
allowClassicFlow) (\s :: CreateIdentityPool
s@CreateIdentityPool' {} Maybe Bool
a -> CreateIdentityPool
s {$sel:allowClassicFlow:CreateIdentityPool' :: Maybe Bool
allowClassicFlow = Maybe Bool
a} :: CreateIdentityPool)

-- | An array of Amazon Cognito user pools and their client IDs.
createIdentityPool_cognitoIdentityProviders :: Lens.Lens' CreateIdentityPool (Prelude.Maybe [CognitoIdentityProvider])
createIdentityPool_cognitoIdentityProviders :: Lens' CreateIdentityPool (Maybe [CognitoIdentityProvider])
createIdentityPool_cognitoIdentityProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIdentityPool' {Maybe [CognitoIdentityProvider]
cognitoIdentityProviders :: Maybe [CognitoIdentityProvider]
$sel:cognitoIdentityProviders:CreateIdentityPool' :: CreateIdentityPool -> Maybe [CognitoIdentityProvider]
cognitoIdentityProviders} -> Maybe [CognitoIdentityProvider]
cognitoIdentityProviders) (\s :: CreateIdentityPool
s@CreateIdentityPool' {} Maybe [CognitoIdentityProvider]
a -> CreateIdentityPool
s {$sel:cognitoIdentityProviders:CreateIdentityPool' :: Maybe [CognitoIdentityProvider]
cognitoIdentityProviders = Maybe [CognitoIdentityProvider]
a} :: CreateIdentityPool) 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. This name acts
-- as a placeholder that allows your backend and the Cognito service to
-- communicate about the developer provider. For the
-- @DeveloperProviderName@, you can use letters as well as period (@.@),
-- underscore (@_@), and dash (@-@).
--
-- Once you have set a developer provider name, you cannot change it.
-- Please take care in setting this parameter.
createIdentityPool_developerProviderName :: Lens.Lens' CreateIdentityPool (Prelude.Maybe Prelude.Text)
createIdentityPool_developerProviderName :: Lens' CreateIdentityPool (Maybe Text)
createIdentityPool_developerProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIdentityPool' {Maybe Text
developerProviderName :: Maybe Text
$sel:developerProviderName:CreateIdentityPool' :: CreateIdentityPool -> Maybe Text
developerProviderName} -> Maybe Text
developerProviderName) (\s :: CreateIdentityPool
s@CreateIdentityPool' {} Maybe Text
a -> CreateIdentityPool
s {$sel:developerProviderName:CreateIdentityPool' :: Maybe Text
developerProviderName = Maybe Text
a} :: CreateIdentityPool)

-- | Tags to assign 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.
createIdentityPool_identityPoolTags :: Lens.Lens' CreateIdentityPool (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createIdentityPool_identityPoolTags :: Lens' CreateIdentityPool (Maybe (HashMap Text Text))
createIdentityPool_identityPoolTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIdentityPool' {Maybe (HashMap Text Text)
identityPoolTags :: Maybe (HashMap Text Text)
$sel:identityPoolTags:CreateIdentityPool' :: CreateIdentityPool -> Maybe (HashMap Text Text)
identityPoolTags} -> Maybe (HashMap Text Text)
identityPoolTags) (\s :: CreateIdentityPool
s@CreateIdentityPool' {} Maybe (HashMap Text Text)
a -> CreateIdentityPool
s {$sel:identityPoolTags:CreateIdentityPool' :: Maybe (HashMap Text Text)
identityPoolTags = Maybe (HashMap Text Text)
a} :: CreateIdentityPool) 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 Amazon Resource Names (ARN) of the OpenID Connect providers.
createIdentityPool_openIdConnectProviderARNs :: Lens.Lens' CreateIdentityPool (Prelude.Maybe [Prelude.Text])
createIdentityPool_openIdConnectProviderARNs :: Lens' CreateIdentityPool (Maybe [Text])
createIdentityPool_openIdConnectProviderARNs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIdentityPool' {Maybe [Text]
openIdConnectProviderARNs :: Maybe [Text]
$sel:openIdConnectProviderARNs:CreateIdentityPool' :: CreateIdentityPool -> Maybe [Text]
openIdConnectProviderARNs} -> Maybe [Text]
openIdConnectProviderARNs) (\s :: CreateIdentityPool
s@CreateIdentityPool' {} Maybe [Text]
a -> CreateIdentityPool
s {$sel:openIdConnectProviderARNs:CreateIdentityPool' :: Maybe [Text]
openIdConnectProviderARNs = Maybe [Text]
a} :: CreateIdentityPool) 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.
createIdentityPool_samlProviderARNs :: Lens.Lens' CreateIdentityPool (Prelude.Maybe [Prelude.Text])
createIdentityPool_samlProviderARNs :: Lens' CreateIdentityPool (Maybe [Text])
createIdentityPool_samlProviderARNs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIdentityPool' {Maybe [Text]
samlProviderARNs :: Maybe [Text]
$sel:samlProviderARNs:CreateIdentityPool' :: CreateIdentityPool -> Maybe [Text]
samlProviderARNs} -> Maybe [Text]
samlProviderARNs) (\s :: CreateIdentityPool
s@CreateIdentityPool' {} Maybe [Text]
a -> CreateIdentityPool
s {$sel:samlProviderARNs:CreateIdentityPool' :: Maybe [Text]
samlProviderARNs = Maybe [Text]
a} :: CreateIdentityPool) 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.
createIdentityPool_supportedLoginProviders :: Lens.Lens' CreateIdentityPool (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createIdentityPool_supportedLoginProviders :: Lens' CreateIdentityPool (Maybe (HashMap Text Text))
createIdentityPool_supportedLoginProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIdentityPool' {Maybe (HashMap Text Text)
supportedLoginProviders :: Maybe (HashMap Text Text)
$sel:supportedLoginProviders:CreateIdentityPool' :: CreateIdentityPool -> Maybe (HashMap Text Text)
supportedLoginProviders} -> Maybe (HashMap Text Text)
supportedLoginProviders) (\s :: CreateIdentityPool
s@CreateIdentityPool' {} Maybe (HashMap Text Text)
a -> CreateIdentityPool
s {$sel:supportedLoginProviders:CreateIdentityPool' :: Maybe (HashMap Text Text)
supportedLoginProviders = Maybe (HashMap Text Text)
a} :: CreateIdentityPool) 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

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

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

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

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

instance Data.ToHeaders CreateIdentityPool where
  toHeaders :: CreateIdentityPool -> 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.CreateIdentityPool" ::
                          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 CreateIdentityPool where
  toJSON :: CreateIdentityPool -> Value
toJSON CreateIdentityPool' {Bool
Maybe Bool
Maybe [Text]
Maybe [CognitoIdentityProvider]
Maybe Text
Maybe (HashMap Text Text)
Text
allowUnauthenticatedIdentities :: Bool
identityPoolName :: 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:CreateIdentityPool' :: CreateIdentityPool -> Bool
$sel:identityPoolName:CreateIdentityPool' :: CreateIdentityPool -> Text
$sel:supportedLoginProviders:CreateIdentityPool' :: CreateIdentityPool -> Maybe (HashMap Text Text)
$sel:samlProviderARNs:CreateIdentityPool' :: CreateIdentityPool -> Maybe [Text]
$sel:openIdConnectProviderARNs:CreateIdentityPool' :: CreateIdentityPool -> Maybe [Text]
$sel:identityPoolTags:CreateIdentityPool' :: CreateIdentityPool -> Maybe (HashMap Text Text)
$sel:developerProviderName:CreateIdentityPool' :: CreateIdentityPool -> Maybe Text
$sel:cognitoIdentityProviders:CreateIdentityPool' :: CreateIdentityPool -> Maybe [CognitoIdentityProvider]
$sel:allowClassicFlow:CreateIdentityPool' :: CreateIdentityPool -> 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
"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 CreateIdentityPool where
  toPath :: CreateIdentityPool -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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