{-# 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.PutSnapshotBlock
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Writes a block of data to a snapshot. If the specified block contains
-- data, the existing data is overwritten. The target snapshot must be in
-- the @pending@ state.
--
-- Data written to a snapshot must be aligned with 512-KiB sectors.
module Amazonka.EBS.PutSnapshotBlock
  ( -- * Creating a Request
    PutSnapshotBlock (..),
    newPutSnapshotBlock,

    -- * Request Lenses
    putSnapshotBlock_progress,
    putSnapshotBlock_snapshotId,
    putSnapshotBlock_blockIndex,
    putSnapshotBlock_dataLength,
    putSnapshotBlock_checksum,
    putSnapshotBlock_checksumAlgorithm,
    putSnapshotBlock_blockData,

    -- * Destructuring the Response
    PutSnapshotBlockResponse (..),
    newPutSnapshotBlockResponse,

    -- * Response Lenses
    putSnapshotBlockResponse_checksum,
    putSnapshotBlockResponse_checksumAlgorithm,
    putSnapshotBlockResponse_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:/ 'newPutSnapshotBlock' smart constructor.
data PutSnapshotBlock = PutSnapshotBlock'
  { -- | The progress of the write process, as a percentage.
    PutSnapshotBlock -> Maybe Natural
progress :: Prelude.Maybe Prelude.Natural,
    -- | The ID of the snapshot.
    --
    -- If the specified snapshot is encrypted, you must have permission to use
    -- the KMS key that was used to encrypt the snapshot. 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/..
    PutSnapshotBlock -> Text
snapshotId :: Prelude.Text,
    -- | The block index of the block in which to write the data. A block index
    -- is a logical index in units of @512@ KiB blocks. To identify the block
    -- index, divide the logical offset of the data in the logical volume by
    -- the block size (logical offset of data\/@524288@). The logical offset of
    -- the data must be @512@ KiB aligned.
    PutSnapshotBlock -> Natural
blockIndex :: Prelude.Natural,
    -- | The size of the data to write to the block, in bytes. Currently, the
    -- only supported size is @524288@ bytes.
    --
    -- Valid values: @524288@
    PutSnapshotBlock -> Int
dataLength :: Prelude.Int,
    -- | A Base64-encoded SHA256 checksum of the data. Only SHA256 checksums are
    -- supported.
    PutSnapshotBlock -> Text
checksum :: Prelude.Text,
    -- | The algorithm used to generate the checksum. Currently, the only
    -- supported algorithm is @SHA256@.
    PutSnapshotBlock -> ChecksumAlgorithm
checksumAlgorithm :: ChecksumAlgorithm,
    -- | The data to write to the block.
    --
    -- The block data is not signed as part of the Signature Version 4 signing
    -- process. As a result, you must generate and provide a Base64-encoded
    -- SHA256 checksum for the block data using the __x-amz-Checksum__ header.
    -- Also, you must specify the checksum algorithm using the
    -- __x-amz-Checksum-Algorithm__ header. The checksum that you provide is
    -- part of the Signature Version 4 signing process. It is validated against
    -- a checksum generated by Amazon EBS to ensure the validity and
    -- authenticity of the data. If the checksums do not correspond, the
    -- request fails. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-accessing-snapshot.html#ebsapis-using-checksums Using checksums with the EBS direct APIs>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    PutSnapshotBlock -> HashedBody
blockData :: Data.HashedBody
  }
  deriving (Int -> PutSnapshotBlock -> ShowS
[PutSnapshotBlock] -> ShowS
PutSnapshotBlock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSnapshotBlock] -> ShowS
$cshowList :: [PutSnapshotBlock] -> ShowS
show :: PutSnapshotBlock -> String
$cshow :: PutSnapshotBlock -> String
showsPrec :: Int -> PutSnapshotBlock -> ShowS
$cshowsPrec :: Int -> PutSnapshotBlock -> ShowS
Prelude.Show, forall x. Rep PutSnapshotBlock x -> PutSnapshotBlock
forall x. PutSnapshotBlock -> Rep PutSnapshotBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutSnapshotBlock x -> PutSnapshotBlock
$cfrom :: forall x. PutSnapshotBlock -> Rep PutSnapshotBlock x
Prelude.Generic)

-- |
-- Create a value of 'PutSnapshotBlock' 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:
--
-- 'progress', 'putSnapshotBlock_progress' - The progress of the write process, as a percentage.
--
-- 'snapshotId', 'putSnapshotBlock_snapshotId' - The ID of the snapshot.
--
-- If the specified snapshot is encrypted, you must have permission to use
-- the KMS key that was used to encrypt the snapshot. 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/..
--
-- 'blockIndex', 'putSnapshotBlock_blockIndex' - The block index of the block in which to write the data. A block index
-- is a logical index in units of @512@ KiB blocks. To identify the block
-- index, divide the logical offset of the data in the logical volume by
-- the block size (logical offset of data\/@524288@). The logical offset of
-- the data must be @512@ KiB aligned.
--
-- 'dataLength', 'putSnapshotBlock_dataLength' - The size of the data to write to the block, in bytes. Currently, the
-- only supported size is @524288@ bytes.
--
-- Valid values: @524288@
--
-- 'checksum', 'putSnapshotBlock_checksum' - A Base64-encoded SHA256 checksum of the data. Only SHA256 checksums are
-- supported.
--
-- 'checksumAlgorithm', 'putSnapshotBlock_checksumAlgorithm' - The algorithm used to generate the checksum. Currently, the only
-- supported algorithm is @SHA256@.
--
-- 'blockData', 'putSnapshotBlock_blockData' - The data to write to the block.
--
-- The block data is not signed as part of the Signature Version 4 signing
-- process. As a result, you must generate and provide a Base64-encoded
-- SHA256 checksum for the block data using the __x-amz-Checksum__ header.
-- Also, you must specify the checksum algorithm using the
-- __x-amz-Checksum-Algorithm__ header. The checksum that you provide is
-- part of the Signature Version 4 signing process. It is validated against
-- a checksum generated by Amazon EBS to ensure the validity and
-- authenticity of the data. If the checksums do not correspond, the
-- request fails. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-accessing-snapshot.html#ebsapis-using-checksums Using checksums with the EBS direct APIs>
-- in the /Amazon Elastic Compute Cloud User Guide/.
newPutSnapshotBlock ::
  -- | 'snapshotId'
  Prelude.Text ->
  -- | 'blockIndex'
  Prelude.Natural ->
  -- | 'dataLength'
  Prelude.Int ->
  -- | 'checksum'
  Prelude.Text ->
  -- | 'checksumAlgorithm'
  ChecksumAlgorithm ->
  -- | 'blockData'
  Data.HashedBody ->
  PutSnapshotBlock
newPutSnapshotBlock :: Text
-> Natural
-> Int
-> Text
-> ChecksumAlgorithm
-> HashedBody
-> PutSnapshotBlock
newPutSnapshotBlock
  Text
pSnapshotId_
  Natural
pBlockIndex_
  Int
pDataLength_
  Text
pChecksum_
  ChecksumAlgorithm
pChecksumAlgorithm_
  HashedBody
pBlockData_ =
    PutSnapshotBlock'
      { $sel:progress:PutSnapshotBlock' :: Maybe Natural
progress = forall a. Maybe a
Prelude.Nothing,
        $sel:snapshotId:PutSnapshotBlock' :: Text
snapshotId = Text
pSnapshotId_,
        $sel:blockIndex:PutSnapshotBlock' :: Natural
blockIndex = Natural
pBlockIndex_,
        $sel:dataLength:PutSnapshotBlock' :: Int
dataLength = Int
pDataLength_,
        $sel:checksum:PutSnapshotBlock' :: Text
checksum = Text
pChecksum_,
        $sel:checksumAlgorithm:PutSnapshotBlock' :: ChecksumAlgorithm
checksumAlgorithm = ChecksumAlgorithm
pChecksumAlgorithm_,
        $sel:blockData:PutSnapshotBlock' :: HashedBody
blockData = HashedBody
pBlockData_
      }

-- | The progress of the write process, as a percentage.
putSnapshotBlock_progress :: Lens.Lens' PutSnapshotBlock (Prelude.Maybe Prelude.Natural)
putSnapshotBlock_progress :: Lens' PutSnapshotBlock (Maybe Natural)
putSnapshotBlock_progress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlock' {Maybe Natural
progress :: Maybe Natural
$sel:progress:PutSnapshotBlock' :: PutSnapshotBlock -> Maybe Natural
progress} -> Maybe Natural
progress) (\s :: PutSnapshotBlock
s@PutSnapshotBlock' {} Maybe Natural
a -> PutSnapshotBlock
s {$sel:progress:PutSnapshotBlock' :: Maybe Natural
progress = Maybe Natural
a} :: PutSnapshotBlock)

-- | The ID of the snapshot.
--
-- If the specified snapshot is encrypted, you must have permission to use
-- the KMS key that was used to encrypt the snapshot. 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/..
putSnapshotBlock_snapshotId :: Lens.Lens' PutSnapshotBlock Prelude.Text
putSnapshotBlock_snapshotId :: Lens' PutSnapshotBlock Text
putSnapshotBlock_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlock' {Text
snapshotId :: Text
$sel:snapshotId:PutSnapshotBlock' :: PutSnapshotBlock -> Text
snapshotId} -> Text
snapshotId) (\s :: PutSnapshotBlock
s@PutSnapshotBlock' {} Text
a -> PutSnapshotBlock
s {$sel:snapshotId:PutSnapshotBlock' :: Text
snapshotId = Text
a} :: PutSnapshotBlock)

-- | The block index of the block in which to write the data. A block index
-- is a logical index in units of @512@ KiB blocks. To identify the block
-- index, divide the logical offset of the data in the logical volume by
-- the block size (logical offset of data\/@524288@). The logical offset of
-- the data must be @512@ KiB aligned.
putSnapshotBlock_blockIndex :: Lens.Lens' PutSnapshotBlock Prelude.Natural
putSnapshotBlock_blockIndex :: Lens' PutSnapshotBlock Natural
putSnapshotBlock_blockIndex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlock' {Natural
blockIndex :: Natural
$sel:blockIndex:PutSnapshotBlock' :: PutSnapshotBlock -> Natural
blockIndex} -> Natural
blockIndex) (\s :: PutSnapshotBlock
s@PutSnapshotBlock' {} Natural
a -> PutSnapshotBlock
s {$sel:blockIndex:PutSnapshotBlock' :: Natural
blockIndex = Natural
a} :: PutSnapshotBlock)

-- | The size of the data to write to the block, in bytes. Currently, the
-- only supported size is @524288@ bytes.
--
-- Valid values: @524288@
putSnapshotBlock_dataLength :: Lens.Lens' PutSnapshotBlock Prelude.Int
putSnapshotBlock_dataLength :: Lens' PutSnapshotBlock Int
putSnapshotBlock_dataLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlock' {Int
dataLength :: Int
$sel:dataLength:PutSnapshotBlock' :: PutSnapshotBlock -> Int
dataLength} -> Int
dataLength) (\s :: PutSnapshotBlock
s@PutSnapshotBlock' {} Int
a -> PutSnapshotBlock
s {$sel:dataLength:PutSnapshotBlock' :: Int
dataLength = Int
a} :: PutSnapshotBlock)

-- | A Base64-encoded SHA256 checksum of the data. Only SHA256 checksums are
-- supported.
putSnapshotBlock_checksum :: Lens.Lens' PutSnapshotBlock Prelude.Text
putSnapshotBlock_checksum :: Lens' PutSnapshotBlock Text
putSnapshotBlock_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlock' {Text
checksum :: Text
$sel:checksum:PutSnapshotBlock' :: PutSnapshotBlock -> Text
checksum} -> Text
checksum) (\s :: PutSnapshotBlock
s@PutSnapshotBlock' {} Text
a -> PutSnapshotBlock
s {$sel:checksum:PutSnapshotBlock' :: Text
checksum = Text
a} :: PutSnapshotBlock)

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

-- | The data to write to the block.
--
-- The block data is not signed as part of the Signature Version 4 signing
-- process. As a result, you must generate and provide a Base64-encoded
-- SHA256 checksum for the block data using the __x-amz-Checksum__ header.
-- Also, you must specify the checksum algorithm using the
-- __x-amz-Checksum-Algorithm__ header. The checksum that you provide is
-- part of the Signature Version 4 signing process. It is validated against
-- a checksum generated by Amazon EBS to ensure the validity and
-- authenticity of the data. If the checksums do not correspond, the
-- request fails. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-accessing-snapshot.html#ebsapis-using-checksums Using checksums with the EBS direct APIs>
-- in the /Amazon Elastic Compute Cloud User Guide/.
putSnapshotBlock_blockData :: Lens.Lens' PutSnapshotBlock Data.HashedBody
putSnapshotBlock_blockData :: Lens' PutSnapshotBlock HashedBody
putSnapshotBlock_blockData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlock' {HashedBody
blockData :: HashedBody
$sel:blockData:PutSnapshotBlock' :: PutSnapshotBlock -> HashedBody
blockData} -> HashedBody
blockData) (\s :: PutSnapshotBlock
s@PutSnapshotBlock' {} HashedBody
a -> PutSnapshotBlock
s {$sel:blockData:PutSnapshotBlock' :: HashedBody
blockData = HashedBody
a} :: PutSnapshotBlock)

instance Core.AWSRequest PutSnapshotBlock where
  type
    AWSResponse PutSnapshotBlock =
      PutSnapshotBlockResponse
  request :: (Service -> Service)
-> PutSnapshotBlock -> Request PutSnapshotBlock
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.putBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutSnapshotBlock
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutSnapshotBlock)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Maybe Text
-> Maybe ChecksumAlgorithm -> Int -> PutSnapshotBlockResponse
PutSnapshotBlockResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-Checksum")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-Checksum-Algorithm")
            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 Data.ToBody PutSnapshotBlock where
  toBody :: PutSnapshotBlock -> RequestBody
toBody PutSnapshotBlock' {Int
Natural
Maybe Natural
Text
HashedBody
ChecksumAlgorithm
blockData :: HashedBody
checksumAlgorithm :: ChecksumAlgorithm
checksum :: Text
dataLength :: Int
blockIndex :: Natural
snapshotId :: Text
progress :: Maybe Natural
$sel:blockData:PutSnapshotBlock' :: PutSnapshotBlock -> HashedBody
$sel:checksumAlgorithm:PutSnapshotBlock' :: PutSnapshotBlock -> ChecksumAlgorithm
$sel:checksum:PutSnapshotBlock' :: PutSnapshotBlock -> Text
$sel:dataLength:PutSnapshotBlock' :: PutSnapshotBlock -> Int
$sel:blockIndex:PutSnapshotBlock' :: PutSnapshotBlock -> Natural
$sel:snapshotId:PutSnapshotBlock' :: PutSnapshotBlock -> Text
$sel:progress:PutSnapshotBlock' :: PutSnapshotBlock -> Maybe Natural
..} = forall a. ToBody a => a -> RequestBody
Data.toBody HashedBody
blockData

instance Data.ToHeaders PutSnapshotBlock where
  toHeaders :: PutSnapshotBlock -> ResponseHeaders
toHeaders PutSnapshotBlock' {Int
Natural
Maybe Natural
Text
HashedBody
ChecksumAlgorithm
blockData :: HashedBody
checksumAlgorithm :: ChecksumAlgorithm
checksum :: Text
dataLength :: Int
blockIndex :: Natural
snapshotId :: Text
progress :: Maybe Natural
$sel:blockData:PutSnapshotBlock' :: PutSnapshotBlock -> HashedBody
$sel:checksumAlgorithm:PutSnapshotBlock' :: PutSnapshotBlock -> ChecksumAlgorithm
$sel:checksum:PutSnapshotBlock' :: PutSnapshotBlock -> Text
$sel:dataLength:PutSnapshotBlock' :: PutSnapshotBlock -> Int
$sel:blockIndex:PutSnapshotBlock' :: PutSnapshotBlock -> Natural
$sel:snapshotId:PutSnapshotBlock' :: PutSnapshotBlock -> Text
$sel:progress:PutSnapshotBlock' :: PutSnapshotBlock -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-Progress" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Natural
progress,
        HeaderName
"x-amz-Data-Length" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Int
dataLength,
        HeaderName
"x-amz-Checksum" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
checksum,
        HeaderName
"x-amz-Checksum-Algorithm" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ChecksumAlgorithm
checksumAlgorithm,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToPath PutSnapshotBlock where
  toPath :: PutSnapshotBlock -> ByteString
toPath PutSnapshotBlock' {Int
Natural
Maybe Natural
Text
HashedBody
ChecksumAlgorithm
blockData :: HashedBody
checksumAlgorithm :: ChecksumAlgorithm
checksum :: Text
dataLength :: Int
blockIndex :: Natural
snapshotId :: Text
progress :: Maybe Natural
$sel:blockData:PutSnapshotBlock' :: PutSnapshotBlock -> HashedBody
$sel:checksumAlgorithm:PutSnapshotBlock' :: PutSnapshotBlock -> ChecksumAlgorithm
$sel:checksum:PutSnapshotBlock' :: PutSnapshotBlock -> Text
$sel:dataLength:PutSnapshotBlock' :: PutSnapshotBlock -> Int
$sel:blockIndex:PutSnapshotBlock' :: PutSnapshotBlock -> Natural
$sel:snapshotId:PutSnapshotBlock' :: PutSnapshotBlock -> Text
$sel:progress:PutSnapshotBlock' :: PutSnapshotBlock -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/snapshots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
snapshotId,
        ByteString
"/blocks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Natural
blockIndex
      ]

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

-- | /See:/ 'newPutSnapshotBlockResponse' smart constructor.
data PutSnapshotBlockResponse = PutSnapshotBlockResponse'
  { -- | The SHA256 checksum generated for the block data by Amazon EBS.
    PutSnapshotBlockResponse -> Maybe Text
checksum :: Prelude.Maybe Prelude.Text,
    -- | The algorithm used by Amazon EBS to generate the checksum.
    PutSnapshotBlockResponse -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | The response's http status code.
    PutSnapshotBlockResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutSnapshotBlockResponse -> PutSnapshotBlockResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutSnapshotBlockResponse -> PutSnapshotBlockResponse -> Bool
$c/= :: PutSnapshotBlockResponse -> PutSnapshotBlockResponse -> Bool
== :: PutSnapshotBlockResponse -> PutSnapshotBlockResponse -> Bool
$c== :: PutSnapshotBlockResponse -> PutSnapshotBlockResponse -> Bool
Prelude.Eq, ReadPrec [PutSnapshotBlockResponse]
ReadPrec PutSnapshotBlockResponse
Int -> ReadS PutSnapshotBlockResponse
ReadS [PutSnapshotBlockResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutSnapshotBlockResponse]
$creadListPrec :: ReadPrec [PutSnapshotBlockResponse]
readPrec :: ReadPrec PutSnapshotBlockResponse
$creadPrec :: ReadPrec PutSnapshotBlockResponse
readList :: ReadS [PutSnapshotBlockResponse]
$creadList :: ReadS [PutSnapshotBlockResponse]
readsPrec :: Int -> ReadS PutSnapshotBlockResponse
$creadsPrec :: Int -> ReadS PutSnapshotBlockResponse
Prelude.Read, Int -> PutSnapshotBlockResponse -> ShowS
[PutSnapshotBlockResponse] -> ShowS
PutSnapshotBlockResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSnapshotBlockResponse] -> ShowS
$cshowList :: [PutSnapshotBlockResponse] -> ShowS
show :: PutSnapshotBlockResponse -> String
$cshow :: PutSnapshotBlockResponse -> String
showsPrec :: Int -> PutSnapshotBlockResponse -> ShowS
$cshowsPrec :: Int -> PutSnapshotBlockResponse -> ShowS
Prelude.Show, forall x.
Rep PutSnapshotBlockResponse x -> PutSnapshotBlockResponse
forall x.
PutSnapshotBlockResponse -> Rep PutSnapshotBlockResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutSnapshotBlockResponse x -> PutSnapshotBlockResponse
$cfrom :: forall x.
PutSnapshotBlockResponse -> Rep PutSnapshotBlockResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutSnapshotBlockResponse' 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', 'putSnapshotBlockResponse_checksum' - The SHA256 checksum generated for the block data by Amazon EBS.
--
-- 'checksumAlgorithm', 'putSnapshotBlockResponse_checksumAlgorithm' - The algorithm used by Amazon EBS to generate the checksum.
--
-- 'httpStatus', 'putSnapshotBlockResponse_httpStatus' - The response's http status code.
newPutSnapshotBlockResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutSnapshotBlockResponse
newPutSnapshotBlockResponse :: Int -> PutSnapshotBlockResponse
newPutSnapshotBlockResponse Int
pHttpStatus_ =
  PutSnapshotBlockResponse'
    { $sel:checksum:PutSnapshotBlockResponse' :: Maybe Text
checksum =
        forall a. Maybe a
Prelude.Nothing,
      $sel:checksumAlgorithm:PutSnapshotBlockResponse' :: Maybe ChecksumAlgorithm
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutSnapshotBlockResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The SHA256 checksum generated for the block data by Amazon EBS.
putSnapshotBlockResponse_checksum :: Lens.Lens' PutSnapshotBlockResponse (Prelude.Maybe Prelude.Text)
putSnapshotBlockResponse_checksum :: Lens' PutSnapshotBlockResponse (Maybe Text)
putSnapshotBlockResponse_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlockResponse' {Maybe Text
checksum :: Maybe Text
$sel:checksum:PutSnapshotBlockResponse' :: PutSnapshotBlockResponse -> Maybe Text
checksum} -> Maybe Text
checksum) (\s :: PutSnapshotBlockResponse
s@PutSnapshotBlockResponse' {} Maybe Text
a -> PutSnapshotBlockResponse
s {$sel:checksum:PutSnapshotBlockResponse' :: Maybe Text
checksum = Maybe Text
a} :: PutSnapshotBlockResponse)

-- | The algorithm used by Amazon EBS to generate the checksum.
putSnapshotBlockResponse_checksumAlgorithm :: Lens.Lens' PutSnapshotBlockResponse (Prelude.Maybe ChecksumAlgorithm)
putSnapshotBlockResponse_checksumAlgorithm :: Lens' PutSnapshotBlockResponse (Maybe ChecksumAlgorithm)
putSnapshotBlockResponse_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSnapshotBlockResponse' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:PutSnapshotBlockResponse' :: PutSnapshotBlockResponse -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: PutSnapshotBlockResponse
s@PutSnapshotBlockResponse' {} Maybe ChecksumAlgorithm
a -> PutSnapshotBlockResponse
s {$sel:checksumAlgorithm:PutSnapshotBlockResponse' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: PutSnapshotBlockResponse)

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

instance Prelude.NFData PutSnapshotBlockResponse where
  rnf :: PutSnapshotBlockResponse -> ()
rnf PutSnapshotBlockResponse' {Int
Maybe Text
Maybe ChecksumAlgorithm
httpStatus :: Int
checksumAlgorithm :: Maybe ChecksumAlgorithm
checksum :: Maybe Text
$sel:httpStatus:PutSnapshotBlockResponse' :: PutSnapshotBlockResponse -> Int
$sel:checksumAlgorithm:PutSnapshotBlockResponse' :: PutSnapshotBlockResponse -> Maybe ChecksumAlgorithm
$sel:checksum:PutSnapshotBlockResponse' :: PutSnapshotBlockResponse -> 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 ChecksumAlgorithm
checksumAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus