{-# 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.CompleteSnapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Seals and completes the snapshot after all of the required blocks of
-- data have been written to it. Completing the snapshot changes the status
-- to @completed@. You cannot write new blocks to a snapshot after it has
-- been completed.
module Amazonka.EBS.CompleteSnapshot
  ( -- * Creating a Request
    CompleteSnapshot (..),
    newCompleteSnapshot,

    -- * Request Lenses
    completeSnapshot_checksum,
    completeSnapshot_checksumAggregationMethod,
    completeSnapshot_checksumAlgorithm,
    completeSnapshot_snapshotId,
    completeSnapshot_changedBlocksCount,

    -- * Destructuring the Response
    CompleteSnapshotResponse (..),
    newCompleteSnapshotResponse,

    -- * Response Lenses
    completeSnapshotResponse_status,
    completeSnapshotResponse_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:/ 'newCompleteSnapshot' smart constructor.
data CompleteSnapshot = CompleteSnapshot'
  { -- | An aggregated Base-64 SHA256 checksum based on the checksums of each
    -- written block.
    --
    -- To generate the aggregated checksum using the linear aggregation method,
    -- arrange the checksums for each written block in ascending order of their
    -- block index, concatenate them to form a single string, and then generate
    -- the checksum on the entire string using the SHA256 algorithm.
    CompleteSnapshot -> Maybe Text
checksum :: Prelude.Maybe Prelude.Text,
    -- | The aggregation method used to generate the checksum. Currently, the
    -- only supported aggregation method is @LINEAR@.
    CompleteSnapshot -> Maybe ChecksumAggregationMethod
checksumAggregationMethod :: Prelude.Maybe ChecksumAggregationMethod,
    -- | The algorithm used to generate the checksum. Currently, the only
    -- supported algorithm is @SHA256@.
    CompleteSnapshot -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | The ID of the snapshot.
    CompleteSnapshot -> Text
snapshotId :: Prelude.Text,
    -- | The number of blocks that were written to the snapshot.
    CompleteSnapshot -> Natural
changedBlocksCount :: Prelude.Natural
  }
  deriving (CompleteSnapshot -> CompleteSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteSnapshot -> CompleteSnapshot -> Bool
$c/= :: CompleteSnapshot -> CompleteSnapshot -> Bool
== :: CompleteSnapshot -> CompleteSnapshot -> Bool
$c== :: CompleteSnapshot -> CompleteSnapshot -> Bool
Prelude.Eq, ReadPrec [CompleteSnapshot]
ReadPrec CompleteSnapshot
Int -> ReadS CompleteSnapshot
ReadS [CompleteSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompleteSnapshot]
$creadListPrec :: ReadPrec [CompleteSnapshot]
readPrec :: ReadPrec CompleteSnapshot
$creadPrec :: ReadPrec CompleteSnapshot
readList :: ReadS [CompleteSnapshot]
$creadList :: ReadS [CompleteSnapshot]
readsPrec :: Int -> ReadS CompleteSnapshot
$creadsPrec :: Int -> ReadS CompleteSnapshot
Prelude.Read, Int -> CompleteSnapshot -> ShowS
[CompleteSnapshot] -> ShowS
CompleteSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteSnapshot] -> ShowS
$cshowList :: [CompleteSnapshot] -> ShowS
show :: CompleteSnapshot -> String
$cshow :: CompleteSnapshot -> String
showsPrec :: Int -> CompleteSnapshot -> ShowS
$cshowsPrec :: Int -> CompleteSnapshot -> ShowS
Prelude.Show, forall x. Rep CompleteSnapshot x -> CompleteSnapshot
forall x. CompleteSnapshot -> Rep CompleteSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompleteSnapshot x -> CompleteSnapshot
$cfrom :: forall x. CompleteSnapshot -> Rep CompleteSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'CompleteSnapshot' 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:
--
-- 'checksum', 'completeSnapshot_checksum' - An aggregated Base-64 SHA256 checksum based on the checksums of each
-- written block.
--
-- To generate the aggregated checksum using the linear aggregation method,
-- arrange the checksums for each written block in ascending order of their
-- block index, concatenate them to form a single string, and then generate
-- the checksum on the entire string using the SHA256 algorithm.
--
-- 'checksumAggregationMethod', 'completeSnapshot_checksumAggregationMethod' - The aggregation method used to generate the checksum. Currently, the
-- only supported aggregation method is @LINEAR@.
--
-- 'checksumAlgorithm', 'completeSnapshot_checksumAlgorithm' - The algorithm used to generate the checksum. Currently, the only
-- supported algorithm is @SHA256@.
--
-- 'snapshotId', 'completeSnapshot_snapshotId' - The ID of the snapshot.
--
-- 'changedBlocksCount', 'completeSnapshot_changedBlocksCount' - The number of blocks that were written to the snapshot.
newCompleteSnapshot ::
  -- | 'snapshotId'
  Prelude.Text ->
  -- | 'changedBlocksCount'
  Prelude.Natural ->
  CompleteSnapshot
newCompleteSnapshot :: Text -> Natural -> CompleteSnapshot
newCompleteSnapshot Text
pSnapshotId_ Natural
pChangedBlocksCount_ =
  CompleteSnapshot'
    { $sel:checksum:CompleteSnapshot' :: Maybe Text
checksum = forall a. Maybe a
Prelude.Nothing,
      $sel:checksumAggregationMethod:CompleteSnapshot' :: Maybe ChecksumAggregationMethod
checksumAggregationMethod = forall a. Maybe a
Prelude.Nothing,
      $sel:checksumAlgorithm:CompleteSnapshot' :: Maybe ChecksumAlgorithm
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotId:CompleteSnapshot' :: Text
snapshotId = Text
pSnapshotId_,
      $sel:changedBlocksCount:CompleteSnapshot' :: Natural
changedBlocksCount = Natural
pChangedBlocksCount_
    }

-- | An aggregated Base-64 SHA256 checksum based on the checksums of each
-- written block.
--
-- To generate the aggregated checksum using the linear aggregation method,
-- arrange the checksums for each written block in ascending order of their
-- block index, concatenate them to form a single string, and then generate
-- the checksum on the entire string using the SHA256 algorithm.
completeSnapshot_checksum :: Lens.Lens' CompleteSnapshot (Prelude.Maybe Prelude.Text)
completeSnapshot_checksum :: Lens' CompleteSnapshot (Maybe Text)
completeSnapshot_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteSnapshot' {Maybe Text
checksum :: Maybe Text
$sel:checksum:CompleteSnapshot' :: CompleteSnapshot -> Maybe Text
checksum} -> Maybe Text
checksum) (\s :: CompleteSnapshot
s@CompleteSnapshot' {} Maybe Text
a -> CompleteSnapshot
s {$sel:checksum:CompleteSnapshot' :: Maybe Text
checksum = Maybe Text
a} :: CompleteSnapshot)

-- | The aggregation method used to generate the checksum. Currently, the
-- only supported aggregation method is @LINEAR@.
completeSnapshot_checksumAggregationMethod :: Lens.Lens' CompleteSnapshot (Prelude.Maybe ChecksumAggregationMethod)
completeSnapshot_checksumAggregationMethod :: Lens' CompleteSnapshot (Maybe ChecksumAggregationMethod)
completeSnapshot_checksumAggregationMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteSnapshot' {Maybe ChecksumAggregationMethod
checksumAggregationMethod :: Maybe ChecksumAggregationMethod
$sel:checksumAggregationMethod:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAggregationMethod
checksumAggregationMethod} -> Maybe ChecksumAggregationMethod
checksumAggregationMethod) (\s :: CompleteSnapshot
s@CompleteSnapshot' {} Maybe ChecksumAggregationMethod
a -> CompleteSnapshot
s {$sel:checksumAggregationMethod:CompleteSnapshot' :: Maybe ChecksumAggregationMethod
checksumAggregationMethod = Maybe ChecksumAggregationMethod
a} :: CompleteSnapshot)

-- | The algorithm used to generate the checksum. Currently, the only
-- supported algorithm is @SHA256@.
completeSnapshot_checksumAlgorithm :: Lens.Lens' CompleteSnapshot (Prelude.Maybe ChecksumAlgorithm)
completeSnapshot_checksumAlgorithm :: Lens' CompleteSnapshot (Maybe ChecksumAlgorithm)
completeSnapshot_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteSnapshot' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: CompleteSnapshot
s@CompleteSnapshot' {} Maybe ChecksumAlgorithm
a -> CompleteSnapshot
s {$sel:checksumAlgorithm:CompleteSnapshot' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: CompleteSnapshot)

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

-- | The number of blocks that were written to the snapshot.
completeSnapshot_changedBlocksCount :: Lens.Lens' CompleteSnapshot Prelude.Natural
completeSnapshot_changedBlocksCount :: Lens' CompleteSnapshot Natural
completeSnapshot_changedBlocksCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteSnapshot' {Natural
changedBlocksCount :: Natural
$sel:changedBlocksCount:CompleteSnapshot' :: CompleteSnapshot -> Natural
changedBlocksCount} -> Natural
changedBlocksCount) (\s :: CompleteSnapshot
s@CompleteSnapshot' {} Natural
a -> CompleteSnapshot
s {$sel:changedBlocksCount:CompleteSnapshot' :: Natural
changedBlocksCount = Natural
a} :: CompleteSnapshot)

instance Core.AWSRequest CompleteSnapshot where
  type
    AWSResponse CompleteSnapshot =
      CompleteSnapshotResponse
  request :: (Service -> Service)
-> CompleteSnapshot -> Request CompleteSnapshot
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 CompleteSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CompleteSnapshot)))
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 Status -> Int -> CompleteSnapshotResponse
CompleteSnapshotResponse'
            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
"Status")
            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 CompleteSnapshot where
  hashWithSalt :: Int -> CompleteSnapshot -> Int
hashWithSalt Int
_salt CompleteSnapshot' {Natural
Maybe Text
Maybe ChecksumAggregationMethod
Maybe ChecksumAlgorithm
Text
changedBlocksCount :: Natural
snapshotId :: Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
checksumAggregationMethod :: Maybe ChecksumAggregationMethod
checksum :: Maybe Text
$sel:changedBlocksCount:CompleteSnapshot' :: CompleteSnapshot -> Natural
$sel:snapshotId:CompleteSnapshot' :: CompleteSnapshot -> Text
$sel:checksumAlgorithm:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAlgorithm
$sel:checksumAggregationMethod:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAggregationMethod
$sel:checksum:CompleteSnapshot' :: CompleteSnapshot -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
checksum
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChecksumAggregationMethod
checksumAggregationMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChecksumAlgorithm
checksumAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
changedBlocksCount

instance Prelude.NFData CompleteSnapshot where
  rnf :: CompleteSnapshot -> ()
rnf CompleteSnapshot' {Natural
Maybe Text
Maybe ChecksumAggregationMethod
Maybe ChecksumAlgorithm
Text
changedBlocksCount :: Natural
snapshotId :: Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
checksumAggregationMethod :: Maybe ChecksumAggregationMethod
checksum :: Maybe Text
$sel:changedBlocksCount:CompleteSnapshot' :: CompleteSnapshot -> Natural
$sel:snapshotId:CompleteSnapshot' :: CompleteSnapshot -> Text
$sel:checksumAlgorithm:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAlgorithm
$sel:checksumAggregationMethod:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAggregationMethod
$sel:checksum:CompleteSnapshot' :: CompleteSnapshot -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
checksum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChecksumAggregationMethod
checksumAggregationMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChecksumAlgorithm
checksumAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
changedBlocksCount

instance Data.ToHeaders CompleteSnapshot where
  toHeaders :: CompleteSnapshot -> ResponseHeaders
toHeaders CompleteSnapshot' {Natural
Maybe Text
Maybe ChecksumAggregationMethod
Maybe ChecksumAlgorithm
Text
changedBlocksCount :: Natural
snapshotId :: Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
checksumAggregationMethod :: Maybe ChecksumAggregationMethod
checksum :: Maybe Text
$sel:changedBlocksCount:CompleteSnapshot' :: CompleteSnapshot -> Natural
$sel:snapshotId:CompleteSnapshot' :: CompleteSnapshot -> Text
$sel:checksumAlgorithm:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAlgorithm
$sel:checksumAggregationMethod:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAggregationMethod
$sel:checksum:CompleteSnapshot' :: CompleteSnapshot -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-Checksum" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
checksum,
        HeaderName
"x-amz-Checksum-Aggregation-Method"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ChecksumAggregationMethod
checksumAggregationMethod,
        HeaderName
"x-amz-Checksum-Algorithm" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ChecksumAlgorithm
checksumAlgorithm,
        HeaderName
"x-amz-ChangedBlocksCount"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Natural
changedBlocksCount,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON CompleteSnapshot where
  toJSON :: CompleteSnapshot -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath CompleteSnapshot where
  toPath :: CompleteSnapshot -> ByteString
toPath CompleteSnapshot' {Natural
Maybe Text
Maybe ChecksumAggregationMethod
Maybe ChecksumAlgorithm
Text
changedBlocksCount :: Natural
snapshotId :: Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
checksumAggregationMethod :: Maybe ChecksumAggregationMethod
checksum :: Maybe Text
$sel:changedBlocksCount:CompleteSnapshot' :: CompleteSnapshot -> Natural
$sel:snapshotId:CompleteSnapshot' :: CompleteSnapshot -> Text
$sel:checksumAlgorithm:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAlgorithm
$sel:checksumAggregationMethod:CompleteSnapshot' :: CompleteSnapshot -> Maybe ChecksumAggregationMethod
$sel:checksum:CompleteSnapshot' :: CompleteSnapshot -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/snapshots/completion/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
snapshotId]

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

-- | /See:/ 'newCompleteSnapshotResponse' smart constructor.
data CompleteSnapshotResponse = CompleteSnapshotResponse'
  { -- | The status of the snapshot.
    CompleteSnapshotResponse -> Maybe Status
status :: Prelude.Maybe Status,
    -- | The response's http status code.
    CompleteSnapshotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CompleteSnapshotResponse -> CompleteSnapshotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteSnapshotResponse -> CompleteSnapshotResponse -> Bool
$c/= :: CompleteSnapshotResponse -> CompleteSnapshotResponse -> Bool
== :: CompleteSnapshotResponse -> CompleteSnapshotResponse -> Bool
$c== :: CompleteSnapshotResponse -> CompleteSnapshotResponse -> Bool
Prelude.Eq, ReadPrec [CompleteSnapshotResponse]
ReadPrec CompleteSnapshotResponse
Int -> ReadS CompleteSnapshotResponse
ReadS [CompleteSnapshotResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompleteSnapshotResponse]
$creadListPrec :: ReadPrec [CompleteSnapshotResponse]
readPrec :: ReadPrec CompleteSnapshotResponse
$creadPrec :: ReadPrec CompleteSnapshotResponse
readList :: ReadS [CompleteSnapshotResponse]
$creadList :: ReadS [CompleteSnapshotResponse]
readsPrec :: Int -> ReadS CompleteSnapshotResponse
$creadsPrec :: Int -> ReadS CompleteSnapshotResponse
Prelude.Read, Int -> CompleteSnapshotResponse -> ShowS
[CompleteSnapshotResponse] -> ShowS
CompleteSnapshotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteSnapshotResponse] -> ShowS
$cshowList :: [CompleteSnapshotResponse] -> ShowS
show :: CompleteSnapshotResponse -> String
$cshow :: CompleteSnapshotResponse -> String
showsPrec :: Int -> CompleteSnapshotResponse -> ShowS
$cshowsPrec :: Int -> CompleteSnapshotResponse -> ShowS
Prelude.Show, forall x.
Rep CompleteSnapshotResponse x -> CompleteSnapshotResponse
forall x.
CompleteSnapshotResponse -> Rep CompleteSnapshotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CompleteSnapshotResponse x -> CompleteSnapshotResponse
$cfrom :: forall x.
CompleteSnapshotResponse -> Rep CompleteSnapshotResponse x
Prelude.Generic)

-- |
-- Create a value of 'CompleteSnapshotResponse' 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:
--
-- 'status', 'completeSnapshotResponse_status' - The status of the snapshot.
--
-- 'httpStatus', 'completeSnapshotResponse_httpStatus' - The response's http status code.
newCompleteSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CompleteSnapshotResponse
newCompleteSnapshotResponse :: Int -> CompleteSnapshotResponse
newCompleteSnapshotResponse Int
pHttpStatus_ =
  CompleteSnapshotResponse'
    { $sel:status:CompleteSnapshotResponse' :: Maybe Status
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CompleteSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData CompleteSnapshotResponse where
  rnf :: CompleteSnapshotResponse -> ()
rnf CompleteSnapshotResponse' {Int
Maybe Status
httpStatus :: Int
status :: Maybe Status
$sel:httpStatus:CompleteSnapshotResponse' :: CompleteSnapshotResponse -> Int
$sel:status:CompleteSnapshotResponse' :: CompleteSnapshotResponse -> Maybe Status
..} =
    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 Int
httpStatus