{-# 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.CopyImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Copies the image within the same region or to a new region within the
-- same AWS account. Note that any tags you added to the image will not be
-- copied.
module Amazonka.AppStream.CopyImage
  ( -- * Creating a Request
    CopyImage (..),
    newCopyImage,

    -- * Request Lenses
    copyImage_destinationImageDescription,
    copyImage_sourceImageName,
    copyImage_destinationImageName,
    copyImage_destinationRegion,

    -- * Destructuring the Response
    CopyImageResponse (..),
    newCopyImageResponse,

    -- * Response Lenses
    copyImageResponse_destinationImageName,
    copyImageResponse_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:/ 'newCopyImage' smart constructor.
data CopyImage = CopyImage'
  { -- | The description that the image will have when it is copied to the
    -- destination.
    CopyImage -> Maybe Text
destinationImageDescription :: Prelude.Maybe Prelude.Text,
    -- | The name of the image to copy.
    CopyImage -> Text
sourceImageName :: Prelude.Text,
    -- | The name that the image will have when it is copied to the destination.
    CopyImage -> Text
destinationImageName :: Prelude.Text,
    -- | The destination region to which the image will be copied. This parameter
    -- is required, even if you are copying an image within the same region.
    CopyImage -> Text
destinationRegion :: Prelude.Text
  }
  deriving (CopyImage -> CopyImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyImage -> CopyImage -> Bool
$c/= :: CopyImage -> CopyImage -> Bool
== :: CopyImage -> CopyImage -> Bool
$c== :: CopyImage -> CopyImage -> Bool
Prelude.Eq, ReadPrec [CopyImage]
ReadPrec CopyImage
Int -> ReadS CopyImage
ReadS [CopyImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyImage]
$creadListPrec :: ReadPrec [CopyImage]
readPrec :: ReadPrec CopyImage
$creadPrec :: ReadPrec CopyImage
readList :: ReadS [CopyImage]
$creadList :: ReadS [CopyImage]
readsPrec :: Int -> ReadS CopyImage
$creadsPrec :: Int -> ReadS CopyImage
Prelude.Read, Int -> CopyImage -> ShowS
[CopyImage] -> ShowS
CopyImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyImage] -> ShowS
$cshowList :: [CopyImage] -> ShowS
show :: CopyImage -> String
$cshow :: CopyImage -> String
showsPrec :: Int -> CopyImage -> ShowS
$cshowsPrec :: Int -> CopyImage -> ShowS
Prelude.Show, forall x. Rep CopyImage x -> CopyImage
forall x. CopyImage -> Rep CopyImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyImage x -> CopyImage
$cfrom :: forall x. CopyImage -> Rep CopyImage x
Prelude.Generic)

-- |
-- Create a value of 'CopyImage' 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:
--
-- 'destinationImageDescription', 'copyImage_destinationImageDescription' - The description that the image will have when it is copied to the
-- destination.
--
-- 'sourceImageName', 'copyImage_sourceImageName' - The name of the image to copy.
--
-- 'destinationImageName', 'copyImage_destinationImageName' - The name that the image will have when it is copied to the destination.
--
-- 'destinationRegion', 'copyImage_destinationRegion' - The destination region to which the image will be copied. This parameter
-- is required, even if you are copying an image within the same region.
newCopyImage ::
  -- | 'sourceImageName'
  Prelude.Text ->
  -- | 'destinationImageName'
  Prelude.Text ->
  -- | 'destinationRegion'
  Prelude.Text ->
  CopyImage
newCopyImage :: Text -> Text -> Text -> CopyImage
newCopyImage
  Text
pSourceImageName_
  Text
pDestinationImageName_
  Text
pDestinationRegion_ =
    CopyImage'
      { $sel:destinationImageDescription:CopyImage' :: Maybe Text
destinationImageDescription =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sourceImageName:CopyImage' :: Text
sourceImageName = Text
pSourceImageName_,
        $sel:destinationImageName:CopyImage' :: Text
destinationImageName = Text
pDestinationImageName_,
        $sel:destinationRegion:CopyImage' :: Text
destinationRegion = Text
pDestinationRegion_
      }

-- | The description that the image will have when it is copied to the
-- destination.
copyImage_destinationImageDescription :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Text)
copyImage_destinationImageDescription :: Lens' CopyImage (Maybe Text)
copyImage_destinationImageDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Text
destinationImageDescription :: Maybe Text
$sel:destinationImageDescription:CopyImage' :: CopyImage -> Maybe Text
destinationImageDescription} -> Maybe Text
destinationImageDescription) (\s :: CopyImage
s@CopyImage' {} Maybe Text
a -> CopyImage
s {$sel:destinationImageDescription:CopyImage' :: Maybe Text
destinationImageDescription = Maybe Text
a} :: CopyImage)

-- | The name of the image to copy.
copyImage_sourceImageName :: Lens.Lens' CopyImage Prelude.Text
copyImage_sourceImageName :: Lens' CopyImage Text
copyImage_sourceImageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Text
sourceImageName :: Text
$sel:sourceImageName:CopyImage' :: CopyImage -> Text
sourceImageName} -> Text
sourceImageName) (\s :: CopyImage
s@CopyImage' {} Text
a -> CopyImage
s {$sel:sourceImageName:CopyImage' :: Text
sourceImageName = Text
a} :: CopyImage)

-- | The name that the image will have when it is copied to the destination.
copyImage_destinationImageName :: Lens.Lens' CopyImage Prelude.Text
copyImage_destinationImageName :: Lens' CopyImage Text
copyImage_destinationImageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Text
destinationImageName :: Text
$sel:destinationImageName:CopyImage' :: CopyImage -> Text
destinationImageName} -> Text
destinationImageName) (\s :: CopyImage
s@CopyImage' {} Text
a -> CopyImage
s {$sel:destinationImageName:CopyImage' :: Text
destinationImageName = Text
a} :: CopyImage)

-- | The destination region to which the image will be copied. This parameter
-- is required, even if you are copying an image within the same region.
copyImage_destinationRegion :: Lens.Lens' CopyImage Prelude.Text
copyImage_destinationRegion :: Lens' CopyImage Text
copyImage_destinationRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Text
destinationRegion :: Text
$sel:destinationRegion:CopyImage' :: CopyImage -> Text
destinationRegion} -> Text
destinationRegion) (\s :: CopyImage
s@CopyImage' {} Text
a -> CopyImage
s {$sel:destinationRegion:CopyImage' :: Text
destinationRegion = Text
a} :: CopyImage)

instance Core.AWSRequest CopyImage where
  type AWSResponse CopyImage = CopyImageResponse
  request :: (Service -> Service) -> CopyImage -> Request CopyImage
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 CopyImage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CopyImage)))
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 Text -> Int -> CopyImageResponse
CopyImageResponse'
            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
"DestinationImageName")
            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 CopyImage where
  hashWithSalt :: Int -> CopyImage -> Int
hashWithSalt Int
_salt CopyImage' {Maybe Text
Text
destinationRegion :: Text
destinationImageName :: Text
sourceImageName :: Text
destinationImageDescription :: Maybe Text
$sel:destinationRegion:CopyImage' :: CopyImage -> Text
$sel:destinationImageName:CopyImage' :: CopyImage -> Text
$sel:sourceImageName:CopyImage' :: CopyImage -> Text
$sel:destinationImageDescription:CopyImage' :: CopyImage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destinationImageDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceImageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationImageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationRegion

instance Prelude.NFData CopyImage where
  rnf :: CopyImage -> ()
rnf CopyImage' {Maybe Text
Text
destinationRegion :: Text
destinationImageName :: Text
sourceImageName :: Text
destinationImageDescription :: Maybe Text
$sel:destinationRegion:CopyImage' :: CopyImage -> Text
$sel:destinationImageName:CopyImage' :: CopyImage -> Text
$sel:sourceImageName:CopyImage' :: CopyImage -> Text
$sel:destinationImageDescription:CopyImage' :: CopyImage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destinationImageDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceImageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationImageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationRegion

instance Data.ToHeaders CopyImage where
  toHeaders :: CopyImage -> 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.CopyImage" ::
                          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 CopyImage where
  toJSON :: CopyImage -> Value
toJSON CopyImage' {Maybe Text
Text
destinationRegion :: Text
destinationImageName :: Text
sourceImageName :: Text
destinationImageDescription :: Maybe Text
$sel:destinationRegion:CopyImage' :: CopyImage -> Text
$sel:destinationImageName:CopyImage' :: CopyImage -> Text
$sel:sourceImageName:CopyImage' :: CopyImage -> Text
$sel:destinationImageDescription:CopyImage' :: CopyImage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DestinationImageDescription" 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
destinationImageDescription,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SourceImageName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceImageName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DestinationImageName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationImageName
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DestinationRegion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationRegion)
          ]
      )

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

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

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

-- |
-- Create a value of 'CopyImageResponse' 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:
--
-- 'destinationImageName', 'copyImageResponse_destinationImageName' - The name of the destination image.
--
-- 'httpStatus', 'copyImageResponse_httpStatus' - The response's http status code.
newCopyImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyImageResponse
newCopyImageResponse :: Int -> CopyImageResponse
newCopyImageResponse Int
pHttpStatus_ =
  CopyImageResponse'
    { $sel:destinationImageName:CopyImageResponse' :: Maybe Text
destinationImageName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the destination image.
copyImageResponse_destinationImageName :: Lens.Lens' CopyImageResponse (Prelude.Maybe Prelude.Text)
copyImageResponse_destinationImageName :: Lens' CopyImageResponse (Maybe Text)
copyImageResponse_destinationImageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImageResponse' {Maybe Text
destinationImageName :: Maybe Text
$sel:destinationImageName:CopyImageResponse' :: CopyImageResponse -> Maybe Text
destinationImageName} -> Maybe Text
destinationImageName) (\s :: CopyImageResponse
s@CopyImageResponse' {} Maybe Text
a -> CopyImageResponse
s {$sel:destinationImageName:CopyImageResponse' :: Maybe Text
destinationImageName = Maybe Text
a} :: CopyImageResponse)

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

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