{-# 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.GetStreamingSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets StreamingSession resource.
--
-- Invoke this operation to poll for a streaming session state while
-- creating or deleting a session.
module Amazonka.Nimble.GetStreamingSession
  ( -- * Creating a Request
    GetStreamingSession (..),
    newGetStreamingSession,

    -- * Request Lenses
    getStreamingSession_sessionId,
    getStreamingSession_studioId,

    -- * Destructuring the Response
    GetStreamingSessionResponse (..),
    newGetStreamingSessionResponse,

    -- * Response Lenses
    getStreamingSessionResponse_session,
    getStreamingSessionResponse_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:/ 'newGetStreamingSession' smart constructor.
data GetStreamingSession = GetStreamingSession'
  { -- | The streaming session ID.
    GetStreamingSession -> Text
sessionId :: Prelude.Text,
    -- | The studio ID.
    GetStreamingSession -> Text
studioId :: Prelude.Text
  }
  deriving (GetStreamingSession -> GetStreamingSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStreamingSession -> GetStreamingSession -> Bool
$c/= :: GetStreamingSession -> GetStreamingSession -> Bool
== :: GetStreamingSession -> GetStreamingSession -> Bool
$c== :: GetStreamingSession -> GetStreamingSession -> Bool
Prelude.Eq, ReadPrec [GetStreamingSession]
ReadPrec GetStreamingSession
Int -> ReadS GetStreamingSession
ReadS [GetStreamingSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStreamingSession]
$creadListPrec :: ReadPrec [GetStreamingSession]
readPrec :: ReadPrec GetStreamingSession
$creadPrec :: ReadPrec GetStreamingSession
readList :: ReadS [GetStreamingSession]
$creadList :: ReadS [GetStreamingSession]
readsPrec :: Int -> ReadS GetStreamingSession
$creadsPrec :: Int -> ReadS GetStreamingSession
Prelude.Read, Int -> GetStreamingSession -> ShowS
[GetStreamingSession] -> ShowS
GetStreamingSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStreamingSession] -> ShowS
$cshowList :: [GetStreamingSession] -> ShowS
show :: GetStreamingSession -> String
$cshow :: GetStreamingSession -> String
showsPrec :: Int -> GetStreamingSession -> ShowS
$cshowsPrec :: Int -> GetStreamingSession -> ShowS
Prelude.Show, forall x. Rep GetStreamingSession x -> GetStreamingSession
forall x. GetStreamingSession -> Rep GetStreamingSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStreamingSession x -> GetStreamingSession
$cfrom :: forall x. GetStreamingSession -> Rep GetStreamingSession x
Prelude.Generic)

-- |
-- Create a value of 'GetStreamingSession' 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:
--
-- 'sessionId', 'getStreamingSession_sessionId' - The streaming session ID.
--
-- 'studioId', 'getStreamingSession_studioId' - The studio ID.
newGetStreamingSession ::
  -- | 'sessionId'
  Prelude.Text ->
  -- | 'studioId'
  Prelude.Text ->
  GetStreamingSession
newGetStreamingSession :: Text -> Text -> GetStreamingSession
newGetStreamingSession Text
pSessionId_ Text
pStudioId_ =
  GetStreamingSession'
    { $sel:sessionId:GetStreamingSession' :: Text
sessionId = Text
pSessionId_,
      $sel:studioId:GetStreamingSession' :: Text
studioId = Text
pStudioId_
    }

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

-- | The studio ID.
getStreamingSession_studioId :: Lens.Lens' GetStreamingSession Prelude.Text
getStreamingSession_studioId :: Lens' GetStreamingSession Text
getStreamingSession_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStreamingSession' {Text
studioId :: Text
$sel:studioId:GetStreamingSession' :: GetStreamingSession -> Text
studioId} -> Text
studioId) (\s :: GetStreamingSession
s@GetStreamingSession' {} Text
a -> GetStreamingSession
s {$sel:studioId:GetStreamingSession' :: Text
studioId = Text
a} :: GetStreamingSession)

instance Core.AWSRequest GetStreamingSession where
  type
    AWSResponse GetStreamingSession =
      GetStreamingSessionResponse
  request :: (Service -> Service)
-> GetStreamingSession -> Request GetStreamingSession
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetStreamingSession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetStreamingSession)))
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 -> GetStreamingSessionResponse
GetStreamingSessionResponse'
            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 GetStreamingSession where
  hashWithSalt :: Int -> GetStreamingSession -> Int
hashWithSalt Int
_salt GetStreamingSession' {Text
studioId :: Text
sessionId :: Text
$sel:studioId:GetStreamingSession' :: GetStreamingSession -> Text
$sel:sessionId:GetStreamingSession' :: GetStreamingSession -> Text
..} =
    Int
_salt
      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 GetStreamingSession where
  rnf :: GetStreamingSession -> ()
rnf GetStreamingSession' {Text
studioId :: Text
sessionId :: Text
$sel:studioId:GetStreamingSession' :: GetStreamingSession -> Text
$sel:sessionId:GetStreamingSession' :: GetStreamingSession -> Text
..} =
    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 GetStreamingSession where
  toHeaders :: GetStreamingSession -> 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.ToPath GetStreamingSession where
  toPath :: GetStreamingSession -> ByteString
toPath GetStreamingSession' {Text
studioId :: Text
sessionId :: Text
$sel:studioId:GetStreamingSession' :: GetStreamingSession -> Text
$sel:sessionId:GetStreamingSession' :: GetStreamingSession -> 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
      ]

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

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

-- |
-- Create a value of 'GetStreamingSessionResponse' 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', 'getStreamingSessionResponse_session' - The session.
--
-- 'httpStatus', 'getStreamingSessionResponse_httpStatus' - The response's http status code.
newGetStreamingSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetStreamingSessionResponse
newGetStreamingSessionResponse :: Int -> GetStreamingSessionResponse
newGetStreamingSessionResponse Int
pHttpStatus_ =
  GetStreamingSessionResponse'
    { $sel:session:GetStreamingSessionResponse' :: Maybe StreamingSession
session =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetStreamingSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The session.
getStreamingSessionResponse_session :: Lens.Lens' GetStreamingSessionResponse (Prelude.Maybe StreamingSession)
getStreamingSessionResponse_session :: Lens' GetStreamingSessionResponse (Maybe StreamingSession)
getStreamingSessionResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStreamingSessionResponse' {Maybe StreamingSession
session :: Maybe StreamingSession
$sel:session:GetStreamingSessionResponse' :: GetStreamingSessionResponse -> Maybe StreamingSession
session} -> Maybe StreamingSession
session) (\s :: GetStreamingSessionResponse
s@GetStreamingSessionResponse' {} Maybe StreamingSession
a -> GetStreamingSessionResponse
s {$sel:session:GetStreamingSessionResponse' :: Maybe StreamingSession
session = Maybe StreamingSession
a} :: GetStreamingSessionResponse)

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

instance Prelude.NFData GetStreamingSessionResponse where
  rnf :: GetStreamingSessionResponse -> ()
rnf GetStreamingSessionResponse' {Int
Maybe StreamingSession
httpStatus :: Int
session :: Maybe StreamingSession
$sel:httpStatus:GetStreamingSessionResponse' :: GetStreamingSessionResponse -> Int
$sel:session:GetStreamingSessionResponse' :: GetStreamingSessionResponse -> 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