{-# 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.FilterLogEvents
-- 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 group. You can list all the log
-- events or filter the results using a filter pattern, a time range, and
-- the name of the log stream.
--
-- You must have the @logs;FilterLogEvents@ permission to perform this
-- operation.
--
-- By default, this operation returns as many log events as can fit in 1 MB
-- (up to 10,000 log events) or all the events found within the specified
-- time range. If the results include a token, that means there are more
-- log events available. You can get additional results by specifying the
-- token in a subsequent call. This operation can return empty results
-- while there are more log events available through the token.
--
-- The returned log events are sorted by event timestamp, the timestamp
-- when the event was ingested by CloudWatch Logs, and the ID of the
-- @PutLogEvents@ request.
--
-- 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>.
--
-- This operation returns paginated results.
module Amazonka.CloudWatchLogs.FilterLogEvents
  ( -- * Creating a Request
    FilterLogEvents (..),
    newFilterLogEvents,

    -- * Request Lenses
    filterLogEvents_endTime,
    filterLogEvents_filterPattern,
    filterLogEvents_interleaved,
    filterLogEvents_limit,
    filterLogEvents_logGroupIdentifier,
    filterLogEvents_logStreamNamePrefix,
    filterLogEvents_logStreamNames,
    filterLogEvents_nextToken,
    filterLogEvents_startTime,
    filterLogEvents_unmask,
    filterLogEvents_logGroupName,

    -- * Destructuring the Response
    FilterLogEventsResponse (..),
    newFilterLogEventsResponse,

    -- * Response Lenses
    filterLogEventsResponse_events,
    filterLogEventsResponse_nextToken,
    filterLogEventsResponse_searchedLogStreams,
    filterLogEventsResponse_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:/ 'newFilterLogEvents' smart constructor.
data FilterLogEvents = FilterLogEvents'
  { -- | The end of the time range, expressed as the number of milliseconds after
    -- @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp later than this time
    -- are not returned.
    FilterLogEvents -> Maybe Natural
endTime :: Prelude.Maybe Prelude.Natural,
    -- | The filter pattern to use. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/logs/FilterAndPatternSyntax.html Filter and Pattern Syntax>.
    --
    -- If not provided, all the events are matched.
    FilterLogEvents -> Maybe Text
filterPattern :: Prelude.Maybe Prelude.Text,
    -- | If the value is true, the operation attempts to provide responses that
    -- contain events from multiple log streams within the log group,
    -- interleaved in a single response. If the value is false, all the matched
    -- log events in the first log stream are searched first, then those in the
    -- next log stream, and so on.
    --
    -- __Important__ As of June 17, 2019, this parameter is ignored and the
    -- value is assumed to be true. The response from this operation always
    -- interleaves events from multiple log streams within a log group.
    FilterLogEvents -> Maybe Bool
interleaved :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of events to return. The default is 10,000 events.
    FilterLogEvents -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | Specify either the name or ARN of the log group to view log 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.
    FilterLogEvents -> Maybe Text
logGroupIdentifier :: Prelude.Maybe Prelude.Text,
    -- | Filters the results to include only events from log streams that have
    -- names starting with this prefix.
    --
    -- If you specify a value for both @logStreamNamePrefix@ and
    -- @logStreamNames@, but the value for @logStreamNamePrefix@ does not match
    -- any log stream names specified in @logStreamNames@, the action returns
    -- an @InvalidParameterException@ error.
    FilterLogEvents -> Maybe Text
logStreamNamePrefix :: Prelude.Maybe Prelude.Text,
    -- | Filters the results to only logs from the log streams in this list.
    --
    -- If you specify a value for both @logStreamNamePrefix@ and
    -- @logStreamNames@, the action returns an @InvalidParameterException@
    -- error.
    FilterLogEvents -> Maybe (NonEmpty Text)
logStreamNames :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The token for the next set of events to return. (You received this token
    -- from a previous call.)
    FilterLogEvents -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The start of the time range, expressed as the number of milliseconds
    -- after @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp before this
    -- time are not returned.
    FilterLogEvents -> 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.
    FilterLogEvents -> Maybe Bool
unmask :: Prelude.Maybe Prelude.Bool,
    -- | The name of the log group to search.
    --
    -- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
    -- the action returns an @InvalidParameterException@ error.
    FilterLogEvents -> Text
logGroupName :: Prelude.Text
  }
  deriving (FilterLogEvents -> FilterLogEvents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterLogEvents -> FilterLogEvents -> Bool
$c/= :: FilterLogEvents -> FilterLogEvents -> Bool
== :: FilterLogEvents -> FilterLogEvents -> Bool
$c== :: FilterLogEvents -> FilterLogEvents -> Bool
Prelude.Eq, ReadPrec [FilterLogEvents]
ReadPrec FilterLogEvents
Int -> ReadS FilterLogEvents
ReadS [FilterLogEvents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilterLogEvents]
$creadListPrec :: ReadPrec [FilterLogEvents]
readPrec :: ReadPrec FilterLogEvents
$creadPrec :: ReadPrec FilterLogEvents
readList :: ReadS [FilterLogEvents]
$creadList :: ReadS [FilterLogEvents]
readsPrec :: Int -> ReadS FilterLogEvents
$creadsPrec :: Int -> ReadS FilterLogEvents
Prelude.Read, Int -> FilterLogEvents -> ShowS
[FilterLogEvents] -> ShowS
FilterLogEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterLogEvents] -> ShowS
$cshowList :: [FilterLogEvents] -> ShowS
show :: FilterLogEvents -> String
$cshow :: FilterLogEvents -> String
showsPrec :: Int -> FilterLogEvents -> ShowS
$cshowsPrec :: Int -> FilterLogEvents -> ShowS
Prelude.Show, forall x. Rep FilterLogEvents x -> FilterLogEvents
forall x. FilterLogEvents -> Rep FilterLogEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterLogEvents x -> FilterLogEvents
$cfrom :: forall x. FilterLogEvents -> Rep FilterLogEvents x
Prelude.Generic)

-- |
-- Create a value of 'FilterLogEvents' 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', 'filterLogEvents_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 later than this time
-- are not returned.
--
-- 'filterPattern', 'filterLogEvents_filterPattern' - The filter pattern to use. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/logs/FilterAndPatternSyntax.html Filter and Pattern Syntax>.
--
-- If not provided, all the events are matched.
--
-- 'interleaved', 'filterLogEvents_interleaved' - If the value is true, the operation attempts to provide responses that
-- contain events from multiple log streams within the log group,
-- interleaved in a single response. If the value is false, all the matched
-- log events in the first log stream are searched first, then those in the
-- next log stream, and so on.
--
-- __Important__ As of June 17, 2019, this parameter is ignored and the
-- value is assumed to be true. The response from this operation always
-- interleaves events from multiple log streams within a log group.
--
-- 'limit', 'filterLogEvents_limit' - The maximum number of events to return. The default is 10,000 events.
--
-- 'logGroupIdentifier', 'filterLogEvents_logGroupIdentifier' - Specify either the name or ARN of the log group to view log 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.
--
-- 'logStreamNamePrefix', 'filterLogEvents_logStreamNamePrefix' - Filters the results to include only events from log streams that have
-- names starting with this prefix.
--
-- If you specify a value for both @logStreamNamePrefix@ and
-- @logStreamNames@, but the value for @logStreamNamePrefix@ does not match
-- any log stream names specified in @logStreamNames@, the action returns
-- an @InvalidParameterException@ error.
--
-- 'logStreamNames', 'filterLogEvents_logStreamNames' - Filters the results to only logs from the log streams in this list.
--
-- If you specify a value for both @logStreamNamePrefix@ and
-- @logStreamNames@, the action returns an @InvalidParameterException@
-- error.
--
-- 'nextToken', 'filterLogEvents_nextToken' - The token for the next set of events to return. (You received this token
-- from a previous call.)
--
-- 'startTime', 'filterLogEvents_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 before this
-- time are not returned.
--
-- 'unmask', 'filterLogEvents_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', 'filterLogEvents_logGroupName' - The name of the log group to search.
--
-- If you specify values for both @logGroupName@ and @logGroupIdentifier@,
-- the action returns an @InvalidParameterException@ error.
newFilterLogEvents ::
  -- | 'logGroupName'
  Prelude.Text ->
  FilterLogEvents
newFilterLogEvents :: Text -> FilterLogEvents
newFilterLogEvents Text
pLogGroupName_ =
  FilterLogEvents'
    { $sel:endTime:FilterLogEvents' :: Maybe Natural
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:filterPattern:FilterLogEvents' :: Maybe Text
filterPattern = forall a. Maybe a
Prelude.Nothing,
      $sel:interleaved:FilterLogEvents' :: Maybe Bool
interleaved = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:FilterLogEvents' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupIdentifier:FilterLogEvents' :: Maybe Text
logGroupIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:logStreamNamePrefix:FilterLogEvents' :: Maybe Text
logStreamNamePrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:logStreamNames:FilterLogEvents' :: Maybe (NonEmpty Text)
logStreamNames = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:FilterLogEvents' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:FilterLogEvents' :: Maybe Natural
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:unmask:FilterLogEvents' :: Maybe Bool
unmask = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupName:FilterLogEvents' :: Text
logGroupName = Text
pLogGroupName_
    }

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

-- | The filter pattern to use. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/logs/FilterAndPatternSyntax.html Filter and Pattern Syntax>.
--
-- If not provided, all the events are matched.
filterLogEvents_filterPattern :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Text)
filterLogEvents_filterPattern :: Lens' FilterLogEvents (Maybe Text)
filterLogEvents_filterPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Text
filterPattern :: Maybe Text
$sel:filterPattern:FilterLogEvents' :: FilterLogEvents -> Maybe Text
filterPattern} -> Maybe Text
filterPattern) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Text
a -> FilterLogEvents
s {$sel:filterPattern:FilterLogEvents' :: Maybe Text
filterPattern = Maybe Text
a} :: FilterLogEvents)

-- | If the value is true, the operation attempts to provide responses that
-- contain events from multiple log streams within the log group,
-- interleaved in a single response. If the value is false, all the matched
-- log events in the first log stream are searched first, then those in the
-- next log stream, and so on.
--
-- __Important__ As of June 17, 2019, this parameter is ignored and the
-- value is assumed to be true. The response from this operation always
-- interleaves events from multiple log streams within a log group.
filterLogEvents_interleaved :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Bool)
filterLogEvents_interleaved :: Lens' FilterLogEvents (Maybe Bool)
filterLogEvents_interleaved = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Bool
interleaved :: Maybe Bool
$sel:interleaved:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
interleaved} -> Maybe Bool
interleaved) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Bool
a -> FilterLogEvents
s {$sel:interleaved:FilterLogEvents' :: Maybe Bool
interleaved = Maybe Bool
a} :: FilterLogEvents)

-- | The maximum number of events to return. The default is 10,000 events.
filterLogEvents_limit :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Natural)
filterLogEvents_limit :: Lens' FilterLogEvents (Maybe Natural)
filterLogEvents_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Natural
limit :: Maybe Natural
$sel:limit:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Natural
a -> FilterLogEvents
s {$sel:limit:FilterLogEvents' :: Maybe Natural
limit = Maybe Natural
a} :: FilterLogEvents)

-- | Specify either the name or ARN of the log group to view log 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.
filterLogEvents_logGroupIdentifier :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Text)
filterLogEvents_logGroupIdentifier :: Lens' FilterLogEvents (Maybe Text)
filterLogEvents_logGroupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Text
logGroupIdentifier :: Maybe Text
$sel:logGroupIdentifier:FilterLogEvents' :: FilterLogEvents -> Maybe Text
logGroupIdentifier} -> Maybe Text
logGroupIdentifier) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Text
a -> FilterLogEvents
s {$sel:logGroupIdentifier:FilterLogEvents' :: Maybe Text
logGroupIdentifier = Maybe Text
a} :: FilterLogEvents)

-- | Filters the results to include only events from log streams that have
-- names starting with this prefix.
--
-- If you specify a value for both @logStreamNamePrefix@ and
-- @logStreamNames@, but the value for @logStreamNamePrefix@ does not match
-- any log stream names specified in @logStreamNames@, the action returns
-- an @InvalidParameterException@ error.
filterLogEvents_logStreamNamePrefix :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Text)
filterLogEvents_logStreamNamePrefix :: Lens' FilterLogEvents (Maybe Text)
filterLogEvents_logStreamNamePrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Text
logStreamNamePrefix :: Maybe Text
$sel:logStreamNamePrefix:FilterLogEvents' :: FilterLogEvents -> Maybe Text
logStreamNamePrefix} -> Maybe Text
logStreamNamePrefix) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Text
a -> FilterLogEvents
s {$sel:logStreamNamePrefix:FilterLogEvents' :: Maybe Text
logStreamNamePrefix = Maybe Text
a} :: FilterLogEvents)

-- | Filters the results to only logs from the log streams in this list.
--
-- If you specify a value for both @logStreamNamePrefix@ and
-- @logStreamNames@, the action returns an @InvalidParameterException@
-- error.
filterLogEvents_logStreamNames :: Lens.Lens' FilterLogEvents (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
filterLogEvents_logStreamNames :: Lens' FilterLogEvents (Maybe (NonEmpty Text))
filterLogEvents_logStreamNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe (NonEmpty Text)
logStreamNames :: Maybe (NonEmpty Text)
$sel:logStreamNames:FilterLogEvents' :: FilterLogEvents -> Maybe (NonEmpty Text)
logStreamNames} -> Maybe (NonEmpty Text)
logStreamNames) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe (NonEmpty Text)
a -> FilterLogEvents
s {$sel:logStreamNames:FilterLogEvents' :: Maybe (NonEmpty Text)
logStreamNames = Maybe (NonEmpty Text)
a} :: FilterLogEvents) 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 events to return. (You received this token
-- from a previous call.)
filterLogEvents_nextToken :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Text)
filterLogEvents_nextToken :: Lens' FilterLogEvents (Maybe Text)
filterLogEvents_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:FilterLogEvents' :: FilterLogEvents -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Text
a -> FilterLogEvents
s {$sel:nextToken:FilterLogEvents' :: Maybe Text
nextToken = Maybe Text
a} :: FilterLogEvents)

-- | The start of the time range, expressed as the number of milliseconds
-- after @Jan 1, 1970 00:00:00 UTC@. Events with a timestamp before this
-- time are not returned.
filterLogEvents_startTime :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Natural)
filterLogEvents_startTime :: Lens' FilterLogEvents (Maybe Natural)
filterLogEvents_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Natural
startTime :: Maybe Natural
$sel:startTime:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
startTime} -> Maybe Natural
startTime) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Natural
a -> FilterLogEvents
s {$sel:startTime:FilterLogEvents' :: Maybe Natural
startTime = Maybe Natural
a} :: FilterLogEvents)

-- | 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.
filterLogEvents_unmask :: Lens.Lens' FilterLogEvents (Prelude.Maybe Prelude.Bool)
filterLogEvents_unmask :: Lens' FilterLogEvents (Maybe Bool)
filterLogEvents_unmask = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEvents' {Maybe Bool
unmask :: Maybe Bool
$sel:unmask:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
unmask} -> Maybe Bool
unmask) (\s :: FilterLogEvents
s@FilterLogEvents' {} Maybe Bool
a -> FilterLogEvents
s {$sel:unmask:FilterLogEvents' :: Maybe Bool
unmask = Maybe Bool
a} :: FilterLogEvents)

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

instance Core.AWSPager FilterLogEvents where
  page :: FilterLogEvents
-> AWSResponse FilterLogEvents -> Maybe FilterLogEvents
page FilterLogEvents
rq AWSResponse FilterLogEvents
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse FilterLogEvents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' FilterLogEventsResponse (Maybe Text)
filterLogEventsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ FilterLogEvents
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' FilterLogEvents (Maybe Text)
filterLogEvents_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse FilterLogEvents
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' FilterLogEventsResponse (Maybe Text)
filterLogEventsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest FilterLogEvents where
  type
    AWSResponse FilterLogEvents =
      FilterLogEventsResponse
  request :: (Service -> Service) -> FilterLogEvents -> Request FilterLogEvents
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 FilterLogEvents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse FilterLogEvents)))
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 [FilteredLogEvent]
-> Maybe Text
-> Maybe [SearchedLogStream]
-> Int
-> FilterLogEventsResponse
FilterLogEventsResponse'
            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
"nextToken")
            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
"searchedLogStreams"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable FilterLogEvents where
  hashWithSalt :: Int -> FilterLogEvents -> Int
hashWithSalt Int
_salt FilterLogEvents' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
logGroupName :: Text
unmask :: Maybe Bool
startTime :: Maybe Natural
nextToken :: Maybe Text
logStreamNames :: Maybe (NonEmpty Text)
logStreamNamePrefix :: Maybe Text
logGroupIdentifier :: Maybe Text
limit :: Maybe Natural
interleaved :: Maybe Bool
filterPattern :: Maybe Text
endTime :: Maybe Natural
$sel:logGroupName:FilterLogEvents' :: FilterLogEvents -> Text
$sel:unmask:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
$sel:startTime:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
$sel:nextToken:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:logStreamNames:FilterLogEvents' :: FilterLogEvents -> Maybe (NonEmpty Text)
$sel:logStreamNamePrefix:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:logGroupIdentifier:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:limit:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
$sel:interleaved:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
$sel:filterPattern:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:endTime:FilterLogEvents' :: FilterLogEvents -> 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 Text
filterPattern
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
interleaved
      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
logStreamNamePrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
logStreamNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      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

instance Prelude.NFData FilterLogEvents where
  rnf :: FilterLogEvents -> ()
rnf FilterLogEvents' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
logGroupName :: Text
unmask :: Maybe Bool
startTime :: Maybe Natural
nextToken :: Maybe Text
logStreamNames :: Maybe (NonEmpty Text)
logStreamNamePrefix :: Maybe Text
logGroupIdentifier :: Maybe Text
limit :: Maybe Natural
interleaved :: Maybe Bool
filterPattern :: Maybe Text
endTime :: Maybe Natural
$sel:logGroupName:FilterLogEvents' :: FilterLogEvents -> Text
$sel:unmask:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
$sel:startTime:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
$sel:nextToken:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:logStreamNames:FilterLogEvents' :: FilterLogEvents -> Maybe (NonEmpty Text)
$sel:logStreamNamePrefix:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:logGroupIdentifier:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:limit:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
$sel:interleaved:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
$sel:filterPattern:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:endTime:FilterLogEvents' :: FilterLogEvents -> 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 Text
filterPattern
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
interleaved
      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
logStreamNamePrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
logStreamNames
      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 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

instance Data.ToHeaders FilterLogEvents where
  toHeaders :: FilterLogEvents -> 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.FilterLogEvents" ::
                          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 FilterLogEvents where
  toJSON :: FilterLogEvents -> Value
toJSON FilterLogEvents' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
logGroupName :: Text
unmask :: Maybe Bool
startTime :: Maybe Natural
nextToken :: Maybe Text
logStreamNames :: Maybe (NonEmpty Text)
logStreamNamePrefix :: Maybe Text
logGroupIdentifier :: Maybe Text
limit :: Maybe Natural
interleaved :: Maybe Bool
filterPattern :: Maybe Text
endTime :: Maybe Natural
$sel:logGroupName:FilterLogEvents' :: FilterLogEvents -> Text
$sel:unmask:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
$sel:startTime:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
$sel:nextToken:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:logStreamNames:FilterLogEvents' :: FilterLogEvents -> Maybe (NonEmpty Text)
$sel:logStreamNamePrefix:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:logGroupIdentifier:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:limit:FilterLogEvents' :: FilterLogEvents -> Maybe Natural
$sel:interleaved:FilterLogEvents' :: FilterLogEvents -> Maybe Bool
$sel:filterPattern:FilterLogEvents' :: FilterLogEvents -> Maybe Text
$sel:endTime:FilterLogEvents' :: FilterLogEvents -> 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
"filterPattern" 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
filterPattern,
            (Key
"interleaved" 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
interleaved,
            (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
"logStreamNamePrefix" 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
logStreamNamePrefix,
            (Key
"logStreamNames" 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 (NonEmpty Text)
logStreamNames,
            (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
"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)
          ]
      )

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

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

-- | /See:/ 'newFilterLogEventsResponse' smart constructor.
data FilterLogEventsResponse = FilterLogEventsResponse'
  { -- | The matched events.
    FilterLogEventsResponse -> Maybe [FilteredLogEvent]
events :: Prelude.Maybe [FilteredLogEvent],
    -- | The token to use when requesting the next set of items. The token
    -- expires after 24 hours.
    FilterLogEventsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | __Important__ As of May 15, 2020, this parameter is no longer supported.
    -- This parameter returns an empty list.
    --
    -- Indicates which log streams have been searched and whether each has been
    -- searched completely.
    FilterLogEventsResponse -> Maybe [SearchedLogStream]
searchedLogStreams :: Prelude.Maybe [SearchedLogStream],
    -- | The response's http status code.
    FilterLogEventsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (FilterLogEventsResponse -> FilterLogEventsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterLogEventsResponse -> FilterLogEventsResponse -> Bool
$c/= :: FilterLogEventsResponse -> FilterLogEventsResponse -> Bool
== :: FilterLogEventsResponse -> FilterLogEventsResponse -> Bool
$c== :: FilterLogEventsResponse -> FilterLogEventsResponse -> Bool
Prelude.Eq, ReadPrec [FilterLogEventsResponse]
ReadPrec FilterLogEventsResponse
Int -> ReadS FilterLogEventsResponse
ReadS [FilterLogEventsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilterLogEventsResponse]
$creadListPrec :: ReadPrec [FilterLogEventsResponse]
readPrec :: ReadPrec FilterLogEventsResponse
$creadPrec :: ReadPrec FilterLogEventsResponse
readList :: ReadS [FilterLogEventsResponse]
$creadList :: ReadS [FilterLogEventsResponse]
readsPrec :: Int -> ReadS FilterLogEventsResponse
$creadsPrec :: Int -> ReadS FilterLogEventsResponse
Prelude.Read, Int -> FilterLogEventsResponse -> ShowS
[FilterLogEventsResponse] -> ShowS
FilterLogEventsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterLogEventsResponse] -> ShowS
$cshowList :: [FilterLogEventsResponse] -> ShowS
show :: FilterLogEventsResponse -> String
$cshow :: FilterLogEventsResponse -> String
showsPrec :: Int -> FilterLogEventsResponse -> ShowS
$cshowsPrec :: Int -> FilterLogEventsResponse -> ShowS
Prelude.Show, forall x. Rep FilterLogEventsResponse x -> FilterLogEventsResponse
forall x. FilterLogEventsResponse -> Rep FilterLogEventsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterLogEventsResponse x -> FilterLogEventsResponse
$cfrom :: forall x. FilterLogEventsResponse -> Rep FilterLogEventsResponse x
Prelude.Generic)

-- |
-- Create a value of 'FilterLogEventsResponse' 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', 'filterLogEventsResponse_events' - The matched events.
--
-- 'nextToken', 'filterLogEventsResponse_nextToken' - The token to use when requesting the next set of items. The token
-- expires after 24 hours.
--
-- 'searchedLogStreams', 'filterLogEventsResponse_searchedLogStreams' - __Important__ As of May 15, 2020, this parameter is no longer supported.
-- This parameter returns an empty list.
--
-- Indicates which log streams have been searched and whether each has been
-- searched completely.
--
-- 'httpStatus', 'filterLogEventsResponse_httpStatus' - The response's http status code.
newFilterLogEventsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  FilterLogEventsResponse
newFilterLogEventsResponse :: Int -> FilterLogEventsResponse
newFilterLogEventsResponse Int
pHttpStatus_ =
  FilterLogEventsResponse'
    { $sel:events:FilterLogEventsResponse' :: Maybe [FilteredLogEvent]
events = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:FilterLogEventsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:searchedLogStreams:FilterLogEventsResponse' :: Maybe [SearchedLogStream]
searchedLogStreams = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:FilterLogEventsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The matched events.
filterLogEventsResponse_events :: Lens.Lens' FilterLogEventsResponse (Prelude.Maybe [FilteredLogEvent])
filterLogEventsResponse_events :: Lens' FilterLogEventsResponse (Maybe [FilteredLogEvent])
filterLogEventsResponse_events = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEventsResponse' {Maybe [FilteredLogEvent]
events :: Maybe [FilteredLogEvent]
$sel:events:FilterLogEventsResponse' :: FilterLogEventsResponse -> Maybe [FilteredLogEvent]
events} -> Maybe [FilteredLogEvent]
events) (\s :: FilterLogEventsResponse
s@FilterLogEventsResponse' {} Maybe [FilteredLogEvent]
a -> FilterLogEventsResponse
s {$sel:events:FilterLogEventsResponse' :: Maybe [FilteredLogEvent]
events = Maybe [FilteredLogEvent]
a} :: FilterLogEventsResponse) 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 to use when requesting the next set of items. The token
-- expires after 24 hours.
filterLogEventsResponse_nextToken :: Lens.Lens' FilterLogEventsResponse (Prelude.Maybe Prelude.Text)
filterLogEventsResponse_nextToken :: Lens' FilterLogEventsResponse (Maybe Text)
filterLogEventsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEventsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:FilterLogEventsResponse' :: FilterLogEventsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: FilterLogEventsResponse
s@FilterLogEventsResponse' {} Maybe Text
a -> FilterLogEventsResponse
s {$sel:nextToken:FilterLogEventsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: FilterLogEventsResponse)

-- | __Important__ As of May 15, 2020, this parameter is no longer supported.
-- This parameter returns an empty list.
--
-- Indicates which log streams have been searched and whether each has been
-- searched completely.
filterLogEventsResponse_searchedLogStreams :: Lens.Lens' FilterLogEventsResponse (Prelude.Maybe [SearchedLogStream])
filterLogEventsResponse_searchedLogStreams :: Lens' FilterLogEventsResponse (Maybe [SearchedLogStream])
filterLogEventsResponse_searchedLogStreams = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEventsResponse' {Maybe [SearchedLogStream]
searchedLogStreams :: Maybe [SearchedLogStream]
$sel:searchedLogStreams:FilterLogEventsResponse' :: FilterLogEventsResponse -> Maybe [SearchedLogStream]
searchedLogStreams} -> Maybe [SearchedLogStream]
searchedLogStreams) (\s :: FilterLogEventsResponse
s@FilterLogEventsResponse' {} Maybe [SearchedLogStream]
a -> FilterLogEventsResponse
s {$sel:searchedLogStreams:FilterLogEventsResponse' :: Maybe [SearchedLogStream]
searchedLogStreams = Maybe [SearchedLogStream]
a} :: FilterLogEventsResponse) 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 response's http status code.
filterLogEventsResponse_httpStatus :: Lens.Lens' FilterLogEventsResponse Prelude.Int
filterLogEventsResponse_httpStatus :: Lens' FilterLogEventsResponse Int
filterLogEventsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FilterLogEventsResponse' {Int
httpStatus :: Int
$sel:httpStatus:FilterLogEventsResponse' :: FilterLogEventsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: FilterLogEventsResponse
s@FilterLogEventsResponse' {} Int
a -> FilterLogEventsResponse
s {$sel:httpStatus:FilterLogEventsResponse' :: Int
httpStatus = Int
a} :: FilterLogEventsResponse)

instance Prelude.NFData FilterLogEventsResponse where
  rnf :: FilterLogEventsResponse -> ()
rnf FilterLogEventsResponse' {Int
Maybe [FilteredLogEvent]
Maybe [SearchedLogStream]
Maybe Text
httpStatus :: Int
searchedLogStreams :: Maybe [SearchedLogStream]
nextToken :: Maybe Text
events :: Maybe [FilteredLogEvent]
$sel:httpStatus:FilterLogEventsResponse' :: FilterLogEventsResponse -> Int
$sel:searchedLogStreams:FilterLogEventsResponse' :: FilterLogEventsResponse -> Maybe [SearchedLogStream]
$sel:nextToken:FilterLogEventsResponse' :: FilterLogEventsResponse -> Maybe Text
$sel:events:FilterLogEventsResponse' :: FilterLogEventsResponse -> Maybe [FilteredLogEvent]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FilteredLogEvent]
events
      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 [SearchedLogStream]
searchedLogStreams
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus