{-# 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.DynamoDBStreams.GetShardIterator
-- 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 a shard iterator. A shard iterator provides information about
-- how to retrieve the stream records from within a shard. Use the shard
-- iterator in a subsequent @GetRecords@ request to read the stream records
-- from the shard.
--
-- A shard iterator expires 15 minutes after it is returned to the
-- requester.
module Amazonka.DynamoDBStreams.GetShardIterator
  ( -- * Creating a Request
    GetShardIterator (..),
    newGetShardIterator,

    -- * Request Lenses
    getShardIterator_sequenceNumber,
    getShardIterator_streamArn,
    getShardIterator_shardId,
    getShardIterator_shardIteratorType,

    -- * Destructuring the Response
    GetShardIteratorResponse (..),
    newGetShardIteratorResponse,

    -- * Response Lenses
    getShardIteratorResponse_shardIterator,
    getShardIteratorResponse_httpStatus,
  )
where

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

-- | Represents the input of a @GetShardIterator@ operation.
--
-- /See:/ 'newGetShardIterator' smart constructor.
data GetShardIterator = GetShardIterator'
  { -- | The sequence number of a stream record in the shard from which to start
    -- reading.
    GetShardIterator -> Maybe Text
sequenceNumber :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the stream.
    GetShardIterator -> Text
streamArn :: Prelude.Text,
    -- | The identifier of the shard. The iterator will be returned for this
    -- shard ID.
    GetShardIterator -> Text
shardId :: Prelude.Text,
    -- | Determines how the shard iterator is used to start reading stream
    -- records from the shard:
    --
    -- -   @AT_SEQUENCE_NUMBER@ - Start reading exactly from the position
    --     denoted by a specific sequence number.
    --
    -- -   @AFTER_SEQUENCE_NUMBER@ - Start reading right after the position
    --     denoted by a specific sequence number.
    --
    -- -   @TRIM_HORIZON@ - Start reading at the last (untrimmed) stream
    --     record, which is the oldest record in the shard. In DynamoDB
    --     Streams, there is a 24 hour limit on data retention. Stream records
    --     whose age exceeds this limit are subject to removal (trimming) from
    --     the stream.
    --
    -- -   @LATEST@ - Start reading just after the most recent stream record in
    --     the shard, so that you always read the most recent data in the
    --     shard.
    GetShardIterator -> ShardIteratorType
shardIteratorType :: ShardIteratorType
  }
  deriving (GetShardIterator -> GetShardIterator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetShardIterator -> GetShardIterator -> Bool
$c/= :: GetShardIterator -> GetShardIterator -> Bool
== :: GetShardIterator -> GetShardIterator -> Bool
$c== :: GetShardIterator -> GetShardIterator -> Bool
Prelude.Eq, ReadPrec [GetShardIterator]
ReadPrec GetShardIterator
Int -> ReadS GetShardIterator
ReadS [GetShardIterator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetShardIterator]
$creadListPrec :: ReadPrec [GetShardIterator]
readPrec :: ReadPrec GetShardIterator
$creadPrec :: ReadPrec GetShardIterator
readList :: ReadS [GetShardIterator]
$creadList :: ReadS [GetShardIterator]
readsPrec :: Int -> ReadS GetShardIterator
$creadsPrec :: Int -> ReadS GetShardIterator
Prelude.Read, Int -> GetShardIterator -> ShowS
[GetShardIterator] -> ShowS
GetShardIterator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetShardIterator] -> ShowS
$cshowList :: [GetShardIterator] -> ShowS
show :: GetShardIterator -> String
$cshow :: GetShardIterator -> String
showsPrec :: Int -> GetShardIterator -> ShowS
$cshowsPrec :: Int -> GetShardIterator -> ShowS
Prelude.Show, forall x. Rep GetShardIterator x -> GetShardIterator
forall x. GetShardIterator -> Rep GetShardIterator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetShardIterator x -> GetShardIterator
$cfrom :: forall x. GetShardIterator -> Rep GetShardIterator x
Prelude.Generic)

-- |
-- Create a value of 'GetShardIterator' 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:
--
-- 'sequenceNumber', 'getShardIterator_sequenceNumber' - The sequence number of a stream record in the shard from which to start
-- reading.
--
-- 'streamArn', 'getShardIterator_streamArn' - The Amazon Resource Name (ARN) for the stream.
--
-- 'shardId', 'getShardIterator_shardId' - The identifier of the shard. The iterator will be returned for this
-- shard ID.
--
-- 'shardIteratorType', 'getShardIterator_shardIteratorType' - Determines how the shard iterator is used to start reading stream
-- records from the shard:
--
-- -   @AT_SEQUENCE_NUMBER@ - Start reading exactly from the position
--     denoted by a specific sequence number.
--
-- -   @AFTER_SEQUENCE_NUMBER@ - Start reading right after the position
--     denoted by a specific sequence number.
--
-- -   @TRIM_HORIZON@ - Start reading at the last (untrimmed) stream
--     record, which is the oldest record in the shard. In DynamoDB
--     Streams, there is a 24 hour limit on data retention. Stream records
--     whose age exceeds this limit are subject to removal (trimming) from
--     the stream.
--
-- -   @LATEST@ - Start reading just after the most recent stream record in
--     the shard, so that you always read the most recent data in the
--     shard.
newGetShardIterator ::
  -- | 'streamArn'
  Prelude.Text ->
  -- | 'shardId'
  Prelude.Text ->
  -- | 'shardIteratorType'
  ShardIteratorType ->
  GetShardIterator
newGetShardIterator :: Text -> Text -> ShardIteratorType -> GetShardIterator
newGetShardIterator
  Text
pStreamArn_
  Text
pShardId_
  ShardIteratorType
pShardIteratorType_ =
    GetShardIterator'
      { $sel:sequenceNumber:GetShardIterator' :: Maybe Text
sequenceNumber = forall a. Maybe a
Prelude.Nothing,
        $sel:streamArn:GetShardIterator' :: Text
streamArn = Text
pStreamArn_,
        $sel:shardId:GetShardIterator' :: Text
shardId = Text
pShardId_,
        $sel:shardIteratorType:GetShardIterator' :: ShardIteratorType
shardIteratorType = ShardIteratorType
pShardIteratorType_
      }

-- | The sequence number of a stream record in the shard from which to start
-- reading.
getShardIterator_sequenceNumber :: Lens.Lens' GetShardIterator (Prelude.Maybe Prelude.Text)
getShardIterator_sequenceNumber :: Lens' GetShardIterator (Maybe Text)
getShardIterator_sequenceNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetShardIterator' {Maybe Text
sequenceNumber :: Maybe Text
$sel:sequenceNumber:GetShardIterator' :: GetShardIterator -> Maybe Text
sequenceNumber} -> Maybe Text
sequenceNumber) (\s :: GetShardIterator
s@GetShardIterator' {} Maybe Text
a -> GetShardIterator
s {$sel:sequenceNumber:GetShardIterator' :: Maybe Text
sequenceNumber = Maybe Text
a} :: GetShardIterator)

-- | The Amazon Resource Name (ARN) for the stream.
getShardIterator_streamArn :: Lens.Lens' GetShardIterator Prelude.Text
getShardIterator_streamArn :: Lens' GetShardIterator Text
getShardIterator_streamArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetShardIterator' {Text
streamArn :: Text
$sel:streamArn:GetShardIterator' :: GetShardIterator -> Text
streamArn} -> Text
streamArn) (\s :: GetShardIterator
s@GetShardIterator' {} Text
a -> GetShardIterator
s {$sel:streamArn:GetShardIterator' :: Text
streamArn = Text
a} :: GetShardIterator)

-- | The identifier of the shard. The iterator will be returned for this
-- shard ID.
getShardIterator_shardId :: Lens.Lens' GetShardIterator Prelude.Text
getShardIterator_shardId :: Lens' GetShardIterator Text
getShardIterator_shardId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetShardIterator' {Text
shardId :: Text
$sel:shardId:GetShardIterator' :: GetShardIterator -> Text
shardId} -> Text
shardId) (\s :: GetShardIterator
s@GetShardIterator' {} Text
a -> GetShardIterator
s {$sel:shardId:GetShardIterator' :: Text
shardId = Text
a} :: GetShardIterator)

-- | Determines how the shard iterator is used to start reading stream
-- records from the shard:
--
-- -   @AT_SEQUENCE_NUMBER@ - Start reading exactly from the position
--     denoted by a specific sequence number.
--
-- -   @AFTER_SEQUENCE_NUMBER@ - Start reading right after the position
--     denoted by a specific sequence number.
--
-- -   @TRIM_HORIZON@ - Start reading at the last (untrimmed) stream
--     record, which is the oldest record in the shard. In DynamoDB
--     Streams, there is a 24 hour limit on data retention. Stream records
--     whose age exceeds this limit are subject to removal (trimming) from
--     the stream.
--
-- -   @LATEST@ - Start reading just after the most recent stream record in
--     the shard, so that you always read the most recent data in the
--     shard.
getShardIterator_shardIteratorType :: Lens.Lens' GetShardIterator ShardIteratorType
getShardIterator_shardIteratorType :: Lens' GetShardIterator ShardIteratorType
getShardIterator_shardIteratorType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetShardIterator' {ShardIteratorType
shardIteratorType :: ShardIteratorType
$sel:shardIteratorType:GetShardIterator' :: GetShardIterator -> ShardIteratorType
shardIteratorType} -> ShardIteratorType
shardIteratorType) (\s :: GetShardIterator
s@GetShardIterator' {} ShardIteratorType
a -> GetShardIterator
s {$sel:shardIteratorType:GetShardIterator' :: ShardIteratorType
shardIteratorType = ShardIteratorType
a} :: GetShardIterator)

instance Core.AWSRequest GetShardIterator where
  type
    AWSResponse GetShardIterator =
      GetShardIteratorResponse
  request :: (Service -> Service)
-> GetShardIterator -> Request GetShardIterator
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 GetShardIterator
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetShardIterator)))
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 -> Int -> GetShardIteratorResponse
GetShardIteratorResponse'
            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
"ShardIterator")
            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 GetShardIterator where
  hashWithSalt :: Int -> GetShardIterator -> Int
hashWithSalt Int
_salt GetShardIterator' {Maybe Text
Text
ShardIteratorType
shardIteratorType :: ShardIteratorType
shardId :: Text
streamArn :: Text
sequenceNumber :: Maybe Text
$sel:shardIteratorType:GetShardIterator' :: GetShardIterator -> ShardIteratorType
$sel:shardId:GetShardIterator' :: GetShardIterator -> Text
$sel:streamArn:GetShardIterator' :: GetShardIterator -> Text
$sel:sequenceNumber:GetShardIterator' :: GetShardIterator -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sequenceNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
streamArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
shardId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ShardIteratorType
shardIteratorType

instance Prelude.NFData GetShardIterator where
  rnf :: GetShardIterator -> ()
rnf GetShardIterator' {Maybe Text
Text
ShardIteratorType
shardIteratorType :: ShardIteratorType
shardId :: Text
streamArn :: Text
sequenceNumber :: Maybe Text
$sel:shardIteratorType:GetShardIterator' :: GetShardIterator -> ShardIteratorType
$sel:shardId:GetShardIterator' :: GetShardIterator -> Text
$sel:streamArn:GetShardIterator' :: GetShardIterator -> Text
$sel:sequenceNumber:GetShardIterator' :: GetShardIterator -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sequenceNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
streamArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
shardId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ShardIteratorType
shardIteratorType

instance Data.ToHeaders GetShardIterator where
  toHeaders :: GetShardIterator -> 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
"DynamoDBStreams_20120810.GetShardIterator" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetShardIterator where
  toJSON :: GetShardIterator -> Value
toJSON GetShardIterator' {Maybe Text
Text
ShardIteratorType
shardIteratorType :: ShardIteratorType
shardId :: Text
streamArn :: Text
sequenceNumber :: Maybe Text
$sel:shardIteratorType:GetShardIterator' :: GetShardIterator -> ShardIteratorType
$sel:shardId:GetShardIterator' :: GetShardIterator -> Text
$sel:streamArn:GetShardIterator' :: GetShardIterator -> Text
$sel:sequenceNumber:GetShardIterator' :: GetShardIterator -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SequenceNumber" 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 Text
sequenceNumber,
            forall a. a -> Maybe a
Prelude.Just (Key
"StreamArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
streamArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"ShardId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
shardId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ShardIteratorType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ShardIteratorType
shardIteratorType)
          ]
      )

instance Data.ToPath GetShardIterator where
  toPath :: GetShardIterator -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | Represents the output of a @GetShardIterator@ operation.
--
-- /See:/ 'newGetShardIteratorResponse' smart constructor.
data GetShardIteratorResponse = GetShardIteratorResponse'
  { -- | The position in the shard from which to start reading stream records
    -- sequentially. A shard iterator specifies this position using the
    -- sequence number of a stream record in a shard.
    GetShardIteratorResponse -> Maybe Text
shardIterator :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetShardIteratorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetShardIteratorResponse -> GetShardIteratorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetShardIteratorResponse -> GetShardIteratorResponse -> Bool
$c/= :: GetShardIteratorResponse -> GetShardIteratorResponse -> Bool
== :: GetShardIteratorResponse -> GetShardIteratorResponse -> Bool
$c== :: GetShardIteratorResponse -> GetShardIteratorResponse -> Bool
Prelude.Eq, ReadPrec [GetShardIteratorResponse]
ReadPrec GetShardIteratorResponse
Int -> ReadS GetShardIteratorResponse
ReadS [GetShardIteratorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetShardIteratorResponse]
$creadListPrec :: ReadPrec [GetShardIteratorResponse]
readPrec :: ReadPrec GetShardIteratorResponse
$creadPrec :: ReadPrec GetShardIteratorResponse
readList :: ReadS [GetShardIteratorResponse]
$creadList :: ReadS [GetShardIteratorResponse]
readsPrec :: Int -> ReadS GetShardIteratorResponse
$creadsPrec :: Int -> ReadS GetShardIteratorResponse
Prelude.Read, Int -> GetShardIteratorResponse -> ShowS
[GetShardIteratorResponse] -> ShowS
GetShardIteratorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetShardIteratorResponse] -> ShowS
$cshowList :: [GetShardIteratorResponse] -> ShowS
show :: GetShardIteratorResponse -> String
$cshow :: GetShardIteratorResponse -> String
showsPrec :: Int -> GetShardIteratorResponse -> ShowS
$cshowsPrec :: Int -> GetShardIteratorResponse -> ShowS
Prelude.Show, forall x.
Rep GetShardIteratorResponse x -> GetShardIteratorResponse
forall x.
GetShardIteratorResponse -> Rep GetShardIteratorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetShardIteratorResponse x -> GetShardIteratorResponse
$cfrom :: forall x.
GetShardIteratorResponse -> Rep GetShardIteratorResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetShardIteratorResponse' 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:
--
-- 'shardIterator', 'getShardIteratorResponse_shardIterator' - The position in the shard from which to start reading stream records
-- sequentially. A shard iterator specifies this position using the
-- sequence number of a stream record in a shard.
--
-- 'httpStatus', 'getShardIteratorResponse_httpStatus' - The response's http status code.
newGetShardIteratorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetShardIteratorResponse
newGetShardIteratorResponse :: Int -> GetShardIteratorResponse
newGetShardIteratorResponse Int
pHttpStatus_ =
  GetShardIteratorResponse'
    { $sel:shardIterator:GetShardIteratorResponse' :: Maybe Text
shardIterator =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetShardIteratorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The position in the shard from which to start reading stream records
-- sequentially. A shard iterator specifies this position using the
-- sequence number of a stream record in a shard.
getShardIteratorResponse_shardIterator :: Lens.Lens' GetShardIteratorResponse (Prelude.Maybe Prelude.Text)
getShardIteratorResponse_shardIterator :: Lens' GetShardIteratorResponse (Maybe Text)
getShardIteratorResponse_shardIterator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetShardIteratorResponse' {Maybe Text
shardIterator :: Maybe Text
$sel:shardIterator:GetShardIteratorResponse' :: GetShardIteratorResponse -> Maybe Text
shardIterator} -> Maybe Text
shardIterator) (\s :: GetShardIteratorResponse
s@GetShardIteratorResponse' {} Maybe Text
a -> GetShardIteratorResponse
s {$sel:shardIterator:GetShardIteratorResponse' :: Maybe Text
shardIterator = Maybe Text
a} :: GetShardIteratorResponse)

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

instance Prelude.NFData GetShardIteratorResponse where
  rnf :: GetShardIteratorResponse -> ()
rnf GetShardIteratorResponse' {Int
Maybe Text
httpStatus :: Int
shardIterator :: Maybe Text
$sel:httpStatus:GetShardIteratorResponse' :: GetShardIteratorResponse -> Int
$sel:shardIterator:GetShardIteratorResponse' :: GetShardIteratorResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
shardIterator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus