{-# 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.CreateStreamingImage
-- 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 a streaming image resource in a studio.
module Amazonka.Nimble.CreateStreamingImage
  ( -- * Creating a Request
    CreateStreamingImage (..),
    newCreateStreamingImage,

    -- * Request Lenses
    createStreamingImage_clientToken,
    createStreamingImage_description,
    createStreamingImage_tags,
    createStreamingImage_ec2ImageId,
    createStreamingImage_name,
    createStreamingImage_studioId,

    -- * Destructuring the Response
    CreateStreamingImageResponse (..),
    newCreateStreamingImageResponse,

    -- * Response Lenses
    createStreamingImageResponse_streamingImage,
    createStreamingImageResponse_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:/ 'newCreateStreamingImage' smart constructor.
data CreateStreamingImage = CreateStreamingImage'
  { -- | 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.
    CreateStreamingImage -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A human-readable description of the streaming image.
    CreateStreamingImage -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A collection of labels, in the form of key-value pairs, that apply to
    -- this resource.
    CreateStreamingImage -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ID of an EC2 machine image with which to create this streaming
    -- image.
    CreateStreamingImage -> Text
ec2ImageId :: Prelude.Text,
    -- | A friendly name for a streaming image resource.
    CreateStreamingImage -> Sensitive Text
name :: Data.Sensitive Prelude.Text,
    -- | The studio ID.
    CreateStreamingImage -> Text
studioId :: Prelude.Text
  }
  deriving (CreateStreamingImage -> CreateStreamingImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStreamingImage -> CreateStreamingImage -> Bool
$c/= :: CreateStreamingImage -> CreateStreamingImage -> Bool
== :: CreateStreamingImage -> CreateStreamingImage -> Bool
$c== :: CreateStreamingImage -> CreateStreamingImage -> Bool
Prelude.Eq, Int -> CreateStreamingImage -> ShowS
[CreateStreamingImage] -> ShowS
CreateStreamingImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStreamingImage] -> ShowS
$cshowList :: [CreateStreamingImage] -> ShowS
show :: CreateStreamingImage -> String
$cshow :: CreateStreamingImage -> String
showsPrec :: Int -> CreateStreamingImage -> ShowS
$cshowsPrec :: Int -> CreateStreamingImage -> ShowS
Prelude.Show, forall x. Rep CreateStreamingImage x -> CreateStreamingImage
forall x. CreateStreamingImage -> Rep CreateStreamingImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStreamingImage x -> CreateStreamingImage
$cfrom :: forall x. CreateStreamingImage -> Rep CreateStreamingImage x
Prelude.Generic)

-- |
-- Create a value of 'CreateStreamingImage' 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', 'createStreamingImage_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.
--
-- 'description', 'createStreamingImage_description' - A human-readable description of the streaming image.
--
-- 'tags', 'createStreamingImage_tags' - A collection of labels, in the form of key-value pairs, that apply to
-- this resource.
--
-- 'ec2ImageId', 'createStreamingImage_ec2ImageId' - The ID of an EC2 machine image with which to create this streaming
-- image.
--
-- 'name', 'createStreamingImage_name' - A friendly name for a streaming image resource.
--
-- 'studioId', 'createStreamingImage_studioId' - The studio ID.
newCreateStreamingImage ::
  -- | 'ec2ImageId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'studioId'
  Prelude.Text ->
  CreateStreamingImage
newCreateStreamingImage :: Text -> Text -> Text -> CreateStreamingImage
newCreateStreamingImage
  Text
pEc2ImageId_
  Text
pName_
  Text
pStudioId_ =
    CreateStreamingImage'
      { $sel:clientToken:CreateStreamingImage' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateStreamingImage' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateStreamingImage' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:ec2ImageId:CreateStreamingImage' :: Text
ec2ImageId = Text
pEc2ImageId_,
        $sel:name:CreateStreamingImage' :: Sensitive Text
name = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pName_,
        $sel:studioId:CreateStreamingImage' :: 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.
createStreamingImage_clientToken :: Lens.Lens' CreateStreamingImage (Prelude.Maybe Prelude.Text)
createStreamingImage_clientToken :: Lens' CreateStreamingImage (Maybe Text)
createStreamingImage_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingImage' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateStreamingImage' :: CreateStreamingImage -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateStreamingImage
s@CreateStreamingImage' {} Maybe Text
a -> CreateStreamingImage
s {$sel:clientToken:CreateStreamingImage' :: Maybe Text
clientToken = Maybe Text
a} :: CreateStreamingImage)

-- | A human-readable description of the streaming image.
createStreamingImage_description :: Lens.Lens' CreateStreamingImage (Prelude.Maybe Prelude.Text)
createStreamingImage_description :: Lens' CreateStreamingImage (Maybe Text)
createStreamingImage_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingImage' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:CreateStreamingImage' :: CreateStreamingImage -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: CreateStreamingImage
s@CreateStreamingImage' {} Maybe (Sensitive Text)
a -> CreateStreamingImage
s {$sel:description:CreateStreamingImage' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: CreateStreamingImage) 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. Iso' (Sensitive a) a
Data._Sensitive

-- | A collection of labels, in the form of key-value pairs, that apply to
-- this resource.
createStreamingImage_tags :: Lens.Lens' CreateStreamingImage (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createStreamingImage_tags :: Lens' CreateStreamingImage (Maybe (HashMap Text Text))
createStreamingImage_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingImage' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateStreamingImage' :: CreateStreamingImage -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateStreamingImage
s@CreateStreamingImage' {} Maybe (HashMap Text Text)
a -> CreateStreamingImage
s {$sel:tags:CreateStreamingImage' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateStreamingImage) 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

-- | The ID of an EC2 machine image with which to create this streaming
-- image.
createStreamingImage_ec2ImageId :: Lens.Lens' CreateStreamingImage Prelude.Text
createStreamingImage_ec2ImageId :: Lens' CreateStreamingImage Text
createStreamingImage_ec2ImageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingImage' {Text
ec2ImageId :: Text
$sel:ec2ImageId:CreateStreamingImage' :: CreateStreamingImage -> Text
ec2ImageId} -> Text
ec2ImageId) (\s :: CreateStreamingImage
s@CreateStreamingImage' {} Text
a -> CreateStreamingImage
s {$sel:ec2ImageId:CreateStreamingImage' :: Text
ec2ImageId = Text
a} :: CreateStreamingImage)

-- | A friendly name for a streaming image resource.
createStreamingImage_name :: Lens.Lens' CreateStreamingImage Prelude.Text
createStreamingImage_name :: Lens' CreateStreamingImage Text
createStreamingImage_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingImage' {Sensitive Text
name :: Sensitive Text
$sel:name:CreateStreamingImage' :: CreateStreamingImage -> Sensitive Text
name} -> Sensitive Text
name) (\s :: CreateStreamingImage
s@CreateStreamingImage' {} Sensitive Text
a -> CreateStreamingImage
s {$sel:name:CreateStreamingImage' :: Sensitive Text
name = Sensitive Text
a} :: CreateStreamingImage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

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

instance Core.AWSRequest CreateStreamingImage where
  type
    AWSResponse CreateStreamingImage =
      CreateStreamingImageResponse
  request :: (Service -> Service)
-> CreateStreamingImage -> Request CreateStreamingImage
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 CreateStreamingImage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateStreamingImage)))
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 -> CreateStreamingImageResponse
CreateStreamingImageResponse'
            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 CreateStreamingImage where
  hashWithSalt :: Int -> CreateStreamingImage -> Int
hashWithSalt Int
_salt CreateStreamingImage' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
Sensitive Text
studioId :: Text
name :: Sensitive Text
ec2ImageId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:name:CreateStreamingImage' :: CreateStreamingImage -> Sensitive Text
$sel:ec2ImageId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:tags:CreateStreamingImage' :: CreateStreamingImage -> Maybe (HashMap Text Text)
$sel:description:CreateStreamingImage' :: CreateStreamingImage -> Maybe (Sensitive Text)
$sel:clientToken:CreateStreamingImage' :: CreateStreamingImage -> 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 (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ec2ImageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData CreateStreamingImage where
  rnf :: CreateStreamingImage -> ()
rnf CreateStreamingImage' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
Sensitive Text
studioId :: Text
name :: Sensitive Text
ec2ImageId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:name:CreateStreamingImage' :: CreateStreamingImage -> Sensitive Text
$sel:ec2ImageId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:tags:CreateStreamingImage' :: CreateStreamingImage -> Maybe (HashMap Text Text)
$sel:description:CreateStreamingImage' :: CreateStreamingImage -> Maybe (Sensitive Text)
$sel:clientToken:CreateStreamingImage' :: CreateStreamingImage -> 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 (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ec2ImageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

instance Data.ToHeaders CreateStreamingImage where
  toHeaders :: CreateStreamingImage -> ResponseHeaders
toHeaders CreateStreamingImage' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
Sensitive Text
studioId :: Text
name :: Sensitive Text
ec2ImageId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:name:CreateStreamingImage' :: CreateStreamingImage -> Sensitive Text
$sel:ec2ImageId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:tags:CreateStreamingImage' :: CreateStreamingImage -> Maybe (HashMap Text Text)
$sel:description:CreateStreamingImage' :: CreateStreamingImage -> Maybe (Sensitive Text)
$sel:clientToken:CreateStreamingImage' :: CreateStreamingImage -> 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 CreateStreamingImage where
  toJSON :: CreateStreamingImage -> Value
toJSON CreateStreamingImage' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
Sensitive Text
studioId :: Text
name :: Sensitive Text
ec2ImageId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:name:CreateStreamingImage' :: CreateStreamingImage -> Sensitive Text
$sel:ec2ImageId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:tags:CreateStreamingImage' :: CreateStreamingImage -> Maybe (HashMap Text Text)
$sel:description:CreateStreamingImage' :: CreateStreamingImage -> Maybe (Sensitive Text)
$sel:clientToken:CreateStreamingImage' :: CreateStreamingImage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" 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 (Sensitive Text)
description,
            (Key
"tags" 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)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"ec2ImageId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
ec2ImageId),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
name)
          ]
      )

instance Data.ToPath CreateStreamingImage where
  toPath :: CreateStreamingImage -> ByteString
toPath CreateStreamingImage' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
Sensitive Text
studioId :: Text
name :: Sensitive Text
ec2ImageId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:name:CreateStreamingImage' :: CreateStreamingImage -> Sensitive Text
$sel:ec2ImageId:CreateStreamingImage' :: CreateStreamingImage -> Text
$sel:tags:CreateStreamingImage' :: CreateStreamingImage -> Maybe (HashMap Text Text)
$sel:description:CreateStreamingImage' :: CreateStreamingImage -> Maybe (Sensitive Text)
$sel:clientToken:CreateStreamingImage' :: CreateStreamingImage -> 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-images"
      ]

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

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

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

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

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

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