{-# 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.EBS.StartSnapshot
-- 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 new Amazon EBS snapshot. The new snapshot enters the @pending@
-- state after the request completes.
--
-- After creating the snapshot, use
-- <https://docs.aws.amazon.com/ebs/latest/APIReference/API_PutSnapshotBlock.html PutSnapshotBlock>
-- to write blocks of data to the snapshot.
module Amazonka.EBS.StartSnapshot
  ( -- * Creating a Request
    StartSnapshot (..),
    newStartSnapshot,

    -- * Request Lenses
    startSnapshot_clientToken,
    startSnapshot_description,
    startSnapshot_encrypted,
    startSnapshot_kmsKeyArn,
    startSnapshot_parentSnapshotId,
    startSnapshot_tags,
    startSnapshot_timeout,
    startSnapshot_volumeSize,

    -- * Destructuring the Response
    StartSnapshotResponse (..),
    newStartSnapshotResponse,

    -- * Response Lenses
    startSnapshotResponse_blockSize,
    startSnapshotResponse_description,
    startSnapshotResponse_kmsKeyArn,
    startSnapshotResponse_ownerId,
    startSnapshotResponse_parentSnapshotId,
    startSnapshotResponse_snapshotId,
    startSnapshotResponse_startTime,
    startSnapshotResponse_status,
    startSnapshotResponse_tags,
    startSnapshotResponse_volumeSize,
    startSnapshotResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartSnapshot' smart constructor.
data StartSnapshot = StartSnapshot'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Idempotency ensures that an API request
    -- completes only once. With an idempotent request, if the original request
    -- completes successfully. The subsequent retries with the same client
    -- token return the result from the original successful request and they
    -- have no additional effect.
    --
    -- If you do not specify a client token, one is automatically generated by
    -- the Amazon Web Services SDK.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-direct-api-idempotency.html Idempotency for StartSnapshot API>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    StartSnapshot -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the snapshot.
    StartSnapshot -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to encrypt the snapshot.
    --
    -- You can\'t specify __Encrypted__ and __ParentSnapshotId__ in the same
    -- request. If you specify both parameters, the request fails with
    -- @ValidationException@.
    --
    -- The encryption status of the snapshot depends on the values that you
    -- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
    -- whether your Amazon Web Services account is enabled for
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    --
    -- To create an encrypted snapshot, you must have permission to use the KMS
    -- key. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    StartSnapshot -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the Key Management Service (KMS) key
    -- to be used to encrypt the snapshot.
    --
    -- The encryption status of the snapshot depends on the values that you
    -- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
    -- whether your Amazon Web Services account is enabled for
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    --
    -- To create an encrypted snapshot, you must have permission to use the KMS
    -- key. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    StartSnapshot -> Maybe (Sensitive Text)
kmsKeyArn :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The ID of the parent snapshot. If there is no parent snapshot, or if you
    -- are creating the first snapshot for an on-premises volume, omit this
    -- parameter.
    --
    -- You can\'t specify __ParentSnapshotId__ and __Encrypted__ in the same
    -- request. If you specify both parameters, the request fails with
    -- @ValidationException@.
    --
    -- The encryption status of the snapshot depends on the values that you
    -- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
    -- whether your Amazon Web Services account is enabled for
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    --
    -- If you specify an encrypted parent snapshot, you must have permission to
    -- use the KMS key that was used to encrypt the parent snapshot. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    StartSnapshot -> Maybe Text
parentSnapshotId :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the snapshot.
    StartSnapshot -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The amount of time (in minutes) after which the snapshot is
    -- automatically cancelled if:
    --
    -- -   No blocks are written to the snapshot.
    --
    -- -   The snapshot is not completed after writing the last block of data.
    --
    -- If no value is specified, the timeout defaults to @60@ minutes.
    StartSnapshot -> Maybe Natural
timeout :: Prelude.Maybe Prelude.Natural,
    -- | The size of the volume, in GiB. The maximum size is @65536@ GiB (64
    -- TiB).
    StartSnapshot -> Natural
volumeSize :: Prelude.Natural
  }
  deriving (StartSnapshot -> StartSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSnapshot -> StartSnapshot -> Bool
$c/= :: StartSnapshot -> StartSnapshot -> Bool
== :: StartSnapshot -> StartSnapshot -> Bool
$c== :: StartSnapshot -> StartSnapshot -> Bool
Prelude.Eq, Int -> StartSnapshot -> ShowS
[StartSnapshot] -> ShowS
StartSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSnapshot] -> ShowS
$cshowList :: [StartSnapshot] -> ShowS
show :: StartSnapshot -> String
$cshow :: StartSnapshot -> String
showsPrec :: Int -> StartSnapshot -> ShowS
$cshowsPrec :: Int -> StartSnapshot -> ShowS
Prelude.Show, forall x. Rep StartSnapshot x -> StartSnapshot
forall x. StartSnapshot -> Rep StartSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSnapshot x -> StartSnapshot
$cfrom :: forall x. StartSnapshot -> Rep StartSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'StartSnapshot' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'clientToken', 'startSnapshot_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully. The subsequent retries with the same client
-- token return the result from the original successful request and they
-- have no additional effect.
--
-- If you do not specify a client token, one is automatically generated by
-- the Amazon Web Services SDK.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-direct-api-idempotency.html Idempotency for StartSnapshot API>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'description', 'startSnapshot_description' - A description for the snapshot.
--
-- 'encrypted', 'startSnapshot_encrypted' - Indicates whether to encrypt the snapshot.
--
-- You can\'t specify __Encrypted__ and __ParentSnapshotId__ in the same
-- request. If you specify both parameters, the request fails with
-- @ValidationException@.
--
-- The encryption status of the snapshot depends on the values that you
-- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
-- whether your Amazon Web Services account is enabled for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- To create an encrypted snapshot, you must have permission to use the KMS
-- key. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'kmsKeyArn', 'startSnapshot_kmsKeyArn' - The Amazon Resource Name (ARN) of the Key Management Service (KMS) key
-- to be used to encrypt the snapshot.
--
-- The encryption status of the snapshot depends on the values that you
-- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
-- whether your Amazon Web Services account is enabled for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- To create an encrypted snapshot, you must have permission to use the KMS
-- key. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'parentSnapshotId', 'startSnapshot_parentSnapshotId' - The ID of the parent snapshot. If there is no parent snapshot, or if you
-- are creating the first snapshot for an on-premises volume, omit this
-- parameter.
--
-- You can\'t specify __ParentSnapshotId__ and __Encrypted__ in the same
-- request. If you specify both parameters, the request fails with
-- @ValidationException@.
--
-- The encryption status of the snapshot depends on the values that you
-- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
-- whether your Amazon Web Services account is enabled for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- If you specify an encrypted parent snapshot, you must have permission to
-- use the KMS key that was used to encrypt the parent snapshot. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'tags', 'startSnapshot_tags' - The tags to apply to the snapshot.
--
-- 'timeout', 'startSnapshot_timeout' - The amount of time (in minutes) after which the snapshot is
-- automatically cancelled if:
--
-- -   No blocks are written to the snapshot.
--
-- -   The snapshot is not completed after writing the last block of data.
--
-- If no value is specified, the timeout defaults to @60@ minutes.
--
-- 'volumeSize', 'startSnapshot_volumeSize' - The size of the volume, in GiB. The maximum size is @65536@ GiB (64
-- TiB).
newStartSnapshot ::
  -- | 'volumeSize'
  Prelude.Natural ->
  StartSnapshot
newStartSnapshot :: Natural -> StartSnapshot
newStartSnapshot Natural
pVolumeSize_ =
  StartSnapshot'
    { $sel:clientToken:StartSnapshot' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:StartSnapshot' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:StartSnapshot' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyArn:StartSnapshot' :: Maybe (Sensitive Text)
kmsKeyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:parentSnapshotId:StartSnapshot' :: Maybe Text
parentSnapshotId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:StartSnapshot' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeout:StartSnapshot' :: Maybe Natural
timeout = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeSize:StartSnapshot' :: Natural
volumeSize = Natural
pVolumeSize_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully. The subsequent retries with the same client
-- token return the result from the original successful request and they
-- have no additional effect.
--
-- If you do not specify a client token, one is automatically generated by
-- the Amazon Web Services SDK.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-direct-api-idempotency.html Idempotency for StartSnapshot API>
-- in the /Amazon Elastic Compute Cloud User Guide/.
startSnapshot_clientToken :: Lens.Lens' StartSnapshot (Prelude.Maybe Prelude.Text)
startSnapshot_clientToken :: Lens' StartSnapshot (Maybe Text)
startSnapshot_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshot' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:StartSnapshot' :: StartSnapshot -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: StartSnapshot
s@StartSnapshot' {} Maybe Text
a -> StartSnapshot
s {$sel:clientToken:StartSnapshot' :: Maybe Text
clientToken = Maybe Text
a} :: StartSnapshot)

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

-- | Indicates whether to encrypt the snapshot.
--
-- You can\'t specify __Encrypted__ and __ParentSnapshotId__ in the same
-- request. If you specify both parameters, the request fails with
-- @ValidationException@.
--
-- The encryption status of the snapshot depends on the values that you
-- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
-- whether your Amazon Web Services account is enabled for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- To create an encrypted snapshot, you must have permission to use the KMS
-- key. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
-- in the /Amazon Elastic Compute Cloud User Guide/.
startSnapshot_encrypted :: Lens.Lens' StartSnapshot (Prelude.Maybe Prelude.Bool)
startSnapshot_encrypted :: Lens' StartSnapshot (Maybe Bool)
startSnapshot_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshot' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:StartSnapshot' :: StartSnapshot -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: StartSnapshot
s@StartSnapshot' {} Maybe Bool
a -> StartSnapshot
s {$sel:encrypted:StartSnapshot' :: Maybe Bool
encrypted = Maybe Bool
a} :: StartSnapshot)

-- | The Amazon Resource Name (ARN) of the Key Management Service (KMS) key
-- to be used to encrypt the snapshot.
--
-- The encryption status of the snapshot depends on the values that you
-- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
-- whether your Amazon Web Services account is enabled for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- To create an encrypted snapshot, you must have permission to use the KMS
-- key. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
-- in the /Amazon Elastic Compute Cloud User Guide/.
startSnapshot_kmsKeyArn :: Lens.Lens' StartSnapshot (Prelude.Maybe Prelude.Text)
startSnapshot_kmsKeyArn :: Lens' StartSnapshot (Maybe Text)
startSnapshot_kmsKeyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshot' {Maybe (Sensitive Text)
kmsKeyArn :: Maybe (Sensitive Text)
$sel:kmsKeyArn:StartSnapshot' :: StartSnapshot -> Maybe (Sensitive Text)
kmsKeyArn} -> Maybe (Sensitive Text)
kmsKeyArn) (\s :: StartSnapshot
s@StartSnapshot' {} Maybe (Sensitive Text)
a -> StartSnapshot
s {$sel:kmsKeyArn:StartSnapshot' :: Maybe (Sensitive Text)
kmsKeyArn = Maybe (Sensitive Text)
a} :: StartSnapshot) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The ID of the parent snapshot. If there is no parent snapshot, or if you
-- are creating the first snapshot for an on-premises volume, omit this
-- parameter.
--
-- You can\'t specify __ParentSnapshotId__ and __Encrypted__ in the same
-- request. If you specify both parameters, the request fails with
-- @ValidationException@.
--
-- The encryption status of the snapshot depends on the values that you
-- specify for __Encrypted__, __KmsKeyArn__, and __ParentSnapshotId__, and
-- whether your Amazon Web Services account is enabled for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default encryption by default>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapis-using-encryption.html Using encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- If you specify an encrypted parent snapshot, you must have permission to
-- use the KMS key that was used to encrypt the parent snapshot. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebsapi-permissions.html#ebsapi-kms-permissions Permissions to use Key Management Service keys>
-- in the /Amazon Elastic Compute Cloud User Guide/.
startSnapshot_parentSnapshotId :: Lens.Lens' StartSnapshot (Prelude.Maybe Prelude.Text)
startSnapshot_parentSnapshotId :: Lens' StartSnapshot (Maybe Text)
startSnapshot_parentSnapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshot' {Maybe Text
parentSnapshotId :: Maybe Text
$sel:parentSnapshotId:StartSnapshot' :: StartSnapshot -> Maybe Text
parentSnapshotId} -> Maybe Text
parentSnapshotId) (\s :: StartSnapshot
s@StartSnapshot' {} Maybe Text
a -> StartSnapshot
s {$sel:parentSnapshotId:StartSnapshot' :: Maybe Text
parentSnapshotId = Maybe Text
a} :: StartSnapshot)

-- | The tags to apply to the snapshot.
startSnapshot_tags :: Lens.Lens' StartSnapshot (Prelude.Maybe [Tag])
startSnapshot_tags :: Lens' StartSnapshot (Maybe [Tag])
startSnapshot_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshot' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:StartSnapshot' :: StartSnapshot -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: StartSnapshot
s@StartSnapshot' {} Maybe [Tag]
a -> StartSnapshot
s {$sel:tags:StartSnapshot' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: StartSnapshot) 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 amount of time (in minutes) after which the snapshot is
-- automatically cancelled if:
--
-- -   No blocks are written to the snapshot.
--
-- -   The snapshot is not completed after writing the last block of data.
--
-- If no value is specified, the timeout defaults to @60@ minutes.
startSnapshot_timeout :: Lens.Lens' StartSnapshot (Prelude.Maybe Prelude.Natural)
startSnapshot_timeout :: Lens' StartSnapshot (Maybe Natural)
startSnapshot_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshot' {Maybe Natural
timeout :: Maybe Natural
$sel:timeout:StartSnapshot' :: StartSnapshot -> Maybe Natural
timeout} -> Maybe Natural
timeout) (\s :: StartSnapshot
s@StartSnapshot' {} Maybe Natural
a -> StartSnapshot
s {$sel:timeout:StartSnapshot' :: Maybe Natural
timeout = Maybe Natural
a} :: StartSnapshot)

-- | The size of the volume, in GiB. The maximum size is @65536@ GiB (64
-- TiB).
startSnapshot_volumeSize :: Lens.Lens' StartSnapshot Prelude.Natural
startSnapshot_volumeSize :: Lens' StartSnapshot Natural
startSnapshot_volumeSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshot' {Natural
volumeSize :: Natural
$sel:volumeSize:StartSnapshot' :: StartSnapshot -> Natural
volumeSize} -> Natural
volumeSize) (\s :: StartSnapshot
s@StartSnapshot' {} Natural
a -> StartSnapshot
s {$sel:volumeSize:StartSnapshot' :: Natural
volumeSize = Natural
a} :: StartSnapshot)

instance Core.AWSRequest StartSnapshot where
  type
    AWSResponse StartSnapshot =
      StartSnapshotResponse
  request :: (Service -> Service) -> StartSnapshot -> Request StartSnapshot
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartSnapshot)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Int
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Status
-> Maybe [Tag]
-> Maybe Natural
-> Int
-> StartSnapshotResponse
StartSnapshotResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"BlockSize")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"KmsKeyArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"OwnerId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ParentSnapshotId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SnapshotId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StartTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VolumeSize")
            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 StartSnapshot where
  hashWithSalt :: Int -> StartSnapshot -> Int
hashWithSalt Int
_salt StartSnapshot' {Natural
Maybe Bool
Maybe Natural
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
volumeSize :: Natural
timeout :: Maybe Natural
tags :: Maybe [Tag]
parentSnapshotId :: Maybe Text
kmsKeyArn :: Maybe (Sensitive Text)
encrypted :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:volumeSize:StartSnapshot' :: StartSnapshot -> Natural
$sel:timeout:StartSnapshot' :: StartSnapshot -> Maybe Natural
$sel:tags:StartSnapshot' :: StartSnapshot -> Maybe [Tag]
$sel:parentSnapshotId:StartSnapshot' :: StartSnapshot -> Maybe Text
$sel:kmsKeyArn:StartSnapshot' :: StartSnapshot -> Maybe (Sensitive Text)
$sel:encrypted:StartSnapshot' :: StartSnapshot -> Maybe Bool
$sel:description:StartSnapshot' :: StartSnapshot -> Maybe Text
$sel:clientToken:StartSnapshot' :: StartSnapshot -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
kmsKeyArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parentSnapshotId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
volumeSize

instance Prelude.NFData StartSnapshot where
  rnf :: StartSnapshot -> ()
rnf StartSnapshot' {Natural
Maybe Bool
Maybe Natural
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
volumeSize :: Natural
timeout :: Maybe Natural
tags :: Maybe [Tag]
parentSnapshotId :: Maybe Text
kmsKeyArn :: Maybe (Sensitive Text)
encrypted :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:volumeSize:StartSnapshot' :: StartSnapshot -> Natural
$sel:timeout:StartSnapshot' :: StartSnapshot -> Maybe Natural
$sel:tags:StartSnapshot' :: StartSnapshot -> Maybe [Tag]
$sel:parentSnapshotId:StartSnapshot' :: StartSnapshot -> Maybe Text
$sel:kmsKeyArn:StartSnapshot' :: StartSnapshot -> Maybe (Sensitive Text)
$sel:encrypted:StartSnapshot' :: StartSnapshot -> Maybe Bool
$sel:description:StartSnapshot' :: StartSnapshot -> Maybe Text
$sel:clientToken:StartSnapshot' :: StartSnapshot -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe 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 (Sensitive Text)
kmsKeyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentSnapshotId
      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 Natural
timeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
volumeSize

instance Data.ToHeaders StartSnapshot where
  toHeaders :: StartSnapshot -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartSnapshot where
  toJSON :: StartSnapshot -> Value
toJSON StartSnapshot' {Natural
Maybe Bool
Maybe Natural
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
volumeSize :: Natural
timeout :: Maybe Natural
tags :: Maybe [Tag]
parentSnapshotId :: Maybe Text
kmsKeyArn :: Maybe (Sensitive Text)
encrypted :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:volumeSize:StartSnapshot' :: StartSnapshot -> Natural
$sel:timeout:StartSnapshot' :: StartSnapshot -> Maybe Natural
$sel:tags:StartSnapshot' :: StartSnapshot -> Maybe [Tag]
$sel:parentSnapshotId:StartSnapshot' :: StartSnapshot -> Maybe Text
$sel:kmsKeyArn:StartSnapshot' :: StartSnapshot -> Maybe (Sensitive Text)
$sel:encrypted:StartSnapshot' :: StartSnapshot -> Maybe Bool
$sel:description:StartSnapshot' :: StartSnapshot -> Maybe Text
$sel:clientToken:StartSnapshot' :: StartSnapshot -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"Encrypted" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
encrypted,
            (Key
"KmsKeyArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive Text)
kmsKeyArn,
            (Key
"ParentSnapshotId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
parentSnapshotId,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            (Key
"Timeout" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
timeout,
            forall a. a -> Maybe a
Prelude.Just (Key
"VolumeSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
volumeSize)
          ]
      )

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

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

-- | /See:/ 'newStartSnapshotResponse' smart constructor.
data StartSnapshotResponse = StartSnapshotResponse'
  { -- | The size of the blocks in the snapshot, in bytes.
    StartSnapshotResponse -> Maybe Int
blockSize :: Prelude.Maybe Prelude.Int,
    -- | The description of the snapshot.
    StartSnapshotResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Key Management Service (KMS) key
    -- used to encrypt the snapshot.
    StartSnapshotResponse -> Maybe (Sensitive Text)
kmsKeyArn :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Web Services account ID of the snapshot owner.
    StartSnapshotResponse -> Maybe Text
ownerId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the parent snapshot.
    StartSnapshotResponse -> Maybe Text
parentSnapshotId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the snapshot.
    StartSnapshotResponse -> Maybe Text
snapshotId :: Prelude.Maybe Prelude.Text,
    -- | The timestamp when the snapshot was created.
    StartSnapshotResponse -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX,
    -- | The status of the snapshot.
    StartSnapshotResponse -> Maybe Status
status :: Prelude.Maybe Status,
    -- | The tags applied to the snapshot. You can specify up to 50 tags per
    -- snapshot. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html Tagging your Amazon EC2 resources>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    StartSnapshotResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The size of the volume, in GiB.
    StartSnapshotResponse -> Maybe Natural
volumeSize :: Prelude.Maybe Prelude.Natural,
    -- | The response's http status code.
    StartSnapshotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSnapshotResponse -> StartSnapshotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSnapshotResponse -> StartSnapshotResponse -> Bool
$c/= :: StartSnapshotResponse -> StartSnapshotResponse -> Bool
== :: StartSnapshotResponse -> StartSnapshotResponse -> Bool
$c== :: StartSnapshotResponse -> StartSnapshotResponse -> Bool
Prelude.Eq, Int -> StartSnapshotResponse -> ShowS
[StartSnapshotResponse] -> ShowS
StartSnapshotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSnapshotResponse] -> ShowS
$cshowList :: [StartSnapshotResponse] -> ShowS
show :: StartSnapshotResponse -> String
$cshow :: StartSnapshotResponse -> String
showsPrec :: Int -> StartSnapshotResponse -> ShowS
$cshowsPrec :: Int -> StartSnapshotResponse -> ShowS
Prelude.Show, forall x. Rep StartSnapshotResponse x -> StartSnapshotResponse
forall x. StartSnapshotResponse -> Rep StartSnapshotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSnapshotResponse x -> StartSnapshotResponse
$cfrom :: forall x. StartSnapshotResponse -> Rep StartSnapshotResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSnapshotResponse' 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:
--
-- 'blockSize', 'startSnapshotResponse_blockSize' - The size of the blocks in the snapshot, in bytes.
--
-- 'description', 'startSnapshotResponse_description' - The description of the snapshot.
--
-- 'kmsKeyArn', 'startSnapshotResponse_kmsKeyArn' - The Amazon Resource Name (ARN) of the Key Management Service (KMS) key
-- used to encrypt the snapshot.
--
-- 'ownerId', 'startSnapshotResponse_ownerId' - The Amazon Web Services account ID of the snapshot owner.
--
-- 'parentSnapshotId', 'startSnapshotResponse_parentSnapshotId' - The ID of the parent snapshot.
--
-- 'snapshotId', 'startSnapshotResponse_snapshotId' - The ID of the snapshot.
--
-- 'startTime', 'startSnapshotResponse_startTime' - The timestamp when the snapshot was created.
--
-- 'status', 'startSnapshotResponse_status' - The status of the snapshot.
--
-- 'tags', 'startSnapshotResponse_tags' - The tags applied to the snapshot. You can specify up to 50 tags per
-- snapshot. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html Tagging your Amazon EC2 resources>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'volumeSize', 'startSnapshotResponse_volumeSize' - The size of the volume, in GiB.
--
-- 'httpStatus', 'startSnapshotResponse_httpStatus' - The response's http status code.
newStartSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSnapshotResponse
newStartSnapshotResponse :: Int -> StartSnapshotResponse
newStartSnapshotResponse Int
pHttpStatus_ =
  StartSnapshotResponse'
    { $sel:blockSize:StartSnapshotResponse' :: Maybe Int
blockSize = forall a. Maybe a
Prelude.Nothing,
      $sel:description:StartSnapshotResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyArn:StartSnapshotResponse' :: Maybe (Sensitive Text)
kmsKeyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerId:StartSnapshotResponse' :: Maybe Text
ownerId = forall a. Maybe a
Prelude.Nothing,
      $sel:parentSnapshotId:StartSnapshotResponse' :: Maybe Text
parentSnapshotId = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotId:StartSnapshotResponse' :: Maybe Text
snapshotId = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:StartSnapshotResponse' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:status:StartSnapshotResponse' :: Maybe Status
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:StartSnapshotResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeSize:StartSnapshotResponse' :: Maybe Natural
volumeSize = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The size of the blocks in the snapshot, in bytes.
startSnapshotResponse_blockSize :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.Int)
startSnapshotResponse_blockSize :: Lens' StartSnapshotResponse (Maybe Int)
startSnapshotResponse_blockSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe Int
blockSize :: Maybe Int
$sel:blockSize:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Int
blockSize} -> Maybe Int
blockSize) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe Int
a -> StartSnapshotResponse
s {$sel:blockSize:StartSnapshotResponse' :: Maybe Int
blockSize = Maybe Int
a} :: StartSnapshotResponse)

-- | The description of the snapshot.
startSnapshotResponse_description :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.Text)
startSnapshotResponse_description :: Lens' StartSnapshotResponse (Maybe Text)
startSnapshotResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe Text
description :: Maybe Text
$sel:description:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe Text
a -> StartSnapshotResponse
s {$sel:description:StartSnapshotResponse' :: Maybe Text
description = Maybe Text
a} :: StartSnapshotResponse)

-- | The Amazon Resource Name (ARN) of the Key Management Service (KMS) key
-- used to encrypt the snapshot.
startSnapshotResponse_kmsKeyArn :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.Text)
startSnapshotResponse_kmsKeyArn :: Lens' StartSnapshotResponse (Maybe Text)
startSnapshotResponse_kmsKeyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe (Sensitive Text)
kmsKeyArn :: Maybe (Sensitive Text)
$sel:kmsKeyArn:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe (Sensitive Text)
kmsKeyArn} -> Maybe (Sensitive Text)
kmsKeyArn) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe (Sensitive Text)
a -> StartSnapshotResponse
s {$sel:kmsKeyArn:StartSnapshotResponse' :: Maybe (Sensitive Text)
kmsKeyArn = Maybe (Sensitive Text)
a} :: StartSnapshotResponse) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The Amazon Web Services account ID of the snapshot owner.
startSnapshotResponse_ownerId :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.Text)
startSnapshotResponse_ownerId :: Lens' StartSnapshotResponse (Maybe Text)
startSnapshotResponse_ownerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe Text
ownerId :: Maybe Text
$sel:ownerId:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
ownerId} -> Maybe Text
ownerId) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe Text
a -> StartSnapshotResponse
s {$sel:ownerId:StartSnapshotResponse' :: Maybe Text
ownerId = Maybe Text
a} :: StartSnapshotResponse)

-- | The ID of the parent snapshot.
startSnapshotResponse_parentSnapshotId :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.Text)
startSnapshotResponse_parentSnapshotId :: Lens' StartSnapshotResponse (Maybe Text)
startSnapshotResponse_parentSnapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe Text
parentSnapshotId :: Maybe Text
$sel:parentSnapshotId:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
parentSnapshotId} -> Maybe Text
parentSnapshotId) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe Text
a -> StartSnapshotResponse
s {$sel:parentSnapshotId:StartSnapshotResponse' :: Maybe Text
parentSnapshotId = Maybe Text
a} :: StartSnapshotResponse)

-- | The ID of the snapshot.
startSnapshotResponse_snapshotId :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.Text)
startSnapshotResponse_snapshotId :: Lens' StartSnapshotResponse (Maybe Text)
startSnapshotResponse_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe Text
snapshotId :: Maybe Text
$sel:snapshotId:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
snapshotId} -> Maybe Text
snapshotId) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe Text
a -> StartSnapshotResponse
s {$sel:snapshotId:StartSnapshotResponse' :: Maybe Text
snapshotId = Maybe Text
a} :: StartSnapshotResponse)

-- | The timestamp when the snapshot was created.
startSnapshotResponse_startTime :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.UTCTime)
startSnapshotResponse_startTime :: Lens' StartSnapshotResponse (Maybe UTCTime)
startSnapshotResponse_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe POSIX
a -> StartSnapshotResponse
s {$sel:startTime:StartSnapshotResponse' :: Maybe POSIX
startTime = Maybe POSIX
a} :: StartSnapshotResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the snapshot.
startSnapshotResponse_status :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Status)
startSnapshotResponse_status :: Lens' StartSnapshotResponse (Maybe Status)
startSnapshotResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe Status
status :: Maybe Status
$sel:status:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Status
status} -> Maybe Status
status) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe Status
a -> StartSnapshotResponse
s {$sel:status:StartSnapshotResponse' :: Maybe Status
status = Maybe Status
a} :: StartSnapshotResponse)

-- | The tags applied to the snapshot. You can specify up to 50 tags per
-- snapshot. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html Tagging your Amazon EC2 resources>
-- in the /Amazon Elastic Compute Cloud User Guide/.
startSnapshotResponse_tags :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe [Tag])
startSnapshotResponse_tags :: Lens' StartSnapshotResponse (Maybe [Tag])
startSnapshotResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe [Tag]
a -> StartSnapshotResponse
s {$sel:tags:StartSnapshotResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: StartSnapshotResponse) 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 size of the volume, in GiB.
startSnapshotResponse_volumeSize :: Lens.Lens' StartSnapshotResponse (Prelude.Maybe Prelude.Natural)
startSnapshotResponse_volumeSize :: Lens' StartSnapshotResponse (Maybe Natural)
startSnapshotResponse_volumeSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSnapshotResponse' {Maybe Natural
volumeSize :: Maybe Natural
$sel:volumeSize:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Natural
volumeSize} -> Maybe Natural
volumeSize) (\s :: StartSnapshotResponse
s@StartSnapshotResponse' {} Maybe Natural
a -> StartSnapshotResponse
s {$sel:volumeSize:StartSnapshotResponse' :: Maybe Natural
volumeSize = Maybe Natural
a} :: StartSnapshotResponse)

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

instance Prelude.NFData StartSnapshotResponse where
  rnf :: StartSnapshotResponse -> ()
rnf StartSnapshotResponse' {Int
Maybe Int
Maybe Natural
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe Status
httpStatus :: Int
volumeSize :: Maybe Natural
tags :: Maybe [Tag]
status :: Maybe Status
startTime :: Maybe POSIX
snapshotId :: Maybe Text
parentSnapshotId :: Maybe Text
ownerId :: Maybe Text
kmsKeyArn :: Maybe (Sensitive Text)
description :: Maybe Text
blockSize :: Maybe Int
$sel:httpStatus:StartSnapshotResponse' :: StartSnapshotResponse -> Int
$sel:volumeSize:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Natural
$sel:tags:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe [Tag]
$sel:status:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Status
$sel:startTime:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe POSIX
$sel:snapshotId:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
$sel:parentSnapshotId:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
$sel:ownerId:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
$sel:kmsKeyArn:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe (Sensitive Text)
$sel:description:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Text
$sel:blockSize:StartSnapshotResponse' :: StartSnapshotResponse -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
blockSize
      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 (Sensitive Text)
kmsKeyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentSnapshotId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Status
status
      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 Natural
volumeSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus