{-# 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.StorageGateway.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)
--
-- Initiates a snapshot of a volume.
--
-- Storage Gateway provides the ability to back up point-in-time snapshots
-- of your data to Amazon Simple Storage (Amazon S3) for durable off-site
-- recovery, and also import the data to an Amazon Elastic Block Store
-- (EBS) volume in Amazon Elastic Compute Cloud (EC2). You can take
-- snapshots of your gateway volume on a scheduled or ad hoc basis. This
-- API enables you to take an ad hoc snapshot. For more information, see
-- <https://docs.aws.amazon.com/storagegateway/latest/userguide/managing-volumes.html#SchedulingSnapshot Editing a snapshot schedule>.
--
-- In the @CreateSnapshot@ request, you identify the volume by providing
-- its Amazon Resource Name (ARN). You must also provide description for
-- the snapshot. When Storage Gateway takes the snapshot of specified
-- volume, the snapshot and description appears in the Storage Gateway
-- console. In response, Storage Gateway returns you a snapshot ID. You can
-- use this snapshot ID to check the snapshot progress or later use it when
-- you want to create a volume from a snapshot. This operation is only
-- supported in stored and cached volume gateway type.
--
-- To list or delete a snapshot, you must use the Amazon EC2 API. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeSnapshots.html DescribeSnapshots>
-- or
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DeleteSnapshot.html DeleteSnapshot>
-- in the /Amazon Elastic Compute Cloud API Reference/.
--
-- Volume and snapshot IDs are changing to a longer length ID format. For
-- more information, see the important note on the
-- <https://docs.aws.amazon.com/storagegateway/latest/APIReference/Welcome.html Welcome>
-- page.
module Amazonka.StorageGateway.CreateSnapshot
  ( -- * Creating a Request
    CreateSnapshot (..),
    newCreateSnapshot,

    -- * Request Lenses
    createSnapshot_tags,
    createSnapshot_volumeARN,
    createSnapshot_snapshotDescription,

    -- * Destructuring the Response
    CreateSnapshotResponse (..),
    newCreateSnapshotResponse,

    -- * Response Lenses
    createSnapshotResponse_snapshotId,
    createSnapshotResponse_volumeARN,
    createSnapshotResponse_httpStatus,
  )
where

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

-- | A JSON object containing one or more of the following fields:
--
-- -   CreateSnapshotInput$SnapshotDescription
--
-- -   CreateSnapshotInput$VolumeARN
--
-- /See:/ 'newCreateSnapshot' smart constructor.
data CreateSnapshot = CreateSnapshot'
  { -- | A list of up to 50 tags that can be assigned to a snapshot. Each tag is
    -- a key-value pair.
    --
    -- Valid characters for key and value are letters, spaces, and numbers
    -- representable in UTF-8 format, and the following special characters: + -
    -- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
    -- the maximum length for a tag\'s value is 256.
    CreateSnapshot -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
    -- operation to return a list of gateway volumes.
    CreateSnapshot -> Text
volumeARN :: Prelude.Text,
    -- | Textual description of the snapshot that appears in the Amazon EC2
    -- console, Elastic Block Store snapshots panel in the __Description__
    -- field, and in the Storage Gateway snapshot __Details__ pane,
    -- __Description__ field.
    CreateSnapshot -> Text
snapshotDescription :: 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:
--
-- 'tags', 'createSnapshot_tags' - A list of up to 50 tags that can be assigned to a snapshot. Each tag is
-- a key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
-- the maximum length for a tag\'s value is 256.
--
-- 'volumeARN', 'createSnapshot_volumeARN' - The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
-- operation to return a list of gateway volumes.
--
-- 'snapshotDescription', 'createSnapshot_snapshotDescription' - Textual description of the snapshot that appears in the Amazon EC2
-- console, Elastic Block Store snapshots panel in the __Description__
-- field, and in the Storage Gateway snapshot __Details__ pane,
-- __Description__ field.
newCreateSnapshot ::
  -- | 'volumeARN'
  Prelude.Text ->
  -- | 'snapshotDescription'
  Prelude.Text ->
  CreateSnapshot
newCreateSnapshot :: Text -> Text -> CreateSnapshot
newCreateSnapshot Text
pVolumeARN_ Text
pSnapshotDescription_ =
  CreateSnapshot'
    { $sel:tags:CreateSnapshot' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeARN:CreateSnapshot' :: Text
volumeARN = Text
pVolumeARN_,
      $sel:snapshotDescription:CreateSnapshot' :: Text
snapshotDescription = Text
pSnapshotDescription_
    }

-- | A list of up to 50 tags that can be assigned to a snapshot. Each tag is
-- a key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
-- the maximum length for a tag\'s value is 256.
createSnapshot_tags :: Lens.Lens' CreateSnapshot (Prelude.Maybe [Tag])
createSnapshot_tags :: Lens' CreateSnapshot (Maybe [Tag])
createSnapshot_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshot' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateSnapshot' :: CreateSnapshot -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateSnapshot
s@CreateSnapshot' {} Maybe [Tag]
a -> CreateSnapshot
s {$sel:tags:CreateSnapshot' :: Maybe [Tag]
tags = Maybe [Tag]
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 Amazon Resource Name (ARN) of the volume. Use the ListVolumes
-- operation to return a list of gateway volumes.
createSnapshot_volumeARN :: Lens.Lens' CreateSnapshot Prelude.Text
createSnapshot_volumeARN :: Lens' CreateSnapshot Text
createSnapshot_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshot' {Text
volumeARN :: Text
$sel:volumeARN:CreateSnapshot' :: CreateSnapshot -> Text
volumeARN} -> Text
volumeARN) (\s :: CreateSnapshot
s@CreateSnapshot' {} Text
a -> CreateSnapshot
s {$sel:volumeARN:CreateSnapshot' :: Text
volumeARN = Text
a} :: CreateSnapshot)

-- | Textual description of the snapshot that appears in the Amazon EC2
-- console, Elastic Block Store snapshots panel in the __Description__
-- field, and in the Storage Gateway snapshot __Details__ pane,
-- __Description__ field.
createSnapshot_snapshotDescription :: Lens.Lens' CreateSnapshot Prelude.Text
createSnapshot_snapshotDescription :: Lens' CreateSnapshot Text
createSnapshot_snapshotDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshot' {Text
snapshotDescription :: Text
$sel:snapshotDescription:CreateSnapshot' :: CreateSnapshot -> Text
snapshotDescription} -> Text
snapshotDescription) (\s :: CreateSnapshot
s@CreateSnapshot' {} Text
a -> CreateSnapshot
s {$sel:snapshotDescription:CreateSnapshot' :: Text
snapshotDescription = Text
a} :: CreateSnapshot)

instance Core.AWSRequest CreateSnapshot where
  type
    AWSResponse CreateSnapshot =
      CreateSnapshotResponse
  request :: (Service -> Service) -> CreateSnapshot -> Request CreateSnapshot
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 CreateSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSnapshot)))
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 Text -> Maybe Text -> Int -> CreateSnapshotResponse
CreateSnapshotResponse'
            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
"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
"VolumeARN")
            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 CreateSnapshot where
  hashWithSalt :: Int -> CreateSnapshot -> Int
hashWithSalt Int
_salt CreateSnapshot' {Maybe [Tag]
Text
snapshotDescription :: Text
volumeARN :: Text
tags :: Maybe [Tag]
$sel:snapshotDescription:CreateSnapshot' :: CreateSnapshot -> Text
$sel:volumeARN:CreateSnapshot' :: CreateSnapshot -> Text
$sel:tags:CreateSnapshot' :: CreateSnapshot -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotDescription

instance Prelude.NFData CreateSnapshot where
  rnf :: CreateSnapshot -> ()
rnf CreateSnapshot' {Maybe [Tag]
Text
snapshotDescription :: Text
volumeARN :: Text
tags :: Maybe [Tag]
$sel:snapshotDescription:CreateSnapshot' :: CreateSnapshot -> Text
$sel:volumeARN:CreateSnapshot' :: CreateSnapshot -> Text
$sel:tags:CreateSnapshot' :: CreateSnapshot -> Maybe [Tag]
..} =
    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 Text
volumeARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotDescription

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

instance Data.ToJSON CreateSnapshot where
  toJSON :: CreateSnapshot -> Value
toJSON CreateSnapshot' {Maybe [Tag]
Text
snapshotDescription :: Text
volumeARN :: Text
tags :: Maybe [Tag]
$sel:snapshotDescription:CreateSnapshot' :: CreateSnapshot -> Text
$sel:volumeARN:CreateSnapshot' :: CreateSnapshot -> Text
$sel:tags:CreateSnapshot' :: CreateSnapshot -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"VolumeARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
volumeARN),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SnapshotDescription" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
snapshotDescription)
          ]
      )

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 = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | A JSON object containing the following fields:
--
-- /See:/ 'newCreateSnapshotResponse' smart constructor.
data CreateSnapshotResponse = CreateSnapshotResponse'
  { -- | The snapshot ID that is used to refer to the snapshot in future
    -- operations such as describing snapshots (Amazon Elastic Compute Cloud
    -- API @DescribeSnapshots@) or creating a volume from a snapshot
    -- (CreateStorediSCSIVolume).
    CreateSnapshotResponse -> Maybe Text
snapshotId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the volume of which the snapshot was
    -- taken.
    CreateSnapshotResponse -> Maybe Text
volumeARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateSnapshotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSnapshotResponse -> CreateSnapshotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSnapshotResponse -> CreateSnapshotResponse -> Bool
$c/= :: CreateSnapshotResponse -> CreateSnapshotResponse -> Bool
== :: CreateSnapshotResponse -> CreateSnapshotResponse -> Bool
$c== :: CreateSnapshotResponse -> CreateSnapshotResponse -> Bool
Prelude.Eq, ReadPrec [CreateSnapshotResponse]
ReadPrec CreateSnapshotResponse
Int -> ReadS CreateSnapshotResponse
ReadS [CreateSnapshotResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSnapshotResponse]
$creadListPrec :: ReadPrec [CreateSnapshotResponse]
readPrec :: ReadPrec CreateSnapshotResponse
$creadPrec :: ReadPrec CreateSnapshotResponse
readList :: ReadS [CreateSnapshotResponse]
$creadList :: ReadS [CreateSnapshotResponse]
readsPrec :: Int -> ReadS CreateSnapshotResponse
$creadsPrec :: Int -> ReadS CreateSnapshotResponse
Prelude.Read, Int -> CreateSnapshotResponse -> ShowS
[CreateSnapshotResponse] -> ShowS
CreateSnapshotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSnapshotResponse] -> ShowS
$cshowList :: [CreateSnapshotResponse] -> ShowS
show :: CreateSnapshotResponse -> String
$cshow :: CreateSnapshotResponse -> String
showsPrec :: Int -> CreateSnapshotResponse -> ShowS
$cshowsPrec :: Int -> CreateSnapshotResponse -> ShowS
Prelude.Show, forall x. Rep CreateSnapshotResponse x -> CreateSnapshotResponse
forall x. CreateSnapshotResponse -> Rep CreateSnapshotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSnapshotResponse x -> CreateSnapshotResponse
$cfrom :: forall x. CreateSnapshotResponse -> Rep CreateSnapshotResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSnapshotResponse' 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:
--
-- 'snapshotId', 'createSnapshotResponse_snapshotId' - The snapshot ID that is used to refer to the snapshot in future
-- operations such as describing snapshots (Amazon Elastic Compute Cloud
-- API @DescribeSnapshots@) or creating a volume from a snapshot
-- (CreateStorediSCSIVolume).
--
-- 'volumeARN', 'createSnapshotResponse_volumeARN' - The Amazon Resource Name (ARN) of the volume of which the snapshot was
-- taken.
--
-- 'httpStatus', 'createSnapshotResponse_httpStatus' - The response's http status code.
newCreateSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSnapshotResponse
newCreateSnapshotResponse :: Int -> CreateSnapshotResponse
newCreateSnapshotResponse Int
pHttpStatus_ =
  CreateSnapshotResponse'
    { $sel:snapshotId:CreateSnapshotResponse' :: Maybe Text
snapshotId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:volumeARN:CreateSnapshotResponse' :: Maybe Text
volumeARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The snapshot ID that is used to refer to the snapshot in future
-- operations such as describing snapshots (Amazon Elastic Compute Cloud
-- API @DescribeSnapshots@) or creating a volume from a snapshot
-- (CreateStorediSCSIVolume).
createSnapshotResponse_snapshotId :: Lens.Lens' CreateSnapshotResponse (Prelude.Maybe Prelude.Text)
createSnapshotResponse_snapshotId :: Lens' CreateSnapshotResponse (Maybe Text)
createSnapshotResponse_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotResponse' {Maybe Text
snapshotId :: Maybe Text
$sel:snapshotId:CreateSnapshotResponse' :: CreateSnapshotResponse -> Maybe Text
snapshotId} -> Maybe Text
snapshotId) (\s :: CreateSnapshotResponse
s@CreateSnapshotResponse' {} Maybe Text
a -> CreateSnapshotResponse
s {$sel:snapshotId:CreateSnapshotResponse' :: Maybe Text
snapshotId = Maybe Text
a} :: CreateSnapshotResponse)

-- | The Amazon Resource Name (ARN) of the volume of which the snapshot was
-- taken.
createSnapshotResponse_volumeARN :: Lens.Lens' CreateSnapshotResponse (Prelude.Maybe Prelude.Text)
createSnapshotResponse_volumeARN :: Lens' CreateSnapshotResponse (Maybe Text)
createSnapshotResponse_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotResponse' {Maybe Text
volumeARN :: Maybe Text
$sel:volumeARN:CreateSnapshotResponse' :: CreateSnapshotResponse -> Maybe Text
volumeARN} -> Maybe Text
volumeARN) (\s :: CreateSnapshotResponse
s@CreateSnapshotResponse' {} Maybe Text
a -> CreateSnapshotResponse
s {$sel:volumeARN:CreateSnapshotResponse' :: Maybe Text
volumeARN = Maybe Text
a} :: CreateSnapshotResponse)

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

instance Prelude.NFData CreateSnapshotResponse where
  rnf :: CreateSnapshotResponse -> ()
rnf CreateSnapshotResponse' {Int
Maybe Text
httpStatus :: Int
volumeARN :: Maybe Text
snapshotId :: Maybe Text
$sel:httpStatus:CreateSnapshotResponse' :: CreateSnapshotResponse -> Int
$sel:volumeARN:CreateSnapshotResponse' :: CreateSnapshotResponse -> Maybe Text
$sel:snapshotId:CreateSnapshotResponse' :: CreateSnapshotResponse -> Maybe Text
..} =
    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 Text
volumeARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus