{-# 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.Athena.ListQueryExecutions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides a list of available query execution IDs for the queries in the
-- specified workgroup. If a workgroup is not specified, returns a list of
-- query execution IDs for the primary workgroup. Requires you to have
-- access to the workgroup in which the queries ran.
--
-- For code samples using the Amazon Web Services SDK for Java, see
-- <http://docs.aws.amazon.com/athena/latest/ug/code-samples.html Examples and Code Samples>
-- in the /Amazon Athena User Guide/.
--
-- This operation returns paginated results.
module Amazonka.Athena.ListQueryExecutions
  ( -- * Creating a Request
    ListQueryExecutions (..),
    newListQueryExecutions,

    -- * Request Lenses
    listQueryExecutions_maxResults,
    listQueryExecutions_nextToken,
    listQueryExecutions_workGroup,

    -- * Destructuring the Response
    ListQueryExecutionsResponse (..),
    newListQueryExecutionsResponse,

    -- * Response Lenses
    listQueryExecutionsResponse_nextToken,
    listQueryExecutionsResponse_queryExecutionIds,
    listQueryExecutionsResponse_httpStatus,
  )
where

import Amazonka.Athena.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:/ 'newListQueryExecutions' smart constructor.
data ListQueryExecutions = ListQueryExecutions'
  { -- | The maximum number of query executions to return in this request.
    ListQueryExecutions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token generated by the Athena service that specifies where to continue
    -- pagination if a previous request was truncated. To obtain the next set
    -- of pages, pass in the @NextToken@ from the response object of the
    -- previous page call.
    ListQueryExecutions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the workgroup from which queries are being returned. If a
    -- workgroup is not specified, a list of available query execution IDs for
    -- the queries in the primary workgroup is returned.
    ListQueryExecutions -> Maybe Text
workGroup :: Prelude.Maybe Prelude.Text
  }
  deriving (ListQueryExecutions -> ListQueryExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQueryExecutions -> ListQueryExecutions -> Bool
$c/= :: ListQueryExecutions -> ListQueryExecutions -> Bool
== :: ListQueryExecutions -> ListQueryExecutions -> Bool
$c== :: ListQueryExecutions -> ListQueryExecutions -> Bool
Prelude.Eq, ReadPrec [ListQueryExecutions]
ReadPrec ListQueryExecutions
Int -> ReadS ListQueryExecutions
ReadS [ListQueryExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQueryExecutions]
$creadListPrec :: ReadPrec [ListQueryExecutions]
readPrec :: ReadPrec ListQueryExecutions
$creadPrec :: ReadPrec ListQueryExecutions
readList :: ReadS [ListQueryExecutions]
$creadList :: ReadS [ListQueryExecutions]
readsPrec :: Int -> ReadS ListQueryExecutions
$creadsPrec :: Int -> ReadS ListQueryExecutions
Prelude.Read, Int -> ListQueryExecutions -> ShowS
[ListQueryExecutions] -> ShowS
ListQueryExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQueryExecutions] -> ShowS
$cshowList :: [ListQueryExecutions] -> ShowS
show :: ListQueryExecutions -> String
$cshow :: ListQueryExecutions -> String
showsPrec :: Int -> ListQueryExecutions -> ShowS
$cshowsPrec :: Int -> ListQueryExecutions -> ShowS
Prelude.Show, forall x. Rep ListQueryExecutions x -> ListQueryExecutions
forall x. ListQueryExecutions -> Rep ListQueryExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListQueryExecutions x -> ListQueryExecutions
$cfrom :: forall x. ListQueryExecutions -> Rep ListQueryExecutions x
Prelude.Generic)

-- |
-- Create a value of 'ListQueryExecutions' 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:
--
-- 'maxResults', 'listQueryExecutions_maxResults' - The maximum number of query executions to return in this request.
--
-- 'nextToken', 'listQueryExecutions_nextToken' - A token generated by the Athena service that specifies where to continue
-- pagination if a previous request was truncated. To obtain the next set
-- of pages, pass in the @NextToken@ from the response object of the
-- previous page call.
--
-- 'workGroup', 'listQueryExecutions_workGroup' - The name of the workgroup from which queries are being returned. If a
-- workgroup is not specified, a list of available query execution IDs for
-- the queries in the primary workgroup is returned.
newListQueryExecutions ::
  ListQueryExecutions
newListQueryExecutions :: ListQueryExecutions
newListQueryExecutions =
  ListQueryExecutions'
    { $sel:maxResults:ListQueryExecutions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListQueryExecutions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:workGroup:ListQueryExecutions' :: Maybe Text
workGroup = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of query executions to return in this request.
listQueryExecutions_maxResults :: Lens.Lens' ListQueryExecutions (Prelude.Maybe Prelude.Natural)
listQueryExecutions_maxResults :: Lens' ListQueryExecutions (Maybe Natural)
listQueryExecutions_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueryExecutions' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListQueryExecutions' :: ListQueryExecutions -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListQueryExecutions
s@ListQueryExecutions' {} Maybe Natural
a -> ListQueryExecutions
s {$sel:maxResults:ListQueryExecutions' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListQueryExecutions)

-- | A token generated by the Athena service that specifies where to continue
-- pagination if a previous request was truncated. To obtain the next set
-- of pages, pass in the @NextToken@ from the response object of the
-- previous page call.
listQueryExecutions_nextToken :: Lens.Lens' ListQueryExecutions (Prelude.Maybe Prelude.Text)
listQueryExecutions_nextToken :: Lens' ListQueryExecutions (Maybe Text)
listQueryExecutions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueryExecutions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQueryExecutions
s@ListQueryExecutions' {} Maybe Text
a -> ListQueryExecutions
s {$sel:nextToken:ListQueryExecutions' :: Maybe Text
nextToken = Maybe Text
a} :: ListQueryExecutions)

-- | The name of the workgroup from which queries are being returned. If a
-- workgroup is not specified, a list of available query execution IDs for
-- the queries in the primary workgroup is returned.
listQueryExecutions_workGroup :: Lens.Lens' ListQueryExecutions (Prelude.Maybe Prelude.Text)
listQueryExecutions_workGroup :: Lens' ListQueryExecutions (Maybe Text)
listQueryExecutions_workGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueryExecutions' {Maybe Text
workGroup :: Maybe Text
$sel:workGroup:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
workGroup} -> Maybe Text
workGroup) (\s :: ListQueryExecutions
s@ListQueryExecutions' {} Maybe Text
a -> ListQueryExecutions
s {$sel:workGroup:ListQueryExecutions' :: Maybe Text
workGroup = Maybe Text
a} :: ListQueryExecutions)

instance Core.AWSPager ListQueryExecutions where
  page :: ListQueryExecutions
-> AWSResponse ListQueryExecutions -> Maybe ListQueryExecutions
page ListQueryExecutions
rq AWSResponse ListQueryExecutions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListQueryExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListQueryExecutionsResponse (Maybe Text)
listQueryExecutionsResponse_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 ListQueryExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListQueryExecutionsResponse (Maybe (NonEmpty Text))
listQueryExecutionsResponse_queryExecutionIds
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall l. IsList l => l -> [Item l]
Prelude.toList
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListQueryExecutions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListQueryExecutions (Maybe Text)
listQueryExecutions_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListQueryExecutions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListQueryExecutionsResponse (Maybe Text)
listQueryExecutionsResponse_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 ListQueryExecutions where
  type
    AWSResponse ListQueryExecutions =
      ListQueryExecutionsResponse
  request :: (Service -> Service)
-> ListQueryExecutions -> Request ListQueryExecutions
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 ListQueryExecutions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListQueryExecutions)))
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 (NonEmpty Text) -> Int -> ListQueryExecutionsResponse
ListQueryExecutionsResponse'
            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
"QueryExecutionIds")
            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 ListQueryExecutions where
  hashWithSalt :: Int -> ListQueryExecutions -> Int
hashWithSalt Int
_salt ListQueryExecutions' {Maybe Natural
Maybe Text
workGroup :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:workGroup:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
$sel:nextToken:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
$sel:maxResults:ListQueryExecutions' :: ListQueryExecutions -> Maybe Natural
..} =
    Int
_salt
      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 Text
workGroup

instance Prelude.NFData ListQueryExecutions where
  rnf :: ListQueryExecutions -> ()
rnf ListQueryExecutions' {Maybe Natural
Maybe Text
workGroup :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:workGroup:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
$sel:nextToken:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
$sel:maxResults:ListQueryExecutions' :: ListQueryExecutions -> Maybe Natural
..} =
    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 Text
workGroup

instance Data.ToHeaders ListQueryExecutions where
  toHeaders :: ListQueryExecutions -> 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
"AmazonAthena.ListQueryExecutions" ::
                          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 ListQueryExecutions where
  toJSON :: ListQueryExecutions -> Value
toJSON ListQueryExecutions' {Maybe Natural
Maybe Text
workGroup :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:workGroup:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
$sel:nextToken:ListQueryExecutions' :: ListQueryExecutions -> Maybe Text
$sel:maxResults:ListQueryExecutions' :: ListQueryExecutions -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"WorkGroup" 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
workGroup
          ]
      )

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

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

-- | /See:/ 'newListQueryExecutionsResponse' smart constructor.
data ListQueryExecutionsResponse = ListQueryExecutionsResponse'
  { -- | A token to be used by the next request if this request is truncated.
    ListQueryExecutionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The unique IDs of each query execution as an array of strings.
    ListQueryExecutionsResponse -> Maybe (NonEmpty Text)
queryExecutionIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    ListQueryExecutionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListQueryExecutionsResponse -> ListQueryExecutionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQueryExecutionsResponse -> ListQueryExecutionsResponse -> Bool
$c/= :: ListQueryExecutionsResponse -> ListQueryExecutionsResponse -> Bool
== :: ListQueryExecutionsResponse -> ListQueryExecutionsResponse -> Bool
$c== :: ListQueryExecutionsResponse -> ListQueryExecutionsResponse -> Bool
Prelude.Eq, ReadPrec [ListQueryExecutionsResponse]
ReadPrec ListQueryExecutionsResponse
Int -> ReadS ListQueryExecutionsResponse
ReadS [ListQueryExecutionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQueryExecutionsResponse]
$creadListPrec :: ReadPrec [ListQueryExecutionsResponse]
readPrec :: ReadPrec ListQueryExecutionsResponse
$creadPrec :: ReadPrec ListQueryExecutionsResponse
readList :: ReadS [ListQueryExecutionsResponse]
$creadList :: ReadS [ListQueryExecutionsResponse]
readsPrec :: Int -> ReadS ListQueryExecutionsResponse
$creadsPrec :: Int -> ReadS ListQueryExecutionsResponse
Prelude.Read, Int -> ListQueryExecutionsResponse -> ShowS
[ListQueryExecutionsResponse] -> ShowS
ListQueryExecutionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQueryExecutionsResponse] -> ShowS
$cshowList :: [ListQueryExecutionsResponse] -> ShowS
show :: ListQueryExecutionsResponse -> String
$cshow :: ListQueryExecutionsResponse -> String
showsPrec :: Int -> ListQueryExecutionsResponse -> ShowS
$cshowsPrec :: Int -> ListQueryExecutionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListQueryExecutionsResponse x -> ListQueryExecutionsResponse
forall x.
ListQueryExecutionsResponse -> Rep ListQueryExecutionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListQueryExecutionsResponse x -> ListQueryExecutionsResponse
$cfrom :: forall x.
ListQueryExecutionsResponse -> Rep ListQueryExecutionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListQueryExecutionsResponse' 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', 'listQueryExecutionsResponse_nextToken' - A token to be used by the next request if this request is truncated.
--
-- 'queryExecutionIds', 'listQueryExecutionsResponse_queryExecutionIds' - The unique IDs of each query execution as an array of strings.
--
-- 'httpStatus', 'listQueryExecutionsResponse_httpStatus' - The response's http status code.
newListQueryExecutionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListQueryExecutionsResponse
newListQueryExecutionsResponse :: Int -> ListQueryExecutionsResponse
newListQueryExecutionsResponse Int
pHttpStatus_ =
  ListQueryExecutionsResponse'
    { $sel:nextToken:ListQueryExecutionsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:queryExecutionIds:ListQueryExecutionsResponse' :: Maybe (NonEmpty Text)
queryExecutionIds = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListQueryExecutionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A token to be used by the next request if this request is truncated.
listQueryExecutionsResponse_nextToken :: Lens.Lens' ListQueryExecutionsResponse (Prelude.Maybe Prelude.Text)
listQueryExecutionsResponse_nextToken :: Lens' ListQueryExecutionsResponse (Maybe Text)
listQueryExecutionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueryExecutionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQueryExecutionsResponse' :: ListQueryExecutionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQueryExecutionsResponse
s@ListQueryExecutionsResponse' {} Maybe Text
a -> ListQueryExecutionsResponse
s {$sel:nextToken:ListQueryExecutionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListQueryExecutionsResponse)

-- | The unique IDs of each query execution as an array of strings.
listQueryExecutionsResponse_queryExecutionIds :: Lens.Lens' ListQueryExecutionsResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
listQueryExecutionsResponse_queryExecutionIds :: Lens' ListQueryExecutionsResponse (Maybe (NonEmpty Text))
listQueryExecutionsResponse_queryExecutionIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueryExecutionsResponse' {Maybe (NonEmpty Text)
queryExecutionIds :: Maybe (NonEmpty Text)
$sel:queryExecutionIds:ListQueryExecutionsResponse' :: ListQueryExecutionsResponse -> Maybe (NonEmpty Text)
queryExecutionIds} -> Maybe (NonEmpty Text)
queryExecutionIds) (\s :: ListQueryExecutionsResponse
s@ListQueryExecutionsResponse' {} Maybe (NonEmpty Text)
a -> ListQueryExecutionsResponse
s {$sel:queryExecutionIds:ListQueryExecutionsResponse' :: Maybe (NonEmpty Text)
queryExecutionIds = Maybe (NonEmpty Text)
a} :: ListQueryExecutionsResponse) 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.
listQueryExecutionsResponse_httpStatus :: Lens.Lens' ListQueryExecutionsResponse Prelude.Int
listQueryExecutionsResponse_httpStatus :: Lens' ListQueryExecutionsResponse Int
listQueryExecutionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueryExecutionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListQueryExecutionsResponse' :: ListQueryExecutionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListQueryExecutionsResponse
s@ListQueryExecutionsResponse' {} Int
a -> ListQueryExecutionsResponse
s {$sel:httpStatus:ListQueryExecutionsResponse' :: Int
httpStatus = Int
a} :: ListQueryExecutionsResponse)

instance Prelude.NFData ListQueryExecutionsResponse where
  rnf :: ListQueryExecutionsResponse -> ()
rnf ListQueryExecutionsResponse' {Int
Maybe (NonEmpty Text)
Maybe Text
httpStatus :: Int
queryExecutionIds :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
$sel:httpStatus:ListQueryExecutionsResponse' :: ListQueryExecutionsResponse -> Int
$sel:queryExecutionIds:ListQueryExecutionsResponse' :: ListQueryExecutionsResponse -> Maybe (NonEmpty Text)
$sel:nextToken:ListQueryExecutionsResponse' :: ListQueryExecutionsResponse -> 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 (NonEmpty Text)
queryExecutionIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus