{-# 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.CognitoIdentityProvider.RevokeToken
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Revokes all of the access tokens generated by, and at the same time as,
-- the specified refresh token. After a token is revoked, you can\'t use
-- the revoked token to access Amazon Cognito user APIs, or to authorize
-- access to your resource server.
module Amazonka.CognitoIdentityProvider.RevokeToken
  ( -- * Creating a Request
    RevokeToken (..),
    newRevokeToken,

    -- * Request Lenses
    revokeToken_clientSecret,
    revokeToken_token,
    revokeToken_clientId,

    -- * Destructuring the Response
    RevokeTokenResponse (..),
    newRevokeTokenResponse,

    -- * Response Lenses
    revokeTokenResponse_httpStatus,
  )
where

import Amazonka.CognitoIdentityProvider.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:/ 'newRevokeToken' smart constructor.
data RevokeToken = RevokeToken'
  { -- | The secret for the client ID. This is required only if the client ID has
    -- a secret.
    RevokeToken -> Maybe (Sensitive Text)
clientSecret :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The refresh token that you want to revoke.
    RevokeToken -> Sensitive Text
token :: Data.Sensitive Prelude.Text,
    -- | The client ID for the token that you want to revoke.
    RevokeToken -> Sensitive Text
clientId :: Data.Sensitive Prelude.Text
  }
  deriving (RevokeToken -> RevokeToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeToken -> RevokeToken -> Bool
$c/= :: RevokeToken -> RevokeToken -> Bool
== :: RevokeToken -> RevokeToken -> Bool
$c== :: RevokeToken -> RevokeToken -> Bool
Prelude.Eq, Int -> RevokeToken -> ShowS
[RevokeToken] -> ShowS
RevokeToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeToken] -> ShowS
$cshowList :: [RevokeToken] -> ShowS
show :: RevokeToken -> String
$cshow :: RevokeToken -> String
showsPrec :: Int -> RevokeToken -> ShowS
$cshowsPrec :: Int -> RevokeToken -> ShowS
Prelude.Show, forall x. Rep RevokeToken x -> RevokeToken
forall x. RevokeToken -> Rep RevokeToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokeToken x -> RevokeToken
$cfrom :: forall x. RevokeToken -> Rep RevokeToken x
Prelude.Generic)

-- |
-- Create a value of 'RevokeToken' 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:
--
-- 'clientSecret', 'revokeToken_clientSecret' - The secret for the client ID. This is required only if the client ID has
-- a secret.
--
-- 'token', 'revokeToken_token' - The refresh token that you want to revoke.
--
-- 'clientId', 'revokeToken_clientId' - The client ID for the token that you want to revoke.
newRevokeToken ::
  -- | 'token'
  Prelude.Text ->
  -- | 'clientId'
  Prelude.Text ->
  RevokeToken
newRevokeToken :: Text -> Text -> RevokeToken
newRevokeToken Text
pToken_ Text
pClientId_ =
  RevokeToken'
    { $sel:clientSecret:RevokeToken' :: Maybe (Sensitive Text)
clientSecret = forall a. Maybe a
Prelude.Nothing,
      $sel:token:RevokeToken' :: Sensitive Text
token = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pToken_,
      $sel:clientId:RevokeToken' :: Sensitive Text
clientId = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pClientId_
    }

-- | The secret for the client ID. This is required only if the client ID has
-- a secret.
revokeToken_clientSecret :: Lens.Lens' RevokeToken (Prelude.Maybe Prelude.Text)
revokeToken_clientSecret :: Lens' RevokeToken (Maybe Text)
revokeToken_clientSecret = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeToken' {Maybe (Sensitive Text)
clientSecret :: Maybe (Sensitive Text)
$sel:clientSecret:RevokeToken' :: RevokeToken -> Maybe (Sensitive Text)
clientSecret} -> Maybe (Sensitive Text)
clientSecret) (\s :: RevokeToken
s@RevokeToken' {} Maybe (Sensitive Text)
a -> RevokeToken
s {$sel:clientSecret:RevokeToken' :: Maybe (Sensitive Text)
clientSecret = Maybe (Sensitive Text)
a} :: RevokeToken) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The refresh token that you want to revoke.
revokeToken_token :: Lens.Lens' RevokeToken Prelude.Text
revokeToken_token :: Lens' RevokeToken Text
revokeToken_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeToken' {Sensitive Text
token :: Sensitive Text
$sel:token:RevokeToken' :: RevokeToken -> Sensitive Text
token} -> Sensitive Text
token) (\s :: RevokeToken
s@RevokeToken' {} Sensitive Text
a -> RevokeToken
s {$sel:token:RevokeToken' :: Sensitive Text
token = Sensitive Text
a} :: RevokeToken) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The client ID for the token that you want to revoke.
revokeToken_clientId :: Lens.Lens' RevokeToken Prelude.Text
revokeToken_clientId :: Lens' RevokeToken Text
revokeToken_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeToken' {Sensitive Text
clientId :: Sensitive Text
$sel:clientId:RevokeToken' :: RevokeToken -> Sensitive Text
clientId} -> Sensitive Text
clientId) (\s :: RevokeToken
s@RevokeToken' {} Sensitive Text
a -> RevokeToken
s {$sel:clientId:RevokeToken' :: Sensitive Text
clientId = Sensitive Text
a} :: RevokeToken) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest RevokeToken where
  type AWSResponse RevokeToken = RevokeTokenResponse
  request :: (Service -> Service) -> RevokeToken -> Request RevokeToken
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 RevokeToken
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RevokeToken)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> RevokeTokenResponse
RevokeTokenResponse'
            forall (f :: * -> *) a b. Functor 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 RevokeToken where
  hashWithSalt :: Int -> RevokeToken -> Int
hashWithSalt Int
_salt RevokeToken' {Maybe (Sensitive Text)
Sensitive Text
clientId :: Sensitive Text
token :: Sensitive Text
clientSecret :: Maybe (Sensitive Text)
$sel:clientId:RevokeToken' :: RevokeToken -> Sensitive Text
$sel:token:RevokeToken' :: RevokeToken -> Sensitive Text
$sel:clientSecret:RevokeToken' :: RevokeToken -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
clientSecret
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
token
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
clientId

instance Prelude.NFData RevokeToken where
  rnf :: RevokeToken -> ()
rnf RevokeToken' {Maybe (Sensitive Text)
Sensitive Text
clientId :: Sensitive Text
token :: Sensitive Text
clientSecret :: Maybe (Sensitive Text)
$sel:clientId:RevokeToken' :: RevokeToken -> Sensitive Text
$sel:token:RevokeToken' :: RevokeToken -> Sensitive Text
$sel:clientSecret:RevokeToken' :: RevokeToken -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
clientSecret
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
token
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
clientId

instance Data.ToHeaders RevokeToken where
  toHeaders :: RevokeToken -> 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
"AWSCognitoIdentityProviderService.RevokeToken" ::
                          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 RevokeToken where
  toJSON :: RevokeToken -> Value
toJSON RevokeToken' {Maybe (Sensitive Text)
Sensitive Text
clientId :: Sensitive Text
token :: Sensitive Text
clientSecret :: Maybe (Sensitive Text)
$sel:clientId:RevokeToken' :: RevokeToken -> Sensitive Text
$sel:token:RevokeToken' :: RevokeToken -> Sensitive Text
$sel:clientSecret:RevokeToken' :: RevokeToken -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientSecret" 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 (Sensitive Text)
clientSecret,
            forall a. a -> Maybe a
Prelude.Just (Key
"Token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
token),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
clientId)
          ]
      )

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

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

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

-- |
-- Create a value of 'RevokeTokenResponse' 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:
--
-- 'httpStatus', 'revokeTokenResponse_httpStatus' - The response's http status code.
newRevokeTokenResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RevokeTokenResponse
newRevokeTokenResponse :: Int -> RevokeTokenResponse
newRevokeTokenResponse Int
pHttpStatus_ =
  RevokeTokenResponse' {$sel:httpStatus:RevokeTokenResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData RevokeTokenResponse where
  rnf :: RevokeTokenResponse -> ()
rnf RevokeTokenResponse' {Int
httpStatus :: Int
$sel:httpStatus:RevokeTokenResponse' :: RevokeTokenResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus