{-# 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.GetLogEvents
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists log events from the specified log stream. You can list all of the
-- log events or filter using a time range.
--
-- By default, this operation returns as many log events as can fit in a
-- response size of 1MB (up to 10,000 log events). You can get additional
-- log events by specifying one of the tokens in a subsequent call. This
-- operation can return empty results while there are more log events
-- available through the token.
--
-- If you are using CloudWatch cross-account observability, you can use
-- this operation in a monitoring account and view data from the linked
-- source accounts. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-Unified-Cross-Account.html CloudWatch cross-account observability>.
module Amazonka.CloudWatchLogs.GetLogEvents
  ( -- * Creating a Request
    GetLogEvents (..),
    newGetLogEvents,

    -- * Request Lenses
    getLogEvents_endTime,
    getLogEvents_limit,
    getLogEvents_logGroupIdentifier,
    getLogEvents_nextToken,
    getLogEvents_startFromHead,
    getLogEvents_startTime,
    getLogEvents_unmask,
    getLogEvents_logGroupName,
    getLogEvents_logStreamName,

    -- * Destructuring the Response
    GetLogEventsResponse (..),
    newGetLogEventsResponse,

    -- * Response Lenses
    getLogEventsResponse_events,
    getLogEventsResponse_nextBackwardToken,
    getLogEventsResponse_nextForwardToken,
    getLogEventsResponse_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:/ 'newGetLogEvents' smart constructor.
data GetLogEvents = GetLogEvents'
  { -- | The end of the time range, expressed as the number of milliseconds after
    -- @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp equal to or later
    -- than this time are not included.
    GetLogEvents -> Maybe Natural
endTime :: Prelude.Maybe Prelude.Natural,
    -- | The maximum number of log events returned. If you don\'t specify a
    -- limit, the default is as many log events as can fit in a response size
    -- of 1 MB (up to 10,000 log events).
    GetLogEvents -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | Specify either the name or ARN of the log group to view events from. If
    -- the log group is in a source account and you are using a monitoring
    -- account, you must use the log group ARN.
    --
    -- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
    -- the action returns an @InvalidParameterException@ error.
    GetLogEvents -> Maybe Text
logGroupIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The token for the next set of items to return. (You received this token
    -- from a previous call.)
    GetLogEvents -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | If the value is true, the earliest log events are returned first. If the
    -- value is false, the latest log events are returned first. The default
    -- value is false.
    --
    -- If you are using a previous @nextForwardToken@ value as the @nextToken@
    -- in this operation, you must specify @true@ for @startFromHead@.
    GetLogEvents -> Maybe Bool
startFromHead :: Prelude.Maybe Prelude.Bool,
    -- | The start of the time range, expressed as the number of milliseconds
    -- after @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp equal to this
    -- time or later than this time are included. Events with a timestamp
    -- earlier than this time are not included.
    GetLogEvents -> Maybe Natural
startTime :: Prelude.Maybe Prelude.Natural,
    -- | Specify @true@ to display the log event fields with all sensitive data
    -- unmasked and visible. The default is @false@.
    --
    -- To use this operation with this parameter, you must be signed into an
    -- account with the @logs:Unmask@ permission.
    GetLogEvents -> Maybe Bool
unmask :: Prelude.Maybe Prelude.Bool,
    -- | The name of the log group.
    --
    -- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
    -- the action returns an @InvalidParameterException@ error.
    GetLogEvents -> Text
logGroupName :: Prelude.Text,
    -- | The name of the log stream.
    GetLogEvents -> Text
logStreamName :: Prelude.Text
  }
  deriving (GetLogEvents -> GetLogEvents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLogEvents -> GetLogEvents -> Bool
$c/= :: GetLogEvents -> GetLogEvents -> Bool
== :: GetLogEvents -> GetLogEvents -> Bool
$c== :: GetLogEvents -> GetLogEvents -> Bool
Prelude.Eq, ReadPrec [GetLogEvents]
ReadPrec GetLogEvents
Int -> ReadS GetLogEvents
ReadS [GetLogEvents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLogEvents]
$creadListPrec :: ReadPrec [GetLogEvents]
readPrec :: ReadPrec GetLogEvents
$creadPrec :: ReadPrec GetLogEvents
readList :: ReadS [GetLogEvents]
$creadList :: ReadS [GetLogEvents]
readsPrec :: Int -> ReadS GetLogEvents
$creadsPrec :: Int -> ReadS GetLogEvents
Prelude.Read, Int -> GetLogEvents -> ShowS
[GetLogEvents] -> ShowS
GetLogEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLogEvents] -> ShowS
$cshowList :: [GetLogEvents] -> ShowS
show :: GetLogEvents -> String
$cshow :: GetLogEvents -> String
showsPrec :: Int -> GetLogEvents -> ShowS
$cshowsPrec :: Int -> GetLogEvents -> ShowS
Prelude.Show, forall x. Rep GetLogEvents x -> GetLogEvents
forall x. GetLogEvents -> Rep GetLogEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLogEvents x -> GetLogEvents
$cfrom :: forall x. GetLogEvents -> Rep GetLogEvents x
Prelude.Generic)

-- |
-- Create a value of 'GetLogEvents' 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:
--
-- 'endTime', 'getLogEvents_endTime' - The end of the time range, expressed as the number of milliseconds after
-- @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp equal to or later
-- than this time are not included.
--
-- 'limit', 'getLogEvents_limit' - The maximum number of log events returned. If you don\'t specify a
-- limit, the default is as many log events as can fit in a response size
-- of 1 MB (up to 10,000 log events).
--
-- 'logGroupIdentifier', 'getLogEvents_logGroupIdentifier' - Specify either the name or ARN of the log group to view events from. If
-- the log group is in a source account and you are using a monitoring
-- account, you must use the log group ARN.
--
-- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
-- the action returns an @InvalidParameterException@ error.
--
-- 'nextToken', 'getLogEvents_nextToken' - The token for the next set of items to return. (You received this token
-- from a previous call.)
--
-- 'startFromHead', 'getLogEvents_startFromHead' - If the value is true, the earliest log events are returned first. If the
-- value is false, the latest log events are returned first. The default
-- value is false.
--
-- If you are using a previous @nextForwardToken@ value as the @nextToken@
-- in this operation, you must specify @true@ for @startFromHead@.
--
-- 'startTime', 'getLogEvents_startTime' - The start of the time range, expressed as the number of milliseconds
-- after @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp equal to this
-- time or later than this time are included. Events with a timestamp
-- earlier than this time are not included.
--
-- 'unmask', 'getLogEvents_unmask' - Specify @true@ to display the log event fields with all sensitive data
-- unmasked and visible. The default is @false@.
--
-- To use this operation with this parameter, you must be signed into an
-- account with the @logs:Unmask@ permission.
--
-- 'logGroupName', 'getLogEvents_logGroupName' - The name of the log group.
--
-- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
-- the action returns an @InvalidParameterException@ error.
--
-- 'logStreamName', 'getLogEvents_logStreamName' - The name of the log stream.
newGetLogEvents ::
  -- | 'logGroupName'
  Prelude.Text ->
  -- | 'logStreamName'
  Prelude.Text ->
  GetLogEvents
newGetLogEvents :: Text -> Text -> GetLogEvents
newGetLogEvents Text
pLogGroupName_ Text
pLogStreamName_ =
  GetLogEvents'
    { $sel:endTime:GetLogEvents' :: Maybe Natural
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:GetLogEvents' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupIdentifier:GetLogEvents' :: Maybe Text
logGroupIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetLogEvents' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startFromHead:GetLogEvents' :: Maybe Bool
startFromHead = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:GetLogEvents' :: Maybe Natural
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:unmask:GetLogEvents' :: Maybe Bool
unmask = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupName:GetLogEvents' :: Text
logGroupName = Text
pLogGroupName_,
      $sel:logStreamName:GetLogEvents' :: Text
logStreamName = Text
pLogStreamName_
    }

-- | The end of the time range, expressed as the number of milliseconds after
-- @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp equal to or later
-- than this time are not included.
getLogEvents_endTime :: Lens.Lens' GetLogEvents (Prelude.Maybe Prelude.Natural)
getLogEvents_endTime :: Lens' GetLogEvents (Maybe Natural)
getLogEvents_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Maybe Natural
endTime :: Maybe Natural
$sel:endTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
endTime} -> Maybe Natural
endTime) (\s :: GetLogEvents
s@GetLogEvents' {} Maybe Natural
a -> GetLogEvents
s {$sel:endTime:GetLogEvents' :: Maybe Natural
endTime = Maybe Natural
a} :: GetLogEvents)

-- | The maximum number of log events returned. If you don\'t specify a
-- limit, the default is as many log events as can fit in a response size
-- of 1 MB (up to 10,000 log events).
getLogEvents_limit :: Lens.Lens' GetLogEvents (Prelude.Maybe Prelude.Natural)
getLogEvents_limit :: Lens' GetLogEvents (Maybe Natural)
getLogEvents_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Maybe Natural
limit :: Maybe Natural
$sel:limit:GetLogEvents' :: GetLogEvents -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: GetLogEvents
s@GetLogEvents' {} Maybe Natural
a -> GetLogEvents
s {$sel:limit:GetLogEvents' :: Maybe Natural
limit = Maybe Natural
a} :: GetLogEvents)

-- | Specify either the name or ARN of the log group to view events from. If
-- the log group is in a source account and you are using a monitoring
-- account, you must use the log group ARN.
--
-- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
-- the action returns an @InvalidParameterException@ error.
getLogEvents_logGroupIdentifier :: Lens.Lens' GetLogEvents (Prelude.Maybe Prelude.Text)
getLogEvents_logGroupIdentifier :: Lens' GetLogEvents (Maybe Text)
getLogEvents_logGroupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Maybe Text
logGroupIdentifier :: Maybe Text
$sel:logGroupIdentifier:GetLogEvents' :: GetLogEvents -> Maybe Text
logGroupIdentifier} -> Maybe Text
logGroupIdentifier) (\s :: GetLogEvents
s@GetLogEvents' {} Maybe Text
a -> GetLogEvents
s {$sel:logGroupIdentifier:GetLogEvents' :: Maybe Text
logGroupIdentifier = Maybe Text
a} :: GetLogEvents)

-- | The token for the next set of items to return. (You received this token
-- from a previous call.)
getLogEvents_nextToken :: Lens.Lens' GetLogEvents (Prelude.Maybe Prelude.Text)
getLogEvents_nextToken :: Lens' GetLogEvents (Maybe Text)
getLogEvents_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetLogEvents' :: GetLogEvents -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetLogEvents
s@GetLogEvents' {} Maybe Text
a -> GetLogEvents
s {$sel:nextToken:GetLogEvents' :: Maybe Text
nextToken = Maybe Text
a} :: GetLogEvents)

-- | If the value is true, the earliest log events are returned first. If the
-- value is false, the latest log events are returned first. The default
-- value is false.
--
-- If you are using a previous @nextForwardToken@ value as the @nextToken@
-- in this operation, you must specify @true@ for @startFromHead@.
getLogEvents_startFromHead :: Lens.Lens' GetLogEvents (Prelude.Maybe Prelude.Bool)
getLogEvents_startFromHead :: Lens' GetLogEvents (Maybe Bool)
getLogEvents_startFromHead = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Maybe Bool
startFromHead :: Maybe Bool
$sel:startFromHead:GetLogEvents' :: GetLogEvents -> Maybe Bool
startFromHead} -> Maybe Bool
startFromHead) (\s :: GetLogEvents
s@GetLogEvents' {} Maybe Bool
a -> GetLogEvents
s {$sel:startFromHead:GetLogEvents' :: Maybe Bool
startFromHead = Maybe Bool
a} :: GetLogEvents)

-- | The start of the time range, expressed as the number of milliseconds
-- after @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp equal to this
-- time or later than this time are included. Events with a timestamp
-- earlier than this time are not included.
getLogEvents_startTime :: Lens.Lens' GetLogEvents (Prelude.Maybe Prelude.Natural)
getLogEvents_startTime :: Lens' GetLogEvents (Maybe Natural)
getLogEvents_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Maybe Natural
startTime :: Maybe Natural
$sel:startTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
startTime} -> Maybe Natural
startTime) (\s :: GetLogEvents
s@GetLogEvents' {} Maybe Natural
a -> GetLogEvents
s {$sel:startTime:GetLogEvents' :: Maybe Natural
startTime = Maybe Natural
a} :: GetLogEvents)

-- | Specify @true@ to display the log event fields with all sensitive data
-- unmasked and visible. The default is @false@.
--
-- To use this operation with this parameter, you must be signed into an
-- account with the @logs:Unmask@ permission.
getLogEvents_unmask :: Lens.Lens' GetLogEvents (Prelude.Maybe Prelude.Bool)
getLogEvents_unmask :: Lens' GetLogEvents (Maybe Bool)
getLogEvents_unmask = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Maybe Bool
unmask :: Maybe Bool
$sel:unmask:GetLogEvents' :: GetLogEvents -> Maybe Bool
unmask} -> Maybe Bool
unmask) (\s :: GetLogEvents
s@GetLogEvents' {} Maybe Bool
a -> GetLogEvents
s {$sel:unmask:GetLogEvents' :: Maybe Bool
unmask = Maybe Bool
a} :: GetLogEvents)

-- | The name of the log group.
--
-- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
-- the action returns an @InvalidParameterException@ error.
getLogEvents_logGroupName :: Lens.Lens' GetLogEvents Prelude.Text
getLogEvents_logGroupName :: Lens' GetLogEvents Text
getLogEvents_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEvents' {Text
logGroupName :: Text
$sel:logGroupName:GetLogEvents' :: GetLogEvents -> Text
logGroupName} -> Text
logGroupName) (\s :: GetLogEvents
s@GetLogEvents' {} Text
a -> GetLogEvents
s {$sel:logGroupName:GetLogEvents' :: Text
logGroupName = Text
a} :: GetLogEvents)

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

instance Core.AWSRequest GetLogEvents where
  type AWSResponse GetLogEvents = GetLogEventsResponse
  request :: (Service -> Service) -> GetLogEvents -> Request GetLogEvents
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 GetLogEvents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetLogEvents)))
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 [OutputLogEvent]
-> Maybe Text -> Maybe Text -> Int -> GetLogEventsResponse
GetLogEventsResponse'
            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
"events" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"nextBackwardToken")
            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
"nextForwardToken")
            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 GetLogEvents where
  hashWithSalt :: Int -> GetLogEvents -> Int
hashWithSalt Int
_salt GetLogEvents' {Maybe Bool
Maybe Natural
Maybe Text
Text
logStreamName :: Text
logGroupName :: Text
unmask :: Maybe Bool
startTime :: Maybe Natural
startFromHead :: Maybe Bool
nextToken :: Maybe Text
logGroupIdentifier :: Maybe Text
limit :: Maybe Natural
endTime :: Maybe Natural
$sel:logStreamName:GetLogEvents' :: GetLogEvents -> Text
$sel:logGroupName:GetLogEvents' :: GetLogEvents -> Text
$sel:unmask:GetLogEvents' :: GetLogEvents -> Maybe Bool
$sel:startTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
$sel:startFromHead:GetLogEvents' :: GetLogEvents -> Maybe Bool
$sel:nextToken:GetLogEvents' :: GetLogEvents -> Maybe Text
$sel:logGroupIdentifier:GetLogEvents' :: GetLogEvents -> Maybe Text
$sel:limit:GetLogEvents' :: GetLogEvents -> Maybe Natural
$sel:endTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logGroupIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
startFromHead
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
unmask
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logStreamName

instance Prelude.NFData GetLogEvents where
  rnf :: GetLogEvents -> ()
rnf GetLogEvents' {Maybe Bool
Maybe Natural
Maybe Text
Text
logStreamName :: Text
logGroupName :: Text
unmask :: Maybe Bool
startTime :: Maybe Natural
startFromHead :: Maybe Bool
nextToken :: Maybe Text
logGroupIdentifier :: Maybe Text
limit :: Maybe Natural
endTime :: Maybe Natural
$sel:logStreamName:GetLogEvents' :: GetLogEvents -> Text
$sel:logGroupName:GetLogEvents' :: GetLogEvents -> Text
$sel:unmask:GetLogEvents' :: GetLogEvents -> Maybe Bool
$sel:startTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
$sel:startFromHead:GetLogEvents' :: GetLogEvents -> Maybe Bool
$sel:nextToken:GetLogEvents' :: GetLogEvents -> Maybe Text
$sel:logGroupIdentifier:GetLogEvents' :: GetLogEvents -> Maybe Text
$sel:limit:GetLogEvents' :: GetLogEvents -> Maybe Natural
$sel:endTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logGroupIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
startFromHead
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
unmask
      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

instance Data.ToHeaders GetLogEvents where
  toHeaders :: GetLogEvents -> 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.GetLogEvents" :: 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 GetLogEvents where
  toJSON :: GetLogEvents -> Value
toJSON GetLogEvents' {Maybe Bool
Maybe Natural
Maybe Text
Text
logStreamName :: Text
logGroupName :: Text
unmask :: Maybe Bool
startTime :: Maybe Natural
startFromHead :: Maybe Bool
nextToken :: Maybe Text
logGroupIdentifier :: Maybe Text
limit :: Maybe Natural
endTime :: Maybe Natural
$sel:logStreamName:GetLogEvents' :: GetLogEvents -> Text
$sel:logGroupName:GetLogEvents' :: GetLogEvents -> Text
$sel:unmask:GetLogEvents' :: GetLogEvents -> Maybe Bool
$sel:startTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
$sel:startFromHead:GetLogEvents' :: GetLogEvents -> Maybe Bool
$sel:nextToken:GetLogEvents' :: GetLogEvents -> Maybe Text
$sel:logGroupIdentifier:GetLogEvents' :: GetLogEvents -> Maybe Text
$sel:limit:GetLogEvents' :: GetLogEvents -> Maybe Natural
$sel:endTime:GetLogEvents' :: GetLogEvents -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"endTime" 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 Natural
endTime,
            (Key
"limit" 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 Natural
limit,
            (Key
"logGroupIdentifier" 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
logGroupIdentifier,
            (Key
"nextToken" 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
nextToken,
            (Key
"startFromHead" 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 Bool
startFromHead,
            (Key
"startTime" 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 Natural
startTime,
            (Key
"unmask" 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 Bool
unmask,
            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)
          ]
      )

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

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

-- | /See:/ 'newGetLogEventsResponse' smart constructor.
data GetLogEventsResponse = GetLogEventsResponse'
  { -- | The events.
    GetLogEventsResponse -> Maybe [OutputLogEvent]
events :: Prelude.Maybe [OutputLogEvent],
    -- | The token for the next set of items in the backward direction. The token
    -- expires after 24 hours. This token is not null. If you have reached the
    -- end of the stream, it returns the same token you passed in.
    GetLogEventsResponse -> Maybe Text
nextBackwardToken :: Prelude.Maybe Prelude.Text,
    -- | The token for the next set of items in the forward direction. The token
    -- expires after 24 hours. If you have reached the end of the stream, it
    -- returns the same token you passed in.
    GetLogEventsResponse -> Maybe Text
nextForwardToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetLogEventsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetLogEventsResponse -> GetLogEventsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLogEventsResponse -> GetLogEventsResponse -> Bool
$c/= :: GetLogEventsResponse -> GetLogEventsResponse -> Bool
== :: GetLogEventsResponse -> GetLogEventsResponse -> Bool
$c== :: GetLogEventsResponse -> GetLogEventsResponse -> Bool
Prelude.Eq, ReadPrec [GetLogEventsResponse]
ReadPrec GetLogEventsResponse
Int -> ReadS GetLogEventsResponse
ReadS [GetLogEventsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLogEventsResponse]
$creadListPrec :: ReadPrec [GetLogEventsResponse]
readPrec :: ReadPrec GetLogEventsResponse
$creadPrec :: ReadPrec GetLogEventsResponse
readList :: ReadS [GetLogEventsResponse]
$creadList :: ReadS [GetLogEventsResponse]
readsPrec :: Int -> ReadS GetLogEventsResponse
$creadsPrec :: Int -> ReadS GetLogEventsResponse
Prelude.Read, Int -> GetLogEventsResponse -> ShowS
[GetLogEventsResponse] -> ShowS
GetLogEventsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLogEventsResponse] -> ShowS
$cshowList :: [GetLogEventsResponse] -> ShowS
show :: GetLogEventsResponse -> String
$cshow :: GetLogEventsResponse -> String
showsPrec :: Int -> GetLogEventsResponse -> ShowS
$cshowsPrec :: Int -> GetLogEventsResponse -> ShowS
Prelude.Show, forall x. Rep GetLogEventsResponse x -> GetLogEventsResponse
forall x. GetLogEventsResponse -> Rep GetLogEventsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLogEventsResponse x -> GetLogEventsResponse
$cfrom :: forall x. GetLogEventsResponse -> Rep GetLogEventsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetLogEventsResponse' 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:
--
-- 'events', 'getLogEventsResponse_events' - The events.
--
-- 'nextBackwardToken', 'getLogEventsResponse_nextBackwardToken' - The token for the next set of items in the backward direction. The token
-- expires after 24 hours. This token is not null. If you have reached the
-- end of the stream, it returns the same token you passed in.
--
-- 'nextForwardToken', 'getLogEventsResponse_nextForwardToken' - The token for the next set of items in the forward direction. The token
-- expires after 24 hours. If you have reached the end of the stream, it
-- returns the same token you passed in.
--
-- 'httpStatus', 'getLogEventsResponse_httpStatus' - The response's http status code.
newGetLogEventsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLogEventsResponse
newGetLogEventsResponse :: Int -> GetLogEventsResponse
newGetLogEventsResponse Int
pHttpStatus_ =
  GetLogEventsResponse'
    { $sel:events:GetLogEventsResponse' :: Maybe [OutputLogEvent]
events = forall a. Maybe a
Prelude.Nothing,
      $sel:nextBackwardToken:GetLogEventsResponse' :: Maybe Text
nextBackwardToken = forall a. Maybe a
Prelude.Nothing,
      $sel:nextForwardToken:GetLogEventsResponse' :: Maybe Text
nextForwardToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLogEventsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The events.
getLogEventsResponse_events :: Lens.Lens' GetLogEventsResponse (Prelude.Maybe [OutputLogEvent])
getLogEventsResponse_events :: Lens' GetLogEventsResponse (Maybe [OutputLogEvent])
getLogEventsResponse_events = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEventsResponse' {Maybe [OutputLogEvent]
events :: Maybe [OutputLogEvent]
$sel:events:GetLogEventsResponse' :: GetLogEventsResponse -> Maybe [OutputLogEvent]
events} -> Maybe [OutputLogEvent]
events) (\s :: GetLogEventsResponse
s@GetLogEventsResponse' {} Maybe [OutputLogEvent]
a -> GetLogEventsResponse
s {$sel:events:GetLogEventsResponse' :: Maybe [OutputLogEvent]
events = Maybe [OutputLogEvent]
a} :: GetLogEventsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The token for the next set of items in the backward direction. The token
-- expires after 24 hours. This token is not null. If you have reached the
-- end of the stream, it returns the same token you passed in.
getLogEventsResponse_nextBackwardToken :: Lens.Lens' GetLogEventsResponse (Prelude.Maybe Prelude.Text)
getLogEventsResponse_nextBackwardToken :: Lens' GetLogEventsResponse (Maybe Text)
getLogEventsResponse_nextBackwardToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEventsResponse' {Maybe Text
nextBackwardToken :: Maybe Text
$sel:nextBackwardToken:GetLogEventsResponse' :: GetLogEventsResponse -> Maybe Text
nextBackwardToken} -> Maybe Text
nextBackwardToken) (\s :: GetLogEventsResponse
s@GetLogEventsResponse' {} Maybe Text
a -> GetLogEventsResponse
s {$sel:nextBackwardToken:GetLogEventsResponse' :: Maybe Text
nextBackwardToken = Maybe Text
a} :: GetLogEventsResponse)

-- | The token for the next set of items in the forward direction. The token
-- expires after 24 hours. If you have reached the end of the stream, it
-- returns the same token you passed in.
getLogEventsResponse_nextForwardToken :: Lens.Lens' GetLogEventsResponse (Prelude.Maybe Prelude.Text)
getLogEventsResponse_nextForwardToken :: Lens' GetLogEventsResponse (Maybe Text)
getLogEventsResponse_nextForwardToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogEventsResponse' {Maybe Text
nextForwardToken :: Maybe Text
$sel:nextForwardToken:GetLogEventsResponse' :: GetLogEventsResponse -> Maybe Text
nextForwardToken} -> Maybe Text
nextForwardToken) (\s :: GetLogEventsResponse
s@GetLogEventsResponse' {} Maybe Text
a -> GetLogEventsResponse
s {$sel:nextForwardToken:GetLogEventsResponse' :: Maybe Text
nextForwardToken = Maybe Text
a} :: GetLogEventsResponse)

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

instance Prelude.NFData GetLogEventsResponse where
  rnf :: GetLogEventsResponse -> ()
rnf GetLogEventsResponse' {Int
Maybe [OutputLogEvent]
Maybe Text
httpStatus :: Int
nextForwardToken :: Maybe Text
nextBackwardToken :: Maybe Text
events :: Maybe [OutputLogEvent]
$sel:httpStatus:GetLogEventsResponse' :: GetLogEventsResponse -> Int
$sel:nextForwardToken:GetLogEventsResponse' :: GetLogEventsResponse -> Maybe Text
$sel:nextBackwardToken:GetLogEventsResponse' :: GetLogEventsResponse -> Maybe Text
$sel:events:GetLogEventsResponse' :: GetLogEventsResponse -> Maybe [OutputLogEvent]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [OutputLogEvent]
events
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextBackwardToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextForwardToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus