{-# 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.ConnectParticipant.CreateParticipantConnection
-- 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 the participant\'s connection.
--
-- @ParticipantToken@ is used for invoking this API instead of
-- @ConnectionToken@.
--
-- The participant token is valid for the lifetime of the participant –
-- until they are part of a contact.
--
-- The response URL for @WEBSOCKET@ Type has a connect expiry timeout of
-- 100s. Clients must manually connect to the returned websocket URL and
-- subscribe to the desired topic.
--
-- For chat, you need to publish the following on the established websocket
-- connection:
--
-- @{\"topic\":\"aws\/subscribe\",\"content\":{\"topics\":[\"aws\/chat\"]}}@
--
-- Upon websocket URL expiry, as specified in the response ConnectionExpiry
-- parameter, clients need to call this API again to obtain a new websocket
-- URL and perform the same steps as before.
--
-- __Message streaming support__: This API can also be used together with
-- the
-- <https://docs.aws.amazon.com/connect/latest/APIReference/API_StartContactStreaming.html StartContactStreaming>
-- API to create a participant connection for chat contacts that are not
-- using a websocket. For more information about message streaming,
-- <https://docs.aws.amazon.com/connect/latest/adminguide/chat-message-streaming.html Enable real-time chat message streaming>
-- in the /Amazon Connect Administrator Guide/.
--
-- __Feature specifications__: For information about feature
-- specifications, such as the allowed number of open websocket connections
-- per participant, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/amazon-connect-service-limits.html#feature-limits Feature specifications>
-- in the /Amazon Connect Administrator Guide/.
--
-- The Amazon Connect Participant Service APIs do not use
-- <https://docs.aws.amazon.com/general/latest/gr/signature-version-4.html Signature Version 4 authentication>.
module Amazonka.ConnectParticipant.CreateParticipantConnection
  ( -- * Creating a Request
    CreateParticipantConnection (..),
    newCreateParticipantConnection,

    -- * Request Lenses
    createParticipantConnection_connectParticipant,
    createParticipantConnection_type,
    createParticipantConnection_participantToken,

    -- * Destructuring the Response
    CreateParticipantConnectionResponse (..),
    newCreateParticipantConnectionResponse,

    -- * Response Lenses
    createParticipantConnectionResponse_connectionCredentials,
    createParticipantConnectionResponse_websocket,
    createParticipantConnectionResponse_httpStatus,
  )
where

import Amazonka.ConnectParticipant.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:/ 'newCreateParticipantConnection' smart constructor.
data CreateParticipantConnection = CreateParticipantConnection'
  { -- | Amazon Connect Participant is used to mark the participant as connected
    -- for message streaming.
    CreateParticipantConnection -> Maybe Bool
connectParticipant :: Prelude.Maybe Prelude.Bool,
    -- | Type of connection information required. This can be omitted if
    -- @ConnectParticipant@ is @true@.
    CreateParticipantConnection -> Maybe (NonEmpty ConnectionType)
type' :: Prelude.Maybe (Prelude.NonEmpty ConnectionType),
    -- | This is a header parameter.
    --
    -- The ParticipantToken as obtained from
    -- <https://docs.aws.amazon.com/connect/latest/APIReference/API_StartChatContact.html StartChatContact>
    -- API response.
    CreateParticipantConnection -> Text
participantToken :: Prelude.Text
  }
  deriving (CreateParticipantConnection -> CreateParticipantConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateParticipantConnection -> CreateParticipantConnection -> Bool
$c/= :: CreateParticipantConnection -> CreateParticipantConnection -> Bool
== :: CreateParticipantConnection -> CreateParticipantConnection -> Bool
$c== :: CreateParticipantConnection -> CreateParticipantConnection -> Bool
Prelude.Eq, ReadPrec [CreateParticipantConnection]
ReadPrec CreateParticipantConnection
Int -> ReadS CreateParticipantConnection
ReadS [CreateParticipantConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateParticipantConnection]
$creadListPrec :: ReadPrec [CreateParticipantConnection]
readPrec :: ReadPrec CreateParticipantConnection
$creadPrec :: ReadPrec CreateParticipantConnection
readList :: ReadS [CreateParticipantConnection]
$creadList :: ReadS [CreateParticipantConnection]
readsPrec :: Int -> ReadS CreateParticipantConnection
$creadsPrec :: Int -> ReadS CreateParticipantConnection
Prelude.Read, Int -> CreateParticipantConnection -> ShowS
[CreateParticipantConnection] -> ShowS
CreateParticipantConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateParticipantConnection] -> ShowS
$cshowList :: [CreateParticipantConnection] -> ShowS
show :: CreateParticipantConnection -> String
$cshow :: CreateParticipantConnection -> String
showsPrec :: Int -> CreateParticipantConnection -> ShowS
$cshowsPrec :: Int -> CreateParticipantConnection -> ShowS
Prelude.Show, forall x.
Rep CreateParticipantConnection x -> CreateParticipantConnection
forall x.
CreateParticipantConnection -> Rep CreateParticipantConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateParticipantConnection x -> CreateParticipantConnection
$cfrom :: forall x.
CreateParticipantConnection -> Rep CreateParticipantConnection x
Prelude.Generic)

-- |
-- Create a value of 'CreateParticipantConnection' 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:
--
-- 'connectParticipant', 'createParticipantConnection_connectParticipant' - Amazon Connect Participant is used to mark the participant as connected
-- for message streaming.
--
-- 'type'', 'createParticipantConnection_type' - Type of connection information required. This can be omitted if
-- @ConnectParticipant@ is @true@.
--
-- 'participantToken', 'createParticipantConnection_participantToken' - This is a header parameter.
--
-- The ParticipantToken as obtained from
-- <https://docs.aws.amazon.com/connect/latest/APIReference/API_StartChatContact.html StartChatContact>
-- API response.
newCreateParticipantConnection ::
  -- | 'participantToken'
  Prelude.Text ->
  CreateParticipantConnection
newCreateParticipantConnection :: Text -> CreateParticipantConnection
newCreateParticipantConnection Text
pParticipantToken_ =
  CreateParticipantConnection'
    { $sel:connectParticipant:CreateParticipantConnection' :: Maybe Bool
connectParticipant =
        forall a. Maybe a
Prelude.Nothing,
      $sel:type':CreateParticipantConnection' :: Maybe (NonEmpty ConnectionType)
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:participantToken:CreateParticipantConnection' :: Text
participantToken = Text
pParticipantToken_
    }

-- | Amazon Connect Participant is used to mark the participant as connected
-- for message streaming.
createParticipantConnection_connectParticipant :: Lens.Lens' CreateParticipantConnection (Prelude.Maybe Prelude.Bool)
createParticipantConnection_connectParticipant :: Lens' CreateParticipantConnection (Maybe Bool)
createParticipantConnection_connectParticipant = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateParticipantConnection' {Maybe Bool
connectParticipant :: Maybe Bool
$sel:connectParticipant:CreateParticipantConnection' :: CreateParticipantConnection -> Maybe Bool
connectParticipant} -> Maybe Bool
connectParticipant) (\s :: CreateParticipantConnection
s@CreateParticipantConnection' {} Maybe Bool
a -> CreateParticipantConnection
s {$sel:connectParticipant:CreateParticipantConnection' :: Maybe Bool
connectParticipant = Maybe Bool
a} :: CreateParticipantConnection)

-- | Type of connection information required. This can be omitted if
-- @ConnectParticipant@ is @true@.
createParticipantConnection_type :: Lens.Lens' CreateParticipantConnection (Prelude.Maybe (Prelude.NonEmpty ConnectionType))
createParticipantConnection_type :: Lens' CreateParticipantConnection (Maybe (NonEmpty ConnectionType))
createParticipantConnection_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateParticipantConnection' {Maybe (NonEmpty ConnectionType)
type' :: Maybe (NonEmpty ConnectionType)
$sel:type':CreateParticipantConnection' :: CreateParticipantConnection -> Maybe (NonEmpty ConnectionType)
type'} -> Maybe (NonEmpty ConnectionType)
type') (\s :: CreateParticipantConnection
s@CreateParticipantConnection' {} Maybe (NonEmpty ConnectionType)
a -> CreateParticipantConnection
s {$sel:type':CreateParticipantConnection' :: Maybe (NonEmpty ConnectionType)
type' = Maybe (NonEmpty ConnectionType)
a} :: CreateParticipantConnection) 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

-- | This is a header parameter.
--
-- The ParticipantToken as obtained from
-- <https://docs.aws.amazon.com/connect/latest/APIReference/API_StartChatContact.html StartChatContact>
-- API response.
createParticipantConnection_participantToken :: Lens.Lens' CreateParticipantConnection Prelude.Text
createParticipantConnection_participantToken :: Lens' CreateParticipantConnection Text
createParticipantConnection_participantToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateParticipantConnection' {Text
participantToken :: Text
$sel:participantToken:CreateParticipantConnection' :: CreateParticipantConnection -> Text
participantToken} -> Text
participantToken) (\s :: CreateParticipantConnection
s@CreateParticipantConnection' {} Text
a -> CreateParticipantConnection
s {$sel:participantToken:CreateParticipantConnection' :: Text
participantToken = Text
a} :: CreateParticipantConnection)

instance Core.AWSRequest CreateParticipantConnection where
  type
    AWSResponse CreateParticipantConnection =
      CreateParticipantConnectionResponse
  request :: (Service -> Service)
-> CreateParticipantConnection
-> Request CreateParticipantConnection
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 CreateParticipantConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateParticipantConnection)))
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 ConnectionCredentials
-> Maybe Websocket -> Int -> CreateParticipantConnectionResponse
CreateParticipantConnectionResponse'
            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
"ConnectionCredentials")
            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
"Websocket")
            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 CreateParticipantConnection where
  hashWithSalt :: Int -> CreateParticipantConnection -> Int
hashWithSalt Int
_salt CreateParticipantConnection' {Maybe Bool
Maybe (NonEmpty ConnectionType)
Text
participantToken :: Text
type' :: Maybe (NonEmpty ConnectionType)
connectParticipant :: Maybe Bool
$sel:participantToken:CreateParticipantConnection' :: CreateParticipantConnection -> Text
$sel:type':CreateParticipantConnection' :: CreateParticipantConnection -> Maybe (NonEmpty ConnectionType)
$sel:connectParticipant:CreateParticipantConnection' :: CreateParticipantConnection -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
connectParticipant
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ConnectionType)
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
participantToken

instance Prelude.NFData CreateParticipantConnection where
  rnf :: CreateParticipantConnection -> ()
rnf CreateParticipantConnection' {Maybe Bool
Maybe (NonEmpty ConnectionType)
Text
participantToken :: Text
type' :: Maybe (NonEmpty ConnectionType)
connectParticipant :: Maybe Bool
$sel:participantToken:CreateParticipantConnection' :: CreateParticipantConnection -> Text
$sel:type':CreateParticipantConnection' :: CreateParticipantConnection -> Maybe (NonEmpty ConnectionType)
$sel:connectParticipant:CreateParticipantConnection' :: CreateParticipantConnection -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
connectParticipant
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ConnectionType)
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
participantToken

instance Data.ToHeaders CreateParticipantConnection where
  toHeaders :: CreateParticipantConnection -> ResponseHeaders
toHeaders CreateParticipantConnection' {Maybe Bool
Maybe (NonEmpty ConnectionType)
Text
participantToken :: Text
type' :: Maybe (NonEmpty ConnectionType)
connectParticipant :: Maybe Bool
$sel:participantToken:CreateParticipantConnection' :: CreateParticipantConnection -> Text
$sel:type':CreateParticipantConnection' :: CreateParticipantConnection -> Maybe (NonEmpty ConnectionType)
$sel:connectParticipant:CreateParticipantConnection' :: CreateParticipantConnection -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amz-Bearer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
participantToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON CreateParticipantConnection where
  toJSON :: CreateParticipantConnection -> Value
toJSON CreateParticipantConnection' {Maybe Bool
Maybe (NonEmpty ConnectionType)
Text
participantToken :: Text
type' :: Maybe (NonEmpty ConnectionType)
connectParticipant :: Maybe Bool
$sel:participantToken:CreateParticipantConnection' :: CreateParticipantConnection -> Text
$sel:type':CreateParticipantConnection' :: CreateParticipantConnection -> Maybe (NonEmpty ConnectionType)
$sel:connectParticipant:CreateParticipantConnection' :: CreateParticipantConnection -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConnectParticipant" 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 Bool
connectParticipant,
            (Key
"Type" 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 (NonEmpty ConnectionType)
type'
          ]
      )

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

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

-- | /See:/ 'newCreateParticipantConnectionResponse' smart constructor.
data CreateParticipantConnectionResponse = CreateParticipantConnectionResponse'
  { -- | Creates the participant\'s connection credentials. The authentication
    -- token associated with the participant\'s connection.
    CreateParticipantConnectionResponse -> Maybe ConnectionCredentials
connectionCredentials :: Prelude.Maybe ConnectionCredentials,
    -- | Creates the participant\'s websocket connection.
    CreateParticipantConnectionResponse -> Maybe Websocket
websocket :: Prelude.Maybe Websocket,
    -- | The response's http status code.
    CreateParticipantConnectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateParticipantConnectionResponse
-> CreateParticipantConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateParticipantConnectionResponse
-> CreateParticipantConnectionResponse -> Bool
$c/= :: CreateParticipantConnectionResponse
-> CreateParticipantConnectionResponse -> Bool
== :: CreateParticipantConnectionResponse
-> CreateParticipantConnectionResponse -> Bool
$c== :: CreateParticipantConnectionResponse
-> CreateParticipantConnectionResponse -> Bool
Prelude.Eq, ReadPrec [CreateParticipantConnectionResponse]
ReadPrec CreateParticipantConnectionResponse
Int -> ReadS CreateParticipantConnectionResponse
ReadS [CreateParticipantConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateParticipantConnectionResponse]
$creadListPrec :: ReadPrec [CreateParticipantConnectionResponse]
readPrec :: ReadPrec CreateParticipantConnectionResponse
$creadPrec :: ReadPrec CreateParticipantConnectionResponse
readList :: ReadS [CreateParticipantConnectionResponse]
$creadList :: ReadS [CreateParticipantConnectionResponse]
readsPrec :: Int -> ReadS CreateParticipantConnectionResponse
$creadsPrec :: Int -> ReadS CreateParticipantConnectionResponse
Prelude.Read, Int -> CreateParticipantConnectionResponse -> ShowS
[CreateParticipantConnectionResponse] -> ShowS
CreateParticipantConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateParticipantConnectionResponse] -> ShowS
$cshowList :: [CreateParticipantConnectionResponse] -> ShowS
show :: CreateParticipantConnectionResponse -> String
$cshow :: CreateParticipantConnectionResponse -> String
showsPrec :: Int -> CreateParticipantConnectionResponse -> ShowS
$cshowsPrec :: Int -> CreateParticipantConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateParticipantConnectionResponse x
-> CreateParticipantConnectionResponse
forall x.
CreateParticipantConnectionResponse
-> Rep CreateParticipantConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateParticipantConnectionResponse x
-> CreateParticipantConnectionResponse
$cfrom :: forall x.
CreateParticipantConnectionResponse
-> Rep CreateParticipantConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateParticipantConnectionResponse' 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:
--
-- 'connectionCredentials', 'createParticipantConnectionResponse_connectionCredentials' - Creates the participant\'s connection credentials. The authentication
-- token associated with the participant\'s connection.
--
-- 'websocket', 'createParticipantConnectionResponse_websocket' - Creates the participant\'s websocket connection.
--
-- 'httpStatus', 'createParticipantConnectionResponse_httpStatus' - The response's http status code.
newCreateParticipantConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateParticipantConnectionResponse
newCreateParticipantConnectionResponse :: Int -> CreateParticipantConnectionResponse
newCreateParticipantConnectionResponse Int
pHttpStatus_ =
  CreateParticipantConnectionResponse'
    { $sel:connectionCredentials:CreateParticipantConnectionResponse' :: Maybe ConnectionCredentials
connectionCredentials =
        forall a. Maybe a
Prelude.Nothing,
      $sel:websocket:CreateParticipantConnectionResponse' :: Maybe Websocket
websocket = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateParticipantConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Creates the participant\'s connection credentials. The authentication
-- token associated with the participant\'s connection.
createParticipantConnectionResponse_connectionCredentials :: Lens.Lens' CreateParticipantConnectionResponse (Prelude.Maybe ConnectionCredentials)
createParticipantConnectionResponse_connectionCredentials :: Lens'
  CreateParticipantConnectionResponse (Maybe ConnectionCredentials)
createParticipantConnectionResponse_connectionCredentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateParticipantConnectionResponse' {Maybe ConnectionCredentials
connectionCredentials :: Maybe ConnectionCredentials
$sel:connectionCredentials:CreateParticipantConnectionResponse' :: CreateParticipantConnectionResponse -> Maybe ConnectionCredentials
connectionCredentials} -> Maybe ConnectionCredentials
connectionCredentials) (\s :: CreateParticipantConnectionResponse
s@CreateParticipantConnectionResponse' {} Maybe ConnectionCredentials
a -> CreateParticipantConnectionResponse
s {$sel:connectionCredentials:CreateParticipantConnectionResponse' :: Maybe ConnectionCredentials
connectionCredentials = Maybe ConnectionCredentials
a} :: CreateParticipantConnectionResponse)

-- | Creates the participant\'s websocket connection.
createParticipantConnectionResponse_websocket :: Lens.Lens' CreateParticipantConnectionResponse (Prelude.Maybe Websocket)
createParticipantConnectionResponse_websocket :: Lens' CreateParticipantConnectionResponse (Maybe Websocket)
createParticipantConnectionResponse_websocket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateParticipantConnectionResponse' {Maybe Websocket
websocket :: Maybe Websocket
$sel:websocket:CreateParticipantConnectionResponse' :: CreateParticipantConnectionResponse -> Maybe Websocket
websocket} -> Maybe Websocket
websocket) (\s :: CreateParticipantConnectionResponse
s@CreateParticipantConnectionResponse' {} Maybe Websocket
a -> CreateParticipantConnectionResponse
s {$sel:websocket:CreateParticipantConnectionResponse' :: Maybe Websocket
websocket = Maybe Websocket
a} :: CreateParticipantConnectionResponse)

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

instance
  Prelude.NFData
    CreateParticipantConnectionResponse
  where
  rnf :: CreateParticipantConnectionResponse -> ()
rnf CreateParticipantConnectionResponse' {Int
Maybe ConnectionCredentials
Maybe Websocket
httpStatus :: Int
websocket :: Maybe Websocket
connectionCredentials :: Maybe ConnectionCredentials
$sel:httpStatus:CreateParticipantConnectionResponse' :: CreateParticipantConnectionResponse -> Int
$sel:websocket:CreateParticipantConnectionResponse' :: CreateParticipantConnectionResponse -> Maybe Websocket
$sel:connectionCredentials:CreateParticipantConnectionResponse' :: CreateParticipantConnectionResponse -> Maybe ConnectionCredentials
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionCredentials
connectionCredentials
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Websocket
websocket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus