{-# 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.AppStream.CreateUpdatedImage
-- 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 new image with the latest Windows operating system updates,
-- driver updates, and AppStream 2.0 agent software.
--
-- For more information, see the \"Update an Image by Using Managed
-- AppStream 2.0 Image Updates\" section in
-- <https://docs.aws.amazon.com/appstream2/latest/developerguide/administer-images.html Administer Your AppStream 2.0 Images>,
-- in the /Amazon AppStream 2.0 Administration Guide/.
module Amazonka.AppStream.CreateUpdatedImage
  ( -- * Creating a Request
    CreateUpdatedImage (..),
    newCreateUpdatedImage,

    -- * Request Lenses
    createUpdatedImage_dryRun,
    createUpdatedImage_newImageDescription,
    createUpdatedImage_newImageDisplayName,
    createUpdatedImage_newImageTags,
    createUpdatedImage_existingImageName,
    createUpdatedImage_newImageName,

    -- * Destructuring the Response
    CreateUpdatedImageResponse (..),
    newCreateUpdatedImageResponse,

    -- * Response Lenses
    createUpdatedImageResponse_canUpdateImage,
    createUpdatedImageResponse_image,
    createUpdatedImageResponse_httpStatus,
  )
where

import Amazonka.AppStream.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:/ 'newCreateUpdatedImage' smart constructor.
data CreateUpdatedImage = CreateUpdatedImage'
  { -- | Indicates whether to display the status of image update availability
    -- before AppStream 2.0 initiates the process of creating a new updated
    -- image. If this value is set to @true@, AppStream 2.0 displays whether
    -- image updates are available. If this value is set to @false@, AppStream
    -- 2.0 initiates the process of creating a new updated image without
    -- displaying whether image updates are available.
    CreateUpdatedImage -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The description to display for the new image.
    CreateUpdatedImage -> Maybe Text
newImageDescription' :: Prelude.Maybe Prelude.Text,
    -- | The name to display for the new image.
    CreateUpdatedImage -> Maybe Text
newImageDisplayName' :: Prelude.Maybe Prelude.Text,
    -- | The tags to associate with the new image. A tag is a key-value pair, and
    -- the value is optional. For example, Environment=Test. If you do not
    -- specify a value, Environment=.
    --
    -- Generally allowed characters are: letters, numbers, and spaces
    -- representable in UTF-8, and the following special characters:
    --
    -- _ . : \/ = + \\ - \@
    --
    -- If you do not specify a value, the value is set to an empty string.
    --
    -- For more information about tags, see
    -- <https://docs.aws.amazon.com/appstream2/latest/developerguide/tagging-basic.html Tagging Your Resources>
    -- in the /Amazon AppStream 2.0 Administration Guide/.
    CreateUpdatedImage -> Maybe (HashMap Text Text)
newImageTags' :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the image to update.
    CreateUpdatedImage -> Text
existingImageName :: Prelude.Text,
    -- | The name of the new image. The name must be unique within the AWS
    -- account and Region.
    CreateUpdatedImage -> Text
newImageName' :: Prelude.Text
  }
  deriving (CreateUpdatedImage -> CreateUpdatedImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateUpdatedImage -> CreateUpdatedImage -> Bool
$c/= :: CreateUpdatedImage -> CreateUpdatedImage -> Bool
== :: CreateUpdatedImage -> CreateUpdatedImage -> Bool
$c== :: CreateUpdatedImage -> CreateUpdatedImage -> Bool
Prelude.Eq, ReadPrec [CreateUpdatedImage]
ReadPrec CreateUpdatedImage
Int -> ReadS CreateUpdatedImage
ReadS [CreateUpdatedImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateUpdatedImage]
$creadListPrec :: ReadPrec [CreateUpdatedImage]
readPrec :: ReadPrec CreateUpdatedImage
$creadPrec :: ReadPrec CreateUpdatedImage
readList :: ReadS [CreateUpdatedImage]
$creadList :: ReadS [CreateUpdatedImage]
readsPrec :: Int -> ReadS CreateUpdatedImage
$creadsPrec :: Int -> ReadS CreateUpdatedImage
Prelude.Read, Int -> CreateUpdatedImage -> ShowS
[CreateUpdatedImage] -> ShowS
CreateUpdatedImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateUpdatedImage] -> ShowS
$cshowList :: [CreateUpdatedImage] -> ShowS
show :: CreateUpdatedImage -> String
$cshow :: CreateUpdatedImage -> String
showsPrec :: Int -> CreateUpdatedImage -> ShowS
$cshowsPrec :: Int -> CreateUpdatedImage -> ShowS
Prelude.Show, forall x. Rep CreateUpdatedImage x -> CreateUpdatedImage
forall x. CreateUpdatedImage -> Rep CreateUpdatedImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateUpdatedImage x -> CreateUpdatedImage
$cfrom :: forall x. CreateUpdatedImage -> Rep CreateUpdatedImage x
Prelude.Generic)

-- |
-- Create a value of 'CreateUpdatedImage' 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:
--
-- 'dryRun', 'createUpdatedImage_dryRun' - Indicates whether to display the status of image update availability
-- before AppStream 2.0 initiates the process of creating a new updated
-- image. If this value is set to @true@, AppStream 2.0 displays whether
-- image updates are available. If this value is set to @false@, AppStream
-- 2.0 initiates the process of creating a new updated image without
-- displaying whether image updates are available.
--
-- 'newImageDescription'', 'createUpdatedImage_newImageDescription' - The description to display for the new image.
--
-- 'newImageDisplayName'', 'createUpdatedImage_newImageDisplayName' - The name to display for the new image.
--
-- 'newImageTags'', 'createUpdatedImage_newImageTags' - The tags to associate with the new image. A tag is a key-value pair, and
-- the value is optional. For example, Environment=Test. If you do not
-- specify a value, Environment=.
--
-- Generally allowed characters are: letters, numbers, and spaces
-- representable in UTF-8, and the following special characters:
--
-- _ . : \/ = + \\ - \@
--
-- If you do not specify a value, the value is set to an empty string.
--
-- For more information about tags, see
-- <https://docs.aws.amazon.com/appstream2/latest/developerguide/tagging-basic.html Tagging Your Resources>
-- in the /Amazon AppStream 2.0 Administration Guide/.
--
-- 'existingImageName', 'createUpdatedImage_existingImageName' - The name of the image to update.
--
-- 'newImageName'', 'createUpdatedImage_newImageName' - The name of the new image. The name must be unique within the AWS
-- account and Region.
newCreateUpdatedImage ::
  -- | 'existingImageName'
  Prelude.Text ->
  -- | 'newImageName''
  Prelude.Text ->
  CreateUpdatedImage
newCreateUpdatedImage :: Text -> Text -> CreateUpdatedImage
newCreateUpdatedImage
  Text
pExistingImageName_
  Text
pNewImageName_ =
    CreateUpdatedImage'
      { $sel:dryRun:CreateUpdatedImage' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:newImageDescription':CreateUpdatedImage' :: Maybe Text
newImageDescription' = forall a. Maybe a
Prelude.Nothing,
        $sel:newImageDisplayName':CreateUpdatedImage' :: Maybe Text
newImageDisplayName' = forall a. Maybe a
Prelude.Nothing,
        $sel:newImageTags':CreateUpdatedImage' :: Maybe (HashMap Text Text)
newImageTags' = forall a. Maybe a
Prelude.Nothing,
        $sel:existingImageName:CreateUpdatedImage' :: Text
existingImageName = Text
pExistingImageName_,
        $sel:newImageName':CreateUpdatedImage' :: Text
newImageName' = Text
pNewImageName_
      }

-- | Indicates whether to display the status of image update availability
-- before AppStream 2.0 initiates the process of creating a new updated
-- image. If this value is set to @true@, AppStream 2.0 displays whether
-- image updates are available. If this value is set to @false@, AppStream
-- 2.0 initiates the process of creating a new updated image without
-- displaying whether image updates are available.
createUpdatedImage_dryRun :: Lens.Lens' CreateUpdatedImage (Prelude.Maybe Prelude.Bool)
createUpdatedImage_dryRun :: Lens' CreateUpdatedImage (Maybe Bool)
createUpdatedImage_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImage' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateUpdatedImage
s@CreateUpdatedImage' {} Maybe Bool
a -> CreateUpdatedImage
s {$sel:dryRun:CreateUpdatedImage' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateUpdatedImage)

-- | The description to display for the new image.
createUpdatedImage_newImageDescription :: Lens.Lens' CreateUpdatedImage (Prelude.Maybe Prelude.Text)
createUpdatedImage_newImageDescription :: Lens' CreateUpdatedImage (Maybe Text)
createUpdatedImage_newImageDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImage' {Maybe Text
newImageDescription' :: Maybe Text
$sel:newImageDescription':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
newImageDescription'} -> Maybe Text
newImageDescription') (\s :: CreateUpdatedImage
s@CreateUpdatedImage' {} Maybe Text
a -> CreateUpdatedImage
s {$sel:newImageDescription':CreateUpdatedImage' :: Maybe Text
newImageDescription' = Maybe Text
a} :: CreateUpdatedImage)

-- | The name to display for the new image.
createUpdatedImage_newImageDisplayName :: Lens.Lens' CreateUpdatedImage (Prelude.Maybe Prelude.Text)
createUpdatedImage_newImageDisplayName :: Lens' CreateUpdatedImage (Maybe Text)
createUpdatedImage_newImageDisplayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImage' {Maybe Text
newImageDisplayName' :: Maybe Text
$sel:newImageDisplayName':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
newImageDisplayName'} -> Maybe Text
newImageDisplayName') (\s :: CreateUpdatedImage
s@CreateUpdatedImage' {} Maybe Text
a -> CreateUpdatedImage
s {$sel:newImageDisplayName':CreateUpdatedImage' :: Maybe Text
newImageDisplayName' = Maybe Text
a} :: CreateUpdatedImage)

-- | The tags to associate with the new image. A tag is a key-value pair, and
-- the value is optional. For example, Environment=Test. If you do not
-- specify a value, Environment=.
--
-- Generally allowed characters are: letters, numbers, and spaces
-- representable in UTF-8, and the following special characters:
--
-- _ . : \/ = + \\ - \@
--
-- If you do not specify a value, the value is set to an empty string.
--
-- For more information about tags, see
-- <https://docs.aws.amazon.com/appstream2/latest/developerguide/tagging-basic.html Tagging Your Resources>
-- in the /Amazon AppStream 2.0 Administration Guide/.
createUpdatedImage_newImageTags :: Lens.Lens' CreateUpdatedImage (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createUpdatedImage_newImageTags :: Lens' CreateUpdatedImage (Maybe (HashMap Text Text))
createUpdatedImage_newImageTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImage' {Maybe (HashMap Text Text)
newImageTags' :: Maybe (HashMap Text Text)
$sel:newImageTags':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe (HashMap Text Text)
newImageTags'} -> Maybe (HashMap Text Text)
newImageTags') (\s :: CreateUpdatedImage
s@CreateUpdatedImage' {} Maybe (HashMap Text Text)
a -> CreateUpdatedImage
s {$sel:newImageTags':CreateUpdatedImage' :: Maybe (HashMap Text Text)
newImageTags' = Maybe (HashMap Text Text)
a} :: CreateUpdatedImage) 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 name of the image to update.
createUpdatedImage_existingImageName :: Lens.Lens' CreateUpdatedImage Prelude.Text
createUpdatedImage_existingImageName :: Lens' CreateUpdatedImage Text
createUpdatedImage_existingImageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImage' {Text
existingImageName :: Text
$sel:existingImageName:CreateUpdatedImage' :: CreateUpdatedImage -> Text
existingImageName} -> Text
existingImageName) (\s :: CreateUpdatedImage
s@CreateUpdatedImage' {} Text
a -> CreateUpdatedImage
s {$sel:existingImageName:CreateUpdatedImage' :: Text
existingImageName = Text
a} :: CreateUpdatedImage)

-- | The name of the new image. The name must be unique within the AWS
-- account and Region.
createUpdatedImage_newImageName :: Lens.Lens' CreateUpdatedImage Prelude.Text
createUpdatedImage_newImageName :: Lens' CreateUpdatedImage Text
createUpdatedImage_newImageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImage' {Text
newImageName' :: Text
$sel:newImageName':CreateUpdatedImage' :: CreateUpdatedImage -> Text
newImageName'} -> Text
newImageName') (\s :: CreateUpdatedImage
s@CreateUpdatedImage' {} Text
a -> CreateUpdatedImage
s {$sel:newImageName':CreateUpdatedImage' :: Text
newImageName' = Text
a} :: CreateUpdatedImage)

instance Core.AWSRequest CreateUpdatedImage where
  type
    AWSResponse CreateUpdatedImage =
      CreateUpdatedImageResponse
  request :: (Service -> Service)
-> CreateUpdatedImage -> Request CreateUpdatedImage
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 CreateUpdatedImage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateUpdatedImage)))
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 Bool -> Maybe Image -> Int -> CreateUpdatedImageResponse
CreateUpdatedImageResponse'
            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
"canUpdateImage")
            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
"image")
            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 CreateUpdatedImage where
  hashWithSalt :: Int -> CreateUpdatedImage -> Int
hashWithSalt Int
_salt CreateUpdatedImage' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Text
newImageName' :: Text
existingImageName :: Text
newImageTags' :: Maybe (HashMap Text Text)
newImageDisplayName' :: Maybe Text
newImageDescription' :: Maybe Text
dryRun :: Maybe Bool
$sel:newImageName':CreateUpdatedImage' :: CreateUpdatedImage -> Text
$sel:existingImageName:CreateUpdatedImage' :: CreateUpdatedImage -> Text
$sel:newImageTags':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe (HashMap Text Text)
$sel:newImageDisplayName':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
$sel:newImageDescription':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
$sel:dryRun:CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newImageDescription'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newImageDisplayName'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
newImageTags'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
existingImageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
newImageName'

instance Prelude.NFData CreateUpdatedImage where
  rnf :: CreateUpdatedImage -> ()
rnf CreateUpdatedImage' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Text
newImageName' :: Text
existingImageName :: Text
newImageTags' :: Maybe (HashMap Text Text)
newImageDisplayName' :: Maybe Text
newImageDescription' :: Maybe Text
dryRun :: Maybe Bool
$sel:newImageName':CreateUpdatedImage' :: CreateUpdatedImage -> Text
$sel:existingImageName:CreateUpdatedImage' :: CreateUpdatedImage -> Text
$sel:newImageTags':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe (HashMap Text Text)
$sel:newImageDisplayName':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
$sel:newImageDescription':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
$sel:dryRun:CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newImageDescription'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newImageDisplayName'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
newImageTags'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
existingImageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
newImageName'

instance Data.ToHeaders CreateUpdatedImage where
  toHeaders :: CreateUpdatedImage -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"PhotonAdminProxyService.CreateUpdatedImage" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateUpdatedImage where
  toJSON :: CreateUpdatedImage -> Value
toJSON CreateUpdatedImage' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Text
newImageName' :: Text
existingImageName :: Text
newImageTags' :: Maybe (HashMap Text Text)
newImageDisplayName' :: Maybe Text
newImageDescription' :: Maybe Text
dryRun :: Maybe Bool
$sel:newImageName':CreateUpdatedImage' :: CreateUpdatedImage -> Text
$sel:existingImageName:CreateUpdatedImage' :: CreateUpdatedImage -> Text
$sel:newImageTags':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe (HashMap Text Text)
$sel:newImageDisplayName':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
$sel:newImageDescription':CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Text
$sel:dryRun:CreateUpdatedImage' :: CreateUpdatedImage -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"dryRun" 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
dryRun,
            (Key
"newImageDescription" 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 Text
newImageDescription',
            (Key
"newImageDisplayName" 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 Text
newImageDisplayName',
            (Key
"newImageTags" 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)
newImageTags',
            forall a. a -> Maybe a
Prelude.Just
              (Key
"existingImageName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
existingImageName),
            forall a. a -> Maybe a
Prelude.Just (Key
"newImageName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
newImageName')
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateUpdatedImageResponse' 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:
--
-- 'canUpdateImage', 'createUpdatedImageResponse_canUpdateImage' - Indicates whether a new image can be created.
--
-- 'image', 'createUpdatedImageResponse_image' - Undocumented member.
--
-- 'httpStatus', 'createUpdatedImageResponse_httpStatus' - The response's http status code.
newCreateUpdatedImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateUpdatedImageResponse
newCreateUpdatedImageResponse :: Int -> CreateUpdatedImageResponse
newCreateUpdatedImageResponse Int
pHttpStatus_ =
  CreateUpdatedImageResponse'
    { $sel:canUpdateImage:CreateUpdatedImageResponse' :: Maybe Bool
canUpdateImage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:image:CreateUpdatedImageResponse' :: Maybe Image
image = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateUpdatedImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates whether a new image can be created.
createUpdatedImageResponse_canUpdateImage :: Lens.Lens' CreateUpdatedImageResponse (Prelude.Maybe Prelude.Bool)
createUpdatedImageResponse_canUpdateImage :: Lens' CreateUpdatedImageResponse (Maybe Bool)
createUpdatedImageResponse_canUpdateImage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImageResponse' {Maybe Bool
canUpdateImage :: Maybe Bool
$sel:canUpdateImage:CreateUpdatedImageResponse' :: CreateUpdatedImageResponse -> Maybe Bool
canUpdateImage} -> Maybe Bool
canUpdateImage) (\s :: CreateUpdatedImageResponse
s@CreateUpdatedImageResponse' {} Maybe Bool
a -> CreateUpdatedImageResponse
s {$sel:canUpdateImage:CreateUpdatedImageResponse' :: Maybe Bool
canUpdateImage = Maybe Bool
a} :: CreateUpdatedImageResponse)

-- | Undocumented member.
createUpdatedImageResponse_image :: Lens.Lens' CreateUpdatedImageResponse (Prelude.Maybe Image)
createUpdatedImageResponse_image :: Lens' CreateUpdatedImageResponse (Maybe Image)
createUpdatedImageResponse_image = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUpdatedImageResponse' {Maybe Image
image :: Maybe Image
$sel:image:CreateUpdatedImageResponse' :: CreateUpdatedImageResponse -> Maybe Image
image} -> Maybe Image
image) (\s :: CreateUpdatedImageResponse
s@CreateUpdatedImageResponse' {} Maybe Image
a -> CreateUpdatedImageResponse
s {$sel:image:CreateUpdatedImageResponse' :: Maybe Image
image = Maybe Image
a} :: CreateUpdatedImageResponse)

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

instance Prelude.NFData CreateUpdatedImageResponse where
  rnf :: CreateUpdatedImageResponse -> ()
rnf CreateUpdatedImageResponse' {Int
Maybe Bool
Maybe Image
httpStatus :: Int
image :: Maybe Image
canUpdateImage :: Maybe Bool
$sel:httpStatus:CreateUpdatedImageResponse' :: CreateUpdatedImageResponse -> Int
$sel:image:CreateUpdatedImageResponse' :: CreateUpdatedImageResponse -> Maybe Image
$sel:canUpdateImage:CreateUpdatedImageResponse' :: CreateUpdatedImageResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
canUpdateImage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Image
image
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus