{-# 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.CloudWatchLogs.PutLogEvents
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uploads a batch of log events to the specified log stream.
--
-- The sequence token is now ignored in @PutLogEvents@ actions.
-- @PutLogEvents@ actions are always accepted and never return
-- @InvalidSequenceTokenException@ or @DataAlreadyAcceptedException@ even
-- if the sequence token is not valid. You can use parallel @PutLogEvents@
-- actions on the same log stream.
--
-- The batch of events must satisfy the following constraints:
--
-- -   The maximum batch size is 1,048,576 bytes. This size is calculated
--     as the sum of all event messages in UTF-8, plus 26 bytes for each
--     log event.
--
-- -   None of the log events in the batch can be more than 2 hours in the
--     future.
--
-- -   None of the log events in the batch can be more than 14 days in the
--     past. Also, none of the log events can be from earlier than the
--     retention period of the log group.
--
-- -   The log events in the batch must be in chronological order by their
--     timestamp. The timestamp is the time that the event occurred,
--     expressed as the number of milliseconds after
--     @Jan 1, 1970 00:00:00 UTC@. (In Amazon Web Services Tools for
--     PowerShell and the Amazon Web Services SDK for .NET, the timestamp
--     is specified in .NET format: @yyyy-mm-ddThh:mm:ss@. For example,
--     @2017-09-15T13:45:30@.)
--
-- -   A batch of log events in a single request cannot span more than 24
--     hours. Otherwise, the operation fails.
--
-- -   The maximum number of log events in a batch is 10,000.
--
-- -   The quota of five requests per second per log stream has been
--     removed. Instead, @PutLogEvents@ actions are throttled based on a
--     per-second per-account quota. You can request an increase to the
--     per-second throttling quota by using the Service Quotas service.
--
-- If a call to @PutLogEvents@ returns \"UnrecognizedClientException\" the
-- most likely cause is a non-valid Amazon Web Services access key ID or
-- secret key.
module Amazonka.CloudWatchLogs.PutLogEvents
  ( -- * Creating a Request
    PutLogEvents (..),
    newPutLogEvents,

    -- * Request Lenses
    putLogEvents_sequenceToken,
    putLogEvents_logGroupName,
    putLogEvents_logStreamName,
    putLogEvents_logEvents,

    -- * Destructuring the Response
    PutLogEventsResponse (..),
    newPutLogEventsResponse,

    -- * Response Lenses
    putLogEventsResponse_nextSequenceToken,
    putLogEventsResponse_rejectedLogEventsInfo,
    putLogEventsResponse_httpStatus,
  )
where

import Amazonka.CloudWatchLogs.Types
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

-- | /See:/ 'newPutLogEvents' smart constructor.
data PutLogEvents = PutLogEvents'
  { -- | The sequence token obtained from the response of the previous
    -- @PutLogEvents@ call.
    --
    -- The @sequenceToken@ parameter is now ignored in @PutLogEvents@ actions.
    -- @PutLogEvents@ actions are now accepted and never return
    -- @InvalidSequenceTokenException@ or @DataAlreadyAcceptedException@ even
    -- if the sequence token is not valid.
    PutLogEvents -> Maybe Text
sequenceToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the log group.
    PutLogEvents -> Text
logGroupName :: Prelude.Text,
    -- | The name of the log stream.
    PutLogEvents -> Text
logStreamName :: Prelude.Text,
    -- | The log events.
    PutLogEvents -> NonEmpty InputLogEvent
logEvents :: Prelude.NonEmpty InputLogEvent
  }
  deriving (PutLogEvents -> PutLogEvents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutLogEvents -> PutLogEvents -> Bool
$c/= :: PutLogEvents -> PutLogEvents -> Bool
== :: PutLogEvents -> PutLogEvents -> Bool
$c== :: PutLogEvents -> PutLogEvents -> Bool
Prelude.Eq, ReadPrec [PutLogEvents]
ReadPrec PutLogEvents
Int -> ReadS PutLogEvents
ReadS [PutLogEvents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutLogEvents]
$creadListPrec :: ReadPrec [PutLogEvents]
readPrec :: ReadPrec PutLogEvents
$creadPrec :: ReadPrec PutLogEvents
readList :: ReadS [PutLogEvents]
$creadList :: ReadS [PutLogEvents]
readsPrec :: Int -> ReadS PutLogEvents
$creadsPrec :: Int -> ReadS PutLogEvents
Prelude.Read, Int -> PutLogEvents -> ShowS
[PutLogEvents] -> ShowS
PutLogEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutLogEvents] -> ShowS
$cshowList :: [PutLogEvents] -> ShowS
show :: PutLogEvents -> String
$cshow :: PutLogEvents -> String
showsPrec :: Int -> PutLogEvents -> ShowS
$cshowsPrec :: Int -> PutLogEvents -> ShowS
Prelude.Show, forall x. Rep PutLogEvents x -> PutLogEvents
forall x. PutLogEvents -> Rep PutLogEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutLogEvents x -> PutLogEvents
$cfrom :: forall x. PutLogEvents -> Rep PutLogEvents x
Prelude.Generic)

-- |
-- Create a value of 'PutLogEvents' 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:
--
-- 'sequenceToken', 'putLogEvents_sequenceToken' - The sequence token obtained from the response of the previous
-- @PutLogEvents@ call.
--
-- The @sequenceToken@ parameter is now ignored in @PutLogEvents@ actions.
-- @PutLogEvents@ actions are now accepted and never return
-- @InvalidSequenceTokenException@ or @DataAlreadyAcceptedException@ even
-- if the sequence token is not valid.
--
-- 'logGroupName', 'putLogEvents_logGroupName' - The name of the log group.
--
-- 'logStreamName', 'putLogEvents_logStreamName' - The name of the log stream.
--
-- 'logEvents', 'putLogEvents_logEvents' - The log events.
newPutLogEvents ::
  -- | 'logGroupName'
  Prelude.Text ->
  -- | 'logStreamName'
  Prelude.Text ->
  -- | 'logEvents'
  Prelude.NonEmpty InputLogEvent ->
  PutLogEvents
newPutLogEvents :: Text -> Text -> NonEmpty InputLogEvent -> PutLogEvents
newPutLogEvents
  Text
pLogGroupName_
  Text
pLogStreamName_
  NonEmpty InputLogEvent
pLogEvents_ =
    PutLogEvents'
      { $sel:sequenceToken:PutLogEvents' :: Maybe Text
sequenceToken = forall a. Maybe a
Prelude.Nothing,
        $sel:logGroupName:PutLogEvents' :: Text
logGroupName = Text
pLogGroupName_,
        $sel:logStreamName:PutLogEvents' :: Text
logStreamName = Text
pLogStreamName_,
        $sel:logEvents:PutLogEvents' :: NonEmpty InputLogEvent
logEvents = 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 InputLogEvent
pLogEvents_
      }

-- | The sequence token obtained from the response of the previous
-- @PutLogEvents@ call.
--
-- The @sequenceToken@ parameter is now ignored in @PutLogEvents@ actions.
-- @PutLogEvents@ actions are now accepted and never return
-- @InvalidSequenceTokenException@ or @DataAlreadyAcceptedException@ even
-- if the sequence token is not valid.
putLogEvents_sequenceToken :: Lens.Lens' PutLogEvents (Prelude.Maybe Prelude.Text)
putLogEvents_sequenceToken :: Lens' PutLogEvents (Maybe Text)
putLogEvents_sequenceToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutLogEvents' {Maybe Text
sequenceToken :: Maybe Text
$sel:sequenceToken:PutLogEvents' :: PutLogEvents -> Maybe Text
sequenceToken} -> Maybe Text
sequenceToken) (\s :: PutLogEvents
s@PutLogEvents' {} Maybe Text
a -> PutLogEvents
s {$sel:sequenceToken:PutLogEvents' :: Maybe Text
sequenceToken = Maybe Text
a} :: PutLogEvents)

-- | The name of the log group.
putLogEvents_logGroupName :: Lens.Lens' PutLogEvents Prelude.Text
putLogEvents_logGroupName :: Lens' PutLogEvents Text
putLogEvents_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutLogEvents' {Text
logGroupName :: Text
$sel:logGroupName:PutLogEvents' :: PutLogEvents -> Text
logGroupName} -> Text
logGroupName) (\s :: PutLogEvents
s@PutLogEvents' {} Text
a -> PutLogEvents
s {$sel:logGroupName:PutLogEvents' :: Text
logGroupName = Text
a} :: PutLogEvents)

-- | The name of the log stream.
putLogEvents_logStreamName :: Lens.Lens' PutLogEvents Prelude.Text
putLogEvents_logStreamName :: Lens' PutLogEvents Text
putLogEvents_logStreamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutLogEvents' {Text
logStreamName :: Text
$sel:logStreamName:PutLogEvents' :: PutLogEvents -> Text
logStreamName} -> Text
logStreamName) (\s :: PutLogEvents
s@PutLogEvents' {} Text
a -> PutLogEvents
s {$sel:logStreamName:PutLogEvents' :: Text
logStreamName = Text
a} :: PutLogEvents)

-- | The log events.
putLogEvents_logEvents :: Lens.Lens' PutLogEvents (Prelude.NonEmpty InputLogEvent)
putLogEvents_logEvents :: Lens' PutLogEvents (NonEmpty InputLogEvent)
putLogEvents_logEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutLogEvents' {NonEmpty InputLogEvent
logEvents :: NonEmpty InputLogEvent
$sel:logEvents:PutLogEvents' :: PutLogEvents -> NonEmpty InputLogEvent
logEvents} -> NonEmpty InputLogEvent
logEvents) (\s :: PutLogEvents
s@PutLogEvents' {} NonEmpty InputLogEvent
a -> PutLogEvents
s {$sel:logEvents:PutLogEvents' :: NonEmpty InputLogEvent
logEvents = NonEmpty InputLogEvent
a} :: PutLogEvents) 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 PutLogEvents where
  type AWSResponse PutLogEvents = PutLogEventsResponse
  request :: (Service -> Service) -> PutLogEvents -> Request PutLogEvents
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 PutLogEvents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutLogEvents)))
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
-> Maybe RejectedLogEventsInfo -> Int -> PutLogEventsResponse
PutLogEventsResponse'
            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
"nextSequenceToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"rejectedLogEventsInfo")
            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 PutLogEvents where
  hashWithSalt :: Int -> PutLogEvents -> Int
hashWithSalt Int
_salt PutLogEvents' {Maybe Text
NonEmpty InputLogEvent
Text
logEvents :: NonEmpty InputLogEvent
logStreamName :: Text
logGroupName :: Text
sequenceToken :: Maybe Text
$sel:logEvents:PutLogEvents' :: PutLogEvents -> NonEmpty InputLogEvent
$sel:logStreamName:PutLogEvents' :: PutLogEvents -> Text
$sel:logGroupName:PutLogEvents' :: PutLogEvents -> Text
$sel:sequenceToken:PutLogEvents' :: PutLogEvents -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sequenceToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logStreamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty InputLogEvent
logEvents

instance Prelude.NFData PutLogEvents where
  rnf :: PutLogEvents -> ()
rnf PutLogEvents' {Maybe Text
NonEmpty InputLogEvent
Text
logEvents :: NonEmpty InputLogEvent
logStreamName :: Text
logGroupName :: Text
sequenceToken :: Maybe Text
$sel:logEvents:PutLogEvents' :: PutLogEvents -> NonEmpty InputLogEvent
$sel:logStreamName:PutLogEvents' :: PutLogEvents -> Text
$sel:logGroupName:PutLogEvents' :: PutLogEvents -> Text
$sel:sequenceToken:PutLogEvents' :: PutLogEvents -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sequenceToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
logGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
logStreamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty InputLogEvent
logEvents

instance Data.ToHeaders PutLogEvents where
  toHeaders :: PutLogEvents -> 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
"Logs_20140328.PutLogEvents" :: 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 PutLogEvents where
  toJSON :: PutLogEvents -> Value
toJSON PutLogEvents' {Maybe Text
NonEmpty InputLogEvent
Text
logEvents :: NonEmpty InputLogEvent
logStreamName :: Text
logGroupName :: Text
sequenceToken :: Maybe Text
$sel:logEvents:PutLogEvents' :: PutLogEvents -> NonEmpty InputLogEvent
$sel:logStreamName:PutLogEvents' :: PutLogEvents -> Text
$sel:logGroupName:PutLogEvents' :: PutLogEvents -> Text
$sel:sequenceToken:PutLogEvents' :: PutLogEvents -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"sequenceToken" 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
sequenceToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"logGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
logGroupName),
            forall a. a -> Maybe a
Prelude.Just (Key
"logStreamName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
logStreamName),
            forall a. a -> Maybe a
Prelude.Just (Key
"logEvents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty InputLogEvent
logEvents)
          ]
      )

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

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

-- | /See:/ 'newPutLogEventsResponse' smart constructor.
data PutLogEventsResponse = PutLogEventsResponse'
  { -- | The next sequence token.
    --
    -- This field has been deprecated.
    --
    -- The sequence token is now ignored in @PutLogEvents@ actions.
    -- @PutLogEvents@ actions are always accepted even if the sequence token is
    -- not valid. You can use parallel @PutLogEvents@ actions on the same log
    -- stream and you do not need to wait for the response of a previous
    -- @PutLogEvents@ action to obtain the @nextSequenceToken@ value.
    PutLogEventsResponse -> Maybe Text
nextSequenceToken :: Prelude.Maybe Prelude.Text,
    -- | The rejected events.
    PutLogEventsResponse -> Maybe RejectedLogEventsInfo
rejectedLogEventsInfo :: Prelude.Maybe RejectedLogEventsInfo,
    -- | The response's http status code.
    PutLogEventsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutLogEventsResponse -> PutLogEventsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutLogEventsResponse -> PutLogEventsResponse -> Bool
$c/= :: PutLogEventsResponse -> PutLogEventsResponse -> Bool
== :: PutLogEventsResponse -> PutLogEventsResponse -> Bool
$c== :: PutLogEventsResponse -> PutLogEventsResponse -> Bool
Prelude.Eq, ReadPrec [PutLogEventsResponse]
ReadPrec PutLogEventsResponse
Int -> ReadS PutLogEventsResponse
ReadS [PutLogEventsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutLogEventsResponse]
$creadListPrec :: ReadPrec [PutLogEventsResponse]
readPrec :: ReadPrec PutLogEventsResponse
$creadPrec :: ReadPrec PutLogEventsResponse
readList :: ReadS [PutLogEventsResponse]
$creadList :: ReadS [PutLogEventsResponse]
readsPrec :: Int -> ReadS PutLogEventsResponse
$creadsPrec :: Int -> ReadS PutLogEventsResponse
Prelude.Read, Int -> PutLogEventsResponse -> ShowS
[PutLogEventsResponse] -> ShowS
PutLogEventsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutLogEventsResponse] -> ShowS
$cshowList :: [PutLogEventsResponse] -> ShowS
show :: PutLogEventsResponse -> String
$cshow :: PutLogEventsResponse -> String
showsPrec :: Int -> PutLogEventsResponse -> ShowS
$cshowsPrec :: Int -> PutLogEventsResponse -> ShowS
Prelude.Show, forall x. Rep PutLogEventsResponse x -> PutLogEventsResponse
forall x. PutLogEventsResponse -> Rep PutLogEventsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutLogEventsResponse x -> PutLogEventsResponse
$cfrom :: forall x. PutLogEventsResponse -> Rep PutLogEventsResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutLogEventsResponse' 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:
--
-- 'nextSequenceToken', 'putLogEventsResponse_nextSequenceToken' - The next sequence token.
--
-- This field has been deprecated.
--
-- The sequence token is now ignored in @PutLogEvents@ actions.
-- @PutLogEvents@ actions are always accepted even if the sequence token is
-- not valid. You can use parallel @PutLogEvents@ actions on the same log
-- stream and you do not need to wait for the response of a previous
-- @PutLogEvents@ action to obtain the @nextSequenceToken@ value.
--
-- 'rejectedLogEventsInfo', 'putLogEventsResponse_rejectedLogEventsInfo' - The rejected events.
--
-- 'httpStatus', 'putLogEventsResponse_httpStatus' - The response's http status code.
newPutLogEventsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutLogEventsResponse
newPutLogEventsResponse :: Int -> PutLogEventsResponse
newPutLogEventsResponse Int
pHttpStatus_ =
  PutLogEventsResponse'
    { $sel:nextSequenceToken:PutLogEventsResponse' :: Maybe Text
nextSequenceToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:rejectedLogEventsInfo:PutLogEventsResponse' :: Maybe RejectedLogEventsInfo
rejectedLogEventsInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutLogEventsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The next sequence token.
--
-- This field has been deprecated.
--
-- The sequence token is now ignored in @PutLogEvents@ actions.
-- @PutLogEvents@ actions are always accepted even if the sequence token is
-- not valid. You can use parallel @PutLogEvents@ actions on the same log
-- stream and you do not need to wait for the response of a previous
-- @PutLogEvents@ action to obtain the @nextSequenceToken@ value.
putLogEventsResponse_nextSequenceToken :: Lens.Lens' PutLogEventsResponse (Prelude.Maybe Prelude.Text)
putLogEventsResponse_nextSequenceToken :: Lens' PutLogEventsResponse (Maybe Text)
putLogEventsResponse_nextSequenceToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutLogEventsResponse' {Maybe Text
nextSequenceToken :: Maybe Text
$sel:nextSequenceToken:PutLogEventsResponse' :: PutLogEventsResponse -> Maybe Text
nextSequenceToken} -> Maybe Text
nextSequenceToken) (\s :: PutLogEventsResponse
s@PutLogEventsResponse' {} Maybe Text
a -> PutLogEventsResponse
s {$sel:nextSequenceToken:PutLogEventsResponse' :: Maybe Text
nextSequenceToken = Maybe Text
a} :: PutLogEventsResponse)

-- | The rejected events.
putLogEventsResponse_rejectedLogEventsInfo :: Lens.Lens' PutLogEventsResponse (Prelude.Maybe RejectedLogEventsInfo)
putLogEventsResponse_rejectedLogEventsInfo :: Lens' PutLogEventsResponse (Maybe RejectedLogEventsInfo)
putLogEventsResponse_rejectedLogEventsInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutLogEventsResponse' {Maybe RejectedLogEventsInfo
rejectedLogEventsInfo :: Maybe RejectedLogEventsInfo
$sel:rejectedLogEventsInfo:PutLogEventsResponse' :: PutLogEventsResponse -> Maybe RejectedLogEventsInfo
rejectedLogEventsInfo} -> Maybe RejectedLogEventsInfo
rejectedLogEventsInfo) (\s :: PutLogEventsResponse
s@PutLogEventsResponse' {} Maybe RejectedLogEventsInfo
a -> PutLogEventsResponse
s {$sel:rejectedLogEventsInfo:PutLogEventsResponse' :: Maybe RejectedLogEventsInfo
rejectedLogEventsInfo = Maybe RejectedLogEventsInfo
a} :: PutLogEventsResponse)

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

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