{-# 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.ImportSnapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports a disk into an EBS snapshot.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmimport-import-snapshot.html Importing a disk as a snapshot using VM Import\/Export>
-- in the /VM Import\/Export User Guide/.
module Amazonka.EC2.ImportSnapshot
  ( -- * Creating a Request
    ImportSnapshot (..),
    newImportSnapshot,

    -- * Request Lenses
    importSnapshot_clientData,
    importSnapshot_clientToken,
    importSnapshot_description,
    importSnapshot_diskContainer,
    importSnapshot_dryRun,
    importSnapshot_encrypted,
    importSnapshot_kmsKeyId,
    importSnapshot_roleName,
    importSnapshot_tagSpecifications,

    -- * Destructuring the Response
    ImportSnapshotResponse (..),
    newImportSnapshotResponse,

    -- * Response Lenses
    importSnapshotResponse_description,
    importSnapshotResponse_importTaskId,
    importSnapshotResponse_snapshotTaskDetail,
    importSnapshotResponse_tags,
    importSnapshotResponse_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:/ 'newImportSnapshot' smart constructor.
data ImportSnapshot = ImportSnapshot'
  { -- | The client-specific data.
    ImportSnapshot -> Maybe ClientData
clientData :: Prelude.Maybe ClientData,
    -- | Token to enable idempotency for VM import requests.
    ImportSnapshot -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The description string for the import snapshot task.
    ImportSnapshot -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Information about the disk container.
    ImportSnapshot -> Maybe SnapshotDiskContainer
diskContainer :: Prelude.Maybe SnapshotDiskContainer,
    -- | 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@.
    ImportSnapshot -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether the destination snapshot 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/.
    ImportSnapshot -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | An identifier for the symmetric KMS key to use when creating the
    -- encrypted snapshot. 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 snapshot is
    -- being copied to.
    --
    -- Amazon EBS does not support asymmetric KMS keys.
    ImportSnapshot -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The name of the role to use when not using the default role,
    -- \'vmimport\'.
    ImportSnapshot -> Maybe Text
roleName :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the import snapshot task during creation.
    ImportSnapshot -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification]
  }
  deriving (ImportSnapshot -> ImportSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSnapshot -> ImportSnapshot -> Bool
$c/= :: ImportSnapshot -> ImportSnapshot -> Bool
== :: ImportSnapshot -> ImportSnapshot -> Bool
$c== :: ImportSnapshot -> ImportSnapshot -> Bool
Prelude.Eq, ReadPrec [ImportSnapshot]
ReadPrec ImportSnapshot
Int -> ReadS ImportSnapshot
ReadS [ImportSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportSnapshot]
$creadListPrec :: ReadPrec [ImportSnapshot]
readPrec :: ReadPrec ImportSnapshot
$creadPrec :: ReadPrec ImportSnapshot
readList :: ReadS [ImportSnapshot]
$creadList :: ReadS [ImportSnapshot]
readsPrec :: Int -> ReadS ImportSnapshot
$creadsPrec :: Int -> ReadS ImportSnapshot
Prelude.Read, Int -> ImportSnapshot -> ShowS
[ImportSnapshot] -> ShowS
ImportSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportSnapshot] -> ShowS
$cshowList :: [ImportSnapshot] -> ShowS
show :: ImportSnapshot -> String
$cshow :: ImportSnapshot -> String
showsPrec :: Int -> ImportSnapshot -> ShowS
$cshowsPrec :: Int -> ImportSnapshot -> ShowS
Prelude.Show, forall x. Rep ImportSnapshot x -> ImportSnapshot
forall x. ImportSnapshot -> Rep ImportSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportSnapshot x -> ImportSnapshot
$cfrom :: forall x. ImportSnapshot -> Rep ImportSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'ImportSnapshot' 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:
--
-- 'clientData', 'importSnapshot_clientData' - The client-specific data.
--
-- 'clientToken', 'importSnapshot_clientToken' - Token to enable idempotency for VM import requests.
--
-- 'description', 'importSnapshot_description' - The description string for the import snapshot task.
--
-- 'diskContainer', 'importSnapshot_diskContainer' - Information about the disk container.
--
-- 'dryRun', 'importSnapshot_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', 'importSnapshot_encrypted' - Specifies whether the destination snapshot 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/.
--
-- 'kmsKeyId', 'importSnapshot_kmsKeyId' - An identifier for the symmetric KMS key to use when creating the
-- encrypted snapshot. 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 snapshot is
-- being copied to.
--
-- Amazon EBS does not support asymmetric KMS keys.
--
-- 'roleName', 'importSnapshot_roleName' - The name of the role to use when not using the default role,
-- \'vmimport\'.
--
-- 'tagSpecifications', 'importSnapshot_tagSpecifications' - The tags to apply to the import snapshot task during creation.
newImportSnapshot ::
  ImportSnapshot
newImportSnapshot :: ImportSnapshot
newImportSnapshot =
  ImportSnapshot'
    { $sel:clientData:ImportSnapshot' :: Maybe ClientData
clientData = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:ImportSnapshot' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:ImportSnapshot' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:diskContainer:ImportSnapshot' :: Maybe SnapshotDiskContainer
diskContainer = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ImportSnapshot' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:ImportSnapshot' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:ImportSnapshot' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:roleName:ImportSnapshot' :: Maybe Text
roleName = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:ImportSnapshot' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing
    }

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

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

-- | The description string for the import snapshot task.
importSnapshot_description :: Lens.Lens' ImportSnapshot (Prelude.Maybe Prelude.Text)
importSnapshot_description :: Lens' ImportSnapshot (Maybe Text)
importSnapshot_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshot' {Maybe Text
description :: Maybe Text
$sel:description:ImportSnapshot' :: ImportSnapshot -> Maybe Text
description} -> Maybe Text
description) (\s :: ImportSnapshot
s@ImportSnapshot' {} Maybe Text
a -> ImportSnapshot
s {$sel:description:ImportSnapshot' :: Maybe Text
description = Maybe Text
a} :: ImportSnapshot)

-- | Information about the disk container.
importSnapshot_diskContainer :: Lens.Lens' ImportSnapshot (Prelude.Maybe SnapshotDiskContainer)
importSnapshot_diskContainer :: Lens' ImportSnapshot (Maybe SnapshotDiskContainer)
importSnapshot_diskContainer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshot' {Maybe SnapshotDiskContainer
diskContainer :: Maybe SnapshotDiskContainer
$sel:diskContainer:ImportSnapshot' :: ImportSnapshot -> Maybe SnapshotDiskContainer
diskContainer} -> Maybe SnapshotDiskContainer
diskContainer) (\s :: ImportSnapshot
s@ImportSnapshot' {} Maybe SnapshotDiskContainer
a -> ImportSnapshot
s {$sel:diskContainer:ImportSnapshot' :: Maybe SnapshotDiskContainer
diskContainer = Maybe SnapshotDiskContainer
a} :: ImportSnapshot)

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

-- | Specifies whether the destination snapshot 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/.
importSnapshot_encrypted :: Lens.Lens' ImportSnapshot (Prelude.Maybe Prelude.Bool)
importSnapshot_encrypted :: Lens' ImportSnapshot (Maybe Bool)
importSnapshot_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshot' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:ImportSnapshot' :: ImportSnapshot -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: ImportSnapshot
s@ImportSnapshot' {} Maybe Bool
a -> ImportSnapshot
s {$sel:encrypted:ImportSnapshot' :: Maybe Bool
encrypted = Maybe Bool
a} :: ImportSnapshot)

-- | An identifier for the symmetric KMS key to use when creating the
-- encrypted snapshot. 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 snapshot is
-- being copied to.
--
-- Amazon EBS does not support asymmetric KMS keys.
importSnapshot_kmsKeyId :: Lens.Lens' ImportSnapshot (Prelude.Maybe Prelude.Text)
importSnapshot_kmsKeyId :: Lens' ImportSnapshot (Maybe Text)
importSnapshot_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshot' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:ImportSnapshot' :: ImportSnapshot -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: ImportSnapshot
s@ImportSnapshot' {} Maybe Text
a -> ImportSnapshot
s {$sel:kmsKeyId:ImportSnapshot' :: Maybe Text
kmsKeyId = Maybe Text
a} :: ImportSnapshot)

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

-- | The tags to apply to the import snapshot task during creation.
importSnapshot_tagSpecifications :: Lens.Lens' ImportSnapshot (Prelude.Maybe [TagSpecification])
importSnapshot_tagSpecifications :: Lens' ImportSnapshot (Maybe [TagSpecification])
importSnapshot_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshot' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:ImportSnapshot' :: ImportSnapshot -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: ImportSnapshot
s@ImportSnapshot' {} Maybe [TagSpecification]
a -> ImportSnapshot
s {$sel:tagSpecifications:ImportSnapshot' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: ImportSnapshot) 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

instance Core.AWSRequest ImportSnapshot where
  type
    AWSResponse ImportSnapshot =
      ImportSnapshotResponse
  request :: (Service -> Service) -> ImportSnapshot -> Request ImportSnapshot
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 ImportSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportSnapshot)))
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 SnapshotTaskDetail
-> Maybe [Tag]
-> Int
-> ImportSnapshotResponse
ImportSnapshotResponse'
            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
"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
"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
"snapshotTaskDetail")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ImportSnapshot where
  hashWithSalt :: Int -> ImportSnapshot -> Int
hashWithSalt Int
_salt ImportSnapshot' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe ClientData
Maybe SnapshotDiskContainer
tagSpecifications :: Maybe [TagSpecification]
roleName :: Maybe Text
kmsKeyId :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
diskContainer :: Maybe SnapshotDiskContainer
description :: Maybe Text
clientToken :: Maybe Text
clientData :: Maybe ClientData
$sel:tagSpecifications:ImportSnapshot' :: ImportSnapshot -> Maybe [TagSpecification]
$sel:roleName:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:kmsKeyId:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:encrypted:ImportSnapshot' :: ImportSnapshot -> Maybe Bool
$sel:dryRun:ImportSnapshot' :: ImportSnapshot -> Maybe Bool
$sel:diskContainer:ImportSnapshot' :: ImportSnapshot -> Maybe SnapshotDiskContainer
$sel:description:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:clientToken:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:clientData:ImportSnapshot' :: ImportSnapshot -> Maybe ClientData
..} =
    Int
_salt
      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 SnapshotDiskContainer
diskContainer
      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` Maybe Text
roleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications

instance Prelude.NFData ImportSnapshot where
  rnf :: ImportSnapshot -> ()
rnf ImportSnapshot' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe ClientData
Maybe SnapshotDiskContainer
tagSpecifications :: Maybe [TagSpecification]
roleName :: Maybe Text
kmsKeyId :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
diskContainer :: Maybe SnapshotDiskContainer
description :: Maybe Text
clientToken :: Maybe Text
clientData :: Maybe ClientData
$sel:tagSpecifications:ImportSnapshot' :: ImportSnapshot -> Maybe [TagSpecification]
$sel:roleName:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:kmsKeyId:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:encrypted:ImportSnapshot' :: ImportSnapshot -> Maybe Bool
$sel:dryRun:ImportSnapshot' :: ImportSnapshot -> Maybe Bool
$sel:diskContainer:ImportSnapshot' :: ImportSnapshot -> Maybe SnapshotDiskContainer
$sel:description:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:clientToken:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:clientData:ImportSnapshot' :: ImportSnapshot -> Maybe ClientData
..} =
    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 SnapshotDiskContainer
diskContainer
      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 Maybe Text
roleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications

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

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

instance Data.ToQuery ImportSnapshot where
  toQuery :: ImportSnapshot -> QueryString
toQuery ImportSnapshot' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe ClientData
Maybe SnapshotDiskContainer
tagSpecifications :: Maybe [TagSpecification]
roleName :: Maybe Text
kmsKeyId :: Maybe Text
encrypted :: Maybe Bool
dryRun :: Maybe Bool
diskContainer :: Maybe SnapshotDiskContainer
description :: Maybe Text
clientToken :: Maybe Text
clientData :: Maybe ClientData
$sel:tagSpecifications:ImportSnapshot' :: ImportSnapshot -> Maybe [TagSpecification]
$sel:roleName:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:kmsKeyId:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:encrypted:ImportSnapshot' :: ImportSnapshot -> Maybe Bool
$sel:dryRun:ImportSnapshot' :: ImportSnapshot -> Maybe Bool
$sel:diskContainer:ImportSnapshot' :: ImportSnapshot -> Maybe SnapshotDiskContainer
$sel:description:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:clientToken:ImportSnapshot' :: ImportSnapshot -> Maybe Text
$sel:clientData:ImportSnapshot' :: ImportSnapshot -> Maybe ClientData
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ImportSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        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,
        ByteString
"DiskContainer" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SnapshotDiskContainer
diskContainer,
        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
"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
          )
      ]

-- | /See:/ 'newImportSnapshotResponse' smart constructor.
data ImportSnapshotResponse = ImportSnapshotResponse'
  { -- | A description of the import snapshot task.
    ImportSnapshotResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ID of the import snapshot task.
    ImportSnapshotResponse -> Maybe Text
importTaskId :: Prelude.Maybe Prelude.Text,
    -- | Information about the import snapshot task.
    ImportSnapshotResponse -> Maybe SnapshotTaskDetail
snapshotTaskDetail :: Prelude.Maybe SnapshotTaskDetail,
    -- | Any tags assigned to the import snapshot task.
    ImportSnapshotResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    ImportSnapshotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportSnapshotResponse -> ImportSnapshotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSnapshotResponse -> ImportSnapshotResponse -> Bool
$c/= :: ImportSnapshotResponse -> ImportSnapshotResponse -> Bool
== :: ImportSnapshotResponse -> ImportSnapshotResponse -> Bool
$c== :: ImportSnapshotResponse -> ImportSnapshotResponse -> Bool
Prelude.Eq, ReadPrec [ImportSnapshotResponse]
ReadPrec ImportSnapshotResponse
Int -> ReadS ImportSnapshotResponse
ReadS [ImportSnapshotResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportSnapshotResponse]
$creadListPrec :: ReadPrec [ImportSnapshotResponse]
readPrec :: ReadPrec ImportSnapshotResponse
$creadPrec :: ReadPrec ImportSnapshotResponse
readList :: ReadS [ImportSnapshotResponse]
$creadList :: ReadS [ImportSnapshotResponse]
readsPrec :: Int -> ReadS ImportSnapshotResponse
$creadsPrec :: Int -> ReadS ImportSnapshotResponse
Prelude.Read, Int -> ImportSnapshotResponse -> ShowS
[ImportSnapshotResponse] -> ShowS
ImportSnapshotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportSnapshotResponse] -> ShowS
$cshowList :: [ImportSnapshotResponse] -> ShowS
show :: ImportSnapshotResponse -> String
$cshow :: ImportSnapshotResponse -> String
showsPrec :: Int -> ImportSnapshotResponse -> ShowS
$cshowsPrec :: Int -> ImportSnapshotResponse -> ShowS
Prelude.Show, forall x. Rep ImportSnapshotResponse x -> ImportSnapshotResponse
forall x. ImportSnapshotResponse -> Rep ImportSnapshotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportSnapshotResponse x -> ImportSnapshotResponse
$cfrom :: forall x. ImportSnapshotResponse -> Rep ImportSnapshotResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportSnapshotResponse' 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:
--
-- 'description', 'importSnapshotResponse_description' - A description of the import snapshot task.
--
-- 'importTaskId', 'importSnapshotResponse_importTaskId' - The ID of the import snapshot task.
--
-- 'snapshotTaskDetail', 'importSnapshotResponse_snapshotTaskDetail' - Information about the import snapshot task.
--
-- 'tags', 'importSnapshotResponse_tags' - Any tags assigned to the import snapshot task.
--
-- 'httpStatus', 'importSnapshotResponse_httpStatus' - The response's http status code.
newImportSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportSnapshotResponse
newImportSnapshotResponse :: Int -> ImportSnapshotResponse
newImportSnapshotResponse Int
pHttpStatus_ =
  ImportSnapshotResponse'
    { $sel:description:ImportSnapshotResponse' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:importTaskId:ImportSnapshotResponse' :: Maybe Text
importTaskId = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotTaskDetail:ImportSnapshotResponse' :: Maybe SnapshotTaskDetail
snapshotTaskDetail = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportSnapshotResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

-- | Information about the import snapshot task.
importSnapshotResponse_snapshotTaskDetail :: Lens.Lens' ImportSnapshotResponse (Prelude.Maybe SnapshotTaskDetail)
importSnapshotResponse_snapshotTaskDetail :: Lens' ImportSnapshotResponse (Maybe SnapshotTaskDetail)
importSnapshotResponse_snapshotTaskDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshotResponse' {Maybe SnapshotTaskDetail
snapshotTaskDetail :: Maybe SnapshotTaskDetail
$sel:snapshotTaskDetail:ImportSnapshotResponse' :: ImportSnapshotResponse -> Maybe SnapshotTaskDetail
snapshotTaskDetail} -> Maybe SnapshotTaskDetail
snapshotTaskDetail) (\s :: ImportSnapshotResponse
s@ImportSnapshotResponse' {} Maybe SnapshotTaskDetail
a -> ImportSnapshotResponse
s {$sel:snapshotTaskDetail:ImportSnapshotResponse' :: Maybe SnapshotTaskDetail
snapshotTaskDetail = Maybe SnapshotTaskDetail
a} :: ImportSnapshotResponse)

-- | Any tags assigned to the import snapshot task.
importSnapshotResponse_tags :: Lens.Lens' ImportSnapshotResponse (Prelude.Maybe [Tag])
importSnapshotResponse_tags :: Lens' ImportSnapshotResponse (Maybe [Tag])
importSnapshotResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshotResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ImportSnapshotResponse' :: ImportSnapshotResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ImportSnapshotResponse
s@ImportSnapshotResponse' {} Maybe [Tag]
a -> ImportSnapshotResponse
s {$sel:tags:ImportSnapshotResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ImportSnapshotResponse) 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 response's http status code.
importSnapshotResponse_httpStatus :: Lens.Lens' ImportSnapshotResponse Prelude.Int
importSnapshotResponse_httpStatus :: Lens' ImportSnapshotResponse Int
importSnapshotResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSnapshotResponse' {Int
httpStatus :: Int
$sel:httpStatus:ImportSnapshotResponse' :: ImportSnapshotResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ImportSnapshotResponse
s@ImportSnapshotResponse' {} Int
a -> ImportSnapshotResponse
s {$sel:httpStatus:ImportSnapshotResponse' :: Int
httpStatus = Int
a} :: ImportSnapshotResponse)

instance Prelude.NFData ImportSnapshotResponse where
  rnf :: ImportSnapshotResponse -> ()
rnf ImportSnapshotResponse' {Int
Maybe [Tag]
Maybe Text
Maybe SnapshotTaskDetail
httpStatus :: Int
tags :: Maybe [Tag]
snapshotTaskDetail :: Maybe SnapshotTaskDetail
importTaskId :: Maybe Text
description :: Maybe Text
$sel:httpStatus:ImportSnapshotResponse' :: ImportSnapshotResponse -> Int
$sel:tags:ImportSnapshotResponse' :: ImportSnapshotResponse -> Maybe [Tag]
$sel:snapshotTaskDetail:ImportSnapshotResponse' :: ImportSnapshotResponse -> Maybe SnapshotTaskDetail
$sel:importTaskId:ImportSnapshotResponse' :: ImportSnapshotResponse -> Maybe Text
$sel:description:ImportSnapshotResponse' :: ImportSnapshotResponse -> Maybe Text
..} =
    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
importTaskId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SnapshotTaskDetail
snapshotTaskDetail
      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 Int
httpStatus