{-# 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.GetSnapshotBlock
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the data in a block in an Amazon Elastic Block Store snapshot.
module Amazonka.EBS.GetSnapshotBlock
  ( -- * Creating a Request
    GetSnapshotBlock (..),
    newGetSnapshotBlock,

    -- * Request Lenses
    getSnapshotBlock_snapshotId,
    getSnapshotBlock_blockIndex,
    getSnapshotBlock_blockToken,

    -- * Destructuring the Response
    GetSnapshotBlockResponse (..),
    newGetSnapshotBlockResponse,

    -- * Response Lenses
    getSnapshotBlockResponse_checksum,
    getSnapshotBlockResponse_checksumAlgorithm,
    getSnapshotBlockResponse_dataLength,
    getSnapshotBlockResponse_httpStatus,
    getSnapshotBlockResponse_blockData,
  )
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:/ 'newGetSnapshotBlock' smart constructor.
data GetSnapshotBlock = GetSnapshotBlock'
  { -- | The ID of the snapshot containing the block from which to get data.
    --
    -- 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/.
    GetSnapshotBlock -> Text
snapshotId :: Prelude.Text,
    -- | The block index of the block in which to read 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.
    GetSnapshotBlock -> Natural
blockIndex :: Prelude.Natural,
    -- | The block token of the block from which to get data. You can obtain the
    -- @BlockToken@ by running the @ListChangedBlocks@ or @ListSnapshotBlocks@
    -- operations.
    GetSnapshotBlock -> Text
blockToken :: Prelude.Text
  }
  deriving (GetSnapshotBlock -> GetSnapshotBlock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSnapshotBlock -> GetSnapshotBlock -> Bool
$c/= :: GetSnapshotBlock -> GetSnapshotBlock -> Bool
== :: GetSnapshotBlock -> GetSnapshotBlock -> Bool
$c== :: GetSnapshotBlock -> GetSnapshotBlock -> Bool
Prelude.Eq, ReadPrec [GetSnapshotBlock]
ReadPrec GetSnapshotBlock
Int -> ReadS GetSnapshotBlock
ReadS [GetSnapshotBlock]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSnapshotBlock]
$creadListPrec :: ReadPrec [GetSnapshotBlock]
readPrec :: ReadPrec GetSnapshotBlock
$creadPrec :: ReadPrec GetSnapshotBlock
readList :: ReadS [GetSnapshotBlock]
$creadList :: ReadS [GetSnapshotBlock]
readsPrec :: Int -> ReadS GetSnapshotBlock
$creadsPrec :: Int -> ReadS GetSnapshotBlock
Prelude.Read, Int -> GetSnapshotBlock -> ShowS
[GetSnapshotBlock] -> ShowS
GetSnapshotBlock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSnapshotBlock] -> ShowS
$cshowList :: [GetSnapshotBlock] -> ShowS
show :: GetSnapshotBlock -> String
$cshow :: GetSnapshotBlock -> String
showsPrec :: Int -> GetSnapshotBlock -> ShowS
$cshowsPrec :: Int -> GetSnapshotBlock -> ShowS
Prelude.Show, forall x. Rep GetSnapshotBlock x -> GetSnapshotBlock
forall x. GetSnapshotBlock -> Rep GetSnapshotBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSnapshotBlock x -> GetSnapshotBlock
$cfrom :: forall x. GetSnapshotBlock -> Rep GetSnapshotBlock x
Prelude.Generic)

-- |
-- Create a value of 'GetSnapshotBlock' 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', 'getSnapshotBlock_snapshotId' - The ID of the snapshot containing the block from which to get data.
--
-- 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', 'getSnapshotBlock_blockIndex' - The block index of the block in which to read 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.
--
-- 'blockToken', 'getSnapshotBlock_blockToken' - The block token of the block from which to get data. You can obtain the
-- @BlockToken@ by running the @ListChangedBlocks@ or @ListSnapshotBlocks@
-- operations.
newGetSnapshotBlock ::
  -- | 'snapshotId'
  Prelude.Text ->
  -- | 'blockIndex'
  Prelude.Natural ->
  -- | 'blockToken'
  Prelude.Text ->
  GetSnapshotBlock
newGetSnapshotBlock :: Text -> Natural -> Text -> GetSnapshotBlock
newGetSnapshotBlock
  Text
pSnapshotId_
  Natural
pBlockIndex_
  Text
pBlockToken_ =
    GetSnapshotBlock'
      { $sel:snapshotId:GetSnapshotBlock' :: Text
snapshotId = Text
pSnapshotId_,
        $sel:blockIndex:GetSnapshotBlock' :: Natural
blockIndex = Natural
pBlockIndex_,
        $sel:blockToken:GetSnapshotBlock' :: Text
blockToken = Text
pBlockToken_
      }

-- | The ID of the snapshot containing the block from which to get data.
--
-- 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/.
getSnapshotBlock_snapshotId :: Lens.Lens' GetSnapshotBlock Prelude.Text
getSnapshotBlock_snapshotId :: Lens' GetSnapshotBlock Text
getSnapshotBlock_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotBlock' {Text
snapshotId :: Text
$sel:snapshotId:GetSnapshotBlock' :: GetSnapshotBlock -> Text
snapshotId} -> Text
snapshotId) (\s :: GetSnapshotBlock
s@GetSnapshotBlock' {} Text
a -> GetSnapshotBlock
s {$sel:snapshotId:GetSnapshotBlock' :: Text
snapshotId = Text
a} :: GetSnapshotBlock)

-- | The block index of the block in which to read 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.
getSnapshotBlock_blockIndex :: Lens.Lens' GetSnapshotBlock Prelude.Natural
getSnapshotBlock_blockIndex :: Lens' GetSnapshotBlock Natural
getSnapshotBlock_blockIndex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotBlock' {Natural
blockIndex :: Natural
$sel:blockIndex:GetSnapshotBlock' :: GetSnapshotBlock -> Natural
blockIndex} -> Natural
blockIndex) (\s :: GetSnapshotBlock
s@GetSnapshotBlock' {} Natural
a -> GetSnapshotBlock
s {$sel:blockIndex:GetSnapshotBlock' :: Natural
blockIndex = Natural
a} :: GetSnapshotBlock)

-- | The block token of the block from which to get data. You can obtain the
-- @BlockToken@ by running the @ListChangedBlocks@ or @ListSnapshotBlocks@
-- operations.
getSnapshotBlock_blockToken :: Lens.Lens' GetSnapshotBlock Prelude.Text
getSnapshotBlock_blockToken :: Lens' GetSnapshotBlock Text
getSnapshotBlock_blockToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotBlock' {Text
blockToken :: Text
$sel:blockToken:GetSnapshotBlock' :: GetSnapshotBlock -> Text
blockToken} -> Text
blockToken) (\s :: GetSnapshotBlock
s@GetSnapshotBlock' {} Text
a -> GetSnapshotBlock
s {$sel:blockToken:GetSnapshotBlock' :: Text
blockToken = Text
a} :: GetSnapshotBlock)

instance Core.AWSRequest GetSnapshotBlock where
  type
    AWSResponse GetSnapshotBlock =
      GetSnapshotBlockResponse
  request :: (Service -> Service)
-> GetSnapshotBlock -> Request GetSnapshotBlock
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSnapshotBlock
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetSnapshotBlock)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBody
      ( \Int
s ResponseHeaders
h ResponseBody
x ->
          Maybe Text
-> Maybe ChecksumAlgorithm
-> Maybe Int
-> Int
-> ResponseBody
-> GetSnapshotBlockResponse
GetSnapshotBlockResponse'
            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.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-Data-Length")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ResponseBody
x)
      )

instance Prelude.Hashable GetSnapshotBlock where
  hashWithSalt :: Int -> GetSnapshotBlock -> Int
hashWithSalt Int
_salt GetSnapshotBlock' {Natural
Text
blockToken :: Text
blockIndex :: Natural
snapshotId :: Text
$sel:blockToken:GetSnapshotBlock' :: GetSnapshotBlock -> Text
$sel:blockIndex:GetSnapshotBlock' :: GetSnapshotBlock -> Natural
$sel:snapshotId:GetSnapshotBlock' :: GetSnapshotBlock -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
blockIndex
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
blockToken

instance Prelude.NFData GetSnapshotBlock where
  rnf :: GetSnapshotBlock -> ()
rnf GetSnapshotBlock' {Natural
Text
blockToken :: Text
blockIndex :: Natural
snapshotId :: Text
$sel:blockToken:GetSnapshotBlock' :: GetSnapshotBlock -> Text
$sel:blockIndex:GetSnapshotBlock' :: GetSnapshotBlock -> Natural
$sel:snapshotId:GetSnapshotBlock' :: GetSnapshotBlock -> Text
..} =
    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
blockIndex
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
blockToken

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

instance Data.ToPath GetSnapshotBlock where
  toPath :: GetSnapshotBlock -> ByteString
toPath GetSnapshotBlock' {Natural
Text
blockToken :: Text
blockIndex :: Natural
snapshotId :: Text
$sel:blockToken:GetSnapshotBlock' :: GetSnapshotBlock -> Text
$sel:blockIndex:GetSnapshotBlock' :: GetSnapshotBlock -> Natural
$sel:snapshotId:GetSnapshotBlock' :: GetSnapshotBlock -> Text
..} =
    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 GetSnapshotBlock where
  toQuery :: GetSnapshotBlock -> QueryString
toQuery GetSnapshotBlock' {Natural
Text
blockToken :: Text
blockIndex :: Natural
snapshotId :: Text
$sel:blockToken:GetSnapshotBlock' :: GetSnapshotBlock -> Text
$sel:blockIndex:GetSnapshotBlock' :: GetSnapshotBlock -> Natural
$sel:snapshotId:GetSnapshotBlock' :: GetSnapshotBlock -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"blockToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
blockToken]

-- | /See:/ 'newGetSnapshotBlockResponse' smart constructor.
data GetSnapshotBlockResponse = GetSnapshotBlockResponse'
  { -- | The checksum generated for the block, which is Base64 encoded.
    GetSnapshotBlockResponse -> Maybe Text
checksum :: Prelude.Maybe Prelude.Text,
    -- | The algorithm used to generate the checksum for the block, such as
    -- SHA256.
    GetSnapshotBlockResponse -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | The size of the data in the block.
    GetSnapshotBlockResponse -> Maybe Int
dataLength :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    GetSnapshotBlockResponse -> Int
httpStatus :: Prelude.Int,
    -- | The data content of the block.
    GetSnapshotBlockResponse -> ResponseBody
blockData :: Data.ResponseBody
  }
  deriving (Int -> GetSnapshotBlockResponse -> ShowS
[GetSnapshotBlockResponse] -> ShowS
GetSnapshotBlockResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSnapshotBlockResponse] -> ShowS
$cshowList :: [GetSnapshotBlockResponse] -> ShowS
show :: GetSnapshotBlockResponse -> String
$cshow :: GetSnapshotBlockResponse -> String
showsPrec :: Int -> GetSnapshotBlockResponse -> ShowS
$cshowsPrec :: Int -> GetSnapshotBlockResponse -> ShowS
Prelude.Show, forall x.
Rep GetSnapshotBlockResponse x -> GetSnapshotBlockResponse
forall x.
GetSnapshotBlockResponse -> Rep GetSnapshotBlockResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSnapshotBlockResponse x -> GetSnapshotBlockResponse
$cfrom :: forall x.
GetSnapshotBlockResponse -> Rep GetSnapshotBlockResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSnapshotBlockResponse' 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', 'getSnapshotBlockResponse_checksum' - The checksum generated for the block, which is Base64 encoded.
--
-- 'checksumAlgorithm', 'getSnapshotBlockResponse_checksumAlgorithm' - The algorithm used to generate the checksum for the block, such as
-- SHA256.
--
-- 'dataLength', 'getSnapshotBlockResponse_dataLength' - The size of the data in the block.
--
-- 'httpStatus', 'getSnapshotBlockResponse_httpStatus' - The response's http status code.
--
-- 'blockData', 'getSnapshotBlockResponse_blockData' - The data content of the block.
newGetSnapshotBlockResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'blockData'
  Data.ResponseBody ->
  GetSnapshotBlockResponse
newGetSnapshotBlockResponse :: Int -> ResponseBody -> GetSnapshotBlockResponse
newGetSnapshotBlockResponse Int
pHttpStatus_ ResponseBody
pBlockData_ =
  GetSnapshotBlockResponse'
    { $sel:checksum:GetSnapshotBlockResponse' :: Maybe Text
checksum =
        forall a. Maybe a
Prelude.Nothing,
      $sel:checksumAlgorithm:GetSnapshotBlockResponse' :: Maybe ChecksumAlgorithm
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:dataLength:GetSnapshotBlockResponse' :: Maybe Int
dataLength = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSnapshotBlockResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:blockData:GetSnapshotBlockResponse' :: ResponseBody
blockData = ResponseBody
pBlockData_
    }

-- | The checksum generated for the block, which is Base64 encoded.
getSnapshotBlockResponse_checksum :: Lens.Lens' GetSnapshotBlockResponse (Prelude.Maybe Prelude.Text)
getSnapshotBlockResponse_checksum :: Lens' GetSnapshotBlockResponse (Maybe Text)
getSnapshotBlockResponse_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotBlockResponse' {Maybe Text
checksum :: Maybe Text
$sel:checksum:GetSnapshotBlockResponse' :: GetSnapshotBlockResponse -> Maybe Text
checksum} -> Maybe Text
checksum) (\s :: GetSnapshotBlockResponse
s@GetSnapshotBlockResponse' {} Maybe Text
a -> GetSnapshotBlockResponse
s {$sel:checksum:GetSnapshotBlockResponse' :: Maybe Text
checksum = Maybe Text
a} :: GetSnapshotBlockResponse)

-- | The algorithm used to generate the checksum for the block, such as
-- SHA256.
getSnapshotBlockResponse_checksumAlgorithm :: Lens.Lens' GetSnapshotBlockResponse (Prelude.Maybe ChecksumAlgorithm)
getSnapshotBlockResponse_checksumAlgorithm :: Lens' GetSnapshotBlockResponse (Maybe ChecksumAlgorithm)
getSnapshotBlockResponse_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotBlockResponse' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:GetSnapshotBlockResponse' :: GetSnapshotBlockResponse -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: GetSnapshotBlockResponse
s@GetSnapshotBlockResponse' {} Maybe ChecksumAlgorithm
a -> GetSnapshotBlockResponse
s {$sel:checksumAlgorithm:GetSnapshotBlockResponse' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: GetSnapshotBlockResponse)

-- | The size of the data in the block.
getSnapshotBlockResponse_dataLength :: Lens.Lens' GetSnapshotBlockResponse (Prelude.Maybe Prelude.Int)
getSnapshotBlockResponse_dataLength :: Lens' GetSnapshotBlockResponse (Maybe Int)
getSnapshotBlockResponse_dataLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotBlockResponse' {Maybe Int
dataLength :: Maybe Int
$sel:dataLength:GetSnapshotBlockResponse' :: GetSnapshotBlockResponse -> Maybe Int
dataLength} -> Maybe Int
dataLength) (\s :: GetSnapshotBlockResponse
s@GetSnapshotBlockResponse' {} Maybe Int
a -> GetSnapshotBlockResponse
s {$sel:dataLength:GetSnapshotBlockResponse' :: Maybe Int
dataLength = Maybe Int
a} :: GetSnapshotBlockResponse)

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

-- | The data content of the block.
getSnapshotBlockResponse_blockData :: Lens.Lens' GetSnapshotBlockResponse Data.ResponseBody
getSnapshotBlockResponse_blockData :: Lens' GetSnapshotBlockResponse ResponseBody
getSnapshotBlockResponse_blockData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotBlockResponse' {ResponseBody
blockData :: ResponseBody
$sel:blockData:GetSnapshotBlockResponse' :: GetSnapshotBlockResponse -> ResponseBody
blockData} -> ResponseBody
blockData) (\s :: GetSnapshotBlockResponse
s@GetSnapshotBlockResponse' {} ResponseBody
a -> GetSnapshotBlockResponse
s {$sel:blockData:GetSnapshotBlockResponse' :: ResponseBody
blockData = ResponseBody
a} :: GetSnapshotBlockResponse)