{-# 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.SSO.Logout
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes the locally stored SSO tokens from the client-side cache and
-- sends an API call to the IAM Identity Center service to invalidate the
-- corresponding server-side IAM Identity Center sign in session.
--
-- If a user uses IAM Identity Center to access the AWS CLI, the user’s IAM
-- Identity Center sign in session is used to obtain an IAM session, as
-- specified in the corresponding IAM Identity Center permission set. More
-- specifically, IAM Identity Center assumes an IAM role in the target
-- account on behalf of the user, and the corresponding temporary AWS
-- credentials are returned to the client.
--
-- After user logout, any existing IAM role sessions that were created by
-- using IAM Identity Center permission sets continue based on the duration
-- configured in the permission set. For more information, see
-- <https://docs.aws.amazon.com/singlesignon/latest/userguide/authconcept.html User authentications>
-- in the /IAM Identity Center User Guide/.
module Amazonka.SSO.Logout
  ( -- * Creating a Request
    Logout (..),
    newLogout,

    -- * Request Lenses
    logout_accessToken,

    -- * Destructuring the Response
    LogoutResponse (..),
    newLogoutResponse,
  )
where

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
import Amazonka.SSO.Types

-- | /See:/ 'newLogout' smart constructor.
data Logout = Logout'
  { -- | The token issued by the @CreateToken@ API call. For more information,
    -- see
    -- <https://docs.aws.amazon.com/singlesignon/latest/OIDCAPIReference/API_CreateToken.html CreateToken>
    -- in the /IAM Identity Center OIDC API Reference Guide/.
    Logout -> Sensitive Text
accessToken :: Data.Sensitive Prelude.Text
  }
  deriving (Logout -> Logout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Logout -> Logout -> Bool
$c/= :: Logout -> Logout -> Bool
== :: Logout -> Logout -> Bool
$c== :: Logout -> Logout -> Bool
Prelude.Eq, Int -> Logout -> ShowS
[Logout] -> ShowS
Logout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Logout] -> ShowS
$cshowList :: [Logout] -> ShowS
show :: Logout -> String
$cshow :: Logout -> String
showsPrec :: Int -> Logout -> ShowS
$cshowsPrec :: Int -> Logout -> ShowS
Prelude.Show, forall x. Rep Logout x -> Logout
forall x. Logout -> Rep Logout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Logout x -> Logout
$cfrom :: forall x. Logout -> Rep Logout x
Prelude.Generic)

-- |
-- Create a value of 'Logout' 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:
--
-- 'accessToken', 'logout_accessToken' - The token issued by the @CreateToken@ API call. For more information,
-- see
-- <https://docs.aws.amazon.com/singlesignon/latest/OIDCAPIReference/API_CreateToken.html CreateToken>
-- in the /IAM Identity Center OIDC API Reference Guide/.
newLogout ::
  -- | 'accessToken'
  Prelude.Text ->
  Logout
newLogout :: Text -> Logout
newLogout Text
pAccessToken_ =
  Logout'
    { $sel:accessToken:Logout' :: Sensitive Text
accessToken =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pAccessToken_
    }

-- | The token issued by the @CreateToken@ API call. For more information,
-- see
-- <https://docs.aws.amazon.com/singlesignon/latest/OIDCAPIReference/API_CreateToken.html CreateToken>
-- in the /IAM Identity Center OIDC API Reference Guide/.
logout_accessToken :: Lens.Lens' Logout Prelude.Text
logout_accessToken :: Lens' Logout Text
logout_accessToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Logout' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:Logout' :: Logout -> Sensitive Text
accessToken} -> Sensitive Text
accessToken) (\s :: Logout
s@Logout' {} Sensitive Text
a -> Logout
s {$sel:accessToken:Logout' :: Sensitive Text
accessToken = Sensitive Text
a} :: Logout) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

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

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

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

instance Data.ToHeaders Logout where
  toHeaders :: Logout -> [Header]
toHeaders Logout' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:Logout' :: Logout -> Sensitive Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-sso_bearer_token" forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Sensitive Text
accessToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON Logout where
  toJSON :: Logout -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

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

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

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