{-# 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.Connect.GetFederationToken
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a token for federation.
--
-- This API doesn\'t support root users. If you try to invoke
-- GetFederationToken with root credentials, an error message similar to
-- the following one appears:
--
-- @Provided identity: Principal: .... User: .... cannot be used for federation with Amazon Connect@
module Amazonka.Connect.GetFederationToken
  ( -- * Creating a Request
    GetFederationToken (..),
    newGetFederationToken,

    -- * Request Lenses
    getFederationToken_instanceId,

    -- * Destructuring the Response
    GetFederationTokenResponse (..),
    newGetFederationTokenResponse,

    -- * Response Lenses
    getFederationTokenResponse_credentials,
    getFederationTokenResponse_signInUrl,
    getFederationTokenResponse_userArn,
    getFederationTokenResponse_userId,
    getFederationTokenResponse_httpStatus,
  )
where

import Amazonka.Connect.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetFederationToken' smart constructor.
data GetFederationToken = GetFederationToken'
  { -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    GetFederationToken -> Text
instanceId :: Prelude.Text
  }
  deriving (GetFederationToken -> GetFederationToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFederationToken -> GetFederationToken -> Bool
$c/= :: GetFederationToken -> GetFederationToken -> Bool
== :: GetFederationToken -> GetFederationToken -> Bool
$c== :: GetFederationToken -> GetFederationToken -> Bool
Prelude.Eq, ReadPrec [GetFederationToken]
ReadPrec GetFederationToken
Int -> ReadS GetFederationToken
ReadS [GetFederationToken]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFederationToken]
$creadListPrec :: ReadPrec [GetFederationToken]
readPrec :: ReadPrec GetFederationToken
$creadPrec :: ReadPrec GetFederationToken
readList :: ReadS [GetFederationToken]
$creadList :: ReadS [GetFederationToken]
readsPrec :: Int -> ReadS GetFederationToken
$creadsPrec :: Int -> ReadS GetFederationToken
Prelude.Read, Int -> GetFederationToken -> ShowS
[GetFederationToken] -> ShowS
GetFederationToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFederationToken] -> ShowS
$cshowList :: [GetFederationToken] -> ShowS
show :: GetFederationToken -> String
$cshow :: GetFederationToken -> String
showsPrec :: Int -> GetFederationToken -> ShowS
$cshowsPrec :: Int -> GetFederationToken -> ShowS
Prelude.Show, forall x. Rep GetFederationToken x -> GetFederationToken
forall x. GetFederationToken -> Rep GetFederationToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFederationToken x -> GetFederationToken
$cfrom :: forall x. GetFederationToken -> Rep GetFederationToken x
Prelude.Generic)

-- |
-- Create a value of 'GetFederationToken' 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:
--
-- 'instanceId', 'getFederationToken_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
newGetFederationToken ::
  -- | 'instanceId'
  Prelude.Text ->
  GetFederationToken
newGetFederationToken :: Text -> GetFederationToken
newGetFederationToken Text
pInstanceId_ =
  GetFederationToken' {$sel:instanceId:GetFederationToken' :: Text
instanceId = Text
pInstanceId_}

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
getFederationToken_instanceId :: Lens.Lens' GetFederationToken Prelude.Text
getFederationToken_instanceId :: Lens' GetFederationToken Text
getFederationToken_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFederationToken' {Text
instanceId :: Text
$sel:instanceId:GetFederationToken' :: GetFederationToken -> Text
instanceId} -> Text
instanceId) (\s :: GetFederationToken
s@GetFederationToken' {} Text
a -> GetFederationToken
s {$sel:instanceId:GetFederationToken' :: Text
instanceId = Text
a} :: GetFederationToken)

instance Core.AWSRequest GetFederationToken where
  type
    AWSResponse GetFederationToken =
      GetFederationTokenResponse
  request :: (Service -> Service)
-> GetFederationToken -> Request GetFederationToken
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetFederationToken
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetFederationToken)))
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 Credentials
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> GetFederationTokenResponse
GetFederationTokenResponse'
            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
"Credentials")
            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
"SignInUrl")
            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
"UserArn")
            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
"UserId")
            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 GetFederationToken where
  hashWithSalt :: Int -> GetFederationToken -> Int
hashWithSalt Int
_salt GetFederationToken' {Text
instanceId :: Text
$sel:instanceId:GetFederationToken' :: GetFederationToken -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

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

instance Data.ToHeaders GetFederationToken where
  toHeaders :: GetFederationToken -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetFederationToken where
  toPath :: GetFederationToken -> ByteString
toPath GetFederationToken' {Text
instanceId :: Text
$sel:instanceId:GetFederationToken' :: GetFederationToken -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/user/federate/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId]

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

-- | /See:/ 'newGetFederationTokenResponse' smart constructor.
data GetFederationTokenResponse = GetFederationTokenResponse'
  { -- | The credentials to use for federation.
    GetFederationTokenResponse -> Maybe Credentials
credentials :: Prelude.Maybe Credentials,
    -- | The URL to sign into the user\'s instance.
    GetFederationTokenResponse -> Maybe Text
signInUrl :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the user.
    GetFederationTokenResponse -> Maybe Text
userArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the user.
    GetFederationTokenResponse -> Maybe Text
userId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetFederationTokenResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetFederationTokenResponse -> GetFederationTokenResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFederationTokenResponse -> GetFederationTokenResponse -> Bool
$c/= :: GetFederationTokenResponse -> GetFederationTokenResponse -> Bool
== :: GetFederationTokenResponse -> GetFederationTokenResponse -> Bool
$c== :: GetFederationTokenResponse -> GetFederationTokenResponse -> Bool
Prelude.Eq, Int -> GetFederationTokenResponse -> ShowS
[GetFederationTokenResponse] -> ShowS
GetFederationTokenResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFederationTokenResponse] -> ShowS
$cshowList :: [GetFederationTokenResponse] -> ShowS
show :: GetFederationTokenResponse -> String
$cshow :: GetFederationTokenResponse -> String
showsPrec :: Int -> GetFederationTokenResponse -> ShowS
$cshowsPrec :: Int -> GetFederationTokenResponse -> ShowS
Prelude.Show, forall x.
Rep GetFederationTokenResponse x -> GetFederationTokenResponse
forall x.
GetFederationTokenResponse -> Rep GetFederationTokenResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetFederationTokenResponse x -> GetFederationTokenResponse
$cfrom :: forall x.
GetFederationTokenResponse -> Rep GetFederationTokenResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFederationTokenResponse' 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:
--
-- 'credentials', 'getFederationTokenResponse_credentials' - The credentials to use for federation.
--
-- 'signInUrl', 'getFederationTokenResponse_signInUrl' - The URL to sign into the user\'s instance.
--
-- 'userArn', 'getFederationTokenResponse_userArn' - The Amazon Resource Name (ARN) of the user.
--
-- 'userId', 'getFederationTokenResponse_userId' - The identifier for the user.
--
-- 'httpStatus', 'getFederationTokenResponse_httpStatus' - The response's http status code.
newGetFederationTokenResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetFederationTokenResponse
newGetFederationTokenResponse :: Int -> GetFederationTokenResponse
newGetFederationTokenResponse Int
pHttpStatus_ =
  GetFederationTokenResponse'
    { $sel:credentials:GetFederationTokenResponse' :: Maybe Credentials
credentials =
        forall a. Maybe a
Prelude.Nothing,
      $sel:signInUrl:GetFederationTokenResponse' :: Maybe Text
signInUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:userArn:GetFederationTokenResponse' :: Maybe Text
userArn = forall a. Maybe a
Prelude.Nothing,
      $sel:userId:GetFederationTokenResponse' :: Maybe Text
userId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetFederationTokenResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The credentials to use for federation.
getFederationTokenResponse_credentials :: Lens.Lens' GetFederationTokenResponse (Prelude.Maybe Credentials)
getFederationTokenResponse_credentials :: Lens' GetFederationTokenResponse (Maybe Credentials)
getFederationTokenResponse_credentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFederationTokenResponse' {Maybe Credentials
credentials :: Maybe Credentials
$sel:credentials:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Credentials
credentials} -> Maybe Credentials
credentials) (\s :: GetFederationTokenResponse
s@GetFederationTokenResponse' {} Maybe Credentials
a -> GetFederationTokenResponse
s {$sel:credentials:GetFederationTokenResponse' :: Maybe Credentials
credentials = Maybe Credentials
a} :: GetFederationTokenResponse)

-- | The URL to sign into the user\'s instance.
getFederationTokenResponse_signInUrl :: Lens.Lens' GetFederationTokenResponse (Prelude.Maybe Prelude.Text)
getFederationTokenResponse_signInUrl :: Lens' GetFederationTokenResponse (Maybe Text)
getFederationTokenResponse_signInUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFederationTokenResponse' {Maybe Text
signInUrl :: Maybe Text
$sel:signInUrl:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Text
signInUrl} -> Maybe Text
signInUrl) (\s :: GetFederationTokenResponse
s@GetFederationTokenResponse' {} Maybe Text
a -> GetFederationTokenResponse
s {$sel:signInUrl:GetFederationTokenResponse' :: Maybe Text
signInUrl = Maybe Text
a} :: GetFederationTokenResponse)

-- | The Amazon Resource Name (ARN) of the user.
getFederationTokenResponse_userArn :: Lens.Lens' GetFederationTokenResponse (Prelude.Maybe Prelude.Text)
getFederationTokenResponse_userArn :: Lens' GetFederationTokenResponse (Maybe Text)
getFederationTokenResponse_userArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFederationTokenResponse' {Maybe Text
userArn :: Maybe Text
$sel:userArn:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Text
userArn} -> Maybe Text
userArn) (\s :: GetFederationTokenResponse
s@GetFederationTokenResponse' {} Maybe Text
a -> GetFederationTokenResponse
s {$sel:userArn:GetFederationTokenResponse' :: Maybe Text
userArn = Maybe Text
a} :: GetFederationTokenResponse)

-- | The identifier for the user.
getFederationTokenResponse_userId :: Lens.Lens' GetFederationTokenResponse (Prelude.Maybe Prelude.Text)
getFederationTokenResponse_userId :: Lens' GetFederationTokenResponse (Maybe Text)
getFederationTokenResponse_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFederationTokenResponse' {Maybe Text
userId :: Maybe Text
$sel:userId:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Text
userId} -> Maybe Text
userId) (\s :: GetFederationTokenResponse
s@GetFederationTokenResponse' {} Maybe Text
a -> GetFederationTokenResponse
s {$sel:userId:GetFederationTokenResponse' :: Maybe Text
userId = Maybe Text
a} :: GetFederationTokenResponse)

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

instance Prelude.NFData GetFederationTokenResponse where
  rnf :: GetFederationTokenResponse -> ()
rnf GetFederationTokenResponse' {Int
Maybe Text
Maybe Credentials
httpStatus :: Int
userId :: Maybe Text
userArn :: Maybe Text
signInUrl :: Maybe Text
credentials :: Maybe Credentials
$sel:httpStatus:GetFederationTokenResponse' :: GetFederationTokenResponse -> Int
$sel:userId:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Text
$sel:userArn:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Text
$sel:signInUrl:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Text
$sel:credentials:GetFederationTokenResponse' :: GetFederationTokenResponse -> Maybe Credentials
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Credentials
credentials
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
signInUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus