{-# 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.CloudTrail.LookupEvents
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Looks up
-- <https://docs.aws.amazon.com/awscloudtrail/latest/userguide/cloudtrail-concepts.html#cloudtrail-concepts-management-events management events>
-- or
-- <https://docs.aws.amazon.com/awscloudtrail/latest/userguide/cloudtrail-concepts.html#cloudtrail-concepts-insights-events CloudTrail Insights events>
-- that are captured by CloudTrail. You can look up events that occurred in
-- a region within the last 90 days. Lookup supports the following
-- attributes for management events:
--
-- -   Amazon Web Services access key
--
-- -   Event ID
--
-- -   Event name
--
-- -   Event source
--
-- -   Read only
--
-- -   Resource name
--
-- -   Resource type
--
-- -   User name
--
-- Lookup supports the following attributes for Insights events:
--
-- -   Event ID
--
-- -   Event name
--
-- -   Event source
--
-- All attributes are optional. The default number of results returned is
-- 50, with a maximum of 50 possible. The response includes a token that
-- you can use to get the next page of results.
--
-- The rate of lookup requests is limited to two per second, per account,
-- per region. If this limit is exceeded, a throttling error occurs.
--
-- This operation returns paginated results.
module Amazonka.CloudTrail.LookupEvents
  ( -- * Creating a Request
    LookupEvents (..),
    newLookupEvents,

    -- * Request Lenses
    lookupEvents_endTime,
    lookupEvents_eventCategory,
    lookupEvents_lookupAttributes,
    lookupEvents_maxResults,
    lookupEvents_nextToken,
    lookupEvents_startTime,

    -- * Destructuring the Response
    LookupEventsResponse (..),
    newLookupEventsResponse,

    -- * Response Lenses
    lookupEventsResponse_events,
    lookupEventsResponse_nextToken,
    lookupEventsResponse_httpStatus,
  )
where

import Amazonka.CloudTrail.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

-- | Contains a request for LookupEvents.
--
-- /See:/ 'newLookupEvents' smart constructor.
data LookupEvents = LookupEvents'
  { -- | Specifies that only events that occur before or at the specified time
    -- are returned. If the specified end time is before the specified start
    -- time, an error is returned.
    LookupEvents -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | Specifies the event category. If you do not specify an event category,
    -- events of the category are not returned in the response. For example, if
    -- you do not specify @insight@ as the value of @EventCategory@, no
    -- Insights events are returned.
    LookupEvents -> Maybe EventCategory
eventCategory :: Prelude.Maybe EventCategory,
    -- | Contains a list of lookup attributes. Currently the list can contain
    -- only one item.
    LookupEvents -> Maybe [LookupAttribute]
lookupAttributes :: Prelude.Maybe [LookupAttribute],
    -- | The number of events to return. Possible values are 1 through 50. The
    -- default is 50.
    LookupEvents -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to use to get the next page of results after a previous API
    -- call. This token must be passed in with the same parameters that were
    -- specified in the original call. For example, if the original call
    -- specified an AttributeKey of \'Username\' with a value of \'root\', the
    -- call with NextToken should include those same parameters.
    LookupEvents -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies that only events that occur after or at the specified time are
    -- returned. If the specified start time is after the specified end time,
    -- an error is returned.
    LookupEvents -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX
  }
  deriving (LookupEvents -> LookupEvents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupEvents -> LookupEvents -> Bool
$c/= :: LookupEvents -> LookupEvents -> Bool
== :: LookupEvents -> LookupEvents -> Bool
$c== :: LookupEvents -> LookupEvents -> Bool
Prelude.Eq, ReadPrec [LookupEvents]
ReadPrec LookupEvents
Int -> ReadS LookupEvents
ReadS [LookupEvents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LookupEvents]
$creadListPrec :: ReadPrec [LookupEvents]
readPrec :: ReadPrec LookupEvents
$creadPrec :: ReadPrec LookupEvents
readList :: ReadS [LookupEvents]
$creadList :: ReadS [LookupEvents]
readsPrec :: Int -> ReadS LookupEvents
$creadsPrec :: Int -> ReadS LookupEvents
Prelude.Read, Int -> LookupEvents -> ShowS
[LookupEvents] -> ShowS
LookupEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookupEvents] -> ShowS
$cshowList :: [LookupEvents] -> ShowS
show :: LookupEvents -> String
$cshow :: LookupEvents -> String
showsPrec :: Int -> LookupEvents -> ShowS
$cshowsPrec :: Int -> LookupEvents -> ShowS
Prelude.Show, forall x. Rep LookupEvents x -> LookupEvents
forall x. LookupEvents -> Rep LookupEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LookupEvents x -> LookupEvents
$cfrom :: forall x. LookupEvents -> Rep LookupEvents x
Prelude.Generic)

-- |
-- Create a value of 'LookupEvents' 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', 'lookupEvents_endTime' - Specifies that only events that occur before or at the specified time
-- are returned. If the specified end time is before the specified start
-- time, an error is returned.
--
-- 'eventCategory', 'lookupEvents_eventCategory' - Specifies the event category. If you do not specify an event category,
-- events of the category are not returned in the response. For example, if
-- you do not specify @insight@ as the value of @EventCategory@, no
-- Insights events are returned.
--
-- 'lookupAttributes', 'lookupEvents_lookupAttributes' - Contains a list of lookup attributes. Currently the list can contain
-- only one item.
--
-- 'maxResults', 'lookupEvents_maxResults' - The number of events to return. Possible values are 1 through 50. The
-- default is 50.
--
-- 'nextToken', 'lookupEvents_nextToken' - The token to use to get the next page of results after a previous API
-- call. This token must be passed in with the same parameters that were
-- specified in the original call. For example, if the original call
-- specified an AttributeKey of \'Username\' with a value of \'root\', the
-- call with NextToken should include those same parameters.
--
-- 'startTime', 'lookupEvents_startTime' - Specifies that only events that occur after or at the specified time are
-- returned. If the specified start time is after the specified end time,
-- an error is returned.
newLookupEvents ::
  LookupEvents
newLookupEvents :: LookupEvents
newLookupEvents =
  LookupEvents'
    { $sel:endTime:LookupEvents' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:eventCategory:LookupEvents' :: Maybe EventCategory
eventCategory = forall a. Maybe a
Prelude.Nothing,
      $sel:lookupAttributes:LookupEvents' :: Maybe [LookupAttribute]
lookupAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:LookupEvents' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:LookupEvents' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:LookupEvents' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies that only events that occur before or at the specified time
-- are returned. If the specified end time is before the specified start
-- time, an error is returned.
lookupEvents_endTime :: Lens.Lens' LookupEvents (Prelude.Maybe Prelude.UTCTime)
lookupEvents_endTime :: Lens' LookupEvents (Maybe UTCTime)
lookupEvents_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEvents' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:LookupEvents' :: LookupEvents -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: LookupEvents
s@LookupEvents' {} Maybe POSIX
a -> LookupEvents
s {$sel:endTime:LookupEvents' :: Maybe POSIX
endTime = Maybe POSIX
a} :: LookupEvents) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Specifies the event category. If you do not specify an event category,
-- events of the category are not returned in the response. For example, if
-- you do not specify @insight@ as the value of @EventCategory@, no
-- Insights events are returned.
lookupEvents_eventCategory :: Lens.Lens' LookupEvents (Prelude.Maybe EventCategory)
lookupEvents_eventCategory :: Lens' LookupEvents (Maybe EventCategory)
lookupEvents_eventCategory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEvents' {Maybe EventCategory
eventCategory :: Maybe EventCategory
$sel:eventCategory:LookupEvents' :: LookupEvents -> Maybe EventCategory
eventCategory} -> Maybe EventCategory
eventCategory) (\s :: LookupEvents
s@LookupEvents' {} Maybe EventCategory
a -> LookupEvents
s {$sel:eventCategory:LookupEvents' :: Maybe EventCategory
eventCategory = Maybe EventCategory
a} :: LookupEvents)

-- | Contains a list of lookup attributes. Currently the list can contain
-- only one item.
lookupEvents_lookupAttributes :: Lens.Lens' LookupEvents (Prelude.Maybe [LookupAttribute])
lookupEvents_lookupAttributes :: Lens' LookupEvents (Maybe [LookupAttribute])
lookupEvents_lookupAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEvents' {Maybe [LookupAttribute]
lookupAttributes :: Maybe [LookupAttribute]
$sel:lookupAttributes:LookupEvents' :: LookupEvents -> Maybe [LookupAttribute]
lookupAttributes} -> Maybe [LookupAttribute]
lookupAttributes) (\s :: LookupEvents
s@LookupEvents' {} Maybe [LookupAttribute]
a -> LookupEvents
s {$sel:lookupAttributes:LookupEvents' :: Maybe [LookupAttribute]
lookupAttributes = Maybe [LookupAttribute]
a} :: LookupEvents) 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 number of events to return. Possible values are 1 through 50. The
-- default is 50.
lookupEvents_maxResults :: Lens.Lens' LookupEvents (Prelude.Maybe Prelude.Natural)
lookupEvents_maxResults :: Lens' LookupEvents (Maybe Natural)
lookupEvents_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEvents' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:LookupEvents' :: LookupEvents -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: LookupEvents
s@LookupEvents' {} Maybe Natural
a -> LookupEvents
s {$sel:maxResults:LookupEvents' :: Maybe Natural
maxResults = Maybe Natural
a} :: LookupEvents)

-- | The token to use to get the next page of results after a previous API
-- call. This token must be passed in with the same parameters that were
-- specified in the original call. For example, if the original call
-- specified an AttributeKey of \'Username\' with a value of \'root\', the
-- call with NextToken should include those same parameters.
lookupEvents_nextToken :: Lens.Lens' LookupEvents (Prelude.Maybe Prelude.Text)
lookupEvents_nextToken :: Lens' LookupEvents (Maybe Text)
lookupEvents_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEvents' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:LookupEvents' :: LookupEvents -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: LookupEvents
s@LookupEvents' {} Maybe Text
a -> LookupEvents
s {$sel:nextToken:LookupEvents' :: Maybe Text
nextToken = Maybe Text
a} :: LookupEvents)

-- | Specifies that only events that occur after or at the specified time are
-- returned. If the specified start time is after the specified end time,
-- an error is returned.
lookupEvents_startTime :: Lens.Lens' LookupEvents (Prelude.Maybe Prelude.UTCTime)
lookupEvents_startTime :: Lens' LookupEvents (Maybe UTCTime)
lookupEvents_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEvents' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:LookupEvents' :: LookupEvents -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: LookupEvents
s@LookupEvents' {} Maybe POSIX
a -> LookupEvents
s {$sel:startTime:LookupEvents' :: Maybe POSIX
startTime = Maybe POSIX
a} :: LookupEvents) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSPager LookupEvents where
  page :: LookupEvents -> AWSResponse LookupEvents -> Maybe LookupEvents
page LookupEvents
rq AWSResponse LookupEvents
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse LookupEvents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' LookupEventsResponse (Maybe Text)
lookupEventsResponse_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
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse LookupEvents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' LookupEventsResponse (Maybe [Event])
lookupEventsResponse_events
            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.$ LookupEvents
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' LookupEvents (Maybe Text)
lookupEvents_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse LookupEvents
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' LookupEventsResponse (Maybe Text)
lookupEventsResponse_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 LookupEvents where
  type AWSResponse LookupEvents = LookupEventsResponse
  request :: (Service -> Service) -> LookupEvents -> Request LookupEvents
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 LookupEvents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse LookupEvents)))
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 [Event] -> Maybe Text -> Int -> LookupEventsResponse
LookupEventsResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable LookupEvents where
  hashWithSalt :: Int -> LookupEvents -> Int
hashWithSalt Int
_salt LookupEvents' {Maybe Natural
Maybe [LookupAttribute]
Maybe Text
Maybe POSIX
Maybe EventCategory
startTime :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
lookupAttributes :: Maybe [LookupAttribute]
eventCategory :: Maybe EventCategory
endTime :: Maybe POSIX
$sel:startTime:LookupEvents' :: LookupEvents -> Maybe POSIX
$sel:nextToken:LookupEvents' :: LookupEvents -> Maybe Text
$sel:maxResults:LookupEvents' :: LookupEvents -> Maybe Natural
$sel:lookupAttributes:LookupEvents' :: LookupEvents -> Maybe [LookupAttribute]
$sel:eventCategory:LookupEvents' :: LookupEvents -> Maybe EventCategory
$sel:endTime:LookupEvents' :: LookupEvents -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EventCategory
eventCategory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LookupAttribute]
lookupAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startTime

instance Prelude.NFData LookupEvents where
  rnf :: LookupEvents -> ()
rnf LookupEvents' {Maybe Natural
Maybe [LookupAttribute]
Maybe Text
Maybe POSIX
Maybe EventCategory
startTime :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
lookupAttributes :: Maybe [LookupAttribute]
eventCategory :: Maybe EventCategory
endTime :: Maybe POSIX
$sel:startTime:LookupEvents' :: LookupEvents -> Maybe POSIX
$sel:nextToken:LookupEvents' :: LookupEvents -> Maybe Text
$sel:maxResults:LookupEvents' :: LookupEvents -> Maybe Natural
$sel:lookupAttributes:LookupEvents' :: LookupEvents -> Maybe [LookupAttribute]
$sel:eventCategory:LookupEvents' :: LookupEvents -> Maybe EventCategory
$sel:endTime:LookupEvents' :: LookupEvents -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EventCategory
eventCategory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LookupAttribute]
lookupAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      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 POSIX
startTime

instance Data.ToHeaders LookupEvents where
  toHeaders :: LookupEvents -> 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
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.LookupEvents" ::
                          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 LookupEvents where
  toJSON :: LookupEvents -> Value
toJSON LookupEvents' {Maybe Natural
Maybe [LookupAttribute]
Maybe Text
Maybe POSIX
Maybe EventCategory
startTime :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
lookupAttributes :: Maybe [LookupAttribute]
eventCategory :: Maybe EventCategory
endTime :: Maybe POSIX
$sel:startTime:LookupEvents' :: LookupEvents -> Maybe POSIX
$sel:nextToken:LookupEvents' :: LookupEvents -> Maybe Text
$sel:maxResults:LookupEvents' :: LookupEvents -> Maybe Natural
$sel:lookupAttributes:LookupEvents' :: LookupEvents -> Maybe [LookupAttribute]
$sel:eventCategory:LookupEvents' :: LookupEvents -> Maybe EventCategory
$sel:endTime:LookupEvents' :: LookupEvents -> Maybe POSIX
..} =
    [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 POSIX
endTime,
            (Key
"EventCategory" 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 EventCategory
eventCategory,
            (Key
"LookupAttributes" 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 [LookupAttribute]
lookupAttributes,
            (Key
"MaxResults" 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
maxResults,
            (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 POSIX
startTime
          ]
      )

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

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

-- | Contains a response to a LookupEvents action.
--
-- /See:/ 'newLookupEventsResponse' smart constructor.
data LookupEventsResponse = LookupEventsResponse'
  { -- | A list of events returned based on the lookup attributes specified and
    -- the CloudTrail event. The events list is sorted by time. The most recent
    -- event is listed first.
    LookupEventsResponse -> Maybe [Event]
events :: Prelude.Maybe [Event],
    -- | The token to use to get the next page of results after a previous API
    -- call. If the token does not appear, there are no more results to return.
    -- The token must be passed in with the same parameters as the previous
    -- call. For example, if the original call specified an AttributeKey of
    -- \'Username\' with a value of \'root\', the call with NextToken should
    -- include those same parameters.
    LookupEventsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    LookupEventsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (LookupEventsResponse -> LookupEventsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupEventsResponse -> LookupEventsResponse -> Bool
$c/= :: LookupEventsResponse -> LookupEventsResponse -> Bool
== :: LookupEventsResponse -> LookupEventsResponse -> Bool
$c== :: LookupEventsResponse -> LookupEventsResponse -> Bool
Prelude.Eq, ReadPrec [LookupEventsResponse]
ReadPrec LookupEventsResponse
Int -> ReadS LookupEventsResponse
ReadS [LookupEventsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LookupEventsResponse]
$creadListPrec :: ReadPrec [LookupEventsResponse]
readPrec :: ReadPrec LookupEventsResponse
$creadPrec :: ReadPrec LookupEventsResponse
readList :: ReadS [LookupEventsResponse]
$creadList :: ReadS [LookupEventsResponse]
readsPrec :: Int -> ReadS LookupEventsResponse
$creadsPrec :: Int -> ReadS LookupEventsResponse
Prelude.Read, Int -> LookupEventsResponse -> ShowS
[LookupEventsResponse] -> ShowS
LookupEventsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookupEventsResponse] -> ShowS
$cshowList :: [LookupEventsResponse] -> ShowS
show :: LookupEventsResponse -> String
$cshow :: LookupEventsResponse -> String
showsPrec :: Int -> LookupEventsResponse -> ShowS
$cshowsPrec :: Int -> LookupEventsResponse -> ShowS
Prelude.Show, forall x. Rep LookupEventsResponse x -> LookupEventsResponse
forall x. LookupEventsResponse -> Rep LookupEventsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LookupEventsResponse x -> LookupEventsResponse
$cfrom :: forall x. LookupEventsResponse -> Rep LookupEventsResponse x
Prelude.Generic)

-- |
-- Create a value of 'LookupEventsResponse' 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', 'lookupEventsResponse_events' - A list of events returned based on the lookup attributes specified and
-- the CloudTrail event. The events list is sorted by time. The most recent
-- event is listed first.
--
-- 'nextToken', 'lookupEventsResponse_nextToken' - The token to use to get the next page of results after a previous API
-- call. If the token does not appear, there are no more results to return.
-- The token must be passed in with the same parameters as the previous
-- call. For example, if the original call specified an AttributeKey of
-- \'Username\' with a value of \'root\', the call with NextToken should
-- include those same parameters.
--
-- 'httpStatus', 'lookupEventsResponse_httpStatus' - The response's http status code.
newLookupEventsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  LookupEventsResponse
newLookupEventsResponse :: Int -> LookupEventsResponse
newLookupEventsResponse Int
pHttpStatus_ =
  LookupEventsResponse'
    { $sel:events:LookupEventsResponse' :: Maybe [Event]
events = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:LookupEventsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:LookupEventsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of events returned based on the lookup attributes specified and
-- the CloudTrail event. The events list is sorted by time. The most recent
-- event is listed first.
lookupEventsResponse_events :: Lens.Lens' LookupEventsResponse (Prelude.Maybe [Event])
lookupEventsResponse_events :: Lens' LookupEventsResponse (Maybe [Event])
lookupEventsResponse_events = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEventsResponse' {Maybe [Event]
events :: Maybe [Event]
$sel:events:LookupEventsResponse' :: LookupEventsResponse -> Maybe [Event]
events} -> Maybe [Event]
events) (\s :: LookupEventsResponse
s@LookupEventsResponse' {} Maybe [Event]
a -> LookupEventsResponse
s {$sel:events:LookupEventsResponse' :: Maybe [Event]
events = Maybe [Event]
a} :: LookupEventsResponse) 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 to get the next page of results after a previous API
-- call. If the token does not appear, there are no more results to return.
-- The token must be passed in with the same parameters as the previous
-- call. For example, if the original call specified an AttributeKey of
-- \'Username\' with a value of \'root\', the call with NextToken should
-- include those same parameters.
lookupEventsResponse_nextToken :: Lens.Lens' LookupEventsResponse (Prelude.Maybe Prelude.Text)
lookupEventsResponse_nextToken :: Lens' LookupEventsResponse (Maybe Text)
lookupEventsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupEventsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:LookupEventsResponse' :: LookupEventsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: LookupEventsResponse
s@LookupEventsResponse' {} Maybe Text
a -> LookupEventsResponse
s {$sel:nextToken:LookupEventsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: LookupEventsResponse)

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

instance Prelude.NFData LookupEventsResponse where
  rnf :: LookupEventsResponse -> ()
rnf LookupEventsResponse' {Int
Maybe [Event]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
events :: Maybe [Event]
$sel:httpStatus:LookupEventsResponse' :: LookupEventsResponse -> Int
$sel:nextToken:LookupEventsResponse' :: LookupEventsResponse -> Maybe Text
$sel:events:LookupEventsResponse' :: LookupEventsResponse -> Maybe [Event]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Event]
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 Int
httpStatus