{-# 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.TimeStreamWrite.WriteRecords
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The WriteRecords operation enables you to write your time series data
-- into Timestream. You can specify a single data point or a batch of data
-- points to be inserted into the system. Timestream offers you with a
-- flexible schema that auto detects the column names and data types for
-- your Timestream tables based on the dimension names and data types of
-- the data points you specify when invoking writes into the database.
-- Timestream support eventual consistency read semantics. This means that
-- when you query data immediately after writing a batch of data into
-- Timestream, the query results might not reflect the results of a
-- recently completed write operation. The results may also include some
-- stale data. If you repeat the query request after a short time, the
-- results should return the latest data.
-- <https://docs.aws.amazon.com/timestream/latest/developerguide/ts-limits.html Service quotas apply>.
--
-- See
-- <https://docs.aws.amazon.com/timestream/latest/developerguide/code-samples.write.html code sample>
-- for details.
--
-- __Upserts__
--
-- You can use the @Version@ parameter in a @WriteRecords@ request to
-- update data points. Timestream tracks a version number with each record.
-- @Version@ defaults to @1@ when not specified for the record in the
-- request. Timestream will update an existing record’s measure value along
-- with its @Version@ upon receiving a write request with a higher
-- @Version@ number for that record. Upon receiving an update request where
-- the measure value is the same as that of the existing record, Timestream
-- still updates @Version@, if it is greater than the existing value of
-- @Version@. You can update a data point as many times as desired, as long
-- as the value of @Version@ continuously increases.
--
-- For example, suppose you write a new record without indicating @Version@
-- in the request. Timestream will store this record, and set @Version@ to
-- @1@. Now, suppose you try to update this record with a @WriteRecords@
-- request of the same record with a different measure value but, like
-- before, do not provide @Version@. In this case, Timestream will reject
-- this update with a @RejectedRecordsException@ since the updated record’s
-- version is not greater than the existing value of Version. However, if
-- you were to resend the update request with @Version@ set to @2@,
-- Timestream would then succeed in updating the record’s value, and the
-- @Version@ would be set to @2@. Next, suppose you sent a @WriteRecords@
-- request with this same record and an identical measure value, but with
-- @Version@ set to @3@. In this case, Timestream would only update
-- @Version@ to @3@. Any further updates would need to send a version
-- number greater than @3@, or the update requests would receive a
-- @RejectedRecordsException@.
module Amazonka.TimeStreamWrite.WriteRecords
  ( -- * Creating a Request
    WriteRecords (..),
    newWriteRecords,

    -- * Request Lenses
    writeRecords_commonAttributes,
    writeRecords_databaseName,
    writeRecords_tableName,
    writeRecords_records,

    -- * Destructuring the Response
    WriteRecordsResponse (..),
    newWriteRecordsResponse,

    -- * Response Lenses
    writeRecordsResponse_recordsIngested,
    writeRecordsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newWriteRecords' smart constructor.
data WriteRecords = WriteRecords'
  { -- | A record containing the common measure, dimension, time, and version
    -- attributes shared across all the records in the request. The measure and
    -- dimension attributes specified will be merged with the measure and
    -- dimension attributes in the records object when the data is written into
    -- Timestream. Dimensions may not overlap, or a @ValidationException@ will
    -- be thrown. In other words, a record must contain dimensions with unique
    -- names.
    WriteRecords -> Maybe Record
commonAttributes :: Prelude.Maybe Record,
    -- | The name of the Timestream database.
    WriteRecords -> Text
databaseName :: Prelude.Text,
    -- | The name of the Timestream table.
    WriteRecords -> Text
tableName :: Prelude.Text,
    -- | An array of records containing the unique measure, dimension, time, and
    -- version attributes for each time series data point.
    WriteRecords -> NonEmpty Record
records :: Prelude.NonEmpty Record
  }
  deriving (WriteRecords -> WriteRecords -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteRecords -> WriteRecords -> Bool
$c/= :: WriteRecords -> WriteRecords -> Bool
== :: WriteRecords -> WriteRecords -> Bool
$c== :: WriteRecords -> WriteRecords -> Bool
Prelude.Eq, ReadPrec [WriteRecords]
ReadPrec WriteRecords
Int -> ReadS WriteRecords
ReadS [WriteRecords]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WriteRecords]
$creadListPrec :: ReadPrec [WriteRecords]
readPrec :: ReadPrec WriteRecords
$creadPrec :: ReadPrec WriteRecords
readList :: ReadS [WriteRecords]
$creadList :: ReadS [WriteRecords]
readsPrec :: Int -> ReadS WriteRecords
$creadsPrec :: Int -> ReadS WriteRecords
Prelude.Read, Int -> WriteRecords -> ShowS
[WriteRecords] -> ShowS
WriteRecords -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteRecords] -> ShowS
$cshowList :: [WriteRecords] -> ShowS
show :: WriteRecords -> String
$cshow :: WriteRecords -> String
showsPrec :: Int -> WriteRecords -> ShowS
$cshowsPrec :: Int -> WriteRecords -> ShowS
Prelude.Show, forall x. Rep WriteRecords x -> WriteRecords
forall x. WriteRecords -> Rep WriteRecords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WriteRecords x -> WriteRecords
$cfrom :: forall x. WriteRecords -> Rep WriteRecords x
Prelude.Generic)

-- |
-- Create a value of 'WriteRecords' 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:
--
-- 'commonAttributes', 'writeRecords_commonAttributes' - A record containing the common measure, dimension, time, and version
-- attributes shared across all the records in the request. The measure and
-- dimension attributes specified will be merged with the measure and
-- dimension attributes in the records object when the data is written into
-- Timestream. Dimensions may not overlap, or a @ValidationException@ will
-- be thrown. In other words, a record must contain dimensions with unique
-- names.
--
-- 'databaseName', 'writeRecords_databaseName' - The name of the Timestream database.
--
-- 'tableName', 'writeRecords_tableName' - The name of the Timestream table.
--
-- 'records', 'writeRecords_records' - An array of records containing the unique measure, dimension, time, and
-- version attributes for each time series data point.
newWriteRecords ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  -- | 'records'
  Prelude.NonEmpty Record ->
  WriteRecords
newWriteRecords :: Text -> Text -> NonEmpty Record -> WriteRecords
newWriteRecords Text
pDatabaseName_ Text
pTableName_ NonEmpty Record
pRecords_ =
  WriteRecords'
    { $sel:commonAttributes:WriteRecords' :: Maybe Record
commonAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:databaseName:WriteRecords' :: Text
databaseName = Text
pDatabaseName_,
      $sel:tableName:WriteRecords' :: Text
tableName = Text
pTableName_,
      $sel:records:WriteRecords' :: 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_
    }

-- | A record containing the common measure, dimension, time, and version
-- attributes shared across all the records in the request. The measure and
-- dimension attributes specified will be merged with the measure and
-- dimension attributes in the records object when the data is written into
-- Timestream. Dimensions may not overlap, or a @ValidationException@ will
-- be thrown. In other words, a record must contain dimensions with unique
-- names.
writeRecords_commonAttributes :: Lens.Lens' WriteRecords (Prelude.Maybe Record)
writeRecords_commonAttributes :: Lens' WriteRecords (Maybe Record)
writeRecords_commonAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WriteRecords' {Maybe Record
commonAttributes :: Maybe Record
$sel:commonAttributes:WriteRecords' :: WriteRecords -> Maybe Record
commonAttributes} -> Maybe Record
commonAttributes) (\s :: WriteRecords
s@WriteRecords' {} Maybe Record
a -> WriteRecords
s {$sel:commonAttributes:WriteRecords' :: Maybe Record
commonAttributes = Maybe Record
a} :: WriteRecords)

-- | The name of the Timestream database.
writeRecords_databaseName :: Lens.Lens' WriteRecords Prelude.Text
writeRecords_databaseName :: Lens' WriteRecords Text
writeRecords_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WriteRecords' {Text
databaseName :: Text
$sel:databaseName:WriteRecords' :: WriteRecords -> Text
databaseName} -> Text
databaseName) (\s :: WriteRecords
s@WriteRecords' {} Text
a -> WriteRecords
s {$sel:databaseName:WriteRecords' :: Text
databaseName = Text
a} :: WriteRecords)

-- | The name of the Timestream table.
writeRecords_tableName :: Lens.Lens' WriteRecords Prelude.Text
writeRecords_tableName :: Lens' WriteRecords Text
writeRecords_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WriteRecords' {Text
tableName :: Text
$sel:tableName:WriteRecords' :: WriteRecords -> Text
tableName} -> Text
tableName) (\s :: WriteRecords
s@WriteRecords' {} Text
a -> WriteRecords
s {$sel:tableName:WriteRecords' :: Text
tableName = Text
a} :: WriteRecords)

-- | An array of records containing the unique measure, dimension, time, and
-- version attributes for each time series data point.
writeRecords_records :: Lens.Lens' WriteRecords (Prelude.NonEmpty Record)
writeRecords_records :: Lens' WriteRecords (NonEmpty Record)
writeRecords_records = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WriteRecords' {NonEmpty Record
records :: NonEmpty Record
$sel:records:WriteRecords' :: WriteRecords -> NonEmpty Record
records} -> NonEmpty Record
records) (\s :: WriteRecords
s@WriteRecords' {} NonEmpty Record
a -> WriteRecords
s {$sel:records:WriteRecords' :: NonEmpty Record
records = NonEmpty Record
a} :: WriteRecords) 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 WriteRecords where
  type AWSResponse WriteRecords = WriteRecordsResponse
  request :: (Service -> Service) -> WriteRecords -> Request WriteRecords
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 WriteRecords
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse WriteRecords)))
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 RecordsIngested -> Int -> WriteRecordsResponse
WriteRecordsResponse'
            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
"RecordsIngested")
            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 WriteRecords where
  hashWithSalt :: Int -> WriteRecords -> Int
hashWithSalt Int
_salt WriteRecords' {Maybe Record
NonEmpty Record
Text
records :: NonEmpty Record
tableName :: Text
databaseName :: Text
commonAttributes :: Maybe Record
$sel:records:WriteRecords' :: WriteRecords -> NonEmpty Record
$sel:tableName:WriteRecords' :: WriteRecords -> Text
$sel:databaseName:WriteRecords' :: WriteRecords -> Text
$sel:commonAttributes:WriteRecords' :: WriteRecords -> Maybe Record
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Record
commonAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
databaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Record
records

instance Prelude.NFData WriteRecords where
  rnf :: WriteRecords -> ()
rnf WriteRecords' {Maybe Record
NonEmpty Record
Text
records :: NonEmpty Record
tableName :: Text
databaseName :: Text
commonAttributes :: Maybe Record
$sel:records:WriteRecords' :: WriteRecords -> NonEmpty Record
$sel:tableName:WriteRecords' :: WriteRecords -> Text
$sel:databaseName:WriteRecords' :: WriteRecords -> Text
$sel:commonAttributes:WriteRecords' :: WriteRecords -> Maybe Record
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Record
commonAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
databaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Record
records

instance Data.ToHeaders WriteRecords where
  toHeaders :: WriteRecords -> 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
"Timestream_20181101.WriteRecords" ::
                          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 WriteRecords where
  toJSON :: WriteRecords -> Value
toJSON WriteRecords' {Maybe Record
NonEmpty Record
Text
records :: NonEmpty Record
tableName :: Text
databaseName :: Text
commonAttributes :: Maybe Record
$sel:records:WriteRecords' :: WriteRecords -> NonEmpty Record
$sel:tableName:WriteRecords' :: WriteRecords -> Text
$sel:databaseName:WriteRecords' :: WriteRecords -> Text
$sel:commonAttributes:WriteRecords' :: WriteRecords -> Maybe Record
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CommonAttributes" 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 Record
commonAttributes,
            forall a. a -> Maybe a
Prelude.Just (Key
"DatabaseName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
databaseName),
            forall a. a -> Maybe a
Prelude.Just (Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            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 WriteRecords where
  toPath :: WriteRecords -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newWriteRecordsResponse' smart constructor.
data WriteRecordsResponse = WriteRecordsResponse'
  { -- | Information on the records ingested by this request.
    WriteRecordsResponse -> Maybe RecordsIngested
recordsIngested :: Prelude.Maybe RecordsIngested,
    -- | The response's http status code.
    WriteRecordsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (WriteRecordsResponse -> WriteRecordsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteRecordsResponse -> WriteRecordsResponse -> Bool
$c/= :: WriteRecordsResponse -> WriteRecordsResponse -> Bool
== :: WriteRecordsResponse -> WriteRecordsResponse -> Bool
$c== :: WriteRecordsResponse -> WriteRecordsResponse -> Bool
Prelude.Eq, ReadPrec [WriteRecordsResponse]
ReadPrec WriteRecordsResponse
Int -> ReadS WriteRecordsResponse
ReadS [WriteRecordsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WriteRecordsResponse]
$creadListPrec :: ReadPrec [WriteRecordsResponse]
readPrec :: ReadPrec WriteRecordsResponse
$creadPrec :: ReadPrec WriteRecordsResponse
readList :: ReadS [WriteRecordsResponse]
$creadList :: ReadS [WriteRecordsResponse]
readsPrec :: Int -> ReadS WriteRecordsResponse
$creadsPrec :: Int -> ReadS WriteRecordsResponse
Prelude.Read, Int -> WriteRecordsResponse -> ShowS
[WriteRecordsResponse] -> ShowS
WriteRecordsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteRecordsResponse] -> ShowS
$cshowList :: [WriteRecordsResponse] -> ShowS
show :: WriteRecordsResponse -> String
$cshow :: WriteRecordsResponse -> String
showsPrec :: Int -> WriteRecordsResponse -> ShowS
$cshowsPrec :: Int -> WriteRecordsResponse -> ShowS
Prelude.Show, forall x. Rep WriteRecordsResponse x -> WriteRecordsResponse
forall x. WriteRecordsResponse -> Rep WriteRecordsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WriteRecordsResponse x -> WriteRecordsResponse
$cfrom :: forall x. WriteRecordsResponse -> Rep WriteRecordsResponse x
Prelude.Generic)

-- |
-- Create a value of 'WriteRecordsResponse' 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:
--
-- 'recordsIngested', 'writeRecordsResponse_recordsIngested' - Information on the records ingested by this request.
--
-- 'httpStatus', 'writeRecordsResponse_httpStatus' - The response's http status code.
newWriteRecordsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  WriteRecordsResponse
newWriteRecordsResponse :: Int -> WriteRecordsResponse
newWriteRecordsResponse Int
pHttpStatus_ =
  WriteRecordsResponse'
    { $sel:recordsIngested:WriteRecordsResponse' :: Maybe RecordsIngested
recordsIngested =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:WriteRecordsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information on the records ingested by this request.
writeRecordsResponse_recordsIngested :: Lens.Lens' WriteRecordsResponse (Prelude.Maybe RecordsIngested)
writeRecordsResponse_recordsIngested :: Lens' WriteRecordsResponse (Maybe RecordsIngested)
writeRecordsResponse_recordsIngested = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WriteRecordsResponse' {Maybe RecordsIngested
recordsIngested :: Maybe RecordsIngested
$sel:recordsIngested:WriteRecordsResponse' :: WriteRecordsResponse -> Maybe RecordsIngested
recordsIngested} -> Maybe RecordsIngested
recordsIngested) (\s :: WriteRecordsResponse
s@WriteRecordsResponse' {} Maybe RecordsIngested
a -> WriteRecordsResponse
s {$sel:recordsIngested:WriteRecordsResponse' :: Maybe RecordsIngested
recordsIngested = Maybe RecordsIngested
a} :: WriteRecordsResponse)

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

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