{-# 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.Firehose.PutRecordBatch
-- 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 multiple data records into a delivery stream in a single call,
-- which can achieve higher throughput per producer than when writing
-- single records. To write single data records into a delivery stream, use
-- PutRecord. Applications using these operations are referred to as
-- producers.
--
-- For information about service quota, see
-- <https://docs.aws.amazon.com/firehose/latest/dev/limits.html Amazon Kinesis Data Firehose Quota>.
--
-- Each PutRecordBatch request supports up to 500 records. Each record in
-- the request can be as large as 1,000 KB (before base64 encoding), up to
-- a limit of 4 MB for the entire request. These limits cannot be changed.
--
-- You must specify the name of the delivery stream and the data record
-- when using PutRecord. The data record consists of a data blob that can
-- be up to 1,000 KB in size, and any kind of data. For example, it could
-- be a segment from a log file, geographic location data, website
-- clickstream data, and so on.
--
-- Kinesis Data Firehose buffers records before delivering them to the
-- destination. To disambiguate the data blobs at the destination, a common
-- solution is to use delimiters in the data, such as a newline (@\\n@) or
-- some other character unique within the data. This allows the consumer
-- application to parse individual data items when reading the data from
-- the destination.
--
-- The PutRecordBatch response includes a count of failed records,
-- @FailedPutCount@, and an array of responses, @RequestResponses@. Even if
-- the PutRecordBatch call succeeds, the value of @FailedPutCount@ may be
-- greater than 0, indicating that there are records for which the
-- operation didn\'t succeed. Each entry in the @RequestResponses@ array
-- provides additional information about the processed record. It directly
-- correlates with a record in the request array using the same ordering,
-- from the top to the bottom. The response array always includes the same
-- number of records as the request array. @RequestResponses@ includes both
-- successfully and unsuccessfully processed records. Kinesis Data Firehose
-- tries to process all records in each PutRecordBatch request. A single
-- record failure does not stop the processing of subsequent records.
--
-- A successfully processed record includes a @RecordId@ value, which is
-- unique for the record. An unsuccessfully processed record includes
-- @ErrorCode@ and @ErrorMessage@ values. @ErrorCode@ reflects the type of
-- error, and is one of the following values: @ServiceUnavailableException@
-- or @InternalFailure@. @ErrorMessage@ provides more detailed information
-- about the error.
--
-- If there is an internal server error or a timeout, the write might have
-- completed or it might have failed. If @FailedPutCount@ is greater than
-- 0, retry the request, resending only those records that might have
-- failed processing. This minimizes the possible duplicate records and
-- also reduces the total bytes sent (and corresponding charges). We
-- recommend that you handle any duplicates at the destination.
--
-- If PutRecordBatch throws @ServiceUnavailableException@, back off and
-- retry. If the exception persists, it is possible that the throughput
-- limits have been exceeded for the delivery stream.
--
-- Data records sent to Kinesis Data Firehose are stored for 24 hours from
-- the time they are added to a delivery stream as it attempts to send the
-- records to the destination. If the destination is unreachable for more
-- than 24 hours, the data is no longer available.
--
-- Don\'t concatenate two or more base64 strings to form the data fields of
-- your records. Instead, concatenate the raw data, then perform base64
-- encoding.
module Amazonka.Firehose.PutRecordBatch
  ( -- * Creating a Request
    PutRecordBatch (..),
    newPutRecordBatch,

    -- * Request Lenses
    putRecordBatch_deliveryStreamName,
    putRecordBatch_records,

    -- * Destructuring the Response
    PutRecordBatchResponse (..),
    newPutRecordBatchResponse,

    -- * Response Lenses
    putRecordBatchResponse_encrypted,
    putRecordBatchResponse_httpStatus,
    putRecordBatchResponse_failedPutCount,
    putRecordBatchResponse_requestResponses,
  )
where

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

-- | /See:/ 'newPutRecordBatch' smart constructor.
data PutRecordBatch = PutRecordBatch'
  { -- | The name of the delivery stream.
    PutRecordBatch -> Text
deliveryStreamName :: Prelude.Text,
    -- | One or more records.
    PutRecordBatch -> NonEmpty Record
records :: Prelude.NonEmpty Record
  }
  deriving (PutRecordBatch -> PutRecordBatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRecordBatch -> PutRecordBatch -> Bool
$c/= :: PutRecordBatch -> PutRecordBatch -> Bool
== :: PutRecordBatch -> PutRecordBatch -> Bool
$c== :: PutRecordBatch -> PutRecordBatch -> Bool
Prelude.Eq, ReadPrec [PutRecordBatch]
ReadPrec PutRecordBatch
Int -> ReadS PutRecordBatch
ReadS [PutRecordBatch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRecordBatch]
$creadListPrec :: ReadPrec [PutRecordBatch]
readPrec :: ReadPrec PutRecordBatch
$creadPrec :: ReadPrec PutRecordBatch
readList :: ReadS [PutRecordBatch]
$creadList :: ReadS [PutRecordBatch]
readsPrec :: Int -> ReadS PutRecordBatch
$creadsPrec :: Int -> ReadS PutRecordBatch
Prelude.Read, Int -> PutRecordBatch -> ShowS
[PutRecordBatch] -> ShowS
PutRecordBatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRecordBatch] -> ShowS
$cshowList :: [PutRecordBatch] -> ShowS
show :: PutRecordBatch -> String
$cshow :: PutRecordBatch -> String
showsPrec :: Int -> PutRecordBatch -> ShowS
$cshowsPrec :: Int -> PutRecordBatch -> ShowS
Prelude.Show, forall x. Rep PutRecordBatch x -> PutRecordBatch
forall x. PutRecordBatch -> Rep PutRecordBatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutRecordBatch x -> PutRecordBatch
$cfrom :: forall x. PutRecordBatch -> Rep PutRecordBatch x
Prelude.Generic)

-- |
-- Create a value of 'PutRecordBatch' 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:
--
-- 'deliveryStreamName', 'putRecordBatch_deliveryStreamName' - The name of the delivery stream.
--
-- 'records', 'putRecordBatch_records' - One or more records.
newPutRecordBatch ::
  -- | 'deliveryStreamName'
  Prelude.Text ->
  -- | 'records'
  Prelude.NonEmpty Record ->
  PutRecordBatch
newPutRecordBatch :: Text -> NonEmpty Record -> PutRecordBatch
newPutRecordBatch Text
pDeliveryStreamName_ NonEmpty Record
pRecords_ =
  PutRecordBatch'
    { $sel:deliveryStreamName:PutRecordBatch' :: Text
deliveryStreamName =
        Text
pDeliveryStreamName_,
      $sel:records:PutRecordBatch' :: NonEmpty Record
records = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Record
pRecords_
    }

-- | The name of the delivery stream.
putRecordBatch_deliveryStreamName :: Lens.Lens' PutRecordBatch Prelude.Text
putRecordBatch_deliveryStreamName :: Lens' PutRecordBatch Text
putRecordBatch_deliveryStreamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRecordBatch' {Text
deliveryStreamName :: Text
$sel:deliveryStreamName:PutRecordBatch' :: PutRecordBatch -> Text
deliveryStreamName} -> Text
deliveryStreamName) (\s :: PutRecordBatch
s@PutRecordBatch' {} Text
a -> PutRecordBatch
s {$sel:deliveryStreamName:PutRecordBatch' :: Text
deliveryStreamName = Text
a} :: PutRecordBatch)

-- | One or more records.
putRecordBatch_records :: Lens.Lens' PutRecordBatch (Prelude.NonEmpty Record)
putRecordBatch_records :: Lens' PutRecordBatch (NonEmpty Record)
putRecordBatch_records = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRecordBatch' {NonEmpty Record
records :: NonEmpty Record
$sel:records:PutRecordBatch' :: PutRecordBatch -> NonEmpty Record
records} -> NonEmpty Record
records) (\s :: PutRecordBatch
s@PutRecordBatch' {} NonEmpty Record
a -> PutRecordBatch
s {$sel:records:PutRecordBatch' :: NonEmpty Record
records = NonEmpty Record
a} :: PutRecordBatch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest PutRecordBatch where
  type
    AWSResponse PutRecordBatch =
      PutRecordBatchResponse
  request :: (Service -> Service) -> PutRecordBatch -> Request PutRecordBatch
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 PutRecordBatch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutRecordBatch)))
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 Bool
-> Int
-> Natural
-> NonEmpty PutRecordBatchResponseEntry
-> PutRecordBatchResponse
PutRecordBatchResponse'
            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
"Encrypted")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"FailedPutCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RequestResponses")
      )

instance Prelude.Hashable PutRecordBatch where
  hashWithSalt :: Int -> PutRecordBatch -> Int
hashWithSalt Int
_salt PutRecordBatch' {NonEmpty Record
Text
records :: NonEmpty Record
deliveryStreamName :: Text
$sel:records:PutRecordBatch' :: PutRecordBatch -> NonEmpty Record
$sel:deliveryStreamName:PutRecordBatch' :: PutRecordBatch -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deliveryStreamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Record
records

instance Prelude.NFData PutRecordBatch where
  rnf :: PutRecordBatch -> ()
rnf PutRecordBatch' {NonEmpty Record
Text
records :: NonEmpty Record
deliveryStreamName :: Text
$sel:records:PutRecordBatch' :: PutRecordBatch -> NonEmpty Record
$sel:deliveryStreamName:PutRecordBatch' :: PutRecordBatch -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
deliveryStreamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Record
records

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

instance Data.ToJSON PutRecordBatch where
  toJSON :: PutRecordBatch -> Value
toJSON PutRecordBatch' {NonEmpty Record
Text
records :: NonEmpty Record
deliveryStreamName :: Text
$sel:records:PutRecordBatch' :: PutRecordBatch -> NonEmpty Record
$sel:deliveryStreamName:PutRecordBatch' :: PutRecordBatch -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"DeliveryStreamName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deliveryStreamName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Records" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Record
records)
          ]
      )

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

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

-- | /See:/ 'newPutRecordBatchResponse' smart constructor.
data PutRecordBatchResponse = PutRecordBatchResponse'
  { -- | Indicates whether server-side encryption (SSE) was enabled during this
    -- operation.
    PutRecordBatchResponse -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    PutRecordBatchResponse -> Int
httpStatus :: Prelude.Int,
    -- | The number of records that might have failed processing. This number
    -- might be greater than 0 even if the PutRecordBatch call succeeds. Check
    -- @FailedPutCount@ to determine whether there are records that you need to
    -- resend.
    PutRecordBatchResponse -> Natural
failedPutCount :: Prelude.Natural,
    -- | The results array. For each record, the index of the response element is
    -- the same as the index used in the request array.
    PutRecordBatchResponse -> NonEmpty PutRecordBatchResponseEntry
requestResponses :: Prelude.NonEmpty PutRecordBatchResponseEntry
  }
  deriving (PutRecordBatchResponse -> PutRecordBatchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRecordBatchResponse -> PutRecordBatchResponse -> Bool
$c/= :: PutRecordBatchResponse -> PutRecordBatchResponse -> Bool
== :: PutRecordBatchResponse -> PutRecordBatchResponse -> Bool
$c== :: PutRecordBatchResponse -> PutRecordBatchResponse -> Bool
Prelude.Eq, ReadPrec [PutRecordBatchResponse]
ReadPrec PutRecordBatchResponse
Int -> ReadS PutRecordBatchResponse
ReadS [PutRecordBatchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRecordBatchResponse]
$creadListPrec :: ReadPrec [PutRecordBatchResponse]
readPrec :: ReadPrec PutRecordBatchResponse
$creadPrec :: ReadPrec PutRecordBatchResponse
readList :: ReadS [PutRecordBatchResponse]
$creadList :: ReadS [PutRecordBatchResponse]
readsPrec :: Int -> ReadS PutRecordBatchResponse
$creadsPrec :: Int -> ReadS PutRecordBatchResponse
Prelude.Read, Int -> PutRecordBatchResponse -> ShowS
[PutRecordBatchResponse] -> ShowS
PutRecordBatchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRecordBatchResponse] -> ShowS
$cshowList :: [PutRecordBatchResponse] -> ShowS
show :: PutRecordBatchResponse -> String
$cshow :: PutRecordBatchResponse -> String
showsPrec :: Int -> PutRecordBatchResponse -> ShowS
$cshowsPrec :: Int -> PutRecordBatchResponse -> ShowS
Prelude.Show, forall x. Rep PutRecordBatchResponse x -> PutRecordBatchResponse
forall x. PutRecordBatchResponse -> Rep PutRecordBatchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutRecordBatchResponse x -> PutRecordBatchResponse
$cfrom :: forall x. PutRecordBatchResponse -> Rep PutRecordBatchResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutRecordBatchResponse' 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:
--
-- 'encrypted', 'putRecordBatchResponse_encrypted' - Indicates whether server-side encryption (SSE) was enabled during this
-- operation.
--
-- 'httpStatus', 'putRecordBatchResponse_httpStatus' - The response's http status code.
--
-- 'failedPutCount', 'putRecordBatchResponse_failedPutCount' - The number of records that might have failed processing. This number
-- might be greater than 0 even if the PutRecordBatch call succeeds. Check
-- @FailedPutCount@ to determine whether there are records that you need to
-- resend.
--
-- 'requestResponses', 'putRecordBatchResponse_requestResponses' - The results array. For each record, the index of the response element is
-- the same as the index used in the request array.
newPutRecordBatchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'failedPutCount'
  Prelude.Natural ->
  -- | 'requestResponses'
  Prelude.NonEmpty PutRecordBatchResponseEntry ->
  PutRecordBatchResponse
newPutRecordBatchResponse :: Int
-> Natural
-> NonEmpty PutRecordBatchResponseEntry
-> PutRecordBatchResponse
newPutRecordBatchResponse
  Int
pHttpStatus_
  Natural
pFailedPutCount_
  NonEmpty PutRecordBatchResponseEntry
pRequestResponses_ =
    PutRecordBatchResponse'
      { $sel:encrypted:PutRecordBatchResponse' :: Maybe Bool
encrypted =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:PutRecordBatchResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:failedPutCount:PutRecordBatchResponse' :: Natural
failedPutCount = Natural
pFailedPutCount_,
        $sel:requestResponses:PutRecordBatchResponse' :: NonEmpty PutRecordBatchResponseEntry
requestResponses =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty PutRecordBatchResponseEntry
pRequestResponses_
      }

-- | Indicates whether server-side encryption (SSE) was enabled during this
-- operation.
putRecordBatchResponse_encrypted :: Lens.Lens' PutRecordBatchResponse (Prelude.Maybe Prelude.Bool)
putRecordBatchResponse_encrypted :: Lens' PutRecordBatchResponse (Maybe Bool)
putRecordBatchResponse_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRecordBatchResponse' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:PutRecordBatchResponse' :: PutRecordBatchResponse -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: PutRecordBatchResponse
s@PutRecordBatchResponse' {} Maybe Bool
a -> PutRecordBatchResponse
s {$sel:encrypted:PutRecordBatchResponse' :: Maybe Bool
encrypted = Maybe Bool
a} :: PutRecordBatchResponse)

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

-- | The number of records that might have failed processing. This number
-- might be greater than 0 even if the PutRecordBatch call succeeds. Check
-- @FailedPutCount@ to determine whether there are records that you need to
-- resend.
putRecordBatchResponse_failedPutCount :: Lens.Lens' PutRecordBatchResponse Prelude.Natural
putRecordBatchResponse_failedPutCount :: Lens' PutRecordBatchResponse Natural
putRecordBatchResponse_failedPutCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRecordBatchResponse' {Natural
failedPutCount :: Natural
$sel:failedPutCount:PutRecordBatchResponse' :: PutRecordBatchResponse -> Natural
failedPutCount} -> Natural
failedPutCount) (\s :: PutRecordBatchResponse
s@PutRecordBatchResponse' {} Natural
a -> PutRecordBatchResponse
s {$sel:failedPutCount:PutRecordBatchResponse' :: Natural
failedPutCount = Natural
a} :: PutRecordBatchResponse)

-- | The results array. For each record, the index of the response element is
-- the same as the index used in the request array.
putRecordBatchResponse_requestResponses :: Lens.Lens' PutRecordBatchResponse (Prelude.NonEmpty PutRecordBatchResponseEntry)
putRecordBatchResponse_requestResponses :: Lens' PutRecordBatchResponse (NonEmpty PutRecordBatchResponseEntry)
putRecordBatchResponse_requestResponses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRecordBatchResponse' {NonEmpty PutRecordBatchResponseEntry
requestResponses :: NonEmpty PutRecordBatchResponseEntry
$sel:requestResponses:PutRecordBatchResponse' :: PutRecordBatchResponse -> NonEmpty PutRecordBatchResponseEntry
requestResponses} -> NonEmpty PutRecordBatchResponseEntry
requestResponses) (\s :: PutRecordBatchResponse
s@PutRecordBatchResponse' {} NonEmpty PutRecordBatchResponseEntry
a -> PutRecordBatchResponse
s {$sel:requestResponses:PutRecordBatchResponse' :: NonEmpty PutRecordBatchResponseEntry
requestResponses = NonEmpty PutRecordBatchResponseEntry
a} :: PutRecordBatchResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData PutRecordBatchResponse where
  rnf :: PutRecordBatchResponse -> ()
rnf PutRecordBatchResponse' {Int
Natural
Maybe Bool
NonEmpty PutRecordBatchResponseEntry
requestResponses :: NonEmpty PutRecordBatchResponseEntry
failedPutCount :: Natural
httpStatus :: Int
encrypted :: Maybe Bool
$sel:requestResponses:PutRecordBatchResponse' :: PutRecordBatchResponse -> NonEmpty PutRecordBatchResponseEntry
$sel:failedPutCount:PutRecordBatchResponse' :: PutRecordBatchResponse -> Natural
$sel:httpStatus:PutRecordBatchResponse' :: PutRecordBatchResponse -> Int
$sel:encrypted:PutRecordBatchResponse' :: PutRecordBatchResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
failedPutCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PutRecordBatchResponseEntry
requestResponses