{-# 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.IVSChat.CreateChatToken
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an encrypted token that is used by a chat participant to
-- establish an individual WebSocket chat connection to a room. When the
-- token is used to connect to chat, the connection is valid for the
-- session duration specified in the request. The token becomes invalid at
-- the token-expiration timestamp included in the response.
--
-- Use the @capabilities@ field to permit an end user to send messages or
-- moderate a room.
--
-- The @attributes@ field securely attaches structured data to the chat
-- session; the data is included within each message sent by the end user
-- and received by other participants in the room. Common use cases for
-- attributes include passing end-user profile data like an icon, display
-- name, colors, badges, and other display features.
--
-- Encryption keys are owned by Amazon IVS Chat and never used directly by
-- your application.
module Amazonka.IVSChat.CreateChatToken
  ( -- * Creating a Request
    CreateChatToken (..),
    newCreateChatToken,

    -- * Request Lenses
    createChatToken_attributes,
    createChatToken_capabilities,
    createChatToken_sessionDurationInMinutes,
    createChatToken_roomIdentifier,
    createChatToken_userId,

    -- * Destructuring the Response
    CreateChatTokenResponse (..),
    newCreateChatTokenResponse,

    -- * Response Lenses
    createChatTokenResponse_sessionExpirationTime,
    createChatTokenResponse_token,
    createChatTokenResponse_tokenExpirationTime,
    createChatTokenResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateChatToken' smart constructor.
data CreateChatToken = CreateChatToken'
  { -- | Application-provided attributes to encode into the token and attach to a
    -- chat session. Map keys and values can contain UTF-8 encoded text. The
    -- maximum length of this field is 1 KB total.
    CreateChatToken -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Set of capabilities that the user is allowed to perform in the room.
    -- Default: None (the capability to view messages is implicitly included in
    -- all requests).
    CreateChatToken -> Maybe [ChatTokenCapability]
capabilities :: Prelude.Maybe [ChatTokenCapability],
    -- | Session duration (in minutes), after which the session expires. Default:
    -- 60 (1 hour).
    CreateChatToken -> Maybe Natural
sessionDurationInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | Identifier of the room that the client is trying to access. Currently
    -- this must be an ARN.
    CreateChatToken -> Text
roomIdentifier :: Prelude.Text,
    -- | Application-provided ID that uniquely identifies the user associated
    -- with this token. This can be any UTF-8 encoded text.
    CreateChatToken -> Text
userId :: Prelude.Text
  }
  deriving (CreateChatToken -> CreateChatToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateChatToken -> CreateChatToken -> Bool
$c/= :: CreateChatToken -> CreateChatToken -> Bool
== :: CreateChatToken -> CreateChatToken -> Bool
$c== :: CreateChatToken -> CreateChatToken -> Bool
Prelude.Eq, ReadPrec [CreateChatToken]
ReadPrec CreateChatToken
Int -> ReadS CreateChatToken
ReadS [CreateChatToken]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateChatToken]
$creadListPrec :: ReadPrec [CreateChatToken]
readPrec :: ReadPrec CreateChatToken
$creadPrec :: ReadPrec CreateChatToken
readList :: ReadS [CreateChatToken]
$creadList :: ReadS [CreateChatToken]
readsPrec :: Int -> ReadS CreateChatToken
$creadsPrec :: Int -> ReadS CreateChatToken
Prelude.Read, Int -> CreateChatToken -> ShowS
[CreateChatToken] -> ShowS
CreateChatToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateChatToken] -> ShowS
$cshowList :: [CreateChatToken] -> ShowS
show :: CreateChatToken -> String
$cshow :: CreateChatToken -> String
showsPrec :: Int -> CreateChatToken -> ShowS
$cshowsPrec :: Int -> CreateChatToken -> ShowS
Prelude.Show, forall x. Rep CreateChatToken x -> CreateChatToken
forall x. CreateChatToken -> Rep CreateChatToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateChatToken x -> CreateChatToken
$cfrom :: forall x. CreateChatToken -> Rep CreateChatToken x
Prelude.Generic)

-- |
-- Create a value of 'CreateChatToken' 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:
--
-- 'attributes', 'createChatToken_attributes' - Application-provided attributes to encode into the token and attach to a
-- chat session. Map keys and values can contain UTF-8 encoded text. The
-- maximum length of this field is 1 KB total.
--
-- 'capabilities', 'createChatToken_capabilities' - Set of capabilities that the user is allowed to perform in the room.
-- Default: None (the capability to view messages is implicitly included in
-- all requests).
--
-- 'sessionDurationInMinutes', 'createChatToken_sessionDurationInMinutes' - Session duration (in minutes), after which the session expires. Default:
-- 60 (1 hour).
--
-- 'roomIdentifier', 'createChatToken_roomIdentifier' - Identifier of the room that the client is trying to access. Currently
-- this must be an ARN.
--
-- 'userId', 'createChatToken_userId' - Application-provided ID that uniquely identifies the user associated
-- with this token. This can be any UTF-8 encoded text.
newCreateChatToken ::
  -- | 'roomIdentifier'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  CreateChatToken
newCreateChatToken :: Text -> Text -> CreateChatToken
newCreateChatToken Text
pRoomIdentifier_ Text
pUserId_ =
  CreateChatToken'
    { $sel:attributes:CreateChatToken' :: Maybe (HashMap Text Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:capabilities:CreateChatToken' :: Maybe [ChatTokenCapability]
capabilities = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionDurationInMinutes:CreateChatToken' :: Maybe Natural
sessionDurationInMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:roomIdentifier:CreateChatToken' :: Text
roomIdentifier = Text
pRoomIdentifier_,
      $sel:userId:CreateChatToken' :: Text
userId = Text
pUserId_
    }

-- | Application-provided attributes to encode into the token and attach to a
-- chat session. Map keys and values can contain UTF-8 encoded text. The
-- maximum length of this field is 1 KB total.
createChatToken_attributes :: Lens.Lens' CreateChatToken (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createChatToken_attributes :: Lens' CreateChatToken (Maybe (HashMap Text Text))
createChatToken_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatToken' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:CreateChatToken' :: CreateChatToken -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: CreateChatToken
s@CreateChatToken' {} Maybe (HashMap Text Text)
a -> CreateChatToken
s {$sel:attributes:CreateChatToken' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: CreateChatToken) 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

-- | Set of capabilities that the user is allowed to perform in the room.
-- Default: None (the capability to view messages is implicitly included in
-- all requests).
createChatToken_capabilities :: Lens.Lens' CreateChatToken (Prelude.Maybe [ChatTokenCapability])
createChatToken_capabilities :: Lens' CreateChatToken (Maybe [ChatTokenCapability])
createChatToken_capabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatToken' {Maybe [ChatTokenCapability]
capabilities :: Maybe [ChatTokenCapability]
$sel:capabilities:CreateChatToken' :: CreateChatToken -> Maybe [ChatTokenCapability]
capabilities} -> Maybe [ChatTokenCapability]
capabilities) (\s :: CreateChatToken
s@CreateChatToken' {} Maybe [ChatTokenCapability]
a -> CreateChatToken
s {$sel:capabilities:CreateChatToken' :: Maybe [ChatTokenCapability]
capabilities = Maybe [ChatTokenCapability]
a} :: CreateChatToken) 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

-- | Session duration (in minutes), after which the session expires. Default:
-- 60 (1 hour).
createChatToken_sessionDurationInMinutes :: Lens.Lens' CreateChatToken (Prelude.Maybe Prelude.Natural)
createChatToken_sessionDurationInMinutes :: Lens' CreateChatToken (Maybe Natural)
createChatToken_sessionDurationInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatToken' {Maybe Natural
sessionDurationInMinutes :: Maybe Natural
$sel:sessionDurationInMinutes:CreateChatToken' :: CreateChatToken -> Maybe Natural
sessionDurationInMinutes} -> Maybe Natural
sessionDurationInMinutes) (\s :: CreateChatToken
s@CreateChatToken' {} Maybe Natural
a -> CreateChatToken
s {$sel:sessionDurationInMinutes:CreateChatToken' :: Maybe Natural
sessionDurationInMinutes = Maybe Natural
a} :: CreateChatToken)

-- | Identifier of the room that the client is trying to access. Currently
-- this must be an ARN.
createChatToken_roomIdentifier :: Lens.Lens' CreateChatToken Prelude.Text
createChatToken_roomIdentifier :: Lens' CreateChatToken Text
createChatToken_roomIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatToken' {Text
roomIdentifier :: Text
$sel:roomIdentifier:CreateChatToken' :: CreateChatToken -> Text
roomIdentifier} -> Text
roomIdentifier) (\s :: CreateChatToken
s@CreateChatToken' {} Text
a -> CreateChatToken
s {$sel:roomIdentifier:CreateChatToken' :: Text
roomIdentifier = Text
a} :: CreateChatToken)

-- | Application-provided ID that uniquely identifies the user associated
-- with this token. This can be any UTF-8 encoded text.
createChatToken_userId :: Lens.Lens' CreateChatToken Prelude.Text
createChatToken_userId :: Lens' CreateChatToken Text
createChatToken_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatToken' {Text
userId :: Text
$sel:userId:CreateChatToken' :: CreateChatToken -> Text
userId} -> Text
userId) (\s :: CreateChatToken
s@CreateChatToken' {} Text
a -> CreateChatToken
s {$sel:userId:CreateChatToken' :: Text
userId = Text
a} :: CreateChatToken)

instance Core.AWSRequest CreateChatToken where
  type
    AWSResponse CreateChatToken =
      CreateChatTokenResponse
  request :: (Service -> Service) -> CreateChatToken -> Request CreateChatToken
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 CreateChatToken
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateChatToken)))
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 ISO8601
-> Maybe Text -> Maybe ISO8601 -> Int -> CreateChatTokenResponse
CreateChatTokenResponse'
            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
"sessionExpirationTime")
            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
"token")
            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
"tokenExpirationTime")
            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 CreateChatToken where
  hashWithSalt :: Int -> CreateChatToken -> Int
hashWithSalt Int
_salt CreateChatToken' {Maybe Natural
Maybe [ChatTokenCapability]
Maybe (HashMap Text Text)
Text
userId :: Text
roomIdentifier :: Text
sessionDurationInMinutes :: Maybe Natural
capabilities :: Maybe [ChatTokenCapability]
attributes :: Maybe (HashMap Text Text)
$sel:userId:CreateChatToken' :: CreateChatToken -> Text
$sel:roomIdentifier:CreateChatToken' :: CreateChatToken -> Text
$sel:sessionDurationInMinutes:CreateChatToken' :: CreateChatToken -> Maybe Natural
$sel:capabilities:CreateChatToken' :: CreateChatToken -> Maybe [ChatTokenCapability]
$sel:attributes:CreateChatToken' :: CreateChatToken -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ChatTokenCapability]
capabilities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
sessionDurationInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roomIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId

instance Prelude.NFData CreateChatToken where
  rnf :: CreateChatToken -> ()
rnf CreateChatToken' {Maybe Natural
Maybe [ChatTokenCapability]
Maybe (HashMap Text Text)
Text
userId :: Text
roomIdentifier :: Text
sessionDurationInMinutes :: Maybe Natural
capabilities :: Maybe [ChatTokenCapability]
attributes :: Maybe (HashMap Text Text)
$sel:userId:CreateChatToken' :: CreateChatToken -> Text
$sel:roomIdentifier:CreateChatToken' :: CreateChatToken -> Text
$sel:sessionDurationInMinutes:CreateChatToken' :: CreateChatToken -> Maybe Natural
$sel:capabilities:CreateChatToken' :: CreateChatToken -> Maybe [ChatTokenCapability]
$sel:attributes:CreateChatToken' :: CreateChatToken -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ChatTokenCapability]
capabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
sessionDurationInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roomIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId

instance Data.ToHeaders CreateChatToken where
  toHeaders :: CreateChatToken -> 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.ToJSON CreateChatToken where
  toJSON :: CreateChatToken -> Value
toJSON CreateChatToken' {Maybe Natural
Maybe [ChatTokenCapability]
Maybe (HashMap Text Text)
Text
userId :: Text
roomIdentifier :: Text
sessionDurationInMinutes :: Maybe Natural
capabilities :: Maybe [ChatTokenCapability]
attributes :: Maybe (HashMap Text Text)
$sel:userId:CreateChatToken' :: CreateChatToken -> Text
$sel:roomIdentifier:CreateChatToken' :: CreateChatToken -> Text
$sel:sessionDurationInMinutes:CreateChatToken' :: CreateChatToken -> Maybe Natural
$sel:capabilities:CreateChatToken' :: CreateChatToken -> Maybe [ChatTokenCapability]
$sel:attributes:CreateChatToken' :: CreateChatToken -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"attributes" 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 Text)
attributes,
            (Key
"capabilities" 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 [ChatTokenCapability]
capabilities,
            (Key
"sessionDurationInMinutes" 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 Natural
sessionDurationInMinutes,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"roomIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roomIdentifier),
            forall a. a -> Maybe a
Prelude.Just (Key
"userId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userId)
          ]
      )

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

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

-- | /See:/ 'newCreateChatTokenResponse' smart constructor.
data CreateChatTokenResponse = CreateChatTokenResponse'
  { -- | Time after which an end user\'s session is no longer valid. This is an
    -- ISO 8601 timestamp; /note that this is returned as a string/.
    CreateChatTokenResponse -> Maybe ISO8601
sessionExpirationTime :: Prelude.Maybe Data.ISO8601,
    -- | The issued client token, encrypted.
    CreateChatTokenResponse -> Maybe Text
token :: Prelude.Maybe Prelude.Text,
    -- | Time after which the token is no longer valid and cannot be used to
    -- connect to a room. This is an ISO 8601 timestamp; /note that this is
    -- returned as a string/.
    CreateChatTokenResponse -> Maybe ISO8601
tokenExpirationTime :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    CreateChatTokenResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateChatTokenResponse -> CreateChatTokenResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateChatTokenResponse -> CreateChatTokenResponse -> Bool
$c/= :: CreateChatTokenResponse -> CreateChatTokenResponse -> Bool
== :: CreateChatTokenResponse -> CreateChatTokenResponse -> Bool
$c== :: CreateChatTokenResponse -> CreateChatTokenResponse -> Bool
Prelude.Eq, ReadPrec [CreateChatTokenResponse]
ReadPrec CreateChatTokenResponse
Int -> ReadS CreateChatTokenResponse
ReadS [CreateChatTokenResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateChatTokenResponse]
$creadListPrec :: ReadPrec [CreateChatTokenResponse]
readPrec :: ReadPrec CreateChatTokenResponse
$creadPrec :: ReadPrec CreateChatTokenResponse
readList :: ReadS [CreateChatTokenResponse]
$creadList :: ReadS [CreateChatTokenResponse]
readsPrec :: Int -> ReadS CreateChatTokenResponse
$creadsPrec :: Int -> ReadS CreateChatTokenResponse
Prelude.Read, Int -> CreateChatTokenResponse -> ShowS
[CreateChatTokenResponse] -> ShowS
CreateChatTokenResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateChatTokenResponse] -> ShowS
$cshowList :: [CreateChatTokenResponse] -> ShowS
show :: CreateChatTokenResponse -> String
$cshow :: CreateChatTokenResponse -> String
showsPrec :: Int -> CreateChatTokenResponse -> ShowS
$cshowsPrec :: Int -> CreateChatTokenResponse -> ShowS
Prelude.Show, forall x. Rep CreateChatTokenResponse x -> CreateChatTokenResponse
forall x. CreateChatTokenResponse -> Rep CreateChatTokenResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateChatTokenResponse x -> CreateChatTokenResponse
$cfrom :: forall x. CreateChatTokenResponse -> Rep CreateChatTokenResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateChatTokenResponse' 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:
--
-- 'sessionExpirationTime', 'createChatTokenResponse_sessionExpirationTime' - Time after which an end user\'s session is no longer valid. This is an
-- ISO 8601 timestamp; /note that this is returned as a string/.
--
-- 'token', 'createChatTokenResponse_token' - The issued client token, encrypted.
--
-- 'tokenExpirationTime', 'createChatTokenResponse_tokenExpirationTime' - Time after which the token is no longer valid and cannot be used to
-- connect to a room. This is an ISO 8601 timestamp; /note that this is
-- returned as a string/.
--
-- 'httpStatus', 'createChatTokenResponse_httpStatus' - The response's http status code.
newCreateChatTokenResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateChatTokenResponse
newCreateChatTokenResponse :: Int -> CreateChatTokenResponse
newCreateChatTokenResponse Int
pHttpStatus_ =
  CreateChatTokenResponse'
    { $sel:sessionExpirationTime:CreateChatTokenResponse' :: Maybe ISO8601
sessionExpirationTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:token:CreateChatTokenResponse' :: Maybe Text
token = forall a. Maybe a
Prelude.Nothing,
      $sel:tokenExpirationTime:CreateChatTokenResponse' :: Maybe ISO8601
tokenExpirationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateChatTokenResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Time after which an end user\'s session is no longer valid. This is an
-- ISO 8601 timestamp; /note that this is returned as a string/.
createChatTokenResponse_sessionExpirationTime :: Lens.Lens' CreateChatTokenResponse (Prelude.Maybe Prelude.UTCTime)
createChatTokenResponse_sessionExpirationTime :: Lens' CreateChatTokenResponse (Maybe UTCTime)
createChatTokenResponse_sessionExpirationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatTokenResponse' {Maybe ISO8601
sessionExpirationTime :: Maybe ISO8601
$sel:sessionExpirationTime:CreateChatTokenResponse' :: CreateChatTokenResponse -> Maybe ISO8601
sessionExpirationTime} -> Maybe ISO8601
sessionExpirationTime) (\s :: CreateChatTokenResponse
s@CreateChatTokenResponse' {} Maybe ISO8601
a -> CreateChatTokenResponse
s {$sel:sessionExpirationTime:CreateChatTokenResponse' :: Maybe ISO8601
sessionExpirationTime = Maybe ISO8601
a} :: CreateChatTokenResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The issued client token, encrypted.
createChatTokenResponse_token :: Lens.Lens' CreateChatTokenResponse (Prelude.Maybe Prelude.Text)
createChatTokenResponse_token :: Lens' CreateChatTokenResponse (Maybe Text)
createChatTokenResponse_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatTokenResponse' {Maybe Text
token :: Maybe Text
$sel:token:CreateChatTokenResponse' :: CreateChatTokenResponse -> Maybe Text
token} -> Maybe Text
token) (\s :: CreateChatTokenResponse
s@CreateChatTokenResponse' {} Maybe Text
a -> CreateChatTokenResponse
s {$sel:token:CreateChatTokenResponse' :: Maybe Text
token = Maybe Text
a} :: CreateChatTokenResponse)

-- | Time after which the token is no longer valid and cannot be used to
-- connect to a room. This is an ISO 8601 timestamp; /note that this is
-- returned as a string/.
createChatTokenResponse_tokenExpirationTime :: Lens.Lens' CreateChatTokenResponse (Prelude.Maybe Prelude.UTCTime)
createChatTokenResponse_tokenExpirationTime :: Lens' CreateChatTokenResponse (Maybe UTCTime)
createChatTokenResponse_tokenExpirationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChatTokenResponse' {Maybe ISO8601
tokenExpirationTime :: Maybe ISO8601
$sel:tokenExpirationTime:CreateChatTokenResponse' :: CreateChatTokenResponse -> Maybe ISO8601
tokenExpirationTime} -> Maybe ISO8601
tokenExpirationTime) (\s :: CreateChatTokenResponse
s@CreateChatTokenResponse' {} Maybe ISO8601
a -> CreateChatTokenResponse
s {$sel:tokenExpirationTime:CreateChatTokenResponse' :: Maybe ISO8601
tokenExpirationTime = Maybe ISO8601
a} :: CreateChatTokenResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData CreateChatTokenResponse where
  rnf :: CreateChatTokenResponse -> ()
rnf CreateChatTokenResponse' {Int
Maybe Text
Maybe ISO8601
httpStatus :: Int
tokenExpirationTime :: Maybe ISO8601
token :: Maybe Text
sessionExpirationTime :: Maybe ISO8601
$sel:httpStatus:CreateChatTokenResponse' :: CreateChatTokenResponse -> Int
$sel:tokenExpirationTime:CreateChatTokenResponse' :: CreateChatTokenResponse -> Maybe ISO8601
$sel:token:CreateChatTokenResponse' :: CreateChatTokenResponse -> Maybe Text
$sel:sessionExpirationTime:CreateChatTokenResponse' :: CreateChatTokenResponse -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
sessionExpirationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
token
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
tokenExpirationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus