{-# 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.CreateSnapshotFromVolumeRecoveryPoint
-- 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 gateway from a volume recovery point. This
-- operation is only supported in the cached volume gateway type.
--
-- A volume recovery point is a point in time at which all data of the
-- volume is consistent and from which you can create a snapshot. To get a
-- list of volume recovery point for cached volume gateway, use
-- ListVolumeRecoveryPoints.
--
-- In the @CreateSnapshotFromVolumeRecoveryPoint@ request, you identify the
-- volume by providing its Amazon Resource Name (ARN). You must also
-- provide a description for the snapshot. When the gateway takes a
-- snapshot of the specified volume, the snapshot and its description
-- appear in the Storage Gateway console. In response, the 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.
--
-- 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/.
module Amazonka.StorageGateway.CreateSnapshotFromVolumeRecoveryPoint
  ( -- * Creating a Request
    CreateSnapshotFromVolumeRecoveryPoint (..),
    newCreateSnapshotFromVolumeRecoveryPoint,

    -- * Request Lenses
    createSnapshotFromVolumeRecoveryPoint_tags,
    createSnapshotFromVolumeRecoveryPoint_volumeARN,
    createSnapshotFromVolumeRecoveryPoint_snapshotDescription,

    -- * Destructuring the Response
    CreateSnapshotFromVolumeRecoveryPointResponse (..),
    newCreateSnapshotFromVolumeRecoveryPointResponse,

    -- * Response Lenses
    createSnapshotFromVolumeRecoveryPointResponse_snapshotId,
    createSnapshotFromVolumeRecoveryPointResponse_volumeARN,
    createSnapshotFromVolumeRecoveryPointResponse_volumeRecoveryPointTime,
    createSnapshotFromVolumeRecoveryPointResponse_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

-- | /See:/ 'newCreateSnapshotFromVolumeRecoveryPoint' smart constructor.
data CreateSnapshotFromVolumeRecoveryPoint = CreateSnapshotFromVolumeRecoveryPoint'
  { -- | 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.
    CreateSnapshotFromVolumeRecoveryPoint -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The Amazon Resource Name (ARN) of the iSCSI volume target. Use the
    -- DescribeStorediSCSIVolumes operation to return to retrieve the TargetARN
    -- for specified VolumeARN.
    CreateSnapshotFromVolumeRecoveryPoint -> 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.
    CreateSnapshotFromVolumeRecoveryPoint -> Text
snapshotDescription :: Prelude.Text
  }
  deriving (CreateSnapshotFromVolumeRecoveryPoint
-> CreateSnapshotFromVolumeRecoveryPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSnapshotFromVolumeRecoveryPoint
-> CreateSnapshotFromVolumeRecoveryPoint -> Bool
$c/= :: CreateSnapshotFromVolumeRecoveryPoint
-> CreateSnapshotFromVolumeRecoveryPoint -> Bool
== :: CreateSnapshotFromVolumeRecoveryPoint
-> CreateSnapshotFromVolumeRecoveryPoint -> Bool
$c== :: CreateSnapshotFromVolumeRecoveryPoint
-> CreateSnapshotFromVolumeRecoveryPoint -> Bool
Prelude.Eq, ReadPrec [CreateSnapshotFromVolumeRecoveryPoint]
ReadPrec CreateSnapshotFromVolumeRecoveryPoint
Int -> ReadS CreateSnapshotFromVolumeRecoveryPoint
ReadS [CreateSnapshotFromVolumeRecoveryPoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSnapshotFromVolumeRecoveryPoint]
$creadListPrec :: ReadPrec [CreateSnapshotFromVolumeRecoveryPoint]
readPrec :: ReadPrec CreateSnapshotFromVolumeRecoveryPoint
$creadPrec :: ReadPrec CreateSnapshotFromVolumeRecoveryPoint
readList :: ReadS [CreateSnapshotFromVolumeRecoveryPoint]
$creadList :: ReadS [CreateSnapshotFromVolumeRecoveryPoint]
readsPrec :: Int -> ReadS CreateSnapshotFromVolumeRecoveryPoint
$creadsPrec :: Int -> ReadS CreateSnapshotFromVolumeRecoveryPoint
Prelude.Read, Int -> CreateSnapshotFromVolumeRecoveryPoint -> ShowS
[CreateSnapshotFromVolumeRecoveryPoint] -> ShowS
CreateSnapshotFromVolumeRecoveryPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSnapshotFromVolumeRecoveryPoint] -> ShowS
$cshowList :: [CreateSnapshotFromVolumeRecoveryPoint] -> ShowS
show :: CreateSnapshotFromVolumeRecoveryPoint -> String
$cshow :: CreateSnapshotFromVolumeRecoveryPoint -> String
showsPrec :: Int -> CreateSnapshotFromVolumeRecoveryPoint -> ShowS
$cshowsPrec :: Int -> CreateSnapshotFromVolumeRecoveryPoint -> ShowS
Prelude.Show, forall x.
Rep CreateSnapshotFromVolumeRecoveryPoint x
-> CreateSnapshotFromVolumeRecoveryPoint
forall x.
CreateSnapshotFromVolumeRecoveryPoint
-> Rep CreateSnapshotFromVolumeRecoveryPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSnapshotFromVolumeRecoveryPoint x
-> CreateSnapshotFromVolumeRecoveryPoint
$cfrom :: forall x.
CreateSnapshotFromVolumeRecoveryPoint
-> Rep CreateSnapshotFromVolumeRecoveryPoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateSnapshotFromVolumeRecoveryPoint' 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', 'createSnapshotFromVolumeRecoveryPoint_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', 'createSnapshotFromVolumeRecoveryPoint_volumeARN' - The Amazon Resource Name (ARN) of the iSCSI volume target. Use the
-- DescribeStorediSCSIVolumes operation to return to retrieve the TargetARN
-- for specified VolumeARN.
--
-- 'snapshotDescription', 'createSnapshotFromVolumeRecoveryPoint_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.
newCreateSnapshotFromVolumeRecoveryPoint ::
  -- | 'volumeARN'
  Prelude.Text ->
  -- | 'snapshotDescription'
  Prelude.Text ->
  CreateSnapshotFromVolumeRecoveryPoint
newCreateSnapshotFromVolumeRecoveryPoint :: Text -> Text -> CreateSnapshotFromVolumeRecoveryPoint
newCreateSnapshotFromVolumeRecoveryPoint
  Text
pVolumeARN_
  Text
pSnapshotDescription_ =
    CreateSnapshotFromVolumeRecoveryPoint'
      { $sel:tags:CreateSnapshotFromVolumeRecoveryPoint' :: Maybe [Tag]
tags =
          forall a. Maybe a
Prelude.Nothing,
        $sel:volumeARN:CreateSnapshotFromVolumeRecoveryPoint' :: Text
volumeARN = Text
pVolumeARN_,
        $sel:snapshotDescription:CreateSnapshotFromVolumeRecoveryPoint' :: 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.
createSnapshotFromVolumeRecoveryPoint_tags :: Lens.Lens' CreateSnapshotFromVolumeRecoveryPoint (Prelude.Maybe [Tag])
createSnapshotFromVolumeRecoveryPoint_tags :: Lens' CreateSnapshotFromVolumeRecoveryPoint (Maybe [Tag])
createSnapshotFromVolumeRecoveryPoint_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotFromVolumeRecoveryPoint' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateSnapshotFromVolumeRecoveryPoint
s@CreateSnapshotFromVolumeRecoveryPoint' {} Maybe [Tag]
a -> CreateSnapshotFromVolumeRecoveryPoint
s {$sel:tags:CreateSnapshotFromVolumeRecoveryPoint' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateSnapshotFromVolumeRecoveryPoint) 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 iSCSI volume target. Use the
-- DescribeStorediSCSIVolumes operation to return to retrieve the TargetARN
-- for specified VolumeARN.
createSnapshotFromVolumeRecoveryPoint_volumeARN :: Lens.Lens' CreateSnapshotFromVolumeRecoveryPoint Prelude.Text
createSnapshotFromVolumeRecoveryPoint_volumeARN :: Lens' CreateSnapshotFromVolumeRecoveryPoint Text
createSnapshotFromVolumeRecoveryPoint_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotFromVolumeRecoveryPoint' {Text
volumeARN :: Text
$sel:volumeARN:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
volumeARN} -> Text
volumeARN) (\s :: CreateSnapshotFromVolumeRecoveryPoint
s@CreateSnapshotFromVolumeRecoveryPoint' {} Text
a -> CreateSnapshotFromVolumeRecoveryPoint
s {$sel:volumeARN:CreateSnapshotFromVolumeRecoveryPoint' :: Text
volumeARN = Text
a} :: CreateSnapshotFromVolumeRecoveryPoint)

-- | 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.
createSnapshotFromVolumeRecoveryPoint_snapshotDescription :: Lens.Lens' CreateSnapshotFromVolumeRecoveryPoint Prelude.Text
createSnapshotFromVolumeRecoveryPoint_snapshotDescription :: Lens' CreateSnapshotFromVolumeRecoveryPoint Text
createSnapshotFromVolumeRecoveryPoint_snapshotDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotFromVolumeRecoveryPoint' {Text
snapshotDescription :: Text
$sel:snapshotDescription:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
snapshotDescription} -> Text
snapshotDescription) (\s :: CreateSnapshotFromVolumeRecoveryPoint
s@CreateSnapshotFromVolumeRecoveryPoint' {} Text
a -> CreateSnapshotFromVolumeRecoveryPoint
s {$sel:snapshotDescription:CreateSnapshotFromVolumeRecoveryPoint' :: Text
snapshotDescription = Text
a} :: CreateSnapshotFromVolumeRecoveryPoint)

instance
  Core.AWSRequest
    CreateSnapshotFromVolumeRecoveryPoint
  where
  type
    AWSResponse
      CreateSnapshotFromVolumeRecoveryPoint =
      CreateSnapshotFromVolumeRecoveryPointResponse
  request :: (Service -> Service)
-> CreateSnapshotFromVolumeRecoveryPoint
-> Request CreateSnapshotFromVolumeRecoveryPoint
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 CreateSnapshotFromVolumeRecoveryPoint
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse CreateSnapshotFromVolumeRecoveryPoint)))
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
-> Maybe Text
-> Int
-> CreateSnapshotFromVolumeRecoveryPointResponse
CreateSnapshotFromVolumeRecoveryPointResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VolumeRecoveryPointTime")
            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
    CreateSnapshotFromVolumeRecoveryPoint
  where
  hashWithSalt :: Int -> CreateSnapshotFromVolumeRecoveryPoint -> Int
hashWithSalt
    Int
_salt
    CreateSnapshotFromVolumeRecoveryPoint' {Maybe [Tag]
Text
snapshotDescription :: Text
volumeARN :: Text
tags :: Maybe [Tag]
$sel:snapshotDescription:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
$sel:volumeARN:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
$sel:tags:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> 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
    CreateSnapshotFromVolumeRecoveryPoint
  where
  rnf :: CreateSnapshotFromVolumeRecoveryPoint -> ()
rnf CreateSnapshotFromVolumeRecoveryPoint' {Maybe [Tag]
Text
snapshotDescription :: Text
volumeARN :: Text
tags :: Maybe [Tag]
$sel:snapshotDescription:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
$sel:volumeARN:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
$sel:tags:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> 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
    CreateSnapshotFromVolumeRecoveryPoint
  where
  toHeaders :: CreateSnapshotFromVolumeRecoveryPoint -> 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.CreateSnapshotFromVolumeRecoveryPoint" ::
                          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
    CreateSnapshotFromVolumeRecoveryPoint
  where
  toJSON :: CreateSnapshotFromVolumeRecoveryPoint -> Value
toJSON CreateSnapshotFromVolumeRecoveryPoint' {Maybe [Tag]
Text
snapshotDescription :: Text
volumeARN :: Text
tags :: Maybe [Tag]
$sel:snapshotDescription:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
$sel:volumeARN:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> Text
$sel:tags:CreateSnapshotFromVolumeRecoveryPoint' :: CreateSnapshotFromVolumeRecoveryPoint -> 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
    CreateSnapshotFromVolumeRecoveryPoint
  where
  toPath :: CreateSnapshotFromVolumeRecoveryPoint -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateSnapshotFromVolumeRecoveryPointResponse' smart constructor.
data CreateSnapshotFromVolumeRecoveryPointResponse = CreateSnapshotFromVolumeRecoveryPointResponse'
  { -- | The ID of the snapshot.
    CreateSnapshotFromVolumeRecoveryPointResponse -> Maybe Text
snapshotId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the iSCSI volume target. Use the
    -- DescribeStorediSCSIVolumes operation to return to retrieve the TargetARN
    -- for specified VolumeARN.
    CreateSnapshotFromVolumeRecoveryPointResponse -> Maybe Text
volumeARN :: Prelude.Maybe Prelude.Text,
    -- | The time the volume was created from the recovery point.
    CreateSnapshotFromVolumeRecoveryPointResponse -> Maybe Text
volumeRecoveryPointTime :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateSnapshotFromVolumeRecoveryPointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSnapshotFromVolumeRecoveryPointResponse
-> CreateSnapshotFromVolumeRecoveryPointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSnapshotFromVolumeRecoveryPointResponse
-> CreateSnapshotFromVolumeRecoveryPointResponse -> Bool
$c/= :: CreateSnapshotFromVolumeRecoveryPointResponse
-> CreateSnapshotFromVolumeRecoveryPointResponse -> Bool
== :: CreateSnapshotFromVolumeRecoveryPointResponse
-> CreateSnapshotFromVolumeRecoveryPointResponse -> Bool
$c== :: CreateSnapshotFromVolumeRecoveryPointResponse
-> CreateSnapshotFromVolumeRecoveryPointResponse -> Bool
Prelude.Eq, ReadPrec [CreateSnapshotFromVolumeRecoveryPointResponse]
ReadPrec CreateSnapshotFromVolumeRecoveryPointResponse
Int -> ReadS CreateSnapshotFromVolumeRecoveryPointResponse
ReadS [CreateSnapshotFromVolumeRecoveryPointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSnapshotFromVolumeRecoveryPointResponse]
$creadListPrec :: ReadPrec [CreateSnapshotFromVolumeRecoveryPointResponse]
readPrec :: ReadPrec CreateSnapshotFromVolumeRecoveryPointResponse
$creadPrec :: ReadPrec CreateSnapshotFromVolumeRecoveryPointResponse
readList :: ReadS [CreateSnapshotFromVolumeRecoveryPointResponse]
$creadList :: ReadS [CreateSnapshotFromVolumeRecoveryPointResponse]
readsPrec :: Int -> ReadS CreateSnapshotFromVolumeRecoveryPointResponse
$creadsPrec :: Int -> ReadS CreateSnapshotFromVolumeRecoveryPointResponse
Prelude.Read, Int -> CreateSnapshotFromVolumeRecoveryPointResponse -> ShowS
[CreateSnapshotFromVolumeRecoveryPointResponse] -> ShowS
CreateSnapshotFromVolumeRecoveryPointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSnapshotFromVolumeRecoveryPointResponse] -> ShowS
$cshowList :: [CreateSnapshotFromVolumeRecoveryPointResponse] -> ShowS
show :: CreateSnapshotFromVolumeRecoveryPointResponse -> String
$cshow :: CreateSnapshotFromVolumeRecoveryPointResponse -> String
showsPrec :: Int -> CreateSnapshotFromVolumeRecoveryPointResponse -> ShowS
$cshowsPrec :: Int -> CreateSnapshotFromVolumeRecoveryPointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSnapshotFromVolumeRecoveryPointResponse x
-> CreateSnapshotFromVolumeRecoveryPointResponse
forall x.
CreateSnapshotFromVolumeRecoveryPointResponse
-> Rep CreateSnapshotFromVolumeRecoveryPointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSnapshotFromVolumeRecoveryPointResponse x
-> CreateSnapshotFromVolumeRecoveryPointResponse
$cfrom :: forall x.
CreateSnapshotFromVolumeRecoveryPointResponse
-> Rep CreateSnapshotFromVolumeRecoveryPointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSnapshotFromVolumeRecoveryPointResponse' 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', 'createSnapshotFromVolumeRecoveryPointResponse_snapshotId' - The ID of the snapshot.
--
-- 'volumeARN', 'createSnapshotFromVolumeRecoveryPointResponse_volumeARN' - The Amazon Resource Name (ARN) of the iSCSI volume target. Use the
-- DescribeStorediSCSIVolumes operation to return to retrieve the TargetARN
-- for specified VolumeARN.
--
-- 'volumeRecoveryPointTime', 'createSnapshotFromVolumeRecoveryPointResponse_volumeRecoveryPointTime' - The time the volume was created from the recovery point.
--
-- 'httpStatus', 'createSnapshotFromVolumeRecoveryPointResponse_httpStatus' - The response's http status code.
newCreateSnapshotFromVolumeRecoveryPointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSnapshotFromVolumeRecoveryPointResponse
newCreateSnapshotFromVolumeRecoveryPointResponse :: Int -> CreateSnapshotFromVolumeRecoveryPointResponse
newCreateSnapshotFromVolumeRecoveryPointResponse
  Int
pHttpStatus_ =
    CreateSnapshotFromVolumeRecoveryPointResponse'
      { $sel:snapshotId:CreateSnapshotFromVolumeRecoveryPointResponse' :: Maybe Text
snapshotId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:volumeARN:CreateSnapshotFromVolumeRecoveryPointResponse' :: Maybe Text
volumeARN = forall a. Maybe a
Prelude.Nothing,
        $sel:volumeRecoveryPointTime:CreateSnapshotFromVolumeRecoveryPointResponse' :: Maybe Text
volumeRecoveryPointTime =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateSnapshotFromVolumeRecoveryPointResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

-- | The Amazon Resource Name (ARN) of the iSCSI volume target. Use the
-- DescribeStorediSCSIVolumes operation to return to retrieve the TargetARN
-- for specified VolumeARN.
createSnapshotFromVolumeRecoveryPointResponse_volumeARN :: Lens.Lens' CreateSnapshotFromVolumeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
createSnapshotFromVolumeRecoveryPointResponse_volumeARN :: Lens' CreateSnapshotFromVolumeRecoveryPointResponse (Maybe Text)
createSnapshotFromVolumeRecoveryPointResponse_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotFromVolumeRecoveryPointResponse' {Maybe Text
volumeARN :: Maybe Text
$sel:volumeARN:CreateSnapshotFromVolumeRecoveryPointResponse' :: CreateSnapshotFromVolumeRecoveryPointResponse -> Maybe Text
volumeARN} -> Maybe Text
volumeARN) (\s :: CreateSnapshotFromVolumeRecoveryPointResponse
s@CreateSnapshotFromVolumeRecoveryPointResponse' {} Maybe Text
a -> CreateSnapshotFromVolumeRecoveryPointResponse
s {$sel:volumeARN:CreateSnapshotFromVolumeRecoveryPointResponse' :: Maybe Text
volumeARN = Maybe Text
a} :: CreateSnapshotFromVolumeRecoveryPointResponse)

-- | The time the volume was created from the recovery point.
createSnapshotFromVolumeRecoveryPointResponse_volumeRecoveryPointTime :: Lens.Lens' CreateSnapshotFromVolumeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
createSnapshotFromVolumeRecoveryPointResponse_volumeRecoveryPointTime :: Lens' CreateSnapshotFromVolumeRecoveryPointResponse (Maybe Text)
createSnapshotFromVolumeRecoveryPointResponse_volumeRecoveryPointTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotFromVolumeRecoveryPointResponse' {Maybe Text
volumeRecoveryPointTime :: Maybe Text
$sel:volumeRecoveryPointTime:CreateSnapshotFromVolumeRecoveryPointResponse' :: CreateSnapshotFromVolumeRecoveryPointResponse -> Maybe Text
volumeRecoveryPointTime} -> Maybe Text
volumeRecoveryPointTime) (\s :: CreateSnapshotFromVolumeRecoveryPointResponse
s@CreateSnapshotFromVolumeRecoveryPointResponse' {} Maybe Text
a -> CreateSnapshotFromVolumeRecoveryPointResponse
s {$sel:volumeRecoveryPointTime:CreateSnapshotFromVolumeRecoveryPointResponse' :: Maybe Text
volumeRecoveryPointTime = Maybe Text
a} :: CreateSnapshotFromVolumeRecoveryPointResponse)

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

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