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

    -- * Request Lenses
    getIdentityPoolRoles_identityPoolId,

    -- * Destructuring the Response
    GetIdentityPoolRolesResponse (..),
    newGetIdentityPoolRolesResponse,

    -- * Response Lenses
    getIdentityPoolRolesResponse_identityPoolId,
    getIdentityPoolRolesResponse_roleMappings,
    getIdentityPoolRolesResponse_roles,
    getIdentityPoolRolesResponse_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

-- | Input to the @GetIdentityPoolRoles@ action.
--
-- /See:/ 'newGetIdentityPoolRoles' smart constructor.
data GetIdentityPoolRoles = GetIdentityPoolRoles'
  { -- | An identity pool ID in the format REGION:GUID.
    GetIdentityPoolRoles -> Text
identityPoolId :: Prelude.Text
  }
  deriving (GetIdentityPoolRoles -> GetIdentityPoolRoles -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIdentityPoolRoles -> GetIdentityPoolRoles -> Bool
$c/= :: GetIdentityPoolRoles -> GetIdentityPoolRoles -> Bool
== :: GetIdentityPoolRoles -> GetIdentityPoolRoles -> Bool
$c== :: GetIdentityPoolRoles -> GetIdentityPoolRoles -> Bool
Prelude.Eq, ReadPrec [GetIdentityPoolRoles]
ReadPrec GetIdentityPoolRoles
Int -> ReadS GetIdentityPoolRoles
ReadS [GetIdentityPoolRoles]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIdentityPoolRoles]
$creadListPrec :: ReadPrec [GetIdentityPoolRoles]
readPrec :: ReadPrec GetIdentityPoolRoles
$creadPrec :: ReadPrec GetIdentityPoolRoles
readList :: ReadS [GetIdentityPoolRoles]
$creadList :: ReadS [GetIdentityPoolRoles]
readsPrec :: Int -> ReadS GetIdentityPoolRoles
$creadsPrec :: Int -> ReadS GetIdentityPoolRoles
Prelude.Read, Int -> GetIdentityPoolRoles -> ShowS
[GetIdentityPoolRoles] -> ShowS
GetIdentityPoolRoles -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIdentityPoolRoles] -> ShowS
$cshowList :: [GetIdentityPoolRoles] -> ShowS
show :: GetIdentityPoolRoles -> String
$cshow :: GetIdentityPoolRoles -> String
showsPrec :: Int -> GetIdentityPoolRoles -> ShowS
$cshowsPrec :: Int -> GetIdentityPoolRoles -> ShowS
Prelude.Show, forall x. Rep GetIdentityPoolRoles x -> GetIdentityPoolRoles
forall x. GetIdentityPoolRoles -> Rep GetIdentityPoolRoles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetIdentityPoolRoles x -> GetIdentityPoolRoles
$cfrom :: forall x. GetIdentityPoolRoles -> Rep GetIdentityPoolRoles x
Prelude.Generic)

-- |
-- Create a value of 'GetIdentityPoolRoles' 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', 'getIdentityPoolRoles_identityPoolId' - An identity pool ID in the format REGION:GUID.
newGetIdentityPoolRoles ::
  -- | 'identityPoolId'
  Prelude.Text ->
  GetIdentityPoolRoles
newGetIdentityPoolRoles :: Text -> GetIdentityPoolRoles
newGetIdentityPoolRoles Text
pIdentityPoolId_ =
  GetIdentityPoolRoles'
    { $sel:identityPoolId:GetIdentityPoolRoles' :: Text
identityPoolId =
        Text
pIdentityPoolId_
    }

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

instance Core.AWSRequest GetIdentityPoolRoles where
  type
    AWSResponse GetIdentityPoolRoles =
      GetIdentityPoolRolesResponse
  request :: (Service -> Service)
-> GetIdentityPoolRoles -> Request GetIdentityPoolRoles
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 GetIdentityPoolRoles
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetIdentityPoolRoles)))
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 (HashMap Text RoleMapping)
-> Maybe (HashMap Text Text)
-> Int
-> GetIdentityPoolRolesResponse
GetIdentityPoolRolesResponse'
            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
"RoleMappings" 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
"Roles" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

instance Prelude.NFData GetIdentityPoolRoles where
  rnf :: GetIdentityPoolRoles -> ()
rnf GetIdentityPoolRoles' {Text
identityPoolId :: Text
$sel:identityPoolId:GetIdentityPoolRoles' :: GetIdentityPoolRoles -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identityPoolId

instance Data.ToHeaders GetIdentityPoolRoles where
  toHeaders :: GetIdentityPoolRoles -> 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.GetIdentityPoolRoles" ::
                          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 GetIdentityPoolRoles where
  toJSON :: GetIdentityPoolRoles -> Value
toJSON GetIdentityPoolRoles' {Text
identityPoolId :: Text
$sel:identityPoolId:GetIdentityPoolRoles' :: GetIdentityPoolRoles -> 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)
          ]
      )

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

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

-- | Returned in response to a successful @GetIdentityPoolRoles@ operation.
--
-- /See:/ 'newGetIdentityPoolRolesResponse' smart constructor.
data GetIdentityPoolRolesResponse = GetIdentityPoolRolesResponse'
  { -- | An identity pool ID in the format REGION:GUID.
    GetIdentityPoolRolesResponse -> Maybe Text
identityPoolId :: Prelude.Maybe Prelude.Text,
    -- | How users for a specific identity provider are to mapped to roles. This
    -- is a String-to-RoleMapping object map. The string identifies the
    -- identity provider, for example, \"graph.facebook.com\" or
    -- \"cognito-idp.us-east-1.amazonaws.com\/us-east-1_abcdefghi:app_client_id\".
    GetIdentityPoolRolesResponse -> Maybe (HashMap Text RoleMapping)
roleMappings :: Prelude.Maybe (Prelude.HashMap Prelude.Text RoleMapping),
    -- | The map of roles associated with this pool. Currently only authenticated
    -- and unauthenticated roles are supported.
    GetIdentityPoolRolesResponse -> Maybe (HashMap Text Text)
roles :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetIdentityPoolRolesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetIdentityPoolRolesResponse
-> GetIdentityPoolRolesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIdentityPoolRolesResponse
-> GetIdentityPoolRolesResponse -> Bool
$c/= :: GetIdentityPoolRolesResponse
-> GetIdentityPoolRolesResponse -> Bool
== :: GetIdentityPoolRolesResponse
-> GetIdentityPoolRolesResponse -> Bool
$c== :: GetIdentityPoolRolesResponse
-> GetIdentityPoolRolesResponse -> Bool
Prelude.Eq, ReadPrec [GetIdentityPoolRolesResponse]
ReadPrec GetIdentityPoolRolesResponse
Int -> ReadS GetIdentityPoolRolesResponse
ReadS [GetIdentityPoolRolesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIdentityPoolRolesResponse]
$creadListPrec :: ReadPrec [GetIdentityPoolRolesResponse]
readPrec :: ReadPrec GetIdentityPoolRolesResponse
$creadPrec :: ReadPrec GetIdentityPoolRolesResponse
readList :: ReadS [GetIdentityPoolRolesResponse]
$creadList :: ReadS [GetIdentityPoolRolesResponse]
readsPrec :: Int -> ReadS GetIdentityPoolRolesResponse
$creadsPrec :: Int -> ReadS GetIdentityPoolRolesResponse
Prelude.Read, Int -> GetIdentityPoolRolesResponse -> ShowS
[GetIdentityPoolRolesResponse] -> ShowS
GetIdentityPoolRolesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIdentityPoolRolesResponse] -> ShowS
$cshowList :: [GetIdentityPoolRolesResponse] -> ShowS
show :: GetIdentityPoolRolesResponse -> String
$cshow :: GetIdentityPoolRolesResponse -> String
showsPrec :: Int -> GetIdentityPoolRolesResponse -> ShowS
$cshowsPrec :: Int -> GetIdentityPoolRolesResponse -> ShowS
Prelude.Show, forall x.
Rep GetIdentityPoolRolesResponse x -> GetIdentityPoolRolesResponse
forall x.
GetIdentityPoolRolesResponse -> Rep GetIdentityPoolRolesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetIdentityPoolRolesResponse x -> GetIdentityPoolRolesResponse
$cfrom :: forall x.
GetIdentityPoolRolesResponse -> Rep GetIdentityPoolRolesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetIdentityPoolRolesResponse' 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', 'getIdentityPoolRolesResponse_identityPoolId' - An identity pool ID in the format REGION:GUID.
--
-- 'roleMappings', 'getIdentityPoolRolesResponse_roleMappings' - How users for a specific identity provider are to mapped to roles. This
-- is a String-to-RoleMapping object map. The string identifies the
-- identity provider, for example, \"graph.facebook.com\" or
-- \"cognito-idp.us-east-1.amazonaws.com\/us-east-1_abcdefghi:app_client_id\".
--
-- 'roles', 'getIdentityPoolRolesResponse_roles' - The map of roles associated with this pool. Currently only authenticated
-- and unauthenticated roles are supported.
--
-- 'httpStatus', 'getIdentityPoolRolesResponse_httpStatus' - The response's http status code.
newGetIdentityPoolRolesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetIdentityPoolRolesResponse
newGetIdentityPoolRolesResponse :: Int -> GetIdentityPoolRolesResponse
newGetIdentityPoolRolesResponse Int
pHttpStatus_ =
  GetIdentityPoolRolesResponse'
    { $sel:identityPoolId:GetIdentityPoolRolesResponse' :: Maybe Text
identityPoolId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:roleMappings:GetIdentityPoolRolesResponse' :: Maybe (HashMap Text RoleMapping)
roleMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:roles:GetIdentityPoolRolesResponse' :: Maybe (HashMap Text Text)
roles = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetIdentityPoolRolesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | How users for a specific identity provider are to mapped to roles. This
-- is a String-to-RoleMapping object map. The string identifies the
-- identity provider, for example, \"graph.facebook.com\" or
-- \"cognito-idp.us-east-1.amazonaws.com\/us-east-1_abcdefghi:app_client_id\".
getIdentityPoolRolesResponse_roleMappings :: Lens.Lens' GetIdentityPoolRolesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text RoleMapping))
getIdentityPoolRolesResponse_roleMappings :: Lens'
  GetIdentityPoolRolesResponse (Maybe (HashMap Text RoleMapping))
getIdentityPoolRolesResponse_roleMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityPoolRolesResponse' {Maybe (HashMap Text RoleMapping)
roleMappings :: Maybe (HashMap Text RoleMapping)
$sel:roleMappings:GetIdentityPoolRolesResponse' :: GetIdentityPoolRolesResponse -> Maybe (HashMap Text RoleMapping)
roleMappings} -> Maybe (HashMap Text RoleMapping)
roleMappings) (\s :: GetIdentityPoolRolesResponse
s@GetIdentityPoolRolesResponse' {} Maybe (HashMap Text RoleMapping)
a -> GetIdentityPoolRolesResponse
s {$sel:roleMappings:GetIdentityPoolRolesResponse' :: Maybe (HashMap Text RoleMapping)
roleMappings = Maybe (HashMap Text RoleMapping)
a} :: GetIdentityPoolRolesResponse) 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 map of roles associated with this pool. Currently only authenticated
-- and unauthenticated roles are supported.
getIdentityPoolRolesResponse_roles :: Lens.Lens' GetIdentityPoolRolesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getIdentityPoolRolesResponse_roles :: Lens' GetIdentityPoolRolesResponse (Maybe (HashMap Text Text))
getIdentityPoolRolesResponse_roles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityPoolRolesResponse' {Maybe (HashMap Text Text)
roles :: Maybe (HashMap Text Text)
$sel:roles:GetIdentityPoolRolesResponse' :: GetIdentityPoolRolesResponse -> Maybe (HashMap Text Text)
roles} -> Maybe (HashMap Text Text)
roles) (\s :: GetIdentityPoolRolesResponse
s@GetIdentityPoolRolesResponse' {} Maybe (HashMap Text Text)
a -> GetIdentityPoolRolesResponse
s {$sel:roles:GetIdentityPoolRolesResponse' :: Maybe (HashMap Text Text)
roles = Maybe (HashMap Text Text)
a} :: GetIdentityPoolRolesResponse) 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 response's http status code.
getIdentityPoolRolesResponse_httpStatus :: Lens.Lens' GetIdentityPoolRolesResponse Prelude.Int
getIdentityPoolRolesResponse_httpStatus :: Lens' GetIdentityPoolRolesResponse Int
getIdentityPoolRolesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityPoolRolesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetIdentityPoolRolesResponse' :: GetIdentityPoolRolesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetIdentityPoolRolesResponse
s@GetIdentityPoolRolesResponse' {} Int
a -> GetIdentityPoolRolesResponse
s {$sel:httpStatus:GetIdentityPoolRolesResponse' :: Int
httpStatus = Int
a} :: GetIdentityPoolRolesResponse)

instance Prelude.NFData GetIdentityPoolRolesResponse where
  rnf :: GetIdentityPoolRolesResponse -> ()
rnf GetIdentityPoolRolesResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text RoleMapping)
httpStatus :: Int
roles :: Maybe (HashMap Text Text)
roleMappings :: Maybe (HashMap Text RoleMapping)
identityPoolId :: Maybe Text
$sel:httpStatus:GetIdentityPoolRolesResponse' :: GetIdentityPoolRolesResponse -> Int
$sel:roles:GetIdentityPoolRolesResponse' :: GetIdentityPoolRolesResponse -> Maybe (HashMap Text Text)
$sel:roleMappings:GetIdentityPoolRolesResponse' :: GetIdentityPoolRolesResponse -> Maybe (HashMap Text RoleMapping)
$sel:identityPoolId:GetIdentityPoolRolesResponse' :: GetIdentityPoolRolesResponse -> 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 (HashMap Text RoleMapping)
roleMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
roles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus