{-# 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.GetStreamingImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get streaming image.
module Amazonka.Nimble.GetStreamingImage
  ( -- * Creating a Request
    GetStreamingImage (..),
    newGetStreamingImage,

    -- * Request Lenses
    getStreamingImage_streamingImageId,
    getStreamingImage_studioId,

    -- * Destructuring the Response
    GetStreamingImageResponse (..),
    newGetStreamingImageResponse,

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

-- |
-- Create a value of 'GetStreamingImage' 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:
--
-- 'streamingImageId', 'getStreamingImage_streamingImageId' - The streaming image ID.
--
-- 'studioId', 'getStreamingImage_studioId' - The studio ID.
newGetStreamingImage ::
  -- | 'streamingImageId'
  Prelude.Text ->
  -- | 'studioId'
  Prelude.Text ->
  GetStreamingImage
newGetStreamingImage :: Text -> Text -> GetStreamingImage
newGetStreamingImage Text
pStreamingImageId_ Text
pStudioId_ =
  GetStreamingImage'
    { $sel:streamingImageId:GetStreamingImage' :: Text
streamingImageId =
        Text
pStreamingImageId_,
      $sel:studioId:GetStreamingImage' :: Text
studioId = Text
pStudioId_
    }

-- | The streaming image ID.
getStreamingImage_streamingImageId :: Lens.Lens' GetStreamingImage Prelude.Text
getStreamingImage_streamingImageId :: Lens' GetStreamingImage Text
getStreamingImage_streamingImageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStreamingImage' {Text
streamingImageId :: Text
$sel:streamingImageId:GetStreamingImage' :: GetStreamingImage -> Text
streamingImageId} -> Text
streamingImageId) (\s :: GetStreamingImage
s@GetStreamingImage' {} Text
a -> GetStreamingImage
s {$sel:streamingImageId:GetStreamingImage' :: Text
streamingImageId = Text
a} :: GetStreamingImage)

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

instance Core.AWSRequest GetStreamingImage where
  type
    AWSResponse GetStreamingImage =
      GetStreamingImageResponse
  request :: (Service -> Service)
-> GetStreamingImage -> Request GetStreamingImage
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 GetStreamingImage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetStreamingImage)))
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 StreamingImage -> Int -> GetStreamingImageResponse
GetStreamingImageResponse'
            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
"streamingImage")
            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 GetStreamingImage where
  hashWithSalt :: Int -> GetStreamingImage -> Int
hashWithSalt Int
_salt GetStreamingImage' {Text
studioId :: Text
streamingImageId :: Text
$sel:studioId:GetStreamingImage' :: GetStreamingImage -> Text
$sel:streamingImageId:GetStreamingImage' :: GetStreamingImage -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
streamingImageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData GetStreamingImage where
  rnf :: GetStreamingImage -> ()
rnf GetStreamingImage' {Text
studioId :: Text
streamingImageId :: Text
$sel:studioId:GetStreamingImage' :: GetStreamingImage -> Text
$sel:streamingImageId:GetStreamingImage' :: GetStreamingImage -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
streamingImageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

instance Data.ToHeaders GetStreamingImage where
  toHeaders :: GetStreamingImage -> 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 GetStreamingImage where
  toPath :: GetStreamingImage -> ByteString
toPath GetStreamingImage' {Text
studioId :: Text
streamingImageId :: Text
$sel:studioId:GetStreamingImage' :: GetStreamingImage -> Text
$sel:streamingImageId:GetStreamingImage' :: GetStreamingImage -> 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-images/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
streamingImageId
      ]

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

-- | /See:/ 'newGetStreamingImageResponse' smart constructor.
data GetStreamingImageResponse = GetStreamingImageResponse'
  { -- | The streaming image.
    GetStreamingImageResponse -> Maybe StreamingImage
streamingImage :: Prelude.Maybe StreamingImage,
    -- | The response's http status code.
    GetStreamingImageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetStreamingImageResponse -> GetStreamingImageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStreamingImageResponse -> GetStreamingImageResponse -> Bool
$c/= :: GetStreamingImageResponse -> GetStreamingImageResponse -> Bool
== :: GetStreamingImageResponse -> GetStreamingImageResponse -> Bool
$c== :: GetStreamingImageResponse -> GetStreamingImageResponse -> Bool
Prelude.Eq, Int -> GetStreamingImageResponse -> ShowS
[GetStreamingImageResponse] -> ShowS
GetStreamingImageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStreamingImageResponse] -> ShowS
$cshowList :: [GetStreamingImageResponse] -> ShowS
show :: GetStreamingImageResponse -> String
$cshow :: GetStreamingImageResponse -> String
showsPrec :: Int -> GetStreamingImageResponse -> ShowS
$cshowsPrec :: Int -> GetStreamingImageResponse -> ShowS
Prelude.Show, forall x.
Rep GetStreamingImageResponse x -> GetStreamingImageResponse
forall x.
GetStreamingImageResponse -> Rep GetStreamingImageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetStreamingImageResponse x -> GetStreamingImageResponse
$cfrom :: forall x.
GetStreamingImageResponse -> Rep GetStreamingImageResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetStreamingImageResponse' 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:
--
-- 'streamingImage', 'getStreamingImageResponse_streamingImage' - The streaming image.
--
-- 'httpStatus', 'getStreamingImageResponse_httpStatus' - The response's http status code.
newGetStreamingImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetStreamingImageResponse
newGetStreamingImageResponse :: Int -> GetStreamingImageResponse
newGetStreamingImageResponse Int
pHttpStatus_ =
  GetStreamingImageResponse'
    { $sel:streamingImage:GetStreamingImageResponse' :: Maybe StreamingImage
streamingImage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetStreamingImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The streaming image.
getStreamingImageResponse_streamingImage :: Lens.Lens' GetStreamingImageResponse (Prelude.Maybe StreamingImage)
getStreamingImageResponse_streamingImage :: Lens' GetStreamingImageResponse (Maybe StreamingImage)
getStreamingImageResponse_streamingImage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStreamingImageResponse' {Maybe StreamingImage
streamingImage :: Maybe StreamingImage
$sel:streamingImage:GetStreamingImageResponse' :: GetStreamingImageResponse -> Maybe StreamingImage
streamingImage} -> Maybe StreamingImage
streamingImage) (\s :: GetStreamingImageResponse
s@GetStreamingImageResponse' {} Maybe StreamingImage
a -> GetStreamingImageResponse
s {$sel:streamingImage:GetStreamingImageResponse' :: Maybe StreamingImage
streamingImage = Maybe StreamingImage
a} :: GetStreamingImageResponse)

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

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