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

    -- * Request Lenses
    setIdentityPoolRoles_roleMappings,
    setIdentityPoolRoles_identityPoolId,
    setIdentityPoolRoles_roles,

    -- * Destructuring the Response
    SetIdentityPoolRolesResponse (..),
    newSetIdentityPoolRolesResponse,
  )
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 @SetIdentityPoolRoles@ action.
--
-- /See:/ 'newSetIdentityPoolRoles' smart constructor.
data SetIdentityPoolRoles = SetIdentityPoolRoles'
  { -- | 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\".
    --
    -- Up to 25 rules can be specified per identity provider.
    SetIdentityPoolRoles -> Maybe (HashMap Text RoleMapping)
roleMappings :: Prelude.Maybe (Prelude.HashMap Prelude.Text RoleMapping),
    -- | An identity pool ID in the format REGION:GUID.
    SetIdentityPoolRoles -> Text
identityPoolId :: Prelude.Text,
    -- | The map of roles associated with this pool. For a given role, the key
    -- will be either \"authenticated\" or \"unauthenticated\" and the value
    -- will be the Role ARN.
    SetIdentityPoolRoles -> HashMap Text Text
roles :: Prelude.HashMap Prelude.Text Prelude.Text
  }
  deriving (SetIdentityPoolRoles -> SetIdentityPoolRoles -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetIdentityPoolRoles -> SetIdentityPoolRoles -> Bool
$c/= :: SetIdentityPoolRoles -> SetIdentityPoolRoles -> Bool
== :: SetIdentityPoolRoles -> SetIdentityPoolRoles -> Bool
$c== :: SetIdentityPoolRoles -> SetIdentityPoolRoles -> Bool
Prelude.Eq, ReadPrec [SetIdentityPoolRoles]
ReadPrec SetIdentityPoolRoles
Int -> ReadS SetIdentityPoolRoles
ReadS [SetIdentityPoolRoles]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetIdentityPoolRoles]
$creadListPrec :: ReadPrec [SetIdentityPoolRoles]
readPrec :: ReadPrec SetIdentityPoolRoles
$creadPrec :: ReadPrec SetIdentityPoolRoles
readList :: ReadS [SetIdentityPoolRoles]
$creadList :: ReadS [SetIdentityPoolRoles]
readsPrec :: Int -> ReadS SetIdentityPoolRoles
$creadsPrec :: Int -> ReadS SetIdentityPoolRoles
Prelude.Read, Int -> SetIdentityPoolRoles -> ShowS
[SetIdentityPoolRoles] -> ShowS
SetIdentityPoolRoles -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetIdentityPoolRoles] -> ShowS
$cshowList :: [SetIdentityPoolRoles] -> ShowS
show :: SetIdentityPoolRoles -> String
$cshow :: SetIdentityPoolRoles -> String
showsPrec :: Int -> SetIdentityPoolRoles -> ShowS
$cshowsPrec :: Int -> SetIdentityPoolRoles -> ShowS
Prelude.Show, forall x. Rep SetIdentityPoolRoles x -> SetIdentityPoolRoles
forall x. SetIdentityPoolRoles -> Rep SetIdentityPoolRoles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetIdentityPoolRoles x -> SetIdentityPoolRoles
$cfrom :: forall x. SetIdentityPoolRoles -> Rep SetIdentityPoolRoles x
Prelude.Generic)

-- |
-- Create a value of 'SetIdentityPoolRoles' 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:
--
-- 'roleMappings', 'setIdentityPoolRoles_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\".
--
-- Up to 25 rules can be specified per identity provider.
--
-- 'identityPoolId', 'setIdentityPoolRoles_identityPoolId' - An identity pool ID in the format REGION:GUID.
--
-- 'roles', 'setIdentityPoolRoles_roles' - The map of roles associated with this pool. For a given role, the key
-- will be either \"authenticated\" or \"unauthenticated\" and the value
-- will be the Role ARN.
newSetIdentityPoolRoles ::
  -- | 'identityPoolId'
  Prelude.Text ->
  SetIdentityPoolRoles
newSetIdentityPoolRoles :: Text -> SetIdentityPoolRoles
newSetIdentityPoolRoles Text
pIdentityPoolId_ =
  SetIdentityPoolRoles'
    { $sel:roleMappings:SetIdentityPoolRoles' :: Maybe (HashMap Text RoleMapping)
roleMappings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityPoolId:SetIdentityPoolRoles' :: Text
identityPoolId = Text
pIdentityPoolId_,
      $sel:roles:SetIdentityPoolRoles' :: HashMap Text Text
roles = forall a. Monoid a => a
Prelude.mempty
    }

-- | 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\".
--
-- Up to 25 rules can be specified per identity provider.
setIdentityPoolRoles_roleMappings :: Lens.Lens' SetIdentityPoolRoles (Prelude.Maybe (Prelude.HashMap Prelude.Text RoleMapping))
setIdentityPoolRoles_roleMappings :: Lens' SetIdentityPoolRoles (Maybe (HashMap Text RoleMapping))
setIdentityPoolRoles_roleMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityPoolRoles' {Maybe (HashMap Text RoleMapping)
roleMappings :: Maybe (HashMap Text RoleMapping)
$sel:roleMappings:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> Maybe (HashMap Text RoleMapping)
roleMappings} -> Maybe (HashMap Text RoleMapping)
roleMappings) (\s :: SetIdentityPoolRoles
s@SetIdentityPoolRoles' {} Maybe (HashMap Text RoleMapping)
a -> SetIdentityPoolRoles
s {$sel:roleMappings:SetIdentityPoolRoles' :: Maybe (HashMap Text RoleMapping)
roleMappings = Maybe (HashMap Text RoleMapping)
a} :: SetIdentityPoolRoles) 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.
setIdentityPoolRoles_identityPoolId :: Lens.Lens' SetIdentityPoolRoles Prelude.Text
setIdentityPoolRoles_identityPoolId :: Lens' SetIdentityPoolRoles Text
setIdentityPoolRoles_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityPoolRoles' {Text
identityPoolId :: Text
$sel:identityPoolId:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> Text
identityPoolId} -> Text
identityPoolId) (\s :: SetIdentityPoolRoles
s@SetIdentityPoolRoles' {} Text
a -> SetIdentityPoolRoles
s {$sel:identityPoolId:SetIdentityPoolRoles' :: Text
identityPoolId = Text
a} :: SetIdentityPoolRoles)

-- | The map of roles associated with this pool. For a given role, the key
-- will be either \"authenticated\" or \"unauthenticated\" and the value
-- will be the Role ARN.
setIdentityPoolRoles_roles :: Lens.Lens' SetIdentityPoolRoles (Prelude.HashMap Prelude.Text Prelude.Text)
setIdentityPoolRoles_roles :: Lens' SetIdentityPoolRoles (HashMap Text Text)
setIdentityPoolRoles_roles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityPoolRoles' {HashMap Text Text
roles :: HashMap Text Text
$sel:roles:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> HashMap Text Text
roles} -> HashMap Text Text
roles) (\s :: SetIdentityPoolRoles
s@SetIdentityPoolRoles' {} HashMap Text Text
a -> SetIdentityPoolRoles
s {$sel:roles:SetIdentityPoolRoles' :: HashMap Text Text
roles = HashMap Text Text
a} :: SetIdentityPoolRoles) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest SetIdentityPoolRoles where
  type
    AWSResponse SetIdentityPoolRoles =
      SetIdentityPoolRolesResponse
  request :: (Service -> Service)
-> SetIdentityPoolRoles -> Request SetIdentityPoolRoles
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 SetIdentityPoolRoles
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetIdentityPoolRoles)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull SetIdentityPoolRolesResponse
SetIdentityPoolRolesResponse'

instance Prelude.Hashable SetIdentityPoolRoles where
  hashWithSalt :: Int -> SetIdentityPoolRoles -> Int
hashWithSalt Int
_salt SetIdentityPoolRoles' {Maybe (HashMap Text RoleMapping)
Text
HashMap Text Text
roles :: HashMap Text Text
identityPoolId :: Text
roleMappings :: Maybe (HashMap Text RoleMapping)
$sel:roles:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> HashMap Text Text
$sel:identityPoolId:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> Text
$sel:roleMappings:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> Maybe (HashMap Text RoleMapping)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text RoleMapping)
roleMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
roles

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

instance Data.ToHeaders SetIdentityPoolRoles where
  toHeaders :: SetIdentityPoolRoles -> [Header]
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 -> [Header]
Data.=# ( ByteString
"AWSCognitoIdentityService.SetIdentityPoolRoles" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON SetIdentityPoolRoles where
  toJSON :: SetIdentityPoolRoles -> Value
toJSON SetIdentityPoolRoles' {Maybe (HashMap Text RoleMapping)
Text
HashMap Text Text
roles :: HashMap Text Text
identityPoolId :: Text
roleMappings :: Maybe (HashMap Text RoleMapping)
$sel:roles:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> HashMap Text Text
$sel:identityPoolId:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> Text
$sel:roleMappings:SetIdentityPoolRoles' :: SetIdentityPoolRoles -> Maybe (HashMap Text RoleMapping)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"RoleMappings" 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 RoleMapping)
roleMappings,
            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
"Roles" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text Text
roles)
          ]
      )

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

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

-- | /See:/ 'newSetIdentityPoolRolesResponse' smart constructor.
data SetIdentityPoolRolesResponse = SetIdentityPoolRolesResponse'
  {
  }
  deriving (SetIdentityPoolRolesResponse
-> SetIdentityPoolRolesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetIdentityPoolRolesResponse
-> SetIdentityPoolRolesResponse -> Bool
$c/= :: SetIdentityPoolRolesResponse
-> SetIdentityPoolRolesResponse -> Bool
== :: SetIdentityPoolRolesResponse
-> SetIdentityPoolRolesResponse -> Bool
$c== :: SetIdentityPoolRolesResponse
-> SetIdentityPoolRolesResponse -> Bool
Prelude.Eq, ReadPrec [SetIdentityPoolRolesResponse]
ReadPrec SetIdentityPoolRolesResponse
Int -> ReadS SetIdentityPoolRolesResponse
ReadS [SetIdentityPoolRolesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetIdentityPoolRolesResponse]
$creadListPrec :: ReadPrec [SetIdentityPoolRolesResponse]
readPrec :: ReadPrec SetIdentityPoolRolesResponse
$creadPrec :: ReadPrec SetIdentityPoolRolesResponse
readList :: ReadS [SetIdentityPoolRolesResponse]
$creadList :: ReadS [SetIdentityPoolRolesResponse]
readsPrec :: Int -> ReadS SetIdentityPoolRolesResponse
$creadsPrec :: Int -> ReadS SetIdentityPoolRolesResponse
Prelude.Read, Int -> SetIdentityPoolRolesResponse -> ShowS
[SetIdentityPoolRolesResponse] -> ShowS
SetIdentityPoolRolesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetIdentityPoolRolesResponse] -> ShowS
$cshowList :: [SetIdentityPoolRolesResponse] -> ShowS
show :: SetIdentityPoolRolesResponse -> String
$cshow :: SetIdentityPoolRolesResponse -> String
showsPrec :: Int -> SetIdentityPoolRolesResponse -> ShowS
$cshowsPrec :: Int -> SetIdentityPoolRolesResponse -> ShowS
Prelude.Show, forall x.
Rep SetIdentityPoolRolesResponse x -> SetIdentityPoolRolesResponse
forall x.
SetIdentityPoolRolesResponse -> Rep SetIdentityPoolRolesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetIdentityPoolRolesResponse x -> SetIdentityPoolRolesResponse
$cfrom :: forall x.
SetIdentityPoolRolesResponse -> Rep SetIdentityPoolRolesResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetIdentityPoolRolesResponse' 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.
newSetIdentityPoolRolesResponse ::
  SetIdentityPoolRolesResponse
newSetIdentityPoolRolesResponse :: SetIdentityPoolRolesResponse
newSetIdentityPoolRolesResponse =
  SetIdentityPoolRolesResponse
SetIdentityPoolRolesResponse'

instance Prelude.NFData SetIdentityPoolRolesResponse where
  rnf :: SetIdentityPoolRolesResponse -> ()
rnf SetIdentityPoolRolesResponse
_ = ()