{-# 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.CreateSnapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a snapshot of an EBS volume and stores it in Amazon S3. You can
-- use snapshots for backups, to make copies of EBS volumes, and to save
-- data before shutting down an instance.
--
-- You can create snapshots of volumes in a Region and volumes on an
-- Outpost. If you create a snapshot of a volume in a Region, the snapshot
-- must be stored in the same Region as the volume. If you create a
-- snapshot of a volume on an Outpost, the snapshot can be stored on the
-- same Outpost as the volume, or in the Region for that Outpost.
--
-- When a snapshot is created, any Amazon Web Services Marketplace product
-- codes that are associated with the source volume are propagated to the
-- snapshot.
--
-- You can take a snapshot of an attached volume that is in use. However,
-- snapshots only capture data that has been written to your Amazon EBS
-- volume at the time the snapshot command is issued; this might exclude
-- any data that has been cached by any applications or the operating
-- system. If you can pause any file systems on the volume long enough to
-- take a snapshot, your snapshot should be complete. However, if you
-- cannot pause all file writes to the volume, you should unmount the
-- volume from within the instance, issue the snapshot command, and then
-- remount the volume to ensure a consistent and complete snapshot. You may
-- remount and use your volume while the snapshot status is @pending@.
--
-- To create a snapshot for Amazon EBS volumes that serve as root devices,
-- you should stop the instance before taking the snapshot.
--
-- Snapshots that are taken from encrypted volumes are automatically
-- encrypted. Volumes that are created from encrypted snapshots are also
-- automatically encrypted. Your encrypted volumes and any associated
-- snapshots always remain protected.
--
-- You can tag your snapshots during creation. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html Tag your Amazon EC2 resources>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/AmazonEBS.html Amazon Elastic Block Store>
-- and
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.CreateSnapshot
  ( -- * Creating a Request
    CreateSnapshot (..),
    newCreateSnapshot,

    -- * Request Lenses
    createSnapshot_description,
    createSnapshot_dryRun,
    createSnapshot_outpostArn,
    createSnapshot_tagSpecifications,
    createSnapshot_volumeId,

    -- * Destructuring the Response
    Snapshot (..),
    newSnapshot,

    -- * Response Lenses
    snapshot_dataEncryptionKeyId,
    snapshot_kmsKeyId,
    snapshot_outpostArn,
    snapshot_ownerAlias,
    snapshot_restoreExpiryTime,
    snapshot_stateMessage,
    snapshot_storageTier,
    snapshot_tags,
    snapshot_snapshotId,
    snapshot_ownerId,
    snapshot_volumeId,
    snapshot_volumeSize,
    snapshot_description,
    snapshot_startTime,
    snapshot_progress,
    snapshot_state,
    snapshot_encrypted,
  )
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:/ 'newCreateSnapshot' smart constructor.
data CreateSnapshot = CreateSnapshot'
  { -- | A description for the snapshot.
    CreateSnapshot -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateSnapshot -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the Outpost on which to create a local
    -- snapshot.
    --
    -- -   To create a snapshot of a volume in a Region, omit this parameter.
    --     The snapshot is created in the same Region as the volume.
    --
    -- -   To create a snapshot of a volume on an Outpost and store the
    --     snapshot in the Region, omit this parameter. The snapshot is created
    --     in the Region for the Outpost.
    --
    -- -   To create a snapshot of a volume on an Outpost and store the
    --     snapshot on an Outpost, specify the ARN of the destination Outpost.
    --     The snapshot must be created on the same Outpost as the volume.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#create-snapshot Create local snapshots from volumes on an Outpost>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    CreateSnapshot -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the snapshot during creation.
    CreateSnapshot -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the Amazon EBS volume.
    CreateSnapshot -> Text
volumeId :: Prelude.Text
  }
  deriving (CreateSnapshot -> CreateSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSnapshot -> CreateSnapshot -> Bool
$c/= :: CreateSnapshot -> CreateSnapshot -> Bool
== :: CreateSnapshot -> CreateSnapshot -> Bool
$c== :: CreateSnapshot -> CreateSnapshot -> Bool
Prelude.Eq, ReadPrec [CreateSnapshot]
ReadPrec CreateSnapshot
Int -> ReadS CreateSnapshot
ReadS [CreateSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSnapshot]
$creadListPrec :: ReadPrec [CreateSnapshot]
readPrec :: ReadPrec CreateSnapshot
$creadPrec :: ReadPrec CreateSnapshot
readList :: ReadS [CreateSnapshot]
$creadList :: ReadS [CreateSnapshot]
readsPrec :: Int -> ReadS CreateSnapshot
$creadsPrec :: Int -> ReadS CreateSnapshot
Prelude.Read, Int -> CreateSnapshot -> ShowS
[CreateSnapshot] -> ShowS
CreateSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSnapshot] -> ShowS
$cshowList :: [CreateSnapshot] -> ShowS
show :: CreateSnapshot -> String
$cshow :: CreateSnapshot -> String
showsPrec :: Int -> CreateSnapshot -> ShowS
$cshowsPrec :: Int -> CreateSnapshot -> ShowS
Prelude.Show, forall x. Rep CreateSnapshot x -> CreateSnapshot
forall x. CreateSnapshot -> Rep CreateSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSnapshot x -> CreateSnapshot
$cfrom :: forall x. CreateSnapshot -> Rep CreateSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'CreateSnapshot' 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', 'createSnapshot_description' - A description for the snapshot.
--
-- 'dryRun', 'createSnapshot_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@.
--
-- 'outpostArn', 'createSnapshot_outpostArn' - The Amazon Resource Name (ARN) of the Outpost on which to create a local
-- snapshot.
--
-- -   To create a snapshot of a volume in a Region, omit this parameter.
--     The snapshot is created in the same Region as the volume.
--
-- -   To create a snapshot of a volume on an Outpost and store the
--     snapshot in the Region, omit this parameter. The snapshot is created
--     in the Region for the Outpost.
--
-- -   To create a snapshot of a volume on an Outpost and store the
--     snapshot on an Outpost, specify the ARN of the destination Outpost.
--     The snapshot must be created on the same Outpost as the volume.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#create-snapshot Create local snapshots from volumes on an Outpost>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'tagSpecifications', 'createSnapshot_tagSpecifications' - The tags to apply to the snapshot during creation.
--
-- 'volumeId', 'createSnapshot_volumeId' - The ID of the Amazon EBS volume.
newCreateSnapshot ::
  -- | 'volumeId'
  Prelude.Text ->
  CreateSnapshot
newCreateSnapshot :: Text -> CreateSnapshot
newCreateSnapshot Text
pVolumeId_ =
  CreateSnapshot'
    { $sel:description:CreateSnapshot' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateSnapshot' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:outpostArn:CreateSnapshot' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateSnapshot' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeId:CreateSnapshot' :: Text
volumeId = Text
pVolumeId_
    }

-- | A description for the snapshot.
createSnapshot_description :: Lens.Lens' CreateSnapshot (Prelude.Maybe Prelude.Text)
createSnapshot_description :: Lens' CreateSnapshot (Maybe Text)
createSnapshot_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshot' {Maybe Text
description :: Maybe Text
$sel:description:CreateSnapshot' :: CreateSnapshot -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateSnapshot
s@CreateSnapshot' {} Maybe Text
a -> CreateSnapshot
s {$sel:description:CreateSnapshot' :: Maybe Text
description = Maybe Text
a} :: CreateSnapshot)

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

-- | The Amazon Resource Name (ARN) of the Outpost on which to create a local
-- snapshot.
--
-- -   To create a snapshot of a volume in a Region, omit this parameter.
--     The snapshot is created in the same Region as the volume.
--
-- -   To create a snapshot of a volume on an Outpost and store the
--     snapshot in the Region, omit this parameter. The snapshot is created
--     in the Region for the Outpost.
--
-- -   To create a snapshot of a volume on an Outpost and store the
--     snapshot on an Outpost, specify the ARN of the destination Outpost.
--     The snapshot must be created on the same Outpost as the volume.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#create-snapshot Create local snapshots from volumes on an Outpost>
-- in the /Amazon Elastic Compute Cloud User Guide/.
createSnapshot_outpostArn :: Lens.Lens' CreateSnapshot (Prelude.Maybe Prelude.Text)
createSnapshot_outpostArn :: Lens' CreateSnapshot (Maybe Text)
createSnapshot_outpostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshot' {Maybe Text
outpostArn :: Maybe Text
$sel:outpostArn:CreateSnapshot' :: CreateSnapshot -> Maybe Text
outpostArn} -> Maybe Text
outpostArn) (\s :: CreateSnapshot
s@CreateSnapshot' {} Maybe Text
a -> CreateSnapshot
s {$sel:outpostArn:CreateSnapshot' :: Maybe Text
outpostArn = Maybe Text
a} :: CreateSnapshot)

-- | The tags to apply to the snapshot during creation.
createSnapshot_tagSpecifications :: Lens.Lens' CreateSnapshot (Prelude.Maybe [TagSpecification])
createSnapshot_tagSpecifications :: Lens' CreateSnapshot (Maybe [TagSpecification])
createSnapshot_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshot' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateSnapshot' :: CreateSnapshot -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateSnapshot
s@CreateSnapshot' {} Maybe [TagSpecification]
a -> CreateSnapshot
s {$sel:tagSpecifications:CreateSnapshot' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateSnapshot) 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 ID of the Amazon EBS volume.
createSnapshot_volumeId :: Lens.Lens' CreateSnapshot Prelude.Text
createSnapshot_volumeId :: Lens' CreateSnapshot Text
createSnapshot_volumeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshot' {Text
volumeId :: Text
$sel:volumeId:CreateSnapshot' :: CreateSnapshot -> Text
volumeId} -> Text
volumeId) (\s :: CreateSnapshot
s@CreateSnapshot' {} Text
a -> CreateSnapshot
s {$sel:volumeId:CreateSnapshot' :: Text
volumeId = Text
a} :: CreateSnapshot)

instance Core.AWSRequest CreateSnapshot where
  type AWSResponse CreateSnapshot = Snapshot
  request :: (Service -> Service) -> CreateSnapshot -> Request CreateSnapshot
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 CreateSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSnapshot)))
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 -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable CreateSnapshot where
  hashWithSalt :: Int -> CreateSnapshot -> Int
hashWithSalt Int
_salt CreateSnapshot' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
volumeId :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
dryRun :: Maybe Bool
description :: Maybe Text
$sel:volumeId:CreateSnapshot' :: CreateSnapshot -> Text
$sel:tagSpecifications:CreateSnapshot' :: CreateSnapshot -> Maybe [TagSpecification]
$sel:outpostArn:CreateSnapshot' :: CreateSnapshot -> Maybe Text
$sel:dryRun:CreateSnapshot' :: CreateSnapshot -> Maybe Bool
$sel:description:CreateSnapshot' :: CreateSnapshot -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outpostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeId

instance Prelude.NFData CreateSnapshot where
  rnf :: CreateSnapshot -> ()
rnf CreateSnapshot' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
volumeId :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
dryRun :: Maybe Bool
description :: Maybe Text
$sel:volumeId:CreateSnapshot' :: CreateSnapshot -> Text
$sel:tagSpecifications:CreateSnapshot' :: CreateSnapshot -> Maybe [TagSpecification]
$sel:outpostArn:CreateSnapshot' :: CreateSnapshot -> Maybe Text
$sel:dryRun:CreateSnapshot' :: CreateSnapshot -> Maybe Bool
$sel:description:CreateSnapshot' :: CreateSnapshot -> 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 Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outpostArn
      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 Text
volumeId

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

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

instance Data.ToQuery CreateSnapshot where
  toQuery :: CreateSnapshot -> QueryString
toQuery CreateSnapshot' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
volumeId :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
dryRun :: Maybe Bool
description :: Maybe Text
$sel:volumeId:CreateSnapshot' :: CreateSnapshot -> Text
$sel:tagSpecifications:CreateSnapshot' :: CreateSnapshot -> Maybe [TagSpecification]
$sel:outpostArn:CreateSnapshot' :: CreateSnapshot -> Maybe Text
$sel:dryRun:CreateSnapshot' :: CreateSnapshot -> Maybe Bool
$sel:description:CreateSnapshot' :: CreateSnapshot -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"OutpostArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
outpostArn,
        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
"VolumeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
volumeId
      ]