{-# 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.BatchExecuteStatement
-- 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 batch SQL statement over an array of data.
--
-- You can run bulk update and insert operations for multiple records using
-- a DML statement with different parameter sets. Bulk operations can
-- provide a significant performance improvement over individual insert and
-- update operations.
--
-- 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.
--
-- There isn\'t a fixed upper limit on the number of parameter sets.
-- However, the maximum size of the HTTP request submitted through the Data
-- API is 4 MiB. If the request exceeds this limit, the Data API returns an
-- error and doesn\'t process the request. This 4-MiB limit includes the
-- size of the HTTP headers and the JSON notation in the request. Thus, the
-- number of parameter sets that you can include depends on a combination
-- of factors, such as the size of the SQL statement and the size of each
-- parameter set.
--
-- The response size limit is 1 MiB. If the call returns more than 1 MiB of
-- response data, the call is terminated.
module Amazonka.RDSData.BatchExecuteStatement
  ( -- * Creating a Request
    BatchExecuteStatement (..),
    newBatchExecuteStatement,

    -- * Request Lenses
    batchExecuteStatement_database,
    batchExecuteStatement_parameterSets,
    batchExecuteStatement_schema,
    batchExecuteStatement_transactionId,
    batchExecuteStatement_resourceArn,
    batchExecuteStatement_secretArn,
    batchExecuteStatement_sql,

    -- * Destructuring the Response
    BatchExecuteStatementResponse (..),
    newBatchExecuteStatementResponse,

    -- * Response Lenses
    batchExecuteStatementResponse_updateResults,
    batchExecuteStatementResponse_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 SQL statement over an
-- array of data.
--
-- /See:/ 'newBatchExecuteStatement' smart constructor.
data BatchExecuteStatement = BatchExecuteStatement'
  { -- | The name of the database.
    BatchExecuteStatement -> Maybe Text
database :: Prelude.Maybe Prelude.Text,
    -- | The parameter set for the batch operation.
    --
    -- The SQL statement is executed as many times as the number of parameter
    -- sets provided. To execute a SQL statement with no parameters, use one of
    -- the following options:
    --
    -- -   Specify one or more empty parameter sets.
    --
    -- -   Use the @ExecuteStatement@ operation instead of the
    --     @BatchExecuteStatement@ operation.
    --
    -- Array parameters are not supported.
    BatchExecuteStatement -> Maybe [[SqlParameter]]
parameterSets :: Prelude.Maybe [[SqlParameter]],
    -- | The name of the database schema.
    --
    -- Currently, the @schema@ parameter isn\'t supported.
    BatchExecuteStatement -> 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.
    BatchExecuteStatement -> Maybe Text
transactionId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
    BatchExecuteStatement -> 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>.
    BatchExecuteStatement -> Text
secretArn :: Prelude.Text,
    -- | The SQL statement to run. Don\'t include a semicolon (;) at the end of
    -- the SQL statement.
    BatchExecuteStatement -> Text
sql :: Prelude.Text
  }
  deriving (BatchExecuteStatement -> BatchExecuteStatement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchExecuteStatement -> BatchExecuteStatement -> Bool
$c/= :: BatchExecuteStatement -> BatchExecuteStatement -> Bool
== :: BatchExecuteStatement -> BatchExecuteStatement -> Bool
$c== :: BatchExecuteStatement -> BatchExecuteStatement -> Bool
Prelude.Eq, ReadPrec [BatchExecuteStatement]
ReadPrec BatchExecuteStatement
Int -> ReadS BatchExecuteStatement
ReadS [BatchExecuteStatement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchExecuteStatement]
$creadListPrec :: ReadPrec [BatchExecuteStatement]
readPrec :: ReadPrec BatchExecuteStatement
$creadPrec :: ReadPrec BatchExecuteStatement
readList :: ReadS [BatchExecuteStatement]
$creadList :: ReadS [BatchExecuteStatement]
readsPrec :: Int -> ReadS BatchExecuteStatement
$creadsPrec :: Int -> ReadS BatchExecuteStatement
Prelude.Read, Int -> BatchExecuteStatement -> ShowS
[BatchExecuteStatement] -> ShowS
BatchExecuteStatement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchExecuteStatement] -> ShowS
$cshowList :: [BatchExecuteStatement] -> ShowS
show :: BatchExecuteStatement -> String
$cshow :: BatchExecuteStatement -> String
showsPrec :: Int -> BatchExecuteStatement -> ShowS
$cshowsPrec :: Int -> BatchExecuteStatement -> ShowS
Prelude.Show, forall x. Rep BatchExecuteStatement x -> BatchExecuteStatement
forall x. BatchExecuteStatement -> Rep BatchExecuteStatement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchExecuteStatement x -> BatchExecuteStatement
$cfrom :: forall x. BatchExecuteStatement -> Rep BatchExecuteStatement x
Prelude.Generic)

-- |
-- Create a value of 'BatchExecuteStatement' 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:
--
-- 'database', 'batchExecuteStatement_database' - The name of the database.
--
-- 'parameterSets', 'batchExecuteStatement_parameterSets' - The parameter set for the batch operation.
--
-- The SQL statement is executed as many times as the number of parameter
-- sets provided. To execute a SQL statement with no parameters, use one of
-- the following options:
--
-- -   Specify one or more empty parameter sets.
--
-- -   Use the @ExecuteStatement@ operation instead of the
--     @BatchExecuteStatement@ operation.
--
-- Array parameters are not supported.
--
-- 'schema', 'batchExecuteStatement_schema' - The name of the database schema.
--
-- Currently, the @schema@ parameter isn\'t supported.
--
-- 'transactionId', 'batchExecuteStatement_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', 'batchExecuteStatement_resourceArn' - The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
--
-- 'secretArn', 'batchExecuteStatement_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', 'batchExecuteStatement_sql' - The SQL statement to run. Don\'t include a semicolon (;) at the end of
-- the SQL statement.
newBatchExecuteStatement ::
  -- | 'resourceArn'
  Prelude.Text ->
  -- | 'secretArn'
  Prelude.Text ->
  -- | 'sql'
  Prelude.Text ->
  BatchExecuteStatement
newBatchExecuteStatement :: Text -> Text -> Text -> BatchExecuteStatement
newBatchExecuteStatement
  Text
pResourceArn_
  Text
pSecretArn_
  Text
pSql_ =
    BatchExecuteStatement'
      { $sel:database:BatchExecuteStatement' :: Maybe Text
database = forall a. Maybe a
Prelude.Nothing,
        $sel:parameterSets:BatchExecuteStatement' :: Maybe [[SqlParameter]]
parameterSets = forall a. Maybe a
Prelude.Nothing,
        $sel:schema:BatchExecuteStatement' :: Maybe Text
schema = forall a. Maybe a
Prelude.Nothing,
        $sel:transactionId:BatchExecuteStatement' :: Maybe Text
transactionId = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceArn:BatchExecuteStatement' :: Text
resourceArn = Text
pResourceArn_,
        $sel:secretArn:BatchExecuteStatement' :: Text
secretArn = Text
pSecretArn_,
        $sel:sql:BatchExecuteStatement' :: Text
sql = Text
pSql_
      }

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

-- | The parameter set for the batch operation.
--
-- The SQL statement is executed as many times as the number of parameter
-- sets provided. To execute a SQL statement with no parameters, use one of
-- the following options:
--
-- -   Specify one or more empty parameter sets.
--
-- -   Use the @ExecuteStatement@ operation instead of the
--     @BatchExecuteStatement@ operation.
--
-- Array parameters are not supported.
batchExecuteStatement_parameterSets :: Lens.Lens' BatchExecuteStatement (Prelude.Maybe [[SqlParameter]])
batchExecuteStatement_parameterSets :: Lens' BatchExecuteStatement (Maybe [[SqlParameter]])
batchExecuteStatement_parameterSets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchExecuteStatement' {Maybe [[SqlParameter]]
parameterSets :: Maybe [[SqlParameter]]
$sel:parameterSets:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe [[SqlParameter]]
parameterSets} -> Maybe [[SqlParameter]]
parameterSets) (\s :: BatchExecuteStatement
s@BatchExecuteStatement' {} Maybe [[SqlParameter]]
a -> BatchExecuteStatement
s {$sel:parameterSets:BatchExecuteStatement' :: Maybe [[SqlParameter]]
parameterSets = Maybe [[SqlParameter]]
a} :: BatchExecuteStatement) 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 name of the database schema.
--
-- Currently, the @schema@ parameter isn\'t supported.
batchExecuteStatement_schema :: Lens.Lens' BatchExecuteStatement (Prelude.Maybe Prelude.Text)
batchExecuteStatement_schema :: Lens' BatchExecuteStatement (Maybe Text)
batchExecuteStatement_schema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchExecuteStatement' {Maybe Text
schema :: Maybe Text
$sel:schema:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
schema} -> Maybe Text
schema) (\s :: BatchExecuteStatement
s@BatchExecuteStatement' {} Maybe Text
a -> BatchExecuteStatement
s {$sel:schema:BatchExecuteStatement' :: Maybe Text
schema = Maybe Text
a} :: BatchExecuteStatement)

-- | 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.
batchExecuteStatement_transactionId :: Lens.Lens' BatchExecuteStatement (Prelude.Maybe Prelude.Text)
batchExecuteStatement_transactionId :: Lens' BatchExecuteStatement (Maybe Text)
batchExecuteStatement_transactionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchExecuteStatement' {Maybe Text
transactionId :: Maybe Text
$sel:transactionId:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
transactionId} -> Maybe Text
transactionId) (\s :: BatchExecuteStatement
s@BatchExecuteStatement' {} Maybe Text
a -> BatchExecuteStatement
s {$sel:transactionId:BatchExecuteStatement' :: Maybe Text
transactionId = Maybe Text
a} :: BatchExecuteStatement)

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

-- | 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>.
batchExecuteStatement_secretArn :: Lens.Lens' BatchExecuteStatement Prelude.Text
batchExecuteStatement_secretArn :: Lens' BatchExecuteStatement Text
batchExecuteStatement_secretArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchExecuteStatement' {Text
secretArn :: Text
$sel:secretArn:BatchExecuteStatement' :: BatchExecuteStatement -> Text
secretArn} -> Text
secretArn) (\s :: BatchExecuteStatement
s@BatchExecuteStatement' {} Text
a -> BatchExecuteStatement
s {$sel:secretArn:BatchExecuteStatement' :: Text
secretArn = Text
a} :: BatchExecuteStatement)

-- | The SQL statement to run. Don\'t include a semicolon (;) at the end of
-- the SQL statement.
batchExecuteStatement_sql :: Lens.Lens' BatchExecuteStatement Prelude.Text
batchExecuteStatement_sql :: Lens' BatchExecuteStatement Text
batchExecuteStatement_sql = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchExecuteStatement' {Text
sql :: Text
$sel:sql:BatchExecuteStatement' :: BatchExecuteStatement -> Text
sql} -> Text
sql) (\s :: BatchExecuteStatement
s@BatchExecuteStatement' {} Text
a -> BatchExecuteStatement
s {$sel:sql:BatchExecuteStatement' :: Text
sql = Text
a} :: BatchExecuteStatement)

instance Core.AWSRequest BatchExecuteStatement where
  type
    AWSResponse BatchExecuteStatement =
      BatchExecuteStatementResponse
  request :: (Service -> Service)
-> BatchExecuteStatement -> Request BatchExecuteStatement
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 BatchExecuteStatement
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchExecuteStatement)))
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 [UpdateResult] -> Int -> BatchExecuteStatementResponse
BatchExecuteStatementResponse'
            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
"updateResults" 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 BatchExecuteStatement where
  hashWithSalt :: Int -> BatchExecuteStatement -> Int
hashWithSalt Int
_salt BatchExecuteStatement' {Maybe [[SqlParameter]]
Maybe Text
Text
sql :: Text
secretArn :: Text
resourceArn :: Text
transactionId :: Maybe Text
schema :: Maybe Text
parameterSets :: Maybe [[SqlParameter]]
database :: Maybe Text
$sel:sql:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:secretArn:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:resourceArn:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:transactionId:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
$sel:schema:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
$sel:parameterSets:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe [[SqlParameter]]
$sel:database:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
database
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [[SqlParameter]]
parameterSets
      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 BatchExecuteStatement where
  rnf :: BatchExecuteStatement -> ()
rnf BatchExecuteStatement' {Maybe [[SqlParameter]]
Maybe Text
Text
sql :: Text
secretArn :: Text
resourceArn :: Text
transactionId :: Maybe Text
schema :: Maybe Text
parameterSets :: Maybe [[SqlParameter]]
database :: Maybe Text
$sel:sql:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:secretArn:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:resourceArn:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:transactionId:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
$sel:schema:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
$sel:parameterSets:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe [[SqlParameter]]
$sel:database:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
..} =
    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 [[SqlParameter]]
parameterSets
      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 BatchExecuteStatement where
  toHeaders :: BatchExecuteStatement -> 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 BatchExecuteStatement where
  toJSON :: BatchExecuteStatement -> Value
toJSON BatchExecuteStatement' {Maybe [[SqlParameter]]
Maybe Text
Text
sql :: Text
secretArn :: Text
resourceArn :: Text
transactionId :: Maybe Text
schema :: Maybe Text
parameterSets :: Maybe [[SqlParameter]]
database :: Maybe Text
$sel:sql:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:secretArn:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:resourceArn:BatchExecuteStatement' :: BatchExecuteStatement -> Text
$sel:transactionId:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
$sel:schema:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
$sel:parameterSets:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe [[SqlParameter]]
$sel:database:BatchExecuteStatement' :: BatchExecuteStatement -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"parameterSets" 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]]
parameterSets,
            (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 BatchExecuteStatement where
  toPath :: BatchExecuteStatement -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/BatchExecute"

instance Data.ToQuery BatchExecuteStatement where
  toQuery :: BatchExecuteStatement -> 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 SQL statement over an
-- array of data.
--
-- /See:/ 'newBatchExecuteStatementResponse' smart constructor.
data BatchExecuteStatementResponse = BatchExecuteStatementResponse'
  { -- | The execution results of each batch entry.
    BatchExecuteStatementResponse -> Maybe [UpdateResult]
updateResults :: Prelude.Maybe [UpdateResult],
    -- | The response's http status code.
    BatchExecuteStatementResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchExecuteStatementResponse
-> BatchExecuteStatementResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchExecuteStatementResponse
-> BatchExecuteStatementResponse -> Bool
$c/= :: BatchExecuteStatementResponse
-> BatchExecuteStatementResponse -> Bool
== :: BatchExecuteStatementResponse
-> BatchExecuteStatementResponse -> Bool
$c== :: BatchExecuteStatementResponse
-> BatchExecuteStatementResponse -> Bool
Prelude.Eq, ReadPrec [BatchExecuteStatementResponse]
ReadPrec BatchExecuteStatementResponse
Int -> ReadS BatchExecuteStatementResponse
ReadS [BatchExecuteStatementResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchExecuteStatementResponse]
$creadListPrec :: ReadPrec [BatchExecuteStatementResponse]
readPrec :: ReadPrec BatchExecuteStatementResponse
$creadPrec :: ReadPrec BatchExecuteStatementResponse
readList :: ReadS [BatchExecuteStatementResponse]
$creadList :: ReadS [BatchExecuteStatementResponse]
readsPrec :: Int -> ReadS BatchExecuteStatementResponse
$creadsPrec :: Int -> ReadS BatchExecuteStatementResponse
Prelude.Read, Int -> BatchExecuteStatementResponse -> ShowS
[BatchExecuteStatementResponse] -> ShowS
BatchExecuteStatementResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchExecuteStatementResponse] -> ShowS
$cshowList :: [BatchExecuteStatementResponse] -> ShowS
show :: BatchExecuteStatementResponse -> String
$cshow :: BatchExecuteStatementResponse -> String
showsPrec :: Int -> BatchExecuteStatementResponse -> ShowS
$cshowsPrec :: Int -> BatchExecuteStatementResponse -> ShowS
Prelude.Show, forall x.
Rep BatchExecuteStatementResponse x
-> BatchExecuteStatementResponse
forall x.
BatchExecuteStatementResponse
-> Rep BatchExecuteStatementResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchExecuteStatementResponse x
-> BatchExecuteStatementResponse
$cfrom :: forall x.
BatchExecuteStatementResponse
-> Rep BatchExecuteStatementResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchExecuteStatementResponse' 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:
--
-- 'updateResults', 'batchExecuteStatementResponse_updateResults' - The execution results of each batch entry.
--
-- 'httpStatus', 'batchExecuteStatementResponse_httpStatus' - The response's http status code.
newBatchExecuteStatementResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchExecuteStatementResponse
newBatchExecuteStatementResponse :: Int -> BatchExecuteStatementResponse
newBatchExecuteStatementResponse Int
pHttpStatus_ =
  BatchExecuteStatementResponse'
    { $sel:updateResults:BatchExecuteStatementResponse' :: Maybe [UpdateResult]
updateResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchExecuteStatementResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The execution results of each batch entry.
batchExecuteStatementResponse_updateResults :: Lens.Lens' BatchExecuteStatementResponse (Prelude.Maybe [UpdateResult])
batchExecuteStatementResponse_updateResults :: Lens' BatchExecuteStatementResponse (Maybe [UpdateResult])
batchExecuteStatementResponse_updateResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchExecuteStatementResponse' {Maybe [UpdateResult]
updateResults :: Maybe [UpdateResult]
$sel:updateResults:BatchExecuteStatementResponse' :: BatchExecuteStatementResponse -> Maybe [UpdateResult]
updateResults} -> Maybe [UpdateResult]
updateResults) (\s :: BatchExecuteStatementResponse
s@BatchExecuteStatementResponse' {} Maybe [UpdateResult]
a -> BatchExecuteStatementResponse
s {$sel:updateResults:BatchExecuteStatementResponse' :: Maybe [UpdateResult]
updateResults = Maybe [UpdateResult]
a} :: BatchExecuteStatementResponse) 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.
batchExecuteStatementResponse_httpStatus :: Lens.Lens' BatchExecuteStatementResponse Prelude.Int
batchExecuteStatementResponse_httpStatus :: Lens' BatchExecuteStatementResponse Int
batchExecuteStatementResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchExecuteStatementResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchExecuteStatementResponse' :: BatchExecuteStatementResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchExecuteStatementResponse
s@BatchExecuteStatementResponse' {} Int
a -> BatchExecuteStatementResponse
s {$sel:httpStatus:BatchExecuteStatementResponse' :: Int
httpStatus = Int
a} :: BatchExecuteStatementResponse)

instance Prelude.NFData BatchExecuteStatementResponse where
  rnf :: BatchExecuteStatementResponse -> ()
rnf BatchExecuteStatementResponse' {Int
Maybe [UpdateResult]
httpStatus :: Int
updateResults :: Maybe [UpdateResult]
$sel:httpStatus:BatchExecuteStatementResponse' :: BatchExecuteStatementResponse -> Int
$sel:updateResults:BatchExecuteStatementResponse' :: BatchExecuteStatementResponse -> Maybe [UpdateResult]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [UpdateResult]
updateResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus