{-# 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.EC2.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)
--
-- Initiates the copy of an AMI. You can copy an AMI from one Region to
-- another, or from a Region to an Outpost. You can\'t copy an AMI from an
-- Outpost to a Region, from one Outpost to another, or within the same
-- Outpost. To copy an AMI to another partition, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateStoreImageTask.html CreateStoreImageTask>.
--
-- To copy an AMI from one Region to another, specify the source Region
-- using the __SourceRegion__ parameter, and specify the destination Region
-- using its endpoint. Copies of encrypted backing snapshots for the AMI
-- are encrypted. Copies of unencrypted backing snapshots remain
-- unencrypted, unless you set @Encrypted@ during the copy operation. You
-- cannot create an unencrypted copy of an encrypted backing snapshot.
--
-- To copy an AMI from a Region to an Outpost, specify the source Region
-- using the __SourceRegion__ parameter, and specify the ARN of the
-- destination Outpost using __DestinationOutpostArn__. Backing snapshots
-- copied to an Outpost are encrypted by default using the default
-- encryption key for the Region, or a different key that you specify in
-- the request using __KmsKeyId__. Outposts do not support unencrypted
-- snapshots. For more information,
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#ami Amazon EBS local snapshots on Outposts>
-- in the /Amazon EC2 User Guide/.
--
-- For more information about the prerequisites and limits when copying an
-- AMI, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/CopyingAMIs.html Copy an AMI>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.CopyImage
  ( -- * Creating a Request
    CopyImage (..),
    newCopyImage,

    -- * Request Lenses
    copyImage_clientToken,
    copyImage_copyImageTags,
    copyImage_description,
    copyImage_destinationOutpostArn,
    copyImage_dryRun,
    copyImage_encrypted,
    copyImage_kmsKeyId,
    copyImage_name,
    copyImage_sourceImageId,
    copyImage_sourceRegion,

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

    -- * Response Lenses
    copyImageResponse_imageId,
    copyImageResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Contains the parameters for CopyImage.
--
-- /See:/ 'newCopyImage' smart constructor.
data CopyImage = CopyImage'
  { -- | Unique, case-sensitive identifier you provide to ensure idempotency of
    -- the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring idempotency>
    -- in the /Amazon EC2 API Reference/.
    CopyImage -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to include your user-defined AMI tags when copying the
    -- AMI.
    --
    -- The following tags will not be copied:
    --
    -- -   System tags (prefixed with @aws:@)
    --
    -- -   For public and shared AMIs, user-defined tags that are attached by
    --     other Amazon Web Services accounts
    --
    -- Default: Your user-defined AMI tags are not copied.
    CopyImage -> Maybe Bool
copyImageTags :: Prelude.Maybe Prelude.Bool,
    -- | A description for the new AMI in the destination Region.
    CopyImage -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Outpost to which to copy the AMI.
    -- Only specify this parameter when copying an AMI from an Amazon Web
    -- Services Region to an Outpost. The AMI must be in the Region of the
    -- destination Outpost. You cannot copy an AMI from an Outpost to a Region,
    -- from one Outpost to another, or within the same Outpost.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#copy-amis Copy AMIs from an Amazon Web Services Region to an Outpost>
    -- in the /Amazon EC2 User Guide/.
    CopyImage -> Maybe Text
destinationOutpostArn :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CopyImage -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether the destination snapshots of the copied image should
    -- be encrypted. You can encrypt a copy of an unencrypted snapshot, but you
    -- cannot create an unencrypted copy of an encrypted snapshot. The default
    -- KMS key for Amazon EBS is used unless you specify a non-default Key
    -- Management Service (KMS) KMS key using @KmsKeyId@. For more information,
    -- see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS encryption>
    -- in the /Amazon EC2 User Guide/.
    CopyImage -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The identifier of the symmetric Key Management Service (KMS) KMS key to
    -- use when creating encrypted volumes. If this parameter is not specified,
    -- your Amazon Web Services managed KMS key for Amazon EBS is used. If you
    -- specify a KMS key, you must also set the encrypted state to @true@.
    --
    -- You can specify a KMS key using any of the following:
    --
    -- -   Key ID. For example, 1234abcd-12ab-34cd-56ef-1234567890ab.
    --
    -- -   Key alias. For example, alias\/ExampleAlias.
    --
    -- -   Key ARN. For example,
    --     arn:aws:kms:us-east-1:012345678910:key\/1234abcd-12ab-34cd-56ef-1234567890ab.
    --
    -- -   Alias ARN. For example,
    --     arn:aws:kms:us-east-1:012345678910:alias\/ExampleAlias.
    --
    -- Amazon Web Services authenticates the KMS key asynchronously. Therefore,
    -- if you specify an identifier that is not valid, the action can appear to
    -- complete, but eventually fails.
    --
    -- The specified KMS key must exist in the destination Region.
    --
    -- Amazon EBS does not support asymmetric KMS keys.
    CopyImage -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The name of the new AMI in the destination Region.
    CopyImage -> Text
name :: Prelude.Text,
    -- | The ID of the AMI to copy.
    CopyImage -> Text
sourceImageId :: Prelude.Text,
    -- | The name of the Region that contains the AMI to copy.
    CopyImage -> Text
sourceRegion :: 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:
--
-- 'clientToken', 'copyImage_clientToken' - Unique, case-sensitive identifier you provide to ensure idempotency of
-- the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring idempotency>
-- in the /Amazon EC2 API Reference/.
--
-- 'copyImageTags', 'copyImage_copyImageTags' - Indicates whether to include your user-defined AMI tags when copying the
-- AMI.
--
-- The following tags will not be copied:
--
-- -   System tags (prefixed with @aws:@)
--
-- -   For public and shared AMIs, user-defined tags that are attached by
--     other Amazon Web Services accounts
--
-- Default: Your user-defined AMI tags are not copied.
--
-- 'description', 'copyImage_description' - A description for the new AMI in the destination Region.
--
-- 'destinationOutpostArn', 'copyImage_destinationOutpostArn' - The Amazon Resource Name (ARN) of the Outpost to which to copy the AMI.
-- Only specify this parameter when copying an AMI from an Amazon Web
-- Services Region to an Outpost. The AMI must be in the Region of the
-- destination Outpost. You cannot copy an AMI from an Outpost to a Region,
-- from one Outpost to another, or within the same Outpost.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#copy-amis Copy AMIs from an Amazon Web Services Region to an Outpost>
-- in the /Amazon EC2 User Guide/.
--
-- 'dryRun', 'copyImage_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'encrypted', 'copyImage_encrypted' - Specifies whether the destination snapshots of the copied image should
-- be encrypted. You can encrypt a copy of an unencrypted snapshot, but you
-- cannot create an unencrypted copy of an encrypted snapshot. The default
-- KMS key for Amazon EBS is used unless you specify a non-default Key
-- Management Service (KMS) KMS key using @KmsKeyId@. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS encryption>
-- in the /Amazon EC2 User Guide/.
--
-- 'kmsKeyId', 'copyImage_kmsKeyId' - The identifier of the symmetric Key Management Service (KMS) KMS key to
-- use when creating encrypted volumes. If this parameter is not specified,
-- your Amazon Web Services managed KMS key for Amazon EBS is used. If you
-- specify a KMS key, you must also set the encrypted state to @true@.
--
-- You can specify a KMS key using any of the following:
--
-- -   Key ID. For example, 1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Key alias. For example, alias\/ExampleAlias.
--
-- -   Key ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:key\/1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Alias ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:alias\/ExampleAlias.
--
-- Amazon Web Services authenticates the KMS key asynchronously. Therefore,
-- if you specify an identifier that is not valid, the action can appear to
-- complete, but eventually fails.
--
-- The specified KMS key must exist in the destination Region.
--
-- Amazon EBS does not support asymmetric KMS keys.
--
-- 'name', 'copyImage_name' - The name of the new AMI in the destination Region.
--
-- 'sourceImageId', 'copyImage_sourceImageId' - The ID of the AMI to copy.
--
-- 'sourceRegion', 'copyImage_sourceRegion' - The name of the Region that contains the AMI to copy.
newCopyImage ::
  -- | 'name'
  Prelude.Text ->
  -- | 'sourceImageId'
  Prelude.Text ->
  -- | 'sourceRegion'
  Prelude.Text ->
  CopyImage
newCopyImage :: Text -> Text -> Text -> CopyImage
newCopyImage Text
pName_ Text
pSourceImageId_ Text
pSourceRegion_ =
  CopyImage'
    { $sel:clientToken:CopyImage' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:copyImageTags:CopyImage' :: Maybe Bool
copyImageTags = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CopyImage' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:destinationOutpostArn:CopyImage' :: Maybe Text
destinationOutpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CopyImage' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:CopyImage' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:CopyImage' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CopyImage' :: Text
name = Text
pName_,
      $sel:sourceImageId:CopyImage' :: Text
sourceImageId = Text
pSourceImageId_,
      $sel:sourceRegion:CopyImage' :: Text
sourceRegion = Text
pSourceRegion_
    }

-- | Unique, case-sensitive identifier you provide to ensure idempotency of
-- the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring idempotency>
-- in the /Amazon EC2 API Reference/.
copyImage_clientToken :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Text)
copyImage_clientToken :: Lens' CopyImage (Maybe Text)
copyImage_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CopyImage' :: CopyImage -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CopyImage
s@CopyImage' {} Maybe Text
a -> CopyImage
s {$sel:clientToken:CopyImage' :: Maybe Text
clientToken = Maybe Text
a} :: CopyImage)

-- | Indicates whether to include your user-defined AMI tags when copying the
-- AMI.
--
-- The following tags will not be copied:
--
-- -   System tags (prefixed with @aws:@)
--
-- -   For public and shared AMIs, user-defined tags that are attached by
--     other Amazon Web Services accounts
--
-- Default: Your user-defined AMI tags are not copied.
copyImage_copyImageTags :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Bool)
copyImage_copyImageTags :: Lens' CopyImage (Maybe Bool)
copyImage_copyImageTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Bool
copyImageTags :: Maybe Bool
$sel:copyImageTags:CopyImage' :: CopyImage -> Maybe Bool
copyImageTags} -> Maybe Bool
copyImageTags) (\s :: CopyImage
s@CopyImage' {} Maybe Bool
a -> CopyImage
s {$sel:copyImageTags:CopyImage' :: Maybe Bool
copyImageTags = Maybe Bool
a} :: CopyImage)

-- | A description for the new AMI in the destination Region.
copyImage_description :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Text)
copyImage_description :: Lens' CopyImage (Maybe Text)
copyImage_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Text
description :: Maybe Text
$sel:description:CopyImage' :: CopyImage -> Maybe Text
description} -> Maybe Text
description) (\s :: CopyImage
s@CopyImage' {} Maybe Text
a -> CopyImage
s {$sel:description:CopyImage' :: Maybe Text
description = Maybe Text
a} :: CopyImage)

-- | The Amazon Resource Name (ARN) of the Outpost to which to copy the AMI.
-- Only specify this parameter when copying an AMI from an Amazon Web
-- Services Region to an Outpost. The AMI must be in the Region of the
-- destination Outpost. You cannot copy an AMI from an Outpost to a Region,
-- from one Outpost to another, or within the same Outpost.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#copy-amis Copy AMIs from an Amazon Web Services Region to an Outpost>
-- in the /Amazon EC2 User Guide/.
copyImage_destinationOutpostArn :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Text)
copyImage_destinationOutpostArn :: Lens' CopyImage (Maybe Text)
copyImage_destinationOutpostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Text
destinationOutpostArn :: Maybe Text
$sel:destinationOutpostArn:CopyImage' :: CopyImage -> Maybe Text
destinationOutpostArn} -> Maybe Text
destinationOutpostArn) (\s :: CopyImage
s@CopyImage' {} Maybe Text
a -> CopyImage
s {$sel:destinationOutpostArn:CopyImage' :: Maybe Text
destinationOutpostArn = Maybe Text
a} :: CopyImage)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
copyImage_dryRun :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Bool)
copyImage_dryRun :: Lens' CopyImage (Maybe Bool)
copyImage_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CopyImage' :: CopyImage -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CopyImage
s@CopyImage' {} Maybe Bool
a -> CopyImage
s {$sel:dryRun:CopyImage' :: Maybe Bool
dryRun = Maybe Bool
a} :: CopyImage)

-- | Specifies whether the destination snapshots of the copied image should
-- be encrypted. You can encrypt a copy of an unencrypted snapshot, but you
-- cannot create an unencrypted copy of an encrypted snapshot. The default
-- KMS key for Amazon EBS is used unless you specify a non-default Key
-- Management Service (KMS) KMS key using @KmsKeyId@. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS encryption>
-- in the /Amazon EC2 User Guide/.
copyImage_encrypted :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Bool)
copyImage_encrypted :: Lens' CopyImage (Maybe Bool)
copyImage_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:CopyImage' :: CopyImage -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: CopyImage
s@CopyImage' {} Maybe Bool
a -> CopyImage
s {$sel:encrypted:CopyImage' :: Maybe Bool
encrypted = Maybe Bool
a} :: CopyImage)

-- | The identifier of the symmetric Key Management Service (KMS) KMS key to
-- use when creating encrypted volumes. If this parameter is not specified,
-- your Amazon Web Services managed KMS key for Amazon EBS is used. If you
-- specify a KMS key, you must also set the encrypted state to @true@.
--
-- You can specify a KMS key using any of the following:
--
-- -   Key ID. For example, 1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Key alias. For example, alias\/ExampleAlias.
--
-- -   Key ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:key\/1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Alias ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:alias\/ExampleAlias.
--
-- Amazon Web Services authenticates the KMS key asynchronously. Therefore,
-- if you specify an identifier that is not valid, the action can appear to
-- complete, but eventually fails.
--
-- The specified KMS key must exist in the destination Region.
--
-- Amazon EBS does not support asymmetric KMS keys.
copyImage_kmsKeyId :: Lens.Lens' CopyImage (Prelude.Maybe Prelude.Text)
copyImage_kmsKeyId :: Lens' CopyImage (Maybe Text)
copyImage_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CopyImage' :: CopyImage -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CopyImage
s@CopyImage' {} Maybe Text
a -> CopyImage
s {$sel:kmsKeyId:CopyImage' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CopyImage)

-- | The name of the new AMI in the destination Region.
copyImage_name :: Lens.Lens' CopyImage Prelude.Text
copyImage_name :: Lens' CopyImage Text
copyImage_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Text
name :: Text
$sel:name:CopyImage' :: CopyImage -> Text
name} -> Text
name) (\s :: CopyImage
s@CopyImage' {} Text
a -> CopyImage
s {$sel:name:CopyImage' :: Text
name = Text
a} :: CopyImage)

-- | The ID of the AMI to copy.
copyImage_sourceImageId :: Lens.Lens' CopyImage Prelude.Text
copyImage_sourceImageId :: Lens' CopyImage Text
copyImage_sourceImageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Text
sourceImageId :: Text
$sel:sourceImageId:CopyImage' :: CopyImage -> Text
sourceImageId} -> Text
sourceImageId) (\s :: CopyImage
s@CopyImage' {} Text
a -> CopyImage
s {$sel:sourceImageId:CopyImage' :: Text
sourceImageId = Text
a} :: CopyImage)

-- | The name of the Region that contains the AMI to copy.
copyImage_sourceRegion :: Lens.Lens' CopyImage Prelude.Text
copyImage_sourceRegion :: Lens' CopyImage Text
copyImage_sourceRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImage' {Text
sourceRegion :: Text
$sel:sourceRegion:CopyImage' :: CopyImage -> Text
sourceRegion} -> Text
sourceRegion) (\s :: CopyImage
s@CopyImage' {} Text
a -> CopyImage
s {$sel:sourceRegion:CopyImage' :: Text
sourceRegion = 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 => Service -> a -> Request a
Request.postQuery (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 -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> CopyImageResponse
CopyImageResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"imageId")
            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 Bool
Maybe Text
Text
sourceRegion :: Text
sourceImageId :: Text
name :: Text
kmsKeyId :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
destinationOutpostArn :: Maybe Text
description :: Maybe Text
copyImageTags :: Maybe Bool
clientToken :: Maybe Text
$sel:sourceRegion:CopyImage' :: CopyImage -> Text
$sel:sourceImageId:CopyImage' :: CopyImage -> Text
$sel:name:CopyImage' :: CopyImage -> Text
$sel:kmsKeyId:CopyImage' :: CopyImage -> Maybe Text
$sel:encrypted:CopyImage' :: CopyImage -> Maybe Bool
$sel:dryRun:CopyImage' :: CopyImage -> Maybe Bool
$sel:destinationOutpostArn:CopyImage' :: CopyImage -> Maybe Text
$sel:description:CopyImage' :: CopyImage -> Maybe Text
$sel:copyImageTags:CopyImage' :: CopyImage -> Maybe Bool
$sel:clientToken:CopyImage' :: CopyImage -> 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 Bool
copyImageTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destinationOutpostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceImageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceRegion

instance Prelude.NFData CopyImage where
  rnf :: CopyImage -> ()
rnf CopyImage' {Maybe Bool
Maybe Text
Text
sourceRegion :: Text
sourceImageId :: Text
name :: Text
kmsKeyId :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
destinationOutpostArn :: Maybe Text
description :: Maybe Text
copyImageTags :: Maybe Bool
clientToken :: Maybe Text
$sel:sourceRegion:CopyImage' :: CopyImage -> Text
$sel:sourceImageId:CopyImage' :: CopyImage -> Text
$sel:name:CopyImage' :: CopyImage -> Text
$sel:kmsKeyId:CopyImage' :: CopyImage -> Maybe Text
$sel:encrypted:CopyImage' :: CopyImage -> Maybe Bool
$sel:dryRun:CopyImage' :: CopyImage -> Maybe Bool
$sel:destinationOutpostArn:CopyImage' :: CopyImage -> Maybe Text
$sel:description:CopyImage' :: CopyImage -> Maybe Text
$sel:copyImageTags:CopyImage' :: CopyImage -> Maybe Bool
$sel:clientToken:CopyImage' :: CopyImage -> 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 Bool
copyImageTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destinationOutpostArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Bool
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceImageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceRegion

instance Data.ToHeaders CopyImage where
  toHeaders :: CopyImage -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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 CopyImage' {Maybe Bool
Maybe Text
Text
sourceRegion :: Text
sourceImageId :: Text
name :: Text
kmsKeyId :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
destinationOutpostArn :: Maybe Text
description :: Maybe Text
copyImageTags :: Maybe Bool
clientToken :: Maybe Text
$sel:sourceRegion:CopyImage' :: CopyImage -> Text
$sel:sourceImageId:CopyImage' :: CopyImage -> Text
$sel:name:CopyImage' :: CopyImage -> Text
$sel:kmsKeyId:CopyImage' :: CopyImage -> Maybe Text
$sel:encrypted:CopyImage' :: CopyImage -> Maybe Bool
$sel:dryRun:CopyImage' :: CopyImage -> Maybe Bool
$sel:destinationOutpostArn:CopyImage' :: CopyImage -> Maybe Text
$sel:description:CopyImage' :: CopyImage -> Maybe Text
$sel:copyImageTags:CopyImage' :: CopyImage -> Maybe Bool
$sel:clientToken:CopyImage' :: CopyImage -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CopyImage" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"CopyImageTags" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
copyImageTags,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"DestinationOutpostArn"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
destinationOutpostArn,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Encrypted" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
encrypted,
        ByteString
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
name,
        ByteString
"SourceImageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceImageId,
        ByteString
"SourceRegion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceRegion
      ]

-- | Contains the output of CopyImage.
--
-- /See:/ 'newCopyImageResponse' smart constructor.
data CopyImageResponse = CopyImageResponse'
  { -- | The ID of the new AMI.
    CopyImageResponse -> Maybe Text
imageId :: 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:
--
-- 'imageId', 'copyImageResponse_imageId' - The ID of the new AMI.
--
-- 'httpStatus', 'copyImageResponse_httpStatus' - The response's http status code.
newCopyImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyImageResponse
newCopyImageResponse :: Int -> CopyImageResponse
newCopyImageResponse Int
pHttpStatus_ =
  CopyImageResponse'
    { $sel:imageId:CopyImageResponse' :: Maybe Text
imageId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the new AMI.
copyImageResponse_imageId :: Lens.Lens' CopyImageResponse (Prelude.Maybe Prelude.Text)
copyImageResponse_imageId :: Lens' CopyImageResponse (Maybe Text)
copyImageResponse_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyImageResponse' {Maybe Text
imageId :: Maybe Text
$sel:imageId:CopyImageResponse' :: CopyImageResponse -> Maybe Text
imageId} -> Maybe Text
imageId) (\s :: CopyImageResponse
s@CopyImageResponse' {} Maybe Text
a -> CopyImageResponse
s {$sel:imageId:CopyImageResponse' :: Maybe Text
imageId = 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
imageId :: Maybe Text
$sel:httpStatus:CopyImageResponse' :: CopyImageResponse -> Int
$sel:imageId:CopyImageResponse' :: CopyImageResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus