{-# 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.RDSData.ExecuteStatement
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Runs a SQL statement against a database.
--
-- If a call isn\'t part of a transaction because it doesn\'t include the
-- @transactionID@ parameter, changes that result from the call are
-- committed automatically.
--
-- If the binary response data from the database is more than 1 MB, the
-- call is terminated.
module Amazonka.RDSData.ExecuteStatement
  ( -- * Creating a Request
    ExecuteStatement (..),
    newExecuteStatement,

    -- * Request Lenses
    executeStatement_continueAfterTimeout,
    executeStatement_database,
    executeStatement_formatRecordsAs,
    executeStatement_includeResultMetadata,
    executeStatement_parameters,
    executeStatement_resultSetOptions,
    executeStatement_schema,
    executeStatement_transactionId,
    executeStatement_resourceArn,
    executeStatement_secretArn,
    executeStatement_sql,

    -- * Destructuring the Response
    ExecuteStatementResponse (..),
    newExecuteStatementResponse,

    -- * Response Lenses
    executeStatementResponse_columnMetadata,
    executeStatementResponse_formattedRecords,
    executeStatementResponse_generatedFields,
    executeStatementResponse_numberOfRecordsUpdated,
    executeStatementResponse_records,
    executeStatementResponse_httpStatus,
  )
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.RDSData.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The request parameters represent the input of a request to run a SQL
-- statement against a database.
--
-- /See:/ 'newExecuteStatement' smart constructor.
data ExecuteStatement = ExecuteStatement'
  { -- | A value that indicates whether to continue running the statement after
    -- the call times out. By default, the statement stops running when the
    -- call times out.
    --
    -- For DDL statements, we recommend continuing to run the statement after
    -- the call times out. When a DDL statement terminates before it is
    -- finished running, it can result in errors and possibly corrupted data
    -- structures.
    ExecuteStatement -> Maybe Bool
continueAfterTimeout :: Prelude.Maybe Prelude.Bool,
    -- | The name of the database.
    ExecuteStatement -> Maybe Text
database :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether to format the result set as a single JSON
    -- string. This parameter only applies to @SELECT@ statements and is
    -- ignored for other types of statements. Allowed values are @NONE@ and
    -- @JSON@. The default value is @NONE@. The result is returned in the
    -- @formattedRecords@ field.
    --
    -- For usage information about the JSON format for result sets, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/data-api.html Using the Data API>
    -- in the /Amazon Aurora User Guide/.
    ExecuteStatement -> Maybe RecordsFormatType
formatRecordsAs :: Prelude.Maybe RecordsFormatType,
    -- | A value that indicates whether to include metadata in the results.
    ExecuteStatement -> Maybe Bool
includeResultMetadata :: Prelude.Maybe Prelude.Bool,
    -- | The parameters for the SQL statement.
    --
    -- Array parameters are not supported.
    ExecuteStatement -> Maybe [SqlParameter]
parameters :: Prelude.Maybe [SqlParameter],
    -- | Options that control how the result set is returned.
    ExecuteStatement -> Maybe ResultSetOptions
resultSetOptions :: Prelude.Maybe ResultSetOptions,
    -- | The name of the database schema.
    --
    -- Currently, the @schema@ parameter isn\'t supported.
    ExecuteStatement -> Maybe Text
schema :: Prelude.Maybe Prelude.Text,
    -- | The identifier of a transaction that was started by using the
    -- @BeginTransaction@ operation. Specify the transaction ID of the
    -- transaction that you want to include the SQL statement in.
    --
    -- If the SQL statement is not part of a transaction, don\'t set this
    -- parameter.
    ExecuteStatement -> Maybe Text
transactionId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
    ExecuteStatement -> Text
resourceArn :: Prelude.Text,
    -- | The ARN of the secret that enables access to the DB cluster. Enter the
    -- database user name and password for the credentials in the secret.
    --
    -- For information about creating the secret, see
    -- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/create_database_secret.html Create a database secret>.
    ExecuteStatement -> Text
secretArn :: Prelude.Text,
    -- | The SQL statement to run.
    ExecuteStatement -> Text
sql :: Prelude.Text
  }
  deriving (ExecuteStatement -> ExecuteStatement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteStatement -> ExecuteStatement -> Bool
$c/= :: ExecuteStatement -> ExecuteStatement -> Bool
== :: ExecuteStatement -> ExecuteStatement -> Bool
$c== :: ExecuteStatement -> ExecuteStatement -> Bool
Prelude.Eq, ReadPrec [ExecuteStatement]
ReadPrec ExecuteStatement
Int -> ReadS ExecuteStatement
ReadS [ExecuteStatement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteStatement]
$creadListPrec :: ReadPrec [ExecuteStatement]
readPrec :: ReadPrec ExecuteStatement
$creadPrec :: ReadPrec ExecuteStatement
readList :: ReadS [ExecuteStatement]
$creadList :: ReadS [ExecuteStatement]
readsPrec :: Int -> ReadS ExecuteStatement
$creadsPrec :: Int -> ReadS ExecuteStatement
Prelude.Read, Int -> ExecuteStatement -> ShowS
[ExecuteStatement] -> ShowS
ExecuteStatement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteStatement] -> ShowS
$cshowList :: [ExecuteStatement] -> ShowS
show :: ExecuteStatement -> String
$cshow :: ExecuteStatement -> String
showsPrec :: Int -> ExecuteStatement -> ShowS
$cshowsPrec :: Int -> ExecuteStatement -> ShowS
Prelude.Show, forall x. Rep ExecuteStatement x -> ExecuteStatement
forall x. ExecuteStatement -> Rep ExecuteStatement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecuteStatement x -> ExecuteStatement
$cfrom :: forall x. ExecuteStatement -> Rep ExecuteStatement x
Prelude.Generic)

-- |
-- Create a value of 'ExecuteStatement' 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:
--
-- 'continueAfterTimeout', 'executeStatement_continueAfterTimeout' - A value that indicates whether to continue running the statement after
-- the call times out. By default, the statement stops running when the
-- call times out.
--
-- For DDL statements, we recommend continuing to run the statement after
-- the call times out. When a DDL statement terminates before it is
-- finished running, it can result in errors and possibly corrupted data
-- structures.
--
-- 'database', 'executeStatement_database' - The name of the database.
--
-- 'formatRecordsAs', 'executeStatement_formatRecordsAs' - A value that indicates whether to format the result set as a single JSON
-- string. This parameter only applies to @SELECT@ statements and is
-- ignored for other types of statements. Allowed values are @NONE@ and
-- @JSON@. The default value is @NONE@. The result is returned in the
-- @formattedRecords@ field.
--
-- For usage information about the JSON format for result sets, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/data-api.html Using the Data API>
-- in the /Amazon Aurora User Guide/.
--
-- 'includeResultMetadata', 'executeStatement_includeResultMetadata' - A value that indicates whether to include metadata in the results.
--
-- 'parameters', 'executeStatement_parameters' - The parameters for the SQL statement.
--
-- Array parameters are not supported.
--
-- 'resultSetOptions', 'executeStatement_resultSetOptions' - Options that control how the result set is returned.
--
-- 'schema', 'executeStatement_schema' - The name of the database schema.
--
-- Currently, the @schema@ parameter isn\'t supported.
--
-- 'transactionId', 'executeStatement_transactionId' - The identifier of a transaction that was started by using the
-- @BeginTransaction@ operation. Specify the transaction ID of the
-- transaction that you want to include the SQL statement in.
--
-- If the SQL statement is not part of a transaction, don\'t set this
-- parameter.
--
-- 'resourceArn', 'executeStatement_resourceArn' - The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
--
-- 'secretArn', 'executeStatement_secretArn' - The ARN of the secret that enables access to the DB cluster. Enter the
-- database user name and password for the credentials in the secret.
--
-- For information about creating the secret, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/create_database_secret.html Create a database secret>.
--
-- 'sql', 'executeStatement_sql' - The SQL statement to run.
newExecuteStatement ::
  -- | 'resourceArn'
  Prelude.Text ->
  -- | 'secretArn'
  Prelude.Text ->
  -- | 'sql'
  Prelude.Text ->
  ExecuteStatement
newExecuteStatement :: Text -> Text -> Text -> ExecuteStatement
newExecuteStatement Text
pResourceArn_ Text
pSecretArn_ Text
pSql_ =
  ExecuteStatement'
    { $sel:continueAfterTimeout:ExecuteStatement' :: Maybe Bool
continueAfterTimeout =
        forall a. Maybe a
Prelude.Nothing,
      $sel:database:ExecuteStatement' :: Maybe Text
database = forall a. Maybe a
Prelude.Nothing,
      $sel:formatRecordsAs:ExecuteStatement' :: Maybe RecordsFormatType
formatRecordsAs = forall a. Maybe a
Prelude.Nothing,
      $sel:includeResultMetadata:ExecuteStatement' :: Maybe Bool
includeResultMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:ExecuteStatement' :: Maybe [SqlParameter]
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:resultSetOptions:ExecuteStatement' :: Maybe ResultSetOptions
resultSetOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:schema:ExecuteStatement' :: Maybe Text
schema = forall a. Maybe a
Prelude.Nothing,
      $sel:transactionId:ExecuteStatement' :: Maybe Text
transactionId = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:ExecuteStatement' :: Text
resourceArn = Text
pResourceArn_,
      $sel:secretArn:ExecuteStatement' :: Text
secretArn = Text
pSecretArn_,
      $sel:sql:ExecuteStatement' :: Text
sql = Text
pSql_
    }

-- | A value that indicates whether to continue running the statement after
-- the call times out. By default, the statement stops running when the
-- call times out.
--
-- For DDL statements, we recommend continuing to run the statement after
-- the call times out. When a DDL statement terminates before it is
-- finished running, it can result in errors and possibly corrupted data
-- structures.
executeStatement_continueAfterTimeout :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Bool)
executeStatement_continueAfterTimeout :: Lens' ExecuteStatement (Maybe Bool)
executeStatement_continueAfterTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Bool
continueAfterTimeout :: Maybe Bool
$sel:continueAfterTimeout:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
continueAfterTimeout} -> Maybe Bool
continueAfterTimeout) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Bool
a -> ExecuteStatement
s {$sel:continueAfterTimeout:ExecuteStatement' :: Maybe Bool
continueAfterTimeout = Maybe Bool
a} :: ExecuteStatement)

-- | The name of the database.
executeStatement_database :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Text)
executeStatement_database :: Lens' ExecuteStatement (Maybe Text)
executeStatement_database = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Text
database :: Maybe Text
$sel:database:ExecuteStatement' :: ExecuteStatement -> Maybe Text
database} -> Maybe Text
database) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Text
a -> ExecuteStatement
s {$sel:database:ExecuteStatement' :: Maybe Text
database = Maybe Text
a} :: ExecuteStatement)

-- | A value that indicates whether to format the result set as a single JSON
-- string. This parameter only applies to @SELECT@ statements and is
-- ignored for other types of statements. Allowed values are @NONE@ and
-- @JSON@. The default value is @NONE@. The result is returned in the
-- @formattedRecords@ field.
--
-- For usage information about the JSON format for result sets, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/data-api.html Using the Data API>
-- in the /Amazon Aurora User Guide/.
executeStatement_formatRecordsAs :: Lens.Lens' ExecuteStatement (Prelude.Maybe RecordsFormatType)
executeStatement_formatRecordsAs :: Lens' ExecuteStatement (Maybe RecordsFormatType)
executeStatement_formatRecordsAs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe RecordsFormatType
formatRecordsAs :: Maybe RecordsFormatType
$sel:formatRecordsAs:ExecuteStatement' :: ExecuteStatement -> Maybe RecordsFormatType
formatRecordsAs} -> Maybe RecordsFormatType
formatRecordsAs) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe RecordsFormatType
a -> ExecuteStatement
s {$sel:formatRecordsAs:ExecuteStatement' :: Maybe RecordsFormatType
formatRecordsAs = Maybe RecordsFormatType
a} :: ExecuteStatement)

-- | A value that indicates whether to include metadata in the results.
executeStatement_includeResultMetadata :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Bool)
executeStatement_includeResultMetadata :: Lens' ExecuteStatement (Maybe Bool)
executeStatement_includeResultMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Bool
includeResultMetadata :: Maybe Bool
$sel:includeResultMetadata:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
includeResultMetadata} -> Maybe Bool
includeResultMetadata) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Bool
a -> ExecuteStatement
s {$sel:includeResultMetadata:ExecuteStatement' :: Maybe Bool
includeResultMetadata = Maybe Bool
a} :: ExecuteStatement)

-- | The parameters for the SQL statement.
--
-- Array parameters are not supported.
executeStatement_parameters :: Lens.Lens' ExecuteStatement (Prelude.Maybe [SqlParameter])
executeStatement_parameters :: Lens' ExecuteStatement (Maybe [SqlParameter])
executeStatement_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe [SqlParameter]
parameters :: Maybe [SqlParameter]
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe [SqlParameter]
parameters} -> Maybe [SqlParameter]
parameters) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe [SqlParameter]
a -> ExecuteStatement
s {$sel:parameters:ExecuteStatement' :: Maybe [SqlParameter]
parameters = Maybe [SqlParameter]
a} :: ExecuteStatement) 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

-- | Options that control how the result set is returned.
executeStatement_resultSetOptions :: Lens.Lens' ExecuteStatement (Prelude.Maybe ResultSetOptions)
executeStatement_resultSetOptions :: Lens' ExecuteStatement (Maybe ResultSetOptions)
executeStatement_resultSetOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe ResultSetOptions
resultSetOptions :: Maybe ResultSetOptions
$sel:resultSetOptions:ExecuteStatement' :: ExecuteStatement -> Maybe ResultSetOptions
resultSetOptions} -> Maybe ResultSetOptions
resultSetOptions) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe ResultSetOptions
a -> ExecuteStatement
s {$sel:resultSetOptions:ExecuteStatement' :: Maybe ResultSetOptions
resultSetOptions = Maybe ResultSetOptions
a} :: ExecuteStatement)

-- | The name of the database schema.
--
-- Currently, the @schema@ parameter isn\'t supported.
executeStatement_schema :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Text)
executeStatement_schema :: Lens' ExecuteStatement (Maybe Text)
executeStatement_schema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Text
schema :: Maybe Text
$sel:schema:ExecuteStatement' :: ExecuteStatement -> Maybe Text
schema} -> Maybe Text
schema) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Text
a -> ExecuteStatement
s {$sel:schema:ExecuteStatement' :: Maybe Text
schema = Maybe Text
a} :: ExecuteStatement)

-- | The identifier of a transaction that was started by using the
-- @BeginTransaction@ operation. Specify the transaction ID of the
-- transaction that you want to include the SQL statement in.
--
-- If the SQL statement is not part of a transaction, don\'t set this
-- parameter.
executeStatement_transactionId :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Text)
executeStatement_transactionId :: Lens' ExecuteStatement (Maybe Text)
executeStatement_transactionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Text
transactionId :: Maybe Text
$sel:transactionId:ExecuteStatement' :: ExecuteStatement -> Maybe Text
transactionId} -> Maybe Text
transactionId) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Text
a -> ExecuteStatement
s {$sel:transactionId:ExecuteStatement' :: Maybe Text
transactionId = Maybe Text
a} :: ExecuteStatement)

-- | The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
executeStatement_resourceArn :: Lens.Lens' ExecuteStatement Prelude.Text
executeStatement_resourceArn :: Lens' ExecuteStatement Text
executeStatement_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Text
resourceArn :: Text
$sel:resourceArn:ExecuteStatement' :: ExecuteStatement -> Text
resourceArn} -> Text
resourceArn) (\s :: ExecuteStatement
s@ExecuteStatement' {} Text
a -> ExecuteStatement
s {$sel:resourceArn:ExecuteStatement' :: Text
resourceArn = Text
a} :: ExecuteStatement)

-- | The ARN of the secret that enables access to the DB cluster. Enter the
-- database user name and password for the credentials in the secret.
--
-- For information about creating the secret, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/create_database_secret.html Create a database secret>.
executeStatement_secretArn :: Lens.Lens' ExecuteStatement Prelude.Text
executeStatement_secretArn :: Lens' ExecuteStatement Text
executeStatement_secretArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Text
secretArn :: Text
$sel:secretArn:ExecuteStatement' :: ExecuteStatement -> Text
secretArn} -> Text
secretArn) (\s :: ExecuteStatement
s@ExecuteStatement' {} Text
a -> ExecuteStatement
s {$sel:secretArn:ExecuteStatement' :: Text
secretArn = Text
a} :: ExecuteStatement)

-- | The SQL statement to run.
executeStatement_sql :: Lens.Lens' ExecuteStatement Prelude.Text
executeStatement_sql :: Lens' ExecuteStatement Text
executeStatement_sql = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Text
sql :: Text
$sel:sql:ExecuteStatement' :: ExecuteStatement -> Text
sql} -> Text
sql) (\s :: ExecuteStatement
s@ExecuteStatement' {} Text
a -> ExecuteStatement
s {$sel:sql:ExecuteStatement' :: Text
sql = Text
a} :: ExecuteStatement)

instance Core.AWSRequest ExecuteStatement where
  type
    AWSResponse ExecuteStatement =
      ExecuteStatementResponse
  request :: (Service -> Service)
-> ExecuteStatement -> Request ExecuteStatement
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 ExecuteStatement
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ExecuteStatement)))
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 [ColumnMetadata]
-> Maybe Text
-> Maybe [Field]
-> Maybe Integer
-> Maybe [[Field]]
-> Int
-> ExecuteStatementResponse
ExecuteStatementResponse'
            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
"columnMetadata" 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
"formattedRecords")
            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
"generatedFields"
                            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
"numberOfRecordsUpdated")
            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
"records" 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 ExecuteStatement where
  hashWithSalt :: Int -> ExecuteStatement -> Int
hashWithSalt Int
_salt ExecuteStatement' {Maybe Bool
Maybe [SqlParameter]
Maybe Text
Maybe RecordsFormatType
Maybe ResultSetOptions
Text
sql :: Text
secretArn :: Text
resourceArn :: Text
transactionId :: Maybe Text
schema :: Maybe Text
resultSetOptions :: Maybe ResultSetOptions
parameters :: Maybe [SqlParameter]
includeResultMetadata :: Maybe Bool
formatRecordsAs :: Maybe RecordsFormatType
database :: Maybe Text
continueAfterTimeout :: Maybe Bool
$sel:sql:ExecuteStatement' :: ExecuteStatement -> Text
$sel:secretArn:ExecuteStatement' :: ExecuteStatement -> Text
$sel:resourceArn:ExecuteStatement' :: ExecuteStatement -> Text
$sel:transactionId:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:schema:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:resultSetOptions:ExecuteStatement' :: ExecuteStatement -> Maybe ResultSetOptions
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe [SqlParameter]
$sel:includeResultMetadata:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
$sel:formatRecordsAs:ExecuteStatement' :: ExecuteStatement -> Maybe RecordsFormatType
$sel:database:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:continueAfterTimeout:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
continueAfterTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
database
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecordsFormatType
formatRecordsAs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeResultMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SqlParameter]
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResultSetOptions
resultSetOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
schema
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
transactionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
secretArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sql

instance Prelude.NFData ExecuteStatement where
  rnf :: ExecuteStatement -> ()
rnf ExecuteStatement' {Maybe Bool
Maybe [SqlParameter]
Maybe Text
Maybe RecordsFormatType
Maybe ResultSetOptions
Text
sql :: Text
secretArn :: Text
resourceArn :: Text
transactionId :: Maybe Text
schema :: Maybe Text
resultSetOptions :: Maybe ResultSetOptions
parameters :: Maybe [SqlParameter]
includeResultMetadata :: Maybe Bool
formatRecordsAs :: Maybe RecordsFormatType
database :: Maybe Text
continueAfterTimeout :: Maybe Bool
$sel:sql:ExecuteStatement' :: ExecuteStatement -> Text
$sel:secretArn:ExecuteStatement' :: ExecuteStatement -> Text
$sel:resourceArn:ExecuteStatement' :: ExecuteStatement -> Text
$sel:transactionId:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:schema:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:resultSetOptions:ExecuteStatement' :: ExecuteStatement -> Maybe ResultSetOptions
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe [SqlParameter]
$sel:includeResultMetadata:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
$sel:formatRecordsAs:ExecuteStatement' :: ExecuteStatement -> Maybe RecordsFormatType
$sel:database:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:continueAfterTimeout:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
continueAfterTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
database
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecordsFormatType
formatRecordsAs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeResultMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SqlParameter]
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResultSetOptions
resultSetOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schema
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
transactionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
secretArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sql

instance Data.ToHeaders ExecuteStatement where
  toHeaders :: ExecuteStatement -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ExecuteStatement where
  toJSON :: ExecuteStatement -> Value
toJSON ExecuteStatement' {Maybe Bool
Maybe [SqlParameter]
Maybe Text
Maybe RecordsFormatType
Maybe ResultSetOptions
Text
sql :: Text
secretArn :: Text
resourceArn :: Text
transactionId :: Maybe Text
schema :: Maybe Text
resultSetOptions :: Maybe ResultSetOptions
parameters :: Maybe [SqlParameter]
includeResultMetadata :: Maybe Bool
formatRecordsAs :: Maybe RecordsFormatType
database :: Maybe Text
continueAfterTimeout :: Maybe Bool
$sel:sql:ExecuteStatement' :: ExecuteStatement -> Text
$sel:secretArn:ExecuteStatement' :: ExecuteStatement -> Text
$sel:resourceArn:ExecuteStatement' :: ExecuteStatement -> Text
$sel:transactionId:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:schema:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:resultSetOptions:ExecuteStatement' :: ExecuteStatement -> Maybe ResultSetOptions
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe [SqlParameter]
$sel:includeResultMetadata:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
$sel:formatRecordsAs:ExecuteStatement' :: ExecuteStatement -> Maybe RecordsFormatType
$sel:database:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:continueAfterTimeout:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"continueAfterTimeout" 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
continueAfterTimeout,
            (Key
"database" 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
database,
            (Key
"formatRecordsAs" 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 RecordsFormatType
formatRecordsAs,
            (Key
"includeResultMetadata" 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
includeResultMetadata,
            (Key
"parameters" 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 [SqlParameter]
parameters,
            (Key
"resultSetOptions" 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 ResultSetOptions
resultSetOptions,
            (Key
"schema" 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
schema,
            (Key
"transactionId" 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
transactionId,
            forall a. a -> Maybe a
Prelude.Just (Key
"resourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"secretArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
secretArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"sql" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sql)
          ]
      )

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

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

-- | The response elements represent the output of a request to run a SQL
-- statement against a database.
--
-- /See:/ 'newExecuteStatementResponse' smart constructor.
data ExecuteStatementResponse = ExecuteStatementResponse'
  { -- | Metadata for the columns included in the results. This field is blank if
    -- the @formatRecordsAs@ parameter is set to @JSON@.
    ExecuteStatementResponse -> Maybe [ColumnMetadata]
columnMetadata :: Prelude.Maybe [ColumnMetadata],
    -- | A string value that represents the result set of a @SELECT@ statement in
    -- JSON format. This value is only present when the @formatRecordsAs@
    -- parameter is set to @JSON@.
    --
    -- The size limit for this field is currently 10 MB. If the JSON-formatted
    -- string representing the result set requires more than 10 MB, the call
    -- returns an error.
    ExecuteStatementResponse -> Maybe Text
formattedRecords :: Prelude.Maybe Prelude.Text,
    -- | Values for fields generated during a DML request.
    --
    -- >  <note> <p>The <code>generatedFields</code> data isn't supported by Aurora PostgreSQL. To get the values of generated fields, use the <code>RETURNING</code> clause. For more information, see <a href="https://www.postgresql.org/docs/10/dml-returning.html">Returning Data From Modified Rows</a> in the PostgreSQL documentation.</p> </note>
    ExecuteStatementResponse -> Maybe [Field]
generatedFields :: Prelude.Maybe [Field],
    -- | The number of records updated by the request.
    ExecuteStatementResponse -> Maybe Integer
numberOfRecordsUpdated :: Prelude.Maybe Prelude.Integer,
    -- | The records returned by the SQL statement. This field is blank if the
    -- @formatRecordsAs@ parameter is set to @JSON@.
    ExecuteStatementResponse -> Maybe [[Field]]
records :: Prelude.Maybe [[Field]],
    -- | The response's http status code.
    ExecuteStatementResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExecuteStatementResponse -> ExecuteStatementResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteStatementResponse -> ExecuteStatementResponse -> Bool
$c/= :: ExecuteStatementResponse -> ExecuteStatementResponse -> Bool
== :: ExecuteStatementResponse -> ExecuteStatementResponse -> Bool
$c== :: ExecuteStatementResponse -> ExecuteStatementResponse -> Bool
Prelude.Eq, ReadPrec [ExecuteStatementResponse]
ReadPrec ExecuteStatementResponse
Int -> ReadS ExecuteStatementResponse
ReadS [ExecuteStatementResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteStatementResponse]
$creadListPrec :: ReadPrec [ExecuteStatementResponse]
readPrec :: ReadPrec ExecuteStatementResponse
$creadPrec :: ReadPrec ExecuteStatementResponse
readList :: ReadS [ExecuteStatementResponse]
$creadList :: ReadS [ExecuteStatementResponse]
readsPrec :: Int -> ReadS ExecuteStatementResponse
$creadsPrec :: Int -> ReadS ExecuteStatementResponse
Prelude.Read, Int -> ExecuteStatementResponse -> ShowS
[ExecuteStatementResponse] -> ShowS
ExecuteStatementResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteStatementResponse] -> ShowS
$cshowList :: [ExecuteStatementResponse] -> ShowS
show :: ExecuteStatementResponse -> String
$cshow :: ExecuteStatementResponse -> String
showsPrec :: Int -> ExecuteStatementResponse -> ShowS
$cshowsPrec :: Int -> ExecuteStatementResponse -> ShowS
Prelude.Show, forall x.
Rep ExecuteStatementResponse x -> ExecuteStatementResponse
forall x.
ExecuteStatementResponse -> Rep ExecuteStatementResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExecuteStatementResponse x -> ExecuteStatementResponse
$cfrom :: forall x.
ExecuteStatementResponse -> Rep ExecuteStatementResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExecuteStatementResponse' 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:
--
-- 'columnMetadata', 'executeStatementResponse_columnMetadata' - Metadata for the columns included in the results. This field is blank if
-- the @formatRecordsAs@ parameter is set to @JSON@.
--
-- 'formattedRecords', 'executeStatementResponse_formattedRecords' - A string value that represents the result set of a @SELECT@ statement in
-- JSON format. This value is only present when the @formatRecordsAs@
-- parameter is set to @JSON@.
--
-- The size limit for this field is currently 10 MB. If the JSON-formatted
-- string representing the result set requires more than 10 MB, the call
-- returns an error.
--
-- 'generatedFields', 'executeStatementResponse_generatedFields' - Values for fields generated during a DML request.
--
-- >  <note> <p>The <code>generatedFields</code> data isn't supported by Aurora PostgreSQL. To get the values of generated fields, use the <code>RETURNING</code> clause. For more information, see <a href="https://www.postgresql.org/docs/10/dml-returning.html">Returning Data From Modified Rows</a> in the PostgreSQL documentation.</p> </note>
--
-- 'numberOfRecordsUpdated', 'executeStatementResponse_numberOfRecordsUpdated' - The number of records updated by the request.
--
-- 'records', 'executeStatementResponse_records' - The records returned by the SQL statement. This field is blank if the
-- @formatRecordsAs@ parameter is set to @JSON@.
--
-- 'httpStatus', 'executeStatementResponse_httpStatus' - The response's http status code.
newExecuteStatementResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExecuteStatementResponse
newExecuteStatementResponse :: Int -> ExecuteStatementResponse
newExecuteStatementResponse Int
pHttpStatus_ =
  ExecuteStatementResponse'
    { $sel:columnMetadata:ExecuteStatementResponse' :: Maybe [ColumnMetadata]
columnMetadata =
        forall a. Maybe a
Prelude.Nothing,
      $sel:formattedRecords:ExecuteStatementResponse' :: Maybe Text
formattedRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:generatedFields:ExecuteStatementResponse' :: Maybe [Field]
generatedFields = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfRecordsUpdated:ExecuteStatementResponse' :: Maybe Integer
numberOfRecordsUpdated = forall a. Maybe a
Prelude.Nothing,
      $sel:records:ExecuteStatementResponse' :: Maybe [[Field]]
records = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExecuteStatementResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Metadata for the columns included in the results. This field is blank if
-- the @formatRecordsAs@ parameter is set to @JSON@.
executeStatementResponse_columnMetadata :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe [ColumnMetadata])
executeStatementResponse_columnMetadata :: Lens' ExecuteStatementResponse (Maybe [ColumnMetadata])
executeStatementResponse_columnMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe [ColumnMetadata]
columnMetadata :: Maybe [ColumnMetadata]
$sel:columnMetadata:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [ColumnMetadata]
columnMetadata} -> Maybe [ColumnMetadata]
columnMetadata) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe [ColumnMetadata]
a -> ExecuteStatementResponse
s {$sel:columnMetadata:ExecuteStatementResponse' :: Maybe [ColumnMetadata]
columnMetadata = Maybe [ColumnMetadata]
a} :: ExecuteStatementResponse) 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

-- | A string value that represents the result set of a @SELECT@ statement in
-- JSON format. This value is only present when the @formatRecordsAs@
-- parameter is set to @JSON@.
--
-- The size limit for this field is currently 10 MB. If the JSON-formatted
-- string representing the result set requires more than 10 MB, the call
-- returns an error.
executeStatementResponse_formattedRecords :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe Prelude.Text)
executeStatementResponse_formattedRecords :: Lens' ExecuteStatementResponse (Maybe Text)
executeStatementResponse_formattedRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe Text
formattedRecords :: Maybe Text
$sel:formattedRecords:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe Text
formattedRecords} -> Maybe Text
formattedRecords) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe Text
a -> ExecuteStatementResponse
s {$sel:formattedRecords:ExecuteStatementResponse' :: Maybe Text
formattedRecords = Maybe Text
a} :: ExecuteStatementResponse)

-- | Values for fields generated during a DML request.
--
-- >  <note> <p>The <code>generatedFields</code> data isn't supported by Aurora PostgreSQL. To get the values of generated fields, use the <code>RETURNING</code> clause. For more information, see <a href="https://www.postgresql.org/docs/10/dml-returning.html">Returning Data From Modified Rows</a> in the PostgreSQL documentation.</p> </note>
executeStatementResponse_generatedFields :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe [Field])
executeStatementResponse_generatedFields :: Lens' ExecuteStatementResponse (Maybe [Field])
executeStatementResponse_generatedFields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe [Field]
generatedFields :: Maybe [Field]
$sel:generatedFields:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [Field]
generatedFields} -> Maybe [Field]
generatedFields) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe [Field]
a -> ExecuteStatementResponse
s {$sel:generatedFields:ExecuteStatementResponse' :: Maybe [Field]
generatedFields = Maybe [Field]
a} :: ExecuteStatementResponse) 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 records updated by the request.
executeStatementResponse_numberOfRecordsUpdated :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe Prelude.Integer)
executeStatementResponse_numberOfRecordsUpdated :: Lens' ExecuteStatementResponse (Maybe Integer)
executeStatementResponse_numberOfRecordsUpdated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe Integer
numberOfRecordsUpdated :: Maybe Integer
$sel:numberOfRecordsUpdated:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe Integer
numberOfRecordsUpdated} -> Maybe Integer
numberOfRecordsUpdated) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe Integer
a -> ExecuteStatementResponse
s {$sel:numberOfRecordsUpdated:ExecuteStatementResponse' :: Maybe Integer
numberOfRecordsUpdated = Maybe Integer
a} :: ExecuteStatementResponse)

-- | The records returned by the SQL statement. This field is blank if the
-- @formatRecordsAs@ parameter is set to @JSON@.
executeStatementResponse_records :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe [[Field]])
executeStatementResponse_records :: Lens' ExecuteStatementResponse (Maybe [[Field]])
executeStatementResponse_records = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe [[Field]]
records :: Maybe [[Field]]
$sel:records:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [[Field]]
records} -> Maybe [[Field]]
records) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe [[Field]]
a -> ExecuteStatementResponse
s {$sel:records:ExecuteStatementResponse' :: Maybe [[Field]]
records = Maybe [[Field]]
a} :: ExecuteStatementResponse) 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.
executeStatementResponse_httpStatus :: Lens.Lens' ExecuteStatementResponse Prelude.Int
executeStatementResponse_httpStatus :: Lens' ExecuteStatementResponse Int
executeStatementResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Int
httpStatus :: Int
$sel:httpStatus:ExecuteStatementResponse' :: ExecuteStatementResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Int
a -> ExecuteStatementResponse
s {$sel:httpStatus:ExecuteStatementResponse' :: Int
httpStatus = Int
a} :: ExecuteStatementResponse)

instance Prelude.NFData ExecuteStatementResponse where
  rnf :: ExecuteStatementResponse -> ()
rnf ExecuteStatementResponse' {Int
Maybe Integer
Maybe [[Field]]
Maybe [ColumnMetadata]
Maybe [Field]
Maybe Text
httpStatus :: Int
records :: Maybe [[Field]]
numberOfRecordsUpdated :: Maybe Integer
generatedFields :: Maybe [Field]
formattedRecords :: Maybe Text
columnMetadata :: Maybe [ColumnMetadata]
$sel:httpStatus:ExecuteStatementResponse' :: ExecuteStatementResponse -> Int
$sel:records:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [[Field]]
$sel:numberOfRecordsUpdated:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe Integer
$sel:generatedFields:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [Field]
$sel:formattedRecords:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe Text
$sel:columnMetadata:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [ColumnMetadata]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ColumnMetadata]
columnMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
formattedRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Field]
generatedFields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
numberOfRecordsUpdated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [[Field]]
records
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus