{-# 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.RedshiftData.ListStatements
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List of SQL statements. By default, only finished statements are shown.
-- A token is returned to page through the statement list.
--
-- For more information about the Amazon Redshift Data API and CLI usage
-- examples, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/data-api.html Using the Amazon Redshift Data API>
-- in the /Amazon Redshift Management Guide/.
--
-- This operation returns paginated results.
module Amazonka.RedshiftData.ListStatements
  ( -- * Creating a Request
    ListStatements (..),
    newListStatements,

    -- * Request Lenses
    listStatements_maxResults,
    listStatements_nextToken,
    listStatements_roleLevel,
    listStatements_statementName,
    listStatements_status,

    -- * Destructuring the Response
    ListStatementsResponse (..),
    newListStatementsResponse,

    -- * Response Lenses
    listStatementsResponse_nextToken,
    listStatementsResponse_httpStatus,
    listStatementsResponse_statements,
  )
where

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 Amazonka.RedshiftData.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListStatements' smart constructor.
data ListStatements = ListStatements'
  { -- | The maximum number of SQL statements to return in the response. If more
    -- SQL statements exist than fit in one response, then @NextToken@ is
    -- returned to page through the results.
    ListStatements -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A value that indicates the starting point for the next set of response
    -- records in a subsequent request. If a value is returned in a response,
    -- you can retrieve the next set of records by providing this returned
    -- NextToken value in the next NextToken parameter and retrying the
    -- command. If the NextToken field is empty, all response records have been
    -- retrieved for the request.
    ListStatements -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A value that filters which statements to return in the response. If
    -- true, all statements run by the caller\'s IAM role are returned. If
    -- false, only statements run by the caller\'s IAM role in the current IAM
    -- session are returned. The default is true.
    ListStatements -> Maybe Bool
roleLevel :: Prelude.Maybe Prelude.Bool,
    -- | The name of the SQL statement specified as input to
    -- @BatchExecuteStatement@ or @ExecuteStatement@ to identify the query. You
    -- can list multiple statements by providing a prefix that matches the
    -- beginning of the statement name. For example, to list myStatement1,
    -- myStatement2, myStatement3, and so on, then provide the a value of
    -- @myStatement@. Data API does a case-sensitive match of SQL statement
    -- names to the prefix value you provide.
    ListStatements -> Maybe Text
statementName :: Prelude.Maybe Prelude.Text,
    -- | The status of the SQL statement to list. Status values are defined as
    -- follows:
    --
    -- -   ABORTED - The query run was stopped by the user.
    --
    -- -   ALL - A status value that includes all query statuses. This value
    --     can be used to filter results.
    --
    -- -   FAILED - The query run failed.
    --
    -- -   FINISHED - The query has finished running.
    --
    -- -   PICKED - The query has been chosen to be run.
    --
    -- -   STARTED - The query run has started.
    --
    -- -   SUBMITTED - The query was submitted, but not yet processed.
    ListStatements -> Maybe StatusString
status :: Prelude.Maybe StatusString
  }
  deriving (ListStatements -> ListStatements -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStatements -> ListStatements -> Bool
$c/= :: ListStatements -> ListStatements -> Bool
== :: ListStatements -> ListStatements -> Bool
$c== :: ListStatements -> ListStatements -> Bool
Prelude.Eq, ReadPrec [ListStatements]
ReadPrec ListStatements
Int -> ReadS ListStatements
ReadS [ListStatements]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStatements]
$creadListPrec :: ReadPrec [ListStatements]
readPrec :: ReadPrec ListStatements
$creadPrec :: ReadPrec ListStatements
readList :: ReadS [ListStatements]
$creadList :: ReadS [ListStatements]
readsPrec :: Int -> ReadS ListStatements
$creadsPrec :: Int -> ReadS ListStatements
Prelude.Read, Int -> ListStatements -> ShowS
[ListStatements] -> ShowS
ListStatements -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStatements] -> ShowS
$cshowList :: [ListStatements] -> ShowS
show :: ListStatements -> String
$cshow :: ListStatements -> String
showsPrec :: Int -> ListStatements -> ShowS
$cshowsPrec :: Int -> ListStatements -> ShowS
Prelude.Show, forall x. Rep ListStatements x -> ListStatements
forall x. ListStatements -> Rep ListStatements x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListStatements x -> ListStatements
$cfrom :: forall x. ListStatements -> Rep ListStatements x
Prelude.Generic)

-- |
-- Create a value of 'ListStatements' 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', 'listStatements_maxResults' - The maximum number of SQL statements to return in the response. If more
-- SQL statements exist than fit in one response, then @NextToken@ is
-- returned to page through the results.
--
-- 'nextToken', 'listStatements_nextToken' - A value that indicates the starting point for the next set of response
-- records in a subsequent request. If a value is returned in a response,
-- you can retrieve the next set of records by providing this returned
-- NextToken value in the next NextToken parameter and retrying the
-- command. If the NextToken field is empty, all response records have been
-- retrieved for the request.
--
-- 'roleLevel', 'listStatements_roleLevel' - A value that filters which statements to return in the response. If
-- true, all statements run by the caller\'s IAM role are returned. If
-- false, only statements run by the caller\'s IAM role in the current IAM
-- session are returned. The default is true.
--
-- 'statementName', 'listStatements_statementName' - The name of the SQL statement specified as input to
-- @BatchExecuteStatement@ or @ExecuteStatement@ to identify the query. You
-- can list multiple statements by providing a prefix that matches the
-- beginning of the statement name. For example, to list myStatement1,
-- myStatement2, myStatement3, and so on, then provide the a value of
-- @myStatement@. Data API does a case-sensitive match of SQL statement
-- names to the prefix value you provide.
--
-- 'status', 'listStatements_status' - The status of the SQL statement to list. Status values are defined as
-- follows:
--
-- -   ABORTED - The query run was stopped by the user.
--
-- -   ALL - A status value that includes all query statuses. This value
--     can be used to filter results.
--
-- -   FAILED - The query run failed.
--
-- -   FINISHED - The query has finished running.
--
-- -   PICKED - The query has been chosen to be run.
--
-- -   STARTED - The query run has started.
--
-- -   SUBMITTED - The query was submitted, but not yet processed.
newListStatements ::
  ListStatements
newListStatements :: ListStatements
newListStatements =
  ListStatements'
    { $sel:maxResults:ListStatements' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListStatements' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:roleLevel:ListStatements' :: Maybe Bool
roleLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:statementName:ListStatements' :: Maybe Text
statementName = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListStatements' :: Maybe StatusString
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of SQL statements to return in the response. If more
-- SQL statements exist than fit in one response, then @NextToken@ is
-- returned to page through the results.
listStatements_maxResults :: Lens.Lens' ListStatements (Prelude.Maybe Prelude.Natural)
listStatements_maxResults :: Lens' ListStatements (Maybe Natural)
listStatements_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStatements' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListStatements' :: ListStatements -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListStatements
s@ListStatements' {} Maybe Natural
a -> ListStatements
s {$sel:maxResults:ListStatements' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListStatements)

-- | A value that indicates the starting point for the next set of response
-- records in a subsequent request. If a value is returned in a response,
-- you can retrieve the next set of records by providing this returned
-- NextToken value in the next NextToken parameter and retrying the
-- command. If the NextToken field is empty, all response records have been
-- retrieved for the request.
listStatements_nextToken :: Lens.Lens' ListStatements (Prelude.Maybe Prelude.Text)
listStatements_nextToken :: Lens' ListStatements (Maybe Text)
listStatements_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStatements' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStatements' :: ListStatements -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStatements
s@ListStatements' {} Maybe Text
a -> ListStatements
s {$sel:nextToken:ListStatements' :: Maybe Text
nextToken = Maybe Text
a} :: ListStatements)

-- | A value that filters which statements to return in the response. If
-- true, all statements run by the caller\'s IAM role are returned. If
-- false, only statements run by the caller\'s IAM role in the current IAM
-- session are returned. The default is true.
listStatements_roleLevel :: Lens.Lens' ListStatements (Prelude.Maybe Prelude.Bool)
listStatements_roleLevel :: Lens' ListStatements (Maybe Bool)
listStatements_roleLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStatements' {Maybe Bool
roleLevel :: Maybe Bool
$sel:roleLevel:ListStatements' :: ListStatements -> Maybe Bool
roleLevel} -> Maybe Bool
roleLevel) (\s :: ListStatements
s@ListStatements' {} Maybe Bool
a -> ListStatements
s {$sel:roleLevel:ListStatements' :: Maybe Bool
roleLevel = Maybe Bool
a} :: ListStatements)

-- | The name of the SQL statement specified as input to
-- @BatchExecuteStatement@ or @ExecuteStatement@ to identify the query. You
-- can list multiple statements by providing a prefix that matches the
-- beginning of the statement name. For example, to list myStatement1,
-- myStatement2, myStatement3, and so on, then provide the a value of
-- @myStatement@. Data API does a case-sensitive match of SQL statement
-- names to the prefix value you provide.
listStatements_statementName :: Lens.Lens' ListStatements (Prelude.Maybe Prelude.Text)
listStatements_statementName :: Lens' ListStatements (Maybe Text)
listStatements_statementName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStatements' {Maybe Text
statementName :: Maybe Text
$sel:statementName:ListStatements' :: ListStatements -> Maybe Text
statementName} -> Maybe Text
statementName) (\s :: ListStatements
s@ListStatements' {} Maybe Text
a -> ListStatements
s {$sel:statementName:ListStatements' :: Maybe Text
statementName = Maybe Text
a} :: ListStatements)

-- | The status of the SQL statement to list. Status values are defined as
-- follows:
--
-- -   ABORTED - The query run was stopped by the user.
--
-- -   ALL - A status value that includes all query statuses. This value
--     can be used to filter results.
--
-- -   FAILED - The query run failed.
--
-- -   FINISHED - The query has finished running.
--
-- -   PICKED - The query has been chosen to be run.
--
-- -   STARTED - The query run has started.
--
-- -   SUBMITTED - The query was submitted, but not yet processed.
listStatements_status :: Lens.Lens' ListStatements (Prelude.Maybe StatusString)
listStatements_status :: Lens' ListStatements (Maybe StatusString)
listStatements_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStatements' {Maybe StatusString
status :: Maybe StatusString
$sel:status:ListStatements' :: ListStatements -> Maybe StatusString
status} -> Maybe StatusString
status) (\s :: ListStatements
s@ListStatements' {} Maybe StatusString
a -> ListStatements
s {$sel:status:ListStatements' :: Maybe StatusString
status = Maybe StatusString
a} :: ListStatements)

instance Core.AWSPager ListStatements where
  page :: ListStatements
-> AWSResponse ListStatements -> Maybe ListStatements
page ListStatements
rq AWSResponse ListStatements
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListStatements
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStatementsResponse (Maybe Text)
listStatementsResponse_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 ListStatements
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListStatementsResponse [StatementData]
listStatementsResponse_statements) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListStatements
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListStatements (Maybe Text)
listStatements_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListStatements
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStatementsResponse (Maybe Text)
listStatementsResponse_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 ListStatements where
  type
    AWSResponse ListStatements =
      ListStatementsResponse
  request :: (Service -> Service) -> ListStatements -> Request ListStatements
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 ListStatements
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListStatements)))
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 -> Int -> [StatementData] -> ListStatementsResponse
ListStatementsResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"Statements" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ListStatements where
  hashWithSalt :: Int -> ListStatements -> Int
hashWithSalt Int
_salt ListStatements' {Maybe Bool
Maybe Natural
Maybe Text
Maybe StatusString
status :: Maybe StatusString
statementName :: Maybe Text
roleLevel :: Maybe Bool
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:status:ListStatements' :: ListStatements -> Maybe StatusString
$sel:statementName:ListStatements' :: ListStatements -> Maybe Text
$sel:roleLevel:ListStatements' :: ListStatements -> Maybe Bool
$sel:nextToken:ListStatements' :: ListStatements -> Maybe Text
$sel:maxResults:ListStatements' :: ListStatements -> 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 Bool
roleLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statementName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StatusString
status

instance Prelude.NFData ListStatements where
  rnf :: ListStatements -> ()
rnf ListStatements' {Maybe Bool
Maybe Natural
Maybe Text
Maybe StatusString
status :: Maybe StatusString
statementName :: Maybe Text
roleLevel :: Maybe Bool
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:status:ListStatements' :: ListStatements -> Maybe StatusString
$sel:statementName:ListStatements' :: ListStatements -> Maybe Text
$sel:roleLevel:ListStatements' :: ListStatements -> Maybe Bool
$sel:nextToken:ListStatements' :: ListStatements -> Maybe Text
$sel:maxResults:ListStatements' :: ListStatements -> 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 Bool
roleLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statementName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StatusString
status

instance Data.ToHeaders ListStatements where
  toHeaders :: ListStatements -> 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
"RedshiftData.ListStatements" ::
                          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 ListStatements where
  toJSON :: ListStatements -> Value
toJSON ListStatements' {Maybe Bool
Maybe Natural
Maybe Text
Maybe StatusString
status :: Maybe StatusString
statementName :: Maybe Text
roleLevel :: Maybe Bool
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:status:ListStatements' :: ListStatements -> Maybe StatusString
$sel:statementName:ListStatements' :: ListStatements -> Maybe Text
$sel:roleLevel:ListStatements' :: ListStatements -> Maybe Bool
$sel:nextToken:ListStatements' :: ListStatements -> Maybe Text
$sel:maxResults:ListStatements' :: ListStatements -> 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
"RoleLevel" 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
roleLevel,
            (Key
"StatementName" 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
statementName,
            (Key
"Status" 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 StatusString
status
          ]
      )

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

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

-- | /See:/ 'newListStatementsResponse' smart constructor.
data ListStatementsResponse = ListStatementsResponse'
  { -- | A value that indicates the starting point for the next set of response
    -- records in a subsequent request. If a value is returned in a response,
    -- you can retrieve the next set of records by providing this returned
    -- NextToken value in the next NextToken parameter and retrying the
    -- command. If the NextToken field is empty, all response records have been
    -- retrieved for the request.
    ListStatementsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListStatementsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The SQL statements.
    ListStatementsResponse -> [StatementData]
statements :: [StatementData]
  }
  deriving (ListStatementsResponse -> ListStatementsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStatementsResponse -> ListStatementsResponse -> Bool
$c/= :: ListStatementsResponse -> ListStatementsResponse -> Bool
== :: ListStatementsResponse -> ListStatementsResponse -> Bool
$c== :: ListStatementsResponse -> ListStatementsResponse -> Bool
Prelude.Eq, ReadPrec [ListStatementsResponse]
ReadPrec ListStatementsResponse
Int -> ReadS ListStatementsResponse
ReadS [ListStatementsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStatementsResponse]
$creadListPrec :: ReadPrec [ListStatementsResponse]
readPrec :: ReadPrec ListStatementsResponse
$creadPrec :: ReadPrec ListStatementsResponse
readList :: ReadS [ListStatementsResponse]
$creadList :: ReadS [ListStatementsResponse]
readsPrec :: Int -> ReadS ListStatementsResponse
$creadsPrec :: Int -> ReadS ListStatementsResponse
Prelude.Read, Int -> ListStatementsResponse -> ShowS
[ListStatementsResponse] -> ShowS
ListStatementsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStatementsResponse] -> ShowS
$cshowList :: [ListStatementsResponse] -> ShowS
show :: ListStatementsResponse -> String
$cshow :: ListStatementsResponse -> String
showsPrec :: Int -> ListStatementsResponse -> ShowS
$cshowsPrec :: Int -> ListStatementsResponse -> ShowS
Prelude.Show, forall x. Rep ListStatementsResponse x -> ListStatementsResponse
forall x. ListStatementsResponse -> Rep ListStatementsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListStatementsResponse x -> ListStatementsResponse
$cfrom :: forall x. ListStatementsResponse -> Rep ListStatementsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListStatementsResponse' 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', 'listStatementsResponse_nextToken' - A value that indicates the starting point for the next set of response
-- records in a subsequent request. If a value is returned in a response,
-- you can retrieve the next set of records by providing this returned
-- NextToken value in the next NextToken parameter and retrying the
-- command. If the NextToken field is empty, all response records have been
-- retrieved for the request.
--
-- 'httpStatus', 'listStatementsResponse_httpStatus' - The response's http status code.
--
-- 'statements', 'listStatementsResponse_statements' - The SQL statements.
newListStatementsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListStatementsResponse
newListStatementsResponse :: Int -> ListStatementsResponse
newListStatementsResponse Int
pHttpStatus_ =
  ListStatementsResponse'
    { $sel:nextToken:ListStatementsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListStatementsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:statements:ListStatementsResponse' :: [StatementData]
statements = forall a. Monoid a => a
Prelude.mempty
    }

-- | A value that indicates the starting point for the next set of response
-- records in a subsequent request. If a value is returned in a response,
-- you can retrieve the next set of records by providing this returned
-- NextToken value in the next NextToken parameter and retrying the
-- command. If the NextToken field is empty, all response records have been
-- retrieved for the request.
listStatementsResponse_nextToken :: Lens.Lens' ListStatementsResponse (Prelude.Maybe Prelude.Text)
listStatementsResponse_nextToken :: Lens' ListStatementsResponse (Maybe Text)
listStatementsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStatementsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStatementsResponse' :: ListStatementsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStatementsResponse
s@ListStatementsResponse' {} Maybe Text
a -> ListStatementsResponse
s {$sel:nextToken:ListStatementsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListStatementsResponse)

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

-- | The SQL statements.
listStatementsResponse_statements :: Lens.Lens' ListStatementsResponse [StatementData]
listStatementsResponse_statements :: Lens' ListStatementsResponse [StatementData]
listStatementsResponse_statements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStatementsResponse' {[StatementData]
statements :: [StatementData]
$sel:statements:ListStatementsResponse' :: ListStatementsResponse -> [StatementData]
statements} -> [StatementData]
statements) (\s :: ListStatementsResponse
s@ListStatementsResponse' {} [StatementData]
a -> ListStatementsResponse
s {$sel:statements:ListStatementsResponse' :: [StatementData]
statements = [StatementData]
a} :: ListStatementsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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