{-# 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.ImportImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Import single or multi-volume disk images or EBS snapshots into an
-- Amazon Machine Image (AMI).
--
-- Amazon Web Services VM Import\/Export strongly recommends specifying a
-- value for either the @--license-type@ or @--usage-operation@ parameter
-- when you create a new VM Import task. This ensures your operating system
-- is licensed appropriately and your billing is optimized.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmimport-image-import.html Importing a VM as an image using VM Import\/Export>
-- in the /VM Import\/Export User Guide/.
module Amazonka.EC2.ImportImage
  ( -- * Creating a Request
    ImportImage (..),
    newImportImage,

    -- * Request Lenses
    importImage_architecture,
    importImage_bootMode,
    importImage_clientData,
    importImage_clientToken,
    importImage_description,
    importImage_diskContainers,
    importImage_dryRun,
    importImage_encrypted,
    importImage_hypervisor,
    importImage_kmsKeyId,
    importImage_licenseSpecifications,
    importImage_licenseType,
    importImage_platform,
    importImage_roleName,
    importImage_tagSpecifications,
    importImage_usageOperation,

    -- * Destructuring the Response
    ImportImageResponse (..),
    newImportImageResponse,

    -- * Response Lenses
    importImageResponse_architecture,
    importImageResponse_description,
    importImageResponse_encrypted,
    importImageResponse_hypervisor,
    importImageResponse_imageId,
    importImageResponse_importTaskId,
    importImageResponse_kmsKeyId,
    importImageResponse_licenseSpecifications,
    importImageResponse_licenseType,
    importImageResponse_platform,
    importImageResponse_progress,
    importImageResponse_snapshotDetails,
    importImageResponse_status,
    importImageResponse_statusMessage,
    importImageResponse_tags,
    importImageResponse_usageOperation,
    importImageResponse_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

-- | /See:/ 'newImportImage' smart constructor.
data ImportImage = ImportImage'
  { -- | The architecture of the virtual machine.
    --
    -- Valid values: @i386@ | @x86_64@
    ImportImage -> Maybe Text
architecture :: Prelude.Maybe Prelude.Text,
    -- | The boot mode of the virtual machine.
    ImportImage -> Maybe BootModeValues
bootMode :: Prelude.Maybe BootModeValues,
    -- | The client-specific data.
    ImportImage -> Maybe ClientData
clientData :: Prelude.Maybe ClientData,
    -- | The token to enable idempotency for VM import requests.
    ImportImage -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description string for the import image task.
    ImportImage -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Information about the disk containers.
    ImportImage -> Maybe [ImageDiskContainer]
diskContainers :: Prelude.Maybe [ImageDiskContainer],
    -- | 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@.
    ImportImage -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether the destination AMI of the imported image should be
    -- encrypted. The default KMS key for EBS is used unless you specify a
    -- non-default KMS key using @KmsKeyId@. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS Encryption>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    ImportImage -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The target hypervisor platform.
    --
    -- Valid values: @xen@
    ImportImage -> Maybe Text
hypervisor :: Prelude.Maybe Prelude.Text,
    -- | An identifier for the symmetric KMS key to use when creating the
    -- encrypted AMI. This parameter is only required if you want to use a
    -- non-default KMS key; if this parameter is not specified, the default KMS
    -- key for EBS is used. If a @KmsKeyId@ is specified, the @Encrypted@ flag
    -- must also be set.
    --
    -- The KMS key identifier may be provided in any of the following formats:
    --
    -- -   Key ID
    --
    -- -   Key alias. The alias ARN contains the @arn:aws:kms@ namespace,
    --     followed by the Region of the key, the Amazon Web Services account
    --     ID of the key owner, the @alias@ namespace, and then the key alias.
    --     For example,
    --     arn:aws:kms:/us-east-1/:/012345678910/:alias\//ExampleAlias/.
    --
    -- -   ARN using key ID. The ID ARN contains the @arn:aws:kms@ namespace,
    --     followed by the Region of the key, the Amazon Web Services account
    --     ID of the key owner, the @key@ namespace, and then the key ID. For
    --     example,
    --     arn:aws:kms:/us-east-1/:/012345678910/:key\//abcd1234-a123-456a-a12b-a123b4cd56ef/.
    --
    -- -   ARN using key alias. The alias ARN contains the @arn:aws:kms@
    --     namespace, followed by the Region of the key, the Amazon Web
    --     Services account ID of the key owner, the @alias@ namespace, and
    --     then the key alias. For example,
    --     arn:aws:kms:/us-east-1/:/012345678910/:alias\//ExampleAlias/.
    --
    -- Amazon Web Services parses @KmsKeyId@ asynchronously, meaning that the
    -- action you call may appear to complete even though you provided an
    -- invalid identifier. This action will eventually report failure.
    --
    -- The specified KMS key must exist in the Region that the AMI is being
    -- copied to.
    --
    -- Amazon EBS does not support asymmetric KMS keys.
    ImportImage -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The ARNs of the license configurations.
    ImportImage -> Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications :: Prelude.Maybe [ImportImageLicenseConfigurationRequest],
    -- | The license type to be used for the Amazon Machine Image (AMI) after
    -- importing.
    --
    -- Specify @AWS@ to replace the source-system license with an Amazon Web
    -- Services license or @BYOL@ to retain the source-system license. Leaving
    -- this parameter undefined is the same as choosing @AWS@ when importing a
    -- Windows Server operating system, and the same as choosing @BYOL@ when
    -- importing a Windows client operating system (such as Windows 10) or a
    -- Linux operating system.
    --
    -- To use @BYOL@, you must have existing licenses with rights to use these
    -- licenses in a third party cloud, such as Amazon Web Services. For more
    -- information, see
    -- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmimport-image-import.html#prerequisites-image Prerequisites>
    -- in the VM Import\/Export User Guide.
    ImportImage -> Maybe Text
licenseType :: Prelude.Maybe Prelude.Text,
    -- | The operating system of the virtual machine.
    --
    -- Valid values: @Windows@ | @Linux@
    ImportImage -> Maybe Text
platform :: Prelude.Maybe Prelude.Text,
    -- | The name of the role to use when not using the default role,
    -- \'vmimport\'.
    ImportImage -> Maybe Text
roleName :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the import image task during creation.
    ImportImage -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The usage operation value. For more information, see
    -- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmie_prereqs.html#prerequisites Licensing options>
    -- in the /VM Import\/Export User Guide/.
    ImportImage -> Maybe Text
usageOperation :: Prelude.Maybe Prelude.Text
  }
  deriving (ImportImage -> ImportImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportImage -> ImportImage -> Bool
$c/= :: ImportImage -> ImportImage -> Bool
== :: ImportImage -> ImportImage -> Bool
$c== :: ImportImage -> ImportImage -> Bool
Prelude.Eq, ReadPrec [ImportImage]
ReadPrec ImportImage
Int -> ReadS ImportImage
ReadS [ImportImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportImage]
$creadListPrec :: ReadPrec [ImportImage]
readPrec :: ReadPrec ImportImage
$creadPrec :: ReadPrec ImportImage
readList :: ReadS [ImportImage]
$creadList :: ReadS [ImportImage]
readsPrec :: Int -> ReadS ImportImage
$creadsPrec :: Int -> ReadS ImportImage
Prelude.Read, Int -> ImportImage -> ShowS
[ImportImage] -> ShowS
ImportImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportImage] -> ShowS
$cshowList :: [ImportImage] -> ShowS
show :: ImportImage -> String
$cshow :: ImportImage -> String
showsPrec :: Int -> ImportImage -> ShowS
$cshowsPrec :: Int -> ImportImage -> ShowS
Prelude.Show, forall x. Rep ImportImage x -> ImportImage
forall x. ImportImage -> Rep ImportImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportImage x -> ImportImage
$cfrom :: forall x. ImportImage -> Rep ImportImage x
Prelude.Generic)

-- |
-- Create a value of 'ImportImage' 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:
--
-- 'architecture', 'importImage_architecture' - The architecture of the virtual machine.
--
-- Valid values: @i386@ | @x86_64@
--
-- 'bootMode', 'importImage_bootMode' - The boot mode of the virtual machine.
--
-- 'clientData', 'importImage_clientData' - The client-specific data.
--
-- 'clientToken', 'importImage_clientToken' - The token to enable idempotency for VM import requests.
--
-- 'description', 'importImage_description' - A description string for the import image task.
--
-- 'diskContainers', 'importImage_diskContainers' - Information about the disk containers.
--
-- 'dryRun', 'importImage_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', 'importImage_encrypted' - Specifies whether the destination AMI of the imported image should be
-- encrypted. The default KMS key for EBS is used unless you specify a
-- non-default KMS key using @KmsKeyId@. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS Encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'hypervisor', 'importImage_hypervisor' - The target hypervisor platform.
--
-- Valid values: @xen@
--
-- 'kmsKeyId', 'importImage_kmsKeyId' - An identifier for the symmetric KMS key to use when creating the
-- encrypted AMI. This parameter is only required if you want to use a
-- non-default KMS key; if this parameter is not specified, the default KMS
-- key for EBS is used. If a @KmsKeyId@ is specified, the @Encrypted@ flag
-- must also be set.
--
-- The KMS key identifier may be provided in any of the following formats:
--
-- -   Key ID
--
-- -   Key alias. The alias ARN contains the @arn:aws:kms@ namespace,
--     followed by the Region of the key, the Amazon Web Services account
--     ID of the key owner, the @alias@ namespace, and then the key alias.
--     For example,
--     arn:aws:kms:/us-east-1/:/012345678910/:alias\//ExampleAlias/.
--
-- -   ARN using key ID. The ID ARN contains the @arn:aws:kms@ namespace,
--     followed by the Region of the key, the Amazon Web Services account
--     ID of the key owner, the @key@ namespace, and then the key ID. For
--     example,
--     arn:aws:kms:/us-east-1/:/012345678910/:key\//abcd1234-a123-456a-a12b-a123b4cd56ef/.
--
-- -   ARN using key alias. The alias ARN contains the @arn:aws:kms@
--     namespace, followed by the Region of the key, the Amazon Web
--     Services account ID of the key owner, the @alias@ namespace, and
--     then the key alias. For example,
--     arn:aws:kms:/us-east-1/:/012345678910/:alias\//ExampleAlias/.
--
-- Amazon Web Services parses @KmsKeyId@ asynchronously, meaning that the
-- action you call may appear to complete even though you provided an
-- invalid identifier. This action will eventually report failure.
--
-- The specified KMS key must exist in the Region that the AMI is being
-- copied to.
--
-- Amazon EBS does not support asymmetric KMS keys.
--
-- 'licenseSpecifications', 'importImage_licenseSpecifications' - The ARNs of the license configurations.
--
-- 'licenseType', 'importImage_licenseType' - The license type to be used for the Amazon Machine Image (AMI) after
-- importing.
--
-- Specify @AWS@ to replace the source-system license with an Amazon Web
-- Services license or @BYOL@ to retain the source-system license. Leaving
-- this parameter undefined is the same as choosing @AWS@ when importing a
-- Windows Server operating system, and the same as choosing @BYOL@ when
-- importing a Windows client operating system (such as Windows 10) or a
-- Linux operating system.
--
-- To use @BYOL@, you must have existing licenses with rights to use these
-- licenses in a third party cloud, such as Amazon Web Services. For more
-- information, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmimport-image-import.html#prerequisites-image Prerequisites>
-- in the VM Import\/Export User Guide.
--
-- 'platform', 'importImage_platform' - The operating system of the virtual machine.
--
-- Valid values: @Windows@ | @Linux@
--
-- 'roleName', 'importImage_roleName' - The name of the role to use when not using the default role,
-- \'vmimport\'.
--
-- 'tagSpecifications', 'importImage_tagSpecifications' - The tags to apply to the import image task during creation.
--
-- 'usageOperation', 'importImage_usageOperation' - The usage operation value. For more information, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmie_prereqs.html#prerequisites Licensing options>
-- in the /VM Import\/Export User Guide/.
newImportImage ::
  ImportImage
newImportImage :: ImportImage
newImportImage =
  ImportImage'
    { $sel:architecture:ImportImage' :: Maybe Text
architecture = forall a. Maybe a
Prelude.Nothing,
      $sel:bootMode:ImportImage' :: Maybe BootModeValues
bootMode = forall a. Maybe a
Prelude.Nothing,
      $sel:clientData:ImportImage' :: Maybe ClientData
clientData = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:ImportImage' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:ImportImage' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:diskContainers:ImportImage' :: Maybe [ImageDiskContainer]
diskContainers = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ImportImage' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:ImportImage' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:hypervisor:ImportImage' :: Maybe Text
hypervisor = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:ImportImage' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseSpecifications:ImportImage' :: Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseType:ImportImage' :: Maybe Text
licenseType = forall a. Maybe a
Prelude.Nothing,
      $sel:platform:ImportImage' :: Maybe Text
platform = forall a. Maybe a
Prelude.Nothing,
      $sel:roleName:ImportImage' :: Maybe Text
roleName = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:ImportImage' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:usageOperation:ImportImage' :: Maybe Text
usageOperation = forall a. Maybe a
Prelude.Nothing
    }

-- | The architecture of the virtual machine.
--
-- Valid values: @i386@ | @x86_64@
importImage_architecture :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_architecture :: Lens' ImportImage (Maybe Text)
importImage_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
architecture :: Maybe Text
$sel:architecture:ImportImage' :: ImportImage -> Maybe Text
architecture} -> Maybe Text
architecture) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:architecture:ImportImage' :: Maybe Text
architecture = Maybe Text
a} :: ImportImage)

-- | The boot mode of the virtual machine.
importImage_bootMode :: Lens.Lens' ImportImage (Prelude.Maybe BootModeValues)
importImage_bootMode :: Lens' ImportImage (Maybe BootModeValues)
importImage_bootMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe BootModeValues
bootMode :: Maybe BootModeValues
$sel:bootMode:ImportImage' :: ImportImage -> Maybe BootModeValues
bootMode} -> Maybe BootModeValues
bootMode) (\s :: ImportImage
s@ImportImage' {} Maybe BootModeValues
a -> ImportImage
s {$sel:bootMode:ImportImage' :: Maybe BootModeValues
bootMode = Maybe BootModeValues
a} :: ImportImage)

-- | The client-specific data.
importImage_clientData :: Lens.Lens' ImportImage (Prelude.Maybe ClientData)
importImage_clientData :: Lens' ImportImage (Maybe ClientData)
importImage_clientData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe ClientData
clientData :: Maybe ClientData
$sel:clientData:ImportImage' :: ImportImage -> Maybe ClientData
clientData} -> Maybe ClientData
clientData) (\s :: ImportImage
s@ImportImage' {} Maybe ClientData
a -> ImportImage
s {$sel:clientData:ImportImage' :: Maybe ClientData
clientData = Maybe ClientData
a} :: ImportImage)

-- | The token to enable idempotency for VM import requests.
importImage_clientToken :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_clientToken :: Lens' ImportImage (Maybe Text)
importImage_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:ImportImage' :: ImportImage -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:clientToken:ImportImage' :: Maybe Text
clientToken = Maybe Text
a} :: ImportImage)

-- | A description string for the import image task.
importImage_description :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_description :: Lens' ImportImage (Maybe Text)
importImage_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
description :: Maybe Text
$sel:description:ImportImage' :: ImportImage -> Maybe Text
description} -> Maybe Text
description) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:description:ImportImage' :: Maybe Text
description = Maybe Text
a} :: ImportImage)

-- | Information about the disk containers.
importImage_diskContainers :: Lens.Lens' ImportImage (Prelude.Maybe [ImageDiskContainer])
importImage_diskContainers :: Lens' ImportImage (Maybe [ImageDiskContainer])
importImage_diskContainers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe [ImageDiskContainer]
diskContainers :: Maybe [ImageDiskContainer]
$sel:diskContainers:ImportImage' :: ImportImage -> Maybe [ImageDiskContainer]
diskContainers} -> Maybe [ImageDiskContainer]
diskContainers) (\s :: ImportImage
s@ImportImage' {} Maybe [ImageDiskContainer]
a -> ImportImage
s {$sel:diskContainers:ImportImage' :: Maybe [ImageDiskContainer]
diskContainers = Maybe [ImageDiskContainer]
a} :: ImportImage) 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

-- | 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@.
importImage_dryRun :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Bool)
importImage_dryRun :: Lens' ImportImage (Maybe Bool)
importImage_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ImportImage' :: ImportImage -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ImportImage
s@ImportImage' {} Maybe Bool
a -> ImportImage
s {$sel:dryRun:ImportImage' :: Maybe Bool
dryRun = Maybe Bool
a} :: ImportImage)

-- | Specifies whether the destination AMI of the imported image should be
-- encrypted. The default KMS key for EBS is used unless you specify a
-- non-default KMS key using @KmsKeyId@. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS Encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
importImage_encrypted :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Bool)
importImage_encrypted :: Lens' ImportImage (Maybe Bool)
importImage_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:ImportImage' :: ImportImage -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: ImportImage
s@ImportImage' {} Maybe Bool
a -> ImportImage
s {$sel:encrypted:ImportImage' :: Maybe Bool
encrypted = Maybe Bool
a} :: ImportImage)

-- | The target hypervisor platform.
--
-- Valid values: @xen@
importImage_hypervisor :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_hypervisor :: Lens' ImportImage (Maybe Text)
importImage_hypervisor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
hypervisor :: Maybe Text
$sel:hypervisor:ImportImage' :: ImportImage -> Maybe Text
hypervisor} -> Maybe Text
hypervisor) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:hypervisor:ImportImage' :: Maybe Text
hypervisor = Maybe Text
a} :: ImportImage)

-- | An identifier for the symmetric KMS key to use when creating the
-- encrypted AMI. This parameter is only required if you want to use a
-- non-default KMS key; if this parameter is not specified, the default KMS
-- key for EBS is used. If a @KmsKeyId@ is specified, the @Encrypted@ flag
-- must also be set.
--
-- The KMS key identifier may be provided in any of the following formats:
--
-- -   Key ID
--
-- -   Key alias. The alias ARN contains the @arn:aws:kms@ namespace,
--     followed by the Region of the key, the Amazon Web Services account
--     ID of the key owner, the @alias@ namespace, and then the key alias.
--     For example,
--     arn:aws:kms:/us-east-1/:/012345678910/:alias\//ExampleAlias/.
--
-- -   ARN using key ID. The ID ARN contains the @arn:aws:kms@ namespace,
--     followed by the Region of the key, the Amazon Web Services account
--     ID of the key owner, the @key@ namespace, and then the key ID. For
--     example,
--     arn:aws:kms:/us-east-1/:/012345678910/:key\//abcd1234-a123-456a-a12b-a123b4cd56ef/.
--
-- -   ARN using key alias. The alias ARN contains the @arn:aws:kms@
--     namespace, followed by the Region of the key, the Amazon Web
--     Services account ID of the key owner, the @alias@ namespace, and
--     then the key alias. For example,
--     arn:aws:kms:/us-east-1/:/012345678910/:alias\//ExampleAlias/.
--
-- Amazon Web Services parses @KmsKeyId@ asynchronously, meaning that the
-- action you call may appear to complete even though you provided an
-- invalid identifier. This action will eventually report failure.
--
-- The specified KMS key must exist in the Region that the AMI is being
-- copied to.
--
-- Amazon EBS does not support asymmetric KMS keys.
importImage_kmsKeyId :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_kmsKeyId :: Lens' ImportImage (Maybe Text)
importImage_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:ImportImage' :: ImportImage -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:kmsKeyId:ImportImage' :: Maybe Text
kmsKeyId = Maybe Text
a} :: ImportImage)

-- | The ARNs of the license configurations.
importImage_licenseSpecifications :: Lens.Lens' ImportImage (Prelude.Maybe [ImportImageLicenseConfigurationRequest])
importImage_licenseSpecifications :: Lens' ImportImage (Maybe [ImportImageLicenseConfigurationRequest])
importImage_licenseSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications :: Maybe [ImportImageLicenseConfigurationRequest]
$sel:licenseSpecifications:ImportImage' :: ImportImage -> Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications} -> Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications) (\s :: ImportImage
s@ImportImage' {} Maybe [ImportImageLicenseConfigurationRequest]
a -> ImportImage
s {$sel:licenseSpecifications:ImportImage' :: Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications = Maybe [ImportImageLicenseConfigurationRequest]
a} :: ImportImage) 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 license type to be used for the Amazon Machine Image (AMI) after
-- importing.
--
-- Specify @AWS@ to replace the source-system license with an Amazon Web
-- Services license or @BYOL@ to retain the source-system license. Leaving
-- this parameter undefined is the same as choosing @AWS@ when importing a
-- Windows Server operating system, and the same as choosing @BYOL@ when
-- importing a Windows client operating system (such as Windows 10) or a
-- Linux operating system.
--
-- To use @BYOL@, you must have existing licenses with rights to use these
-- licenses in a third party cloud, such as Amazon Web Services. For more
-- information, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmimport-image-import.html#prerequisites-image Prerequisites>
-- in the VM Import\/Export User Guide.
importImage_licenseType :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_licenseType :: Lens' ImportImage (Maybe Text)
importImage_licenseType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
licenseType :: Maybe Text
$sel:licenseType:ImportImage' :: ImportImage -> Maybe Text
licenseType} -> Maybe Text
licenseType) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:licenseType:ImportImage' :: Maybe Text
licenseType = Maybe Text
a} :: ImportImage)

-- | The operating system of the virtual machine.
--
-- Valid values: @Windows@ | @Linux@
importImage_platform :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_platform :: Lens' ImportImage (Maybe Text)
importImage_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
platform :: Maybe Text
$sel:platform:ImportImage' :: ImportImage -> Maybe Text
platform} -> Maybe Text
platform) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:platform:ImportImage' :: Maybe Text
platform = Maybe Text
a} :: ImportImage)

-- | The name of the role to use when not using the default role,
-- \'vmimport\'.
importImage_roleName :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_roleName :: Lens' ImportImage (Maybe Text)
importImage_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
roleName :: Maybe Text
$sel:roleName:ImportImage' :: ImportImage -> Maybe Text
roleName} -> Maybe Text
roleName) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:roleName:ImportImage' :: Maybe Text
roleName = Maybe Text
a} :: ImportImage)

-- | The tags to apply to the import image task during creation.
importImage_tagSpecifications :: Lens.Lens' ImportImage (Prelude.Maybe [TagSpecification])
importImage_tagSpecifications :: Lens' ImportImage (Maybe [TagSpecification])
importImage_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:ImportImage' :: ImportImage -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: ImportImage
s@ImportImage' {} Maybe [TagSpecification]
a -> ImportImage
s {$sel:tagSpecifications:ImportImage' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: ImportImage) 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 usage operation value. For more information, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmie_prereqs.html#prerequisites Licensing options>
-- in the /VM Import\/Export User Guide/.
importImage_usageOperation :: Lens.Lens' ImportImage (Prelude.Maybe Prelude.Text)
importImage_usageOperation :: Lens' ImportImage (Maybe Text)
importImage_usageOperation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImage' {Maybe Text
usageOperation :: Maybe Text
$sel:usageOperation:ImportImage' :: ImportImage -> Maybe Text
usageOperation} -> Maybe Text
usageOperation) (\s :: ImportImage
s@ImportImage' {} Maybe Text
a -> ImportImage
s {$sel:usageOperation:ImportImage' :: Maybe Text
usageOperation = Maybe Text
a} :: ImportImage)

instance Core.AWSRequest ImportImage where
  type AWSResponse ImportImage = ImportImageResponse
  request :: (Service -> Service) -> ImportImage -> Request ImportImage
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 ImportImage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportImage)))
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
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [ImportImageLicenseConfigurationResponse]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [SnapshotDetail]
-> Maybe Text
-> Maybe Text
-> Maybe [Tag]
-> Maybe Text
-> Int
-> ImportImageResponse
ImportImageResponse'
            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
"architecture")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"encrypted")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"hypervisor")
            forall (f :: * -> *) a b. Applicative f => 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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"importTaskId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"kmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"licenseSpecifications"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"licenseType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"platform")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"progress")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"snapshotDetailSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"statusMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"tagSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"usageOperation")
            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 ImportImage where
  hashWithSalt :: Int -> ImportImage -> Int
hashWithSalt Int
_salt ImportImage' {Maybe Bool
Maybe [ImportImageLicenseConfigurationRequest]
Maybe [TagSpecification]
Maybe [ImageDiskContainer]
Maybe Text
Maybe BootModeValues
Maybe ClientData
usageOperation :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
roleName :: Maybe Text
platform :: Maybe Text
licenseType :: Maybe Text
licenseSpecifications :: Maybe [ImportImageLicenseConfigurationRequest]
kmsKeyId :: Maybe Text
hypervisor :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
diskContainers :: Maybe [ImageDiskContainer]
description :: Maybe Text
clientToken :: Maybe Text
clientData :: Maybe ClientData
bootMode :: Maybe BootModeValues
architecture :: Maybe Text
$sel:usageOperation:ImportImage' :: ImportImage -> Maybe Text
$sel:tagSpecifications:ImportImage' :: ImportImage -> Maybe [TagSpecification]
$sel:roleName:ImportImage' :: ImportImage -> Maybe Text
$sel:platform:ImportImage' :: ImportImage -> Maybe Text
$sel:licenseType:ImportImage' :: ImportImage -> Maybe Text
$sel:licenseSpecifications:ImportImage' :: ImportImage -> Maybe [ImportImageLicenseConfigurationRequest]
$sel:kmsKeyId:ImportImage' :: ImportImage -> Maybe Text
$sel:hypervisor:ImportImage' :: ImportImage -> Maybe Text
$sel:encrypted:ImportImage' :: ImportImage -> Maybe Bool
$sel:dryRun:ImportImage' :: ImportImage -> Maybe Bool
$sel:diskContainers:ImportImage' :: ImportImage -> Maybe [ImageDiskContainer]
$sel:description:ImportImage' :: ImportImage -> Maybe Text
$sel:clientToken:ImportImage' :: ImportImage -> Maybe Text
$sel:clientData:ImportImage' :: ImportImage -> Maybe ClientData
$sel:bootMode:ImportImage' :: ImportImage -> Maybe BootModeValues
$sel:architecture:ImportImage' :: ImportImage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
architecture
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BootModeValues
bootMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientData
clientData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ImageDiskContainer]
diskContainers
      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
hypervisor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
licenseType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
usageOperation

instance Prelude.NFData ImportImage where
  rnf :: ImportImage -> ()
rnf ImportImage' {Maybe Bool
Maybe [ImportImageLicenseConfigurationRequest]
Maybe [TagSpecification]
Maybe [ImageDiskContainer]
Maybe Text
Maybe BootModeValues
Maybe ClientData
usageOperation :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
roleName :: Maybe Text
platform :: Maybe Text
licenseType :: Maybe Text
licenseSpecifications :: Maybe [ImportImageLicenseConfigurationRequest]
kmsKeyId :: Maybe Text
hypervisor :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
diskContainers :: Maybe [ImageDiskContainer]
description :: Maybe Text
clientToken :: Maybe Text
clientData :: Maybe ClientData
bootMode :: Maybe BootModeValues
architecture :: Maybe Text
$sel:usageOperation:ImportImage' :: ImportImage -> Maybe Text
$sel:tagSpecifications:ImportImage' :: ImportImage -> Maybe [TagSpecification]
$sel:roleName:ImportImage' :: ImportImage -> Maybe Text
$sel:platform:ImportImage' :: ImportImage -> Maybe Text
$sel:licenseType:ImportImage' :: ImportImage -> Maybe Text
$sel:licenseSpecifications:ImportImage' :: ImportImage -> Maybe [ImportImageLicenseConfigurationRequest]
$sel:kmsKeyId:ImportImage' :: ImportImage -> Maybe Text
$sel:hypervisor:ImportImage' :: ImportImage -> Maybe Text
$sel:encrypted:ImportImage' :: ImportImage -> Maybe Bool
$sel:dryRun:ImportImage' :: ImportImage -> Maybe Bool
$sel:diskContainers:ImportImage' :: ImportImage -> Maybe [ImageDiskContainer]
$sel:description:ImportImage' :: ImportImage -> Maybe Text
$sel:clientToken:ImportImage' :: ImportImage -> Maybe Text
$sel:clientData:ImportImage' :: ImportImage -> Maybe ClientData
$sel:bootMode:ImportImage' :: ImportImage -> Maybe BootModeValues
$sel:architecture:ImportImage' :: ImportImage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
architecture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BootModeValues
bootMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientData
clientData
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ImageDiskContainer]
diskContainers
      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
hypervisor
      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 Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
licenseType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
usageOperation

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

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

instance Data.ToQuery ImportImage where
  toQuery :: ImportImage -> QueryString
toQuery ImportImage' {Maybe Bool
Maybe [ImportImageLicenseConfigurationRequest]
Maybe [TagSpecification]
Maybe [ImageDiskContainer]
Maybe Text
Maybe BootModeValues
Maybe ClientData
usageOperation :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
roleName :: Maybe Text
platform :: Maybe Text
licenseType :: Maybe Text
licenseSpecifications :: Maybe [ImportImageLicenseConfigurationRequest]
kmsKeyId :: Maybe Text
hypervisor :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
diskContainers :: Maybe [ImageDiskContainer]
description :: Maybe Text
clientToken :: Maybe Text
clientData :: Maybe ClientData
bootMode :: Maybe BootModeValues
architecture :: Maybe Text
$sel:usageOperation:ImportImage' :: ImportImage -> Maybe Text
$sel:tagSpecifications:ImportImage' :: ImportImage -> Maybe [TagSpecification]
$sel:roleName:ImportImage' :: ImportImage -> Maybe Text
$sel:platform:ImportImage' :: ImportImage -> Maybe Text
$sel:licenseType:ImportImage' :: ImportImage -> Maybe Text
$sel:licenseSpecifications:ImportImage' :: ImportImage -> Maybe [ImportImageLicenseConfigurationRequest]
$sel:kmsKeyId:ImportImage' :: ImportImage -> Maybe Text
$sel:hypervisor:ImportImage' :: ImportImage -> Maybe Text
$sel:encrypted:ImportImage' :: ImportImage -> Maybe Bool
$sel:dryRun:ImportImage' :: ImportImage -> Maybe Bool
$sel:diskContainers:ImportImage' :: ImportImage -> Maybe [ImageDiskContainer]
$sel:description:ImportImage' :: ImportImage -> Maybe Text
$sel:clientToken:ImportImage' :: ImportImage -> Maybe Text
$sel:clientData:ImportImage' :: ImportImage -> Maybe ClientData
$sel:bootMode:ImportImage' :: ImportImage -> Maybe BootModeValues
$sel:architecture:ImportImage' :: ImportImage -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ImportImage" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Architecture" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
architecture,
        ByteString
"BootMode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe BootModeValues
bootMode,
        ByteString
"ClientData" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ClientData
clientData,
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"DiskContainer"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ImageDiskContainer]
diskContainers
          ),
        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
"Hypervisor" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
hypervisor,
        ByteString
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"LicenseSpecifications"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ImportImageLicenseConfigurationRequest]
licenseSpecifications
          ),
        ByteString
"LicenseType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
licenseType,
        ByteString
"Platform" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
platform,
        ByteString
"RoleName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
roleName,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"UsageOperation" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
usageOperation
      ]

-- | /See:/ 'newImportImageResponse' smart constructor.
data ImportImageResponse = ImportImageResponse'
  { -- | The architecture of the virtual machine.
    ImportImageResponse -> Maybe Text
architecture :: Prelude.Maybe Prelude.Text,
    -- | A description of the import task.
    ImportImageResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the AMI is encrypted.
    ImportImageResponse -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The target hypervisor of the import task.
    ImportImageResponse -> Maybe Text
hypervisor :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Amazon Machine Image (AMI) created by the import task.
    ImportImageResponse -> Maybe Text
imageId :: Prelude.Maybe Prelude.Text,
    -- | The task ID of the import image task.
    ImportImageResponse -> Maybe Text
importTaskId :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the symmetric KMS key that was used to create the
    -- encrypted AMI.
    ImportImageResponse -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The ARNs of the license configurations.
    ImportImageResponse
-> Maybe [ImportImageLicenseConfigurationResponse]
licenseSpecifications :: Prelude.Maybe [ImportImageLicenseConfigurationResponse],
    -- | The license type of the virtual machine.
    ImportImageResponse -> Maybe Text
licenseType :: Prelude.Maybe Prelude.Text,
    -- | The operating system of the virtual machine.
    ImportImageResponse -> Maybe Text
platform :: Prelude.Maybe Prelude.Text,
    -- | The progress of the task.
    ImportImageResponse -> Maybe Text
progress :: Prelude.Maybe Prelude.Text,
    -- | Information about the snapshots.
    ImportImageResponse -> Maybe [SnapshotDetail]
snapshotDetails :: Prelude.Maybe [SnapshotDetail],
    -- | A brief status of the task.
    ImportImageResponse -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | A detailed status message of the import task.
    ImportImageResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | Any tags assigned to the import image task.
    ImportImageResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The usage operation value.
    ImportImageResponse -> Maybe Text
usageOperation :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ImportImageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportImageResponse -> ImportImageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportImageResponse -> ImportImageResponse -> Bool
$c/= :: ImportImageResponse -> ImportImageResponse -> Bool
== :: ImportImageResponse -> ImportImageResponse -> Bool
$c== :: ImportImageResponse -> ImportImageResponse -> Bool
Prelude.Eq, ReadPrec [ImportImageResponse]
ReadPrec ImportImageResponse
Int -> ReadS ImportImageResponse
ReadS [ImportImageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportImageResponse]
$creadListPrec :: ReadPrec [ImportImageResponse]
readPrec :: ReadPrec ImportImageResponse
$creadPrec :: ReadPrec ImportImageResponse
readList :: ReadS [ImportImageResponse]
$creadList :: ReadS [ImportImageResponse]
readsPrec :: Int -> ReadS ImportImageResponse
$creadsPrec :: Int -> ReadS ImportImageResponse
Prelude.Read, Int -> ImportImageResponse -> ShowS
[ImportImageResponse] -> ShowS
ImportImageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportImageResponse] -> ShowS
$cshowList :: [ImportImageResponse] -> ShowS
show :: ImportImageResponse -> String
$cshow :: ImportImageResponse -> String
showsPrec :: Int -> ImportImageResponse -> ShowS
$cshowsPrec :: Int -> ImportImageResponse -> ShowS
Prelude.Show, forall x. Rep ImportImageResponse x -> ImportImageResponse
forall x. ImportImageResponse -> Rep ImportImageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportImageResponse x -> ImportImageResponse
$cfrom :: forall x. ImportImageResponse -> Rep ImportImageResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportImageResponse' 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:
--
-- 'architecture', 'importImageResponse_architecture' - The architecture of the virtual machine.
--
-- 'description', 'importImageResponse_description' - A description of the import task.
--
-- 'encrypted', 'importImageResponse_encrypted' - Indicates whether the AMI is encrypted.
--
-- 'hypervisor', 'importImageResponse_hypervisor' - The target hypervisor of the import task.
--
-- 'imageId', 'importImageResponse_imageId' - The ID of the Amazon Machine Image (AMI) created by the import task.
--
-- 'importTaskId', 'importImageResponse_importTaskId' - The task ID of the import image task.
--
-- 'kmsKeyId', 'importImageResponse_kmsKeyId' - The identifier for the symmetric KMS key that was used to create the
-- encrypted AMI.
--
-- 'licenseSpecifications', 'importImageResponse_licenseSpecifications' - The ARNs of the license configurations.
--
-- 'licenseType', 'importImageResponse_licenseType' - The license type of the virtual machine.
--
-- 'platform', 'importImageResponse_platform' - The operating system of the virtual machine.
--
-- 'progress', 'importImageResponse_progress' - The progress of the task.
--
-- 'snapshotDetails', 'importImageResponse_snapshotDetails' - Information about the snapshots.
--
-- 'status', 'importImageResponse_status' - A brief status of the task.
--
-- 'statusMessage', 'importImageResponse_statusMessage' - A detailed status message of the import task.
--
-- 'tags', 'importImageResponse_tags' - Any tags assigned to the import image task.
--
-- 'usageOperation', 'importImageResponse_usageOperation' - The usage operation value.
--
-- 'httpStatus', 'importImageResponse_httpStatus' - The response's http status code.
newImportImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportImageResponse
newImportImageResponse :: Int -> ImportImageResponse
newImportImageResponse Int
pHttpStatus_ =
  ImportImageResponse'
    { $sel:architecture:ImportImageResponse' :: Maybe Text
architecture =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:ImportImageResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:ImportImageResponse' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:hypervisor:ImportImageResponse' :: Maybe Text
hypervisor = forall a. Maybe a
Prelude.Nothing,
      $sel:imageId:ImportImageResponse' :: Maybe Text
imageId = forall a. Maybe a
Prelude.Nothing,
      $sel:importTaskId:ImportImageResponse' :: Maybe Text
importTaskId = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:ImportImageResponse' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseSpecifications:ImportImageResponse' :: Maybe [ImportImageLicenseConfigurationResponse]
licenseSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseType:ImportImageResponse' :: Maybe Text
licenseType = forall a. Maybe a
Prelude.Nothing,
      $sel:platform:ImportImageResponse' :: Maybe Text
platform = forall a. Maybe a
Prelude.Nothing,
      $sel:progress:ImportImageResponse' :: Maybe Text
progress = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotDetails:ImportImageResponse' :: Maybe [SnapshotDetail]
snapshotDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ImportImageResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:ImportImageResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportImageResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:usageOperation:ImportImageResponse' :: Maybe Text
usageOperation = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The architecture of the virtual machine.
importImageResponse_architecture :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_architecture :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
architecture :: Maybe Text
$sel:architecture:ImportImageResponse' :: ImportImageResponse -> Maybe Text
architecture} -> Maybe Text
architecture) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:architecture:ImportImageResponse' :: Maybe Text
architecture = Maybe Text
a} :: ImportImageResponse)

-- | A description of the import task.
importImageResponse_description :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_description :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
description :: Maybe Text
$sel:description:ImportImageResponse' :: ImportImageResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:description:ImportImageResponse' :: Maybe Text
description = Maybe Text
a} :: ImportImageResponse)

-- | Indicates whether the AMI is encrypted.
importImageResponse_encrypted :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Bool)
importImageResponse_encrypted :: Lens' ImportImageResponse (Maybe Bool)
importImageResponse_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:ImportImageResponse' :: ImportImageResponse -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Bool
a -> ImportImageResponse
s {$sel:encrypted:ImportImageResponse' :: Maybe Bool
encrypted = Maybe Bool
a} :: ImportImageResponse)

-- | The target hypervisor of the import task.
importImageResponse_hypervisor :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_hypervisor :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_hypervisor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
hypervisor :: Maybe Text
$sel:hypervisor:ImportImageResponse' :: ImportImageResponse -> Maybe Text
hypervisor} -> Maybe Text
hypervisor) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:hypervisor:ImportImageResponse' :: Maybe Text
hypervisor = Maybe Text
a} :: ImportImageResponse)

-- | The ID of the Amazon Machine Image (AMI) created by the import task.
importImageResponse_imageId :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_imageId :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
imageId :: Maybe Text
$sel:imageId:ImportImageResponse' :: ImportImageResponse -> Maybe Text
imageId} -> Maybe Text
imageId) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:imageId:ImportImageResponse' :: Maybe Text
imageId = Maybe Text
a} :: ImportImageResponse)

-- | The task ID of the import image task.
importImageResponse_importTaskId :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_importTaskId :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_importTaskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
importTaskId :: Maybe Text
$sel:importTaskId:ImportImageResponse' :: ImportImageResponse -> Maybe Text
importTaskId} -> Maybe Text
importTaskId) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:importTaskId:ImportImageResponse' :: Maybe Text
importTaskId = Maybe Text
a} :: ImportImageResponse)

-- | The identifier for the symmetric KMS key that was used to create the
-- encrypted AMI.
importImageResponse_kmsKeyId :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_kmsKeyId :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:ImportImageResponse' :: ImportImageResponse -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:kmsKeyId:ImportImageResponse' :: Maybe Text
kmsKeyId = Maybe Text
a} :: ImportImageResponse)

-- | The ARNs of the license configurations.
importImageResponse_licenseSpecifications :: Lens.Lens' ImportImageResponse (Prelude.Maybe [ImportImageLicenseConfigurationResponse])
importImageResponse_licenseSpecifications :: Lens'
  ImportImageResponse
  (Maybe [ImportImageLicenseConfigurationResponse])
importImageResponse_licenseSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe [ImportImageLicenseConfigurationResponse]
licenseSpecifications :: Maybe [ImportImageLicenseConfigurationResponse]
$sel:licenseSpecifications:ImportImageResponse' :: ImportImageResponse
-> Maybe [ImportImageLicenseConfigurationResponse]
licenseSpecifications} -> Maybe [ImportImageLicenseConfigurationResponse]
licenseSpecifications) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe [ImportImageLicenseConfigurationResponse]
a -> ImportImageResponse
s {$sel:licenseSpecifications:ImportImageResponse' :: Maybe [ImportImageLicenseConfigurationResponse]
licenseSpecifications = Maybe [ImportImageLicenseConfigurationResponse]
a} :: ImportImageResponse) 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 license type of the virtual machine.
importImageResponse_licenseType :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_licenseType :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_licenseType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
licenseType :: Maybe Text
$sel:licenseType:ImportImageResponse' :: ImportImageResponse -> Maybe Text
licenseType} -> Maybe Text
licenseType) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:licenseType:ImportImageResponse' :: Maybe Text
licenseType = Maybe Text
a} :: ImportImageResponse)

-- | The operating system of the virtual machine.
importImageResponse_platform :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_platform :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
platform :: Maybe Text
$sel:platform:ImportImageResponse' :: ImportImageResponse -> Maybe Text
platform} -> Maybe Text
platform) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:platform:ImportImageResponse' :: Maybe Text
platform = Maybe Text
a} :: ImportImageResponse)

-- | The progress of the task.
importImageResponse_progress :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_progress :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_progress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
progress :: Maybe Text
$sel:progress:ImportImageResponse' :: ImportImageResponse -> Maybe Text
progress} -> Maybe Text
progress) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:progress:ImportImageResponse' :: Maybe Text
progress = Maybe Text
a} :: ImportImageResponse)

-- | Information about the snapshots.
importImageResponse_snapshotDetails :: Lens.Lens' ImportImageResponse (Prelude.Maybe [SnapshotDetail])
importImageResponse_snapshotDetails :: Lens' ImportImageResponse (Maybe [SnapshotDetail])
importImageResponse_snapshotDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe [SnapshotDetail]
snapshotDetails :: Maybe [SnapshotDetail]
$sel:snapshotDetails:ImportImageResponse' :: ImportImageResponse -> Maybe [SnapshotDetail]
snapshotDetails} -> Maybe [SnapshotDetail]
snapshotDetails) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe [SnapshotDetail]
a -> ImportImageResponse
s {$sel:snapshotDetails:ImportImageResponse' :: Maybe [SnapshotDetail]
snapshotDetails = Maybe [SnapshotDetail]
a} :: ImportImageResponse) 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

-- | A brief status of the task.
importImageResponse_status :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_status :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
status :: Maybe Text
$sel:status:ImportImageResponse' :: ImportImageResponse -> Maybe Text
status} -> Maybe Text
status) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:status:ImportImageResponse' :: Maybe Text
status = Maybe Text
a} :: ImportImageResponse)

-- | A detailed status message of the import task.
importImageResponse_statusMessage :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_statusMessage :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:ImportImageResponse' :: ImportImageResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:statusMessage:ImportImageResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: ImportImageResponse)

-- | Any tags assigned to the import image task.
importImageResponse_tags :: Lens.Lens' ImportImageResponse (Prelude.Maybe [Tag])
importImageResponse_tags :: Lens' ImportImageResponse (Maybe [Tag])
importImageResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ImportImageResponse' :: ImportImageResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe [Tag]
a -> ImportImageResponse
s {$sel:tags:ImportImageResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ImportImageResponse) 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 usage operation value.
importImageResponse_usageOperation :: Lens.Lens' ImportImageResponse (Prelude.Maybe Prelude.Text)
importImageResponse_usageOperation :: Lens' ImportImageResponse (Maybe Text)
importImageResponse_usageOperation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportImageResponse' {Maybe Text
usageOperation :: Maybe Text
$sel:usageOperation:ImportImageResponse' :: ImportImageResponse -> Maybe Text
usageOperation} -> Maybe Text
usageOperation) (\s :: ImportImageResponse
s@ImportImageResponse' {} Maybe Text
a -> ImportImageResponse
s {$sel:usageOperation:ImportImageResponse' :: Maybe Text
usageOperation = Maybe Text
a} :: ImportImageResponse)

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

instance Prelude.NFData ImportImageResponse where
  rnf :: ImportImageResponse -> ()
rnf ImportImageResponse' {Int
Maybe Bool
Maybe [ImportImageLicenseConfigurationResponse]
Maybe [Tag]
Maybe [SnapshotDetail]
Maybe Text
httpStatus :: Int
usageOperation :: Maybe Text
tags :: Maybe [Tag]
statusMessage :: Maybe Text
status :: Maybe Text
snapshotDetails :: Maybe [SnapshotDetail]
progress :: Maybe Text
platform :: Maybe Text
licenseType :: Maybe Text
licenseSpecifications :: Maybe [ImportImageLicenseConfigurationResponse]
kmsKeyId :: Maybe Text
importTaskId :: Maybe Text
imageId :: Maybe Text
hypervisor :: Maybe Text
encrypted :: Maybe Bool
description :: Maybe Text
architecture :: Maybe Text
$sel:httpStatus:ImportImageResponse' :: ImportImageResponse -> Int
$sel:usageOperation:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:tags:ImportImageResponse' :: ImportImageResponse -> Maybe [Tag]
$sel:statusMessage:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:status:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:snapshotDetails:ImportImageResponse' :: ImportImageResponse -> Maybe [SnapshotDetail]
$sel:progress:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:platform:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:licenseType:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:licenseSpecifications:ImportImageResponse' :: ImportImageResponse
-> Maybe [ImportImageLicenseConfigurationResponse]
$sel:kmsKeyId:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:importTaskId:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:imageId:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:hypervisor:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:encrypted:ImportImageResponse' :: ImportImageResponse -> Maybe Bool
$sel:description:ImportImageResponse' :: ImportImageResponse -> Maybe Text
$sel:architecture:ImportImageResponse' :: ImportImageResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
architecture
      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 Bool
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hypervisor
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Text
importTaskId
      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 Maybe [ImportImageLicenseConfigurationResponse]
licenseSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
licenseType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
progress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SnapshotDetail]
snapshotDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
usageOperation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus