{-# 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.ListQueries
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of queries and query statuses for the past seven days.
-- You must specify an ARN value for @EventDataStore@. Optionally, to
-- shorten the list of results, you can specify a time range, formatted as
-- timestamps, by adding @StartTime@ and @EndTime@ parameters, and a
-- @QueryStatus@ value. Valid values for @QueryStatus@ include @QUEUED@,
-- @RUNNING@, @FINISHED@, @FAILED@, @TIMED_OUT@, or @CANCELLED@.
module Amazonka.CloudTrail.ListQueries
  ( -- * Creating a Request
    ListQueries (..),
    newListQueries,

    -- * Request Lenses
    listQueries_endTime,
    listQueries_maxResults,
    listQueries_nextToken,
    listQueries_queryStatus,
    listQueries_startTime,
    listQueries_eventDataStore,

    -- * Destructuring the Response
    ListQueriesResponse (..),
    newListQueriesResponse,

    -- * Response Lenses
    listQueriesResponse_nextToken,
    listQueriesResponse_queries,
    listQueriesResponse_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

-- | /See:/ 'newListQueries' smart constructor.
data ListQueries = ListQueries'
  { -- | Use with @StartTime@ to bound a @ListQueries@ request, and limit its
    -- results to only those queries run within a specified time period.
    ListQueries -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | The maximum number of queries to show on a page.
    ListQueries -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token you can use to get the next page of results.
    ListQueries -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The status of queries that you want to return in results. Valid values
    -- for @QueryStatus@ include @QUEUED@, @RUNNING@, @FINISHED@, @FAILED@,
    -- @TIMED_OUT@, or @CANCELLED@.
    ListQueries -> Maybe QueryStatus
queryStatus :: Prelude.Maybe QueryStatus,
    -- | Use with @EndTime@ to bound a @ListQueries@ request, and limit its
    -- results to only those queries run within a specified time period.
    ListQueries -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX,
    -- | The ARN (or the ID suffix of the ARN) of an event data store on which
    -- queries were run.
    ListQueries -> Text
eventDataStore :: Prelude.Text
  }
  deriving (ListQueries -> ListQueries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQueries -> ListQueries -> Bool
$c/= :: ListQueries -> ListQueries -> Bool
== :: ListQueries -> ListQueries -> Bool
$c== :: ListQueries -> ListQueries -> Bool
Prelude.Eq, ReadPrec [ListQueries]
ReadPrec ListQueries
Int -> ReadS ListQueries
ReadS [ListQueries]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQueries]
$creadListPrec :: ReadPrec [ListQueries]
readPrec :: ReadPrec ListQueries
$creadPrec :: ReadPrec ListQueries
readList :: ReadS [ListQueries]
$creadList :: ReadS [ListQueries]
readsPrec :: Int -> ReadS ListQueries
$creadsPrec :: Int -> ReadS ListQueries
Prelude.Read, Int -> ListQueries -> ShowS
[ListQueries] -> ShowS
ListQueries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQueries] -> ShowS
$cshowList :: [ListQueries] -> ShowS
show :: ListQueries -> String
$cshow :: ListQueries -> String
showsPrec :: Int -> ListQueries -> ShowS
$cshowsPrec :: Int -> ListQueries -> ShowS
Prelude.Show, forall x. Rep ListQueries x -> ListQueries
forall x. ListQueries -> Rep ListQueries x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListQueries x -> ListQueries
$cfrom :: forall x. ListQueries -> Rep ListQueries x
Prelude.Generic)

-- |
-- Create a value of 'ListQueries' 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', 'listQueries_endTime' - Use with @StartTime@ to bound a @ListQueries@ request, and limit its
-- results to only those queries run within a specified time period.
--
-- 'maxResults', 'listQueries_maxResults' - The maximum number of queries to show on a page.
--
-- 'nextToken', 'listQueries_nextToken' - A token you can use to get the next page of results.
--
-- 'queryStatus', 'listQueries_queryStatus' - The status of queries that you want to return in results. Valid values
-- for @QueryStatus@ include @QUEUED@, @RUNNING@, @FINISHED@, @FAILED@,
-- @TIMED_OUT@, or @CANCELLED@.
--
-- 'startTime', 'listQueries_startTime' - Use with @EndTime@ to bound a @ListQueries@ request, and limit its
-- results to only those queries run within a specified time period.
--
-- 'eventDataStore', 'listQueries_eventDataStore' - The ARN (or the ID suffix of the ARN) of an event data store on which
-- queries were run.
newListQueries ::
  -- | 'eventDataStore'
  Prelude.Text ->
  ListQueries
newListQueries :: Text -> ListQueries
newListQueries Text
pEventDataStore_ =
  ListQueries'
    { $sel:endTime:ListQueries' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListQueries' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListQueries' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:queryStatus:ListQueries' :: Maybe QueryStatus
queryStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:ListQueries' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:eventDataStore:ListQueries' :: Text
eventDataStore = Text
pEventDataStore_
    }

-- | Use with @StartTime@ to bound a @ListQueries@ request, and limit its
-- results to only those queries run within a specified time period.
listQueries_endTime :: Lens.Lens' ListQueries (Prelude.Maybe Prelude.UTCTime)
listQueries_endTime :: Lens' ListQueries (Maybe UTCTime)
listQueries_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueries' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:ListQueries' :: ListQueries -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: ListQueries
s@ListQueries' {} Maybe POSIX
a -> ListQueries
s {$sel:endTime:ListQueries' :: Maybe POSIX
endTime = Maybe POSIX
a} :: ListQueries) 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

-- | The maximum number of queries to show on a page.
listQueries_maxResults :: Lens.Lens' ListQueries (Prelude.Maybe Prelude.Natural)
listQueries_maxResults :: Lens' ListQueries (Maybe Natural)
listQueries_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueries' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListQueries' :: ListQueries -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListQueries
s@ListQueries' {} Maybe Natural
a -> ListQueries
s {$sel:maxResults:ListQueries' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListQueries)

-- | A token you can use to get the next page of results.
listQueries_nextToken :: Lens.Lens' ListQueries (Prelude.Maybe Prelude.Text)
listQueries_nextToken :: Lens' ListQueries (Maybe Text)
listQueries_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueries' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQueries' :: ListQueries -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQueries
s@ListQueries' {} Maybe Text
a -> ListQueries
s {$sel:nextToken:ListQueries' :: Maybe Text
nextToken = Maybe Text
a} :: ListQueries)

-- | The status of queries that you want to return in results. Valid values
-- for @QueryStatus@ include @QUEUED@, @RUNNING@, @FINISHED@, @FAILED@,
-- @TIMED_OUT@, or @CANCELLED@.
listQueries_queryStatus :: Lens.Lens' ListQueries (Prelude.Maybe QueryStatus)
listQueries_queryStatus :: Lens' ListQueries (Maybe QueryStatus)
listQueries_queryStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueries' {Maybe QueryStatus
queryStatus :: Maybe QueryStatus
$sel:queryStatus:ListQueries' :: ListQueries -> Maybe QueryStatus
queryStatus} -> Maybe QueryStatus
queryStatus) (\s :: ListQueries
s@ListQueries' {} Maybe QueryStatus
a -> ListQueries
s {$sel:queryStatus:ListQueries' :: Maybe QueryStatus
queryStatus = Maybe QueryStatus
a} :: ListQueries)

-- | Use with @EndTime@ to bound a @ListQueries@ request, and limit its
-- results to only those queries run within a specified time period.
listQueries_startTime :: Lens.Lens' ListQueries (Prelude.Maybe Prelude.UTCTime)
listQueries_startTime :: Lens' ListQueries (Maybe UTCTime)
listQueries_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueries' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:ListQueries' :: ListQueries -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: ListQueries
s@ListQueries' {} Maybe POSIX
a -> ListQueries
s {$sel:startTime:ListQueries' :: Maybe POSIX
startTime = Maybe POSIX
a} :: ListQueries) 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

-- | The ARN (or the ID suffix of the ARN) of an event data store on which
-- queries were run.
listQueries_eventDataStore :: Lens.Lens' ListQueries Prelude.Text
listQueries_eventDataStore :: Lens' ListQueries Text
listQueries_eventDataStore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueries' {Text
eventDataStore :: Text
$sel:eventDataStore:ListQueries' :: ListQueries -> Text
eventDataStore} -> Text
eventDataStore) (\s :: ListQueries
s@ListQueries' {} Text
a -> ListQueries
s {$sel:eventDataStore:ListQueries' :: Text
eventDataStore = Text
a} :: ListQueries)

instance Core.AWSRequest ListQueries where
  type AWSResponse ListQueries = ListQueriesResponse
  request :: (Service -> Service) -> ListQueries -> Request ListQueries
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 ListQueries
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListQueries)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Maybe [Query] -> Int -> ListQueriesResponse
ListQueriesResponse'
            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
"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
"Queries" 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 ListQueries where
  hashWithSalt :: Int -> ListQueries -> Int
hashWithSalt Int
_salt ListQueries' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe QueryStatus
Text
eventDataStore :: Text
startTime :: Maybe POSIX
queryStatus :: Maybe QueryStatus
nextToken :: Maybe Text
maxResults :: Maybe Natural
endTime :: Maybe POSIX
$sel:eventDataStore:ListQueries' :: ListQueries -> Text
$sel:startTime:ListQueries' :: ListQueries -> Maybe POSIX
$sel:queryStatus:ListQueries' :: ListQueries -> Maybe QueryStatus
$sel:nextToken:ListQueries' :: ListQueries -> Maybe Text
$sel:maxResults:ListQueries' :: ListQueries -> Maybe Natural
$sel:endTime:ListQueries' :: ListQueries -> 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 Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QueryStatus
queryStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventDataStore

instance Prelude.NFData ListQueries where
  rnf :: ListQueries -> ()
rnf ListQueries' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe QueryStatus
Text
eventDataStore :: Text
startTime :: Maybe POSIX
queryStatus :: Maybe QueryStatus
nextToken :: Maybe Text
maxResults :: Maybe Natural
endTime :: Maybe POSIX
$sel:eventDataStore:ListQueries' :: ListQueries -> Text
$sel:startTime:ListQueries' :: ListQueries -> Maybe POSIX
$sel:queryStatus:ListQueries' :: ListQueries -> Maybe QueryStatus
$sel:nextToken:ListQueries' :: ListQueries -> Maybe Text
$sel:maxResults:ListQueries' :: ListQueries -> Maybe Natural
$sel:endTime:ListQueries' :: ListQueries -> 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 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 QueryStatus
queryStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventDataStore

instance Data.ToHeaders ListQueries where
  toHeaders :: ListQueries -> 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.ListQueries" ::
                          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 ListQueries where
  toJSON :: ListQueries -> Value
toJSON ListQueries' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe QueryStatus
Text
eventDataStore :: Text
startTime :: Maybe POSIX
queryStatus :: Maybe QueryStatus
nextToken :: Maybe Text
maxResults :: Maybe Natural
endTime :: Maybe POSIX
$sel:eventDataStore:ListQueries' :: ListQueries -> Text
$sel:startTime:ListQueries' :: ListQueries -> Maybe POSIX
$sel:queryStatus:ListQueries' :: ListQueries -> Maybe QueryStatus
$sel:nextToken:ListQueries' :: ListQueries -> Maybe Text
$sel:maxResults:ListQueries' :: ListQueries -> Maybe Natural
$sel:endTime:ListQueries' :: ListQueries -> 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
"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
"QueryStatus" 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 QueryStatus
queryStatus,
            (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EventDataStore" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventDataStore)
          ]
      )

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

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

-- | /See:/ 'newListQueriesResponse' smart constructor.
data ListQueriesResponse = ListQueriesResponse'
  { -- | A token you can use to get the next page of results.
    ListQueriesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Lists matching query results, and shows query ID, status, and creation
    -- time of each query.
    ListQueriesResponse -> Maybe [Query]
queries :: Prelude.Maybe [Query],
    -- | The response's http status code.
    ListQueriesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListQueriesResponse -> ListQueriesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQueriesResponse -> ListQueriesResponse -> Bool
$c/= :: ListQueriesResponse -> ListQueriesResponse -> Bool
== :: ListQueriesResponse -> ListQueriesResponse -> Bool
$c== :: ListQueriesResponse -> ListQueriesResponse -> Bool
Prelude.Eq, ReadPrec [ListQueriesResponse]
ReadPrec ListQueriesResponse
Int -> ReadS ListQueriesResponse
ReadS [ListQueriesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQueriesResponse]
$creadListPrec :: ReadPrec [ListQueriesResponse]
readPrec :: ReadPrec ListQueriesResponse
$creadPrec :: ReadPrec ListQueriesResponse
readList :: ReadS [ListQueriesResponse]
$creadList :: ReadS [ListQueriesResponse]
readsPrec :: Int -> ReadS ListQueriesResponse
$creadsPrec :: Int -> ReadS ListQueriesResponse
Prelude.Read, Int -> ListQueriesResponse -> ShowS
[ListQueriesResponse] -> ShowS
ListQueriesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQueriesResponse] -> ShowS
$cshowList :: [ListQueriesResponse] -> ShowS
show :: ListQueriesResponse -> String
$cshow :: ListQueriesResponse -> String
showsPrec :: Int -> ListQueriesResponse -> ShowS
$cshowsPrec :: Int -> ListQueriesResponse -> ShowS
Prelude.Show, forall x. Rep ListQueriesResponse x -> ListQueriesResponse
forall x. ListQueriesResponse -> Rep ListQueriesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListQueriesResponse x -> ListQueriesResponse
$cfrom :: forall x. ListQueriesResponse -> Rep ListQueriesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListQueriesResponse' 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:
--
-- 'nextToken', 'listQueriesResponse_nextToken' - A token you can use to get the next page of results.
--
-- 'queries', 'listQueriesResponse_queries' - Lists matching query results, and shows query ID, status, and creation
-- time of each query.
--
-- 'httpStatus', 'listQueriesResponse_httpStatus' - The response's http status code.
newListQueriesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListQueriesResponse
newListQueriesResponse :: Int -> ListQueriesResponse
newListQueriesResponse Int
pHttpStatus_ =
  ListQueriesResponse'
    { $sel:nextToken:ListQueriesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:queries:ListQueriesResponse' :: Maybe [Query]
queries = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListQueriesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A token you can use to get the next page of results.
listQueriesResponse_nextToken :: Lens.Lens' ListQueriesResponse (Prelude.Maybe Prelude.Text)
listQueriesResponse_nextToken :: Lens' ListQueriesResponse (Maybe Text)
listQueriesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueriesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQueriesResponse' :: ListQueriesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQueriesResponse
s@ListQueriesResponse' {} Maybe Text
a -> ListQueriesResponse
s {$sel:nextToken:ListQueriesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListQueriesResponse)

-- | Lists matching query results, and shows query ID, status, and creation
-- time of each query.
listQueriesResponse_queries :: Lens.Lens' ListQueriesResponse (Prelude.Maybe [Query])
listQueriesResponse_queries :: Lens' ListQueriesResponse (Maybe [Query])
listQueriesResponse_queries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueriesResponse' {Maybe [Query]
queries :: Maybe [Query]
$sel:queries:ListQueriesResponse' :: ListQueriesResponse -> Maybe [Query]
queries} -> Maybe [Query]
queries) (\s :: ListQueriesResponse
s@ListQueriesResponse' {} Maybe [Query]
a -> ListQueriesResponse
s {$sel:queries:ListQueriesResponse' :: Maybe [Query]
queries = Maybe [Query]
a} :: ListQueriesResponse) 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.
listQueriesResponse_httpStatus :: Lens.Lens' ListQueriesResponse Prelude.Int
listQueriesResponse_httpStatus :: Lens' ListQueriesResponse Int
listQueriesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueriesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListQueriesResponse' :: ListQueriesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListQueriesResponse
s@ListQueriesResponse' {} Int
a -> ListQueriesResponse
s {$sel:httpStatus:ListQueriesResponse' :: Int
httpStatus = Int
a} :: ListQueriesResponse)

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