{-# 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.Nimble.StopStreamingSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Transitions sessions from the @READY@ state into the @STOPPED@ state.
-- The @STOP_IN_PROGRESS@ state is the intermediate state between the
-- @READY@ and @STOPPED@ states.
module Amazonka.Nimble.StopStreamingSession
  ( -- * Creating a Request
    StopStreamingSession (..),
    newStopStreamingSession,

    -- * Request Lenses
    stopStreamingSession_clientToken,
    stopStreamingSession_volumeRetentionMode,
    stopStreamingSession_sessionId,
    stopStreamingSession_studioId,

    -- * Destructuring the Response
    StopStreamingSessionResponse (..),
    newStopStreamingSessionResponse,

    -- * Response Lenses
    stopStreamingSessionResponse_session,
    stopStreamingSessionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStopStreamingSession' smart constructor.
data StopStreamingSession = StopStreamingSession'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If you don’t specify a client token, the
    -- Amazon Web Services SDK automatically generates a client token and uses
    -- it for the request to ensure idempotency.
    StopStreamingSession -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Adds additional instructions to a streaming session stop action to
    -- either retain the EBS volumes or delete the EBS volumes.
    StopStreamingSession -> Maybe VolumeRetentionMode
volumeRetentionMode :: Prelude.Maybe VolumeRetentionMode,
    -- | The streaming session ID for the @StopStreamingSessionRequest@.
    StopStreamingSession -> Text
sessionId :: Prelude.Text,
    -- | The studioId for the StopStreamingSessionRequest.
    StopStreamingSession -> Text
studioId :: Prelude.Text
  }
  deriving (StopStreamingSession -> StopStreamingSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopStreamingSession -> StopStreamingSession -> Bool
$c/= :: StopStreamingSession -> StopStreamingSession -> Bool
== :: StopStreamingSession -> StopStreamingSession -> Bool
$c== :: StopStreamingSession -> StopStreamingSession -> Bool
Prelude.Eq, ReadPrec [StopStreamingSession]
ReadPrec StopStreamingSession
Int -> ReadS StopStreamingSession
ReadS [StopStreamingSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopStreamingSession]
$creadListPrec :: ReadPrec [StopStreamingSession]
readPrec :: ReadPrec StopStreamingSession
$creadPrec :: ReadPrec StopStreamingSession
readList :: ReadS [StopStreamingSession]
$creadList :: ReadS [StopStreamingSession]
readsPrec :: Int -> ReadS StopStreamingSession
$creadsPrec :: Int -> ReadS StopStreamingSession
Prelude.Read, Int -> StopStreamingSession -> ShowS
[StopStreamingSession] -> ShowS
StopStreamingSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopStreamingSession] -> ShowS
$cshowList :: [StopStreamingSession] -> ShowS
show :: StopStreamingSession -> String
$cshow :: StopStreamingSession -> String
showsPrec :: Int -> StopStreamingSession -> ShowS
$cshowsPrec :: Int -> StopStreamingSession -> ShowS
Prelude.Show, forall x. Rep StopStreamingSession x -> StopStreamingSession
forall x. StopStreamingSession -> Rep StopStreamingSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopStreamingSession x -> StopStreamingSession
$cfrom :: forall x. StopStreamingSession -> Rep StopStreamingSession x
Prelude.Generic)

-- |
-- Create a value of 'StopStreamingSession' 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:
--
-- 'clientToken', 'stopStreamingSession_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If you don’t specify a client token, the
-- Amazon Web Services SDK automatically generates a client token and uses
-- it for the request to ensure idempotency.
--
-- 'volumeRetentionMode', 'stopStreamingSession_volumeRetentionMode' - Adds additional instructions to a streaming session stop action to
-- either retain the EBS volumes or delete the EBS volumes.
--
-- 'sessionId', 'stopStreamingSession_sessionId' - The streaming session ID for the @StopStreamingSessionRequest@.
--
-- 'studioId', 'stopStreamingSession_studioId' - The studioId for the StopStreamingSessionRequest.
newStopStreamingSession ::
  -- | 'sessionId'
  Prelude.Text ->
  -- | 'studioId'
  Prelude.Text ->
  StopStreamingSession
newStopStreamingSession :: Text -> Text -> StopStreamingSession
newStopStreamingSession Text
pSessionId_ Text
pStudioId_ =
  StopStreamingSession'
    { $sel:clientToken:StopStreamingSession' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:volumeRetentionMode:StopStreamingSession' :: Maybe VolumeRetentionMode
volumeRetentionMode = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:StopStreamingSession' :: Text
sessionId = Text
pSessionId_,
      $sel:studioId:StopStreamingSession' :: Text
studioId = Text
pStudioId_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If you don’t specify a client token, the
-- Amazon Web Services SDK automatically generates a client token and uses
-- it for the request to ensure idempotency.
stopStreamingSession_clientToken :: Lens.Lens' StopStreamingSession (Prelude.Maybe Prelude.Text)
stopStreamingSession_clientToken :: Lens' StopStreamingSession (Maybe Text)
stopStreamingSession_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamingSession' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:StopStreamingSession' :: StopStreamingSession -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: StopStreamingSession
s@StopStreamingSession' {} Maybe Text
a -> StopStreamingSession
s {$sel:clientToken:StopStreamingSession' :: Maybe Text
clientToken = Maybe Text
a} :: StopStreamingSession)

-- | Adds additional instructions to a streaming session stop action to
-- either retain the EBS volumes or delete the EBS volumes.
stopStreamingSession_volumeRetentionMode :: Lens.Lens' StopStreamingSession (Prelude.Maybe VolumeRetentionMode)
stopStreamingSession_volumeRetentionMode :: Lens' StopStreamingSession (Maybe VolumeRetentionMode)
stopStreamingSession_volumeRetentionMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamingSession' {Maybe VolumeRetentionMode
volumeRetentionMode :: Maybe VolumeRetentionMode
$sel:volumeRetentionMode:StopStreamingSession' :: StopStreamingSession -> Maybe VolumeRetentionMode
volumeRetentionMode} -> Maybe VolumeRetentionMode
volumeRetentionMode) (\s :: StopStreamingSession
s@StopStreamingSession' {} Maybe VolumeRetentionMode
a -> StopStreamingSession
s {$sel:volumeRetentionMode:StopStreamingSession' :: Maybe VolumeRetentionMode
volumeRetentionMode = Maybe VolumeRetentionMode
a} :: StopStreamingSession)

-- | The streaming session ID for the @StopStreamingSessionRequest@.
stopStreamingSession_sessionId :: Lens.Lens' StopStreamingSession Prelude.Text
stopStreamingSession_sessionId :: Lens' StopStreamingSession Text
stopStreamingSession_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamingSession' {Text
sessionId :: Text
$sel:sessionId:StopStreamingSession' :: StopStreamingSession -> Text
sessionId} -> Text
sessionId) (\s :: StopStreamingSession
s@StopStreamingSession' {} Text
a -> StopStreamingSession
s {$sel:sessionId:StopStreamingSession' :: Text
sessionId = Text
a} :: StopStreamingSession)

-- | The studioId for the StopStreamingSessionRequest.
stopStreamingSession_studioId :: Lens.Lens' StopStreamingSession Prelude.Text
stopStreamingSession_studioId :: Lens' StopStreamingSession Text
stopStreamingSession_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamingSession' {Text
studioId :: Text
$sel:studioId:StopStreamingSession' :: StopStreamingSession -> Text
studioId} -> Text
studioId) (\s :: StopStreamingSession
s@StopStreamingSession' {} Text
a -> StopStreamingSession
s {$sel:studioId:StopStreamingSession' :: Text
studioId = Text
a} :: StopStreamingSession)

instance Core.AWSRequest StopStreamingSession where
  type
    AWSResponse StopStreamingSession =
      StopStreamingSessionResponse
  request :: (Service -> Service)
-> StopStreamingSession -> Request StopStreamingSession
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 StopStreamingSession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopStreamingSession)))
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 StreamingSession -> Int -> StopStreamingSessionResponse
StopStreamingSessionResponse'
            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
"session")
            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 StopStreamingSession where
  hashWithSalt :: Int -> StopStreamingSession -> Int
hashWithSalt Int
_salt StopStreamingSession' {Maybe Text
Maybe VolumeRetentionMode
Text
studioId :: Text
sessionId :: Text
volumeRetentionMode :: Maybe VolumeRetentionMode
clientToken :: Maybe Text
$sel:studioId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:sessionId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:volumeRetentionMode:StopStreamingSession' :: StopStreamingSession -> Maybe VolumeRetentionMode
$sel:clientToken:StopStreamingSession' :: StopStreamingSession -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VolumeRetentionMode
volumeRetentionMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sessionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData StopStreamingSession where
  rnf :: StopStreamingSession -> ()
rnf StopStreamingSession' {Maybe Text
Maybe VolumeRetentionMode
Text
studioId :: Text
sessionId :: Text
volumeRetentionMode :: Maybe VolumeRetentionMode
clientToken :: Maybe Text
$sel:studioId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:sessionId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:volumeRetentionMode:StopStreamingSession' :: StopStreamingSession -> Maybe VolumeRetentionMode
$sel:clientToken:StopStreamingSession' :: StopStreamingSession -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VolumeRetentionMode
volumeRetentionMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

instance Data.ToHeaders StopStreamingSession where
  toHeaders :: StopStreamingSession -> ResponseHeaders
toHeaders StopStreamingSession' {Maybe Text
Maybe VolumeRetentionMode
Text
studioId :: Text
sessionId :: Text
volumeRetentionMode :: Maybe VolumeRetentionMode
clientToken :: Maybe Text
$sel:studioId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:sessionId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:volumeRetentionMode:StopStreamingSession' :: StopStreamingSession -> Maybe VolumeRetentionMode
$sel:clientToken:StopStreamingSession' :: StopStreamingSession -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amz-Client-Token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
clientToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON StopStreamingSession where
  toJSON :: StopStreamingSession -> Value
toJSON StopStreamingSession' {Maybe Text
Maybe VolumeRetentionMode
Text
studioId :: Text
sessionId :: Text
volumeRetentionMode :: Maybe VolumeRetentionMode
clientToken :: Maybe Text
$sel:studioId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:sessionId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:volumeRetentionMode:StopStreamingSession' :: StopStreamingSession -> Maybe VolumeRetentionMode
$sel:clientToken:StopStreamingSession' :: StopStreamingSession -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"volumeRetentionMode" 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 VolumeRetentionMode
volumeRetentionMode
          ]
      )

instance Data.ToPath StopStreamingSession where
  toPath :: StopStreamingSession -> ByteString
toPath StopStreamingSession' {Maybe Text
Maybe VolumeRetentionMode
Text
studioId :: Text
sessionId :: Text
volumeRetentionMode :: Maybe VolumeRetentionMode
clientToken :: Maybe Text
$sel:studioId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:sessionId:StopStreamingSession' :: StopStreamingSession -> Text
$sel:volumeRetentionMode:StopStreamingSession' :: StopStreamingSession -> Maybe VolumeRetentionMode
$sel:clientToken:StopStreamingSession' :: StopStreamingSession -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-08-01/studios/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
studioId,
        ByteString
"/streaming-sessions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
sessionId,
        ByteString
"/stop"
      ]

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

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

-- |
-- Create a value of 'StopStreamingSessionResponse' 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:
--
-- 'session', 'stopStreamingSessionResponse_session' - Undocumented member.
--
-- 'httpStatus', 'stopStreamingSessionResponse_httpStatus' - The response's http status code.
newStopStreamingSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopStreamingSessionResponse
newStopStreamingSessionResponse :: Int -> StopStreamingSessionResponse
newStopStreamingSessionResponse Int
pHttpStatus_ =
  StopStreamingSessionResponse'
    { $sel:session:StopStreamingSessionResponse' :: Maybe StreamingSession
session =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopStreamingSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
stopStreamingSessionResponse_session :: Lens.Lens' StopStreamingSessionResponse (Prelude.Maybe StreamingSession)
stopStreamingSessionResponse_session :: Lens' StopStreamingSessionResponse (Maybe StreamingSession)
stopStreamingSessionResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamingSessionResponse' {Maybe StreamingSession
session :: Maybe StreamingSession
$sel:session:StopStreamingSessionResponse' :: StopStreamingSessionResponse -> Maybe StreamingSession
session} -> Maybe StreamingSession
session) (\s :: StopStreamingSessionResponse
s@StopStreamingSessionResponse' {} Maybe StreamingSession
a -> StopStreamingSessionResponse
s {$sel:session:StopStreamingSessionResponse' :: Maybe StreamingSession
session = Maybe StreamingSession
a} :: StopStreamingSessionResponse)

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

instance Prelude.NFData StopStreamingSessionResponse where
  rnf :: StopStreamingSessionResponse -> ()
rnf StopStreamingSessionResponse' {Int
Maybe StreamingSession
httpStatus :: Int
session :: Maybe StreamingSession
$sel:httpStatus:StopStreamingSessionResponse' :: StopStreamingSessionResponse -> Int
$sel:session:StopStreamingSessionResponse' :: StopStreamingSessionResponse -> Maybe StreamingSession
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamingSession
session
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus