{-# 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.DynamoDB.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)
--
-- This operation allows you to perform reads and singleton writes on data
-- stored in DynamoDB, using PartiQL.
--
-- For PartiQL reads (@SELECT@ statement), if the total number of processed
-- items exceeds the maximum dataset size limit of 1 MB, the read stops and
-- results are returned to the user as a @LastEvaluatedKey@ value to
-- continue the read in a subsequent operation. If the filter criteria in
-- @WHERE@ clause does not match any data, the read will return an empty
-- result set.
--
-- A single @SELECT@ statement response can return up to the maximum number
-- of items (if using the Limit parameter) or a maximum of 1 MB of data
-- (and then apply any filtering to the results using @WHERE@ clause). If
-- @LastEvaluatedKey@ is present in the response, you need to paginate the
-- result set.
module Amazonka.DynamoDB.ExecuteStatement
  ( -- * Creating a Request
    ExecuteStatement (..),
    newExecuteStatement,

    -- * Request Lenses
    executeStatement_consistentRead,
    executeStatement_limit,
    executeStatement_nextToken,
    executeStatement_parameters,
    executeStatement_returnConsumedCapacity,
    executeStatement_statement,

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

    -- * Response Lenses
    executeStatementResponse_consumedCapacity,
    executeStatementResponse_items,
    executeStatementResponse_lastEvaluatedKey,
    executeStatementResponse_nextToken,
    executeStatementResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DynamoDB.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newExecuteStatement' smart constructor.
data ExecuteStatement = ExecuteStatement'
  { -- | The consistency of a read operation. If set to @true@, then a strongly
    -- consistent read is used; otherwise, an eventually consistent read is
    -- used.
    ExecuteStatement -> Maybe Bool
consistentRead :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of items to evaluate (not necessarily the number of
    -- matching items). If DynamoDB processes the number of items up to the
    -- limit while processing the results, it stops the operation and returns
    -- the matching values up to that point, along with a key in
    -- @LastEvaluatedKey@ to apply in a subsequent operation so you can pick up
    -- where you left off. Also, if the processed dataset size exceeds 1 MB
    -- before DynamoDB reaches this limit, it stops the operation and returns
    -- the matching values up to the limit, and a key in @LastEvaluatedKey@ to
    -- apply in a subsequent operation to continue the operation.
    ExecuteStatement -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | Set this value to get remaining results, if @NextToken@ was returned in
    -- the statement response.
    ExecuteStatement -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The parameters for the PartiQL statement, if any.
    ExecuteStatement -> Maybe (NonEmpty AttributeValue)
parameters :: Prelude.Maybe (Prelude.NonEmpty AttributeValue),
    ExecuteStatement -> Maybe ReturnConsumedCapacity
returnConsumedCapacity :: Prelude.Maybe ReturnConsumedCapacity,
    -- | The PartiQL statement representing the operation to run.
    ExecuteStatement -> Text
statement :: 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:
--
-- 'consistentRead', 'executeStatement_consistentRead' - The consistency of a read operation. If set to @true@, then a strongly
-- consistent read is used; otherwise, an eventually consistent read is
-- used.
--
-- 'limit', 'executeStatement_limit' - The maximum number of items to evaluate (not necessarily the number of
-- matching items). If DynamoDB processes the number of items up to the
-- limit while processing the results, it stops the operation and returns
-- the matching values up to that point, along with a key in
-- @LastEvaluatedKey@ to apply in a subsequent operation so you can pick up
-- where you left off. Also, if the processed dataset size exceeds 1 MB
-- before DynamoDB reaches this limit, it stops the operation and returns
-- the matching values up to the limit, and a key in @LastEvaluatedKey@ to
-- apply in a subsequent operation to continue the operation.
--
-- 'nextToken', 'executeStatement_nextToken' - Set this value to get remaining results, if @NextToken@ was returned in
-- the statement response.
--
-- 'parameters', 'executeStatement_parameters' - The parameters for the PartiQL statement, if any.
--
-- 'returnConsumedCapacity', 'executeStatement_returnConsumedCapacity' - Undocumented member.
--
-- 'statement', 'executeStatement_statement' - The PartiQL statement representing the operation to run.
newExecuteStatement ::
  -- | 'statement'
  Prelude.Text ->
  ExecuteStatement
newExecuteStatement :: Text -> ExecuteStatement
newExecuteStatement Text
pStatement_ =
  ExecuteStatement'
    { $sel:consistentRead:ExecuteStatement' :: Maybe Bool
consistentRead = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ExecuteStatement' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ExecuteStatement' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:ExecuteStatement' :: Maybe (NonEmpty AttributeValue)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:returnConsumedCapacity:ExecuteStatement' :: Maybe ReturnConsumedCapacity
returnConsumedCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:statement:ExecuteStatement' :: Text
statement = Text
pStatement_
    }

-- | The consistency of a read operation. If set to @true@, then a strongly
-- consistent read is used; otherwise, an eventually consistent read is
-- used.
executeStatement_consistentRead :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Bool)
executeStatement_consistentRead :: Lens' ExecuteStatement (Maybe Bool)
executeStatement_consistentRead = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Bool
consistentRead :: Maybe Bool
$sel:consistentRead:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
consistentRead} -> Maybe Bool
consistentRead) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Bool
a -> ExecuteStatement
s {$sel:consistentRead:ExecuteStatement' :: Maybe Bool
consistentRead = Maybe Bool
a} :: ExecuteStatement)

-- | The maximum number of items to evaluate (not necessarily the number of
-- matching items). If DynamoDB processes the number of items up to the
-- limit while processing the results, it stops the operation and returns
-- the matching values up to that point, along with a key in
-- @LastEvaluatedKey@ to apply in a subsequent operation so you can pick up
-- where you left off. Also, if the processed dataset size exceeds 1 MB
-- before DynamoDB reaches this limit, it stops the operation and returns
-- the matching values up to the limit, and a key in @LastEvaluatedKey@ to
-- apply in a subsequent operation to continue the operation.
executeStatement_limit :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Natural)
executeStatement_limit :: Lens' ExecuteStatement (Maybe Natural)
executeStatement_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ExecuteStatement' :: ExecuteStatement -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Natural
a -> ExecuteStatement
s {$sel:limit:ExecuteStatement' :: Maybe Natural
limit = Maybe Natural
a} :: ExecuteStatement)

-- | Set this value to get remaining results, if @NextToken@ was returned in
-- the statement response.
executeStatement_nextToken :: Lens.Lens' ExecuteStatement (Prelude.Maybe Prelude.Text)
executeStatement_nextToken :: Lens' ExecuteStatement (Maybe Text)
executeStatement_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ExecuteStatement' :: ExecuteStatement -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe Text
a -> ExecuteStatement
s {$sel:nextToken:ExecuteStatement' :: Maybe Text
nextToken = Maybe Text
a} :: ExecuteStatement)

-- | The parameters for the PartiQL statement, if any.
executeStatement_parameters :: Lens.Lens' ExecuteStatement (Prelude.Maybe (Prelude.NonEmpty AttributeValue))
executeStatement_parameters :: Lens' ExecuteStatement (Maybe (NonEmpty AttributeValue))
executeStatement_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe (NonEmpty AttributeValue)
parameters :: Maybe (NonEmpty AttributeValue)
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe (NonEmpty AttributeValue)
parameters} -> Maybe (NonEmpty AttributeValue)
parameters) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe (NonEmpty AttributeValue)
a -> ExecuteStatement
s {$sel:parameters:ExecuteStatement' :: Maybe (NonEmpty AttributeValue)
parameters = Maybe (NonEmpty AttributeValue)
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

-- | Undocumented member.
executeStatement_returnConsumedCapacity :: Lens.Lens' ExecuteStatement (Prelude.Maybe ReturnConsumedCapacity)
executeStatement_returnConsumedCapacity :: Lens' ExecuteStatement (Maybe ReturnConsumedCapacity)
executeStatement_returnConsumedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Maybe ReturnConsumedCapacity
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
$sel:returnConsumedCapacity:ExecuteStatement' :: ExecuteStatement -> Maybe ReturnConsumedCapacity
returnConsumedCapacity} -> Maybe ReturnConsumedCapacity
returnConsumedCapacity) (\s :: ExecuteStatement
s@ExecuteStatement' {} Maybe ReturnConsumedCapacity
a -> ExecuteStatement
s {$sel:returnConsumedCapacity:ExecuteStatement' :: Maybe ReturnConsumedCapacity
returnConsumedCapacity = Maybe ReturnConsumedCapacity
a} :: ExecuteStatement)

-- | The PartiQL statement representing the operation to run.
executeStatement_statement :: Lens.Lens' ExecuteStatement Prelude.Text
executeStatement_statement :: Lens' ExecuteStatement Text
executeStatement_statement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatement' {Text
statement :: Text
$sel:statement:ExecuteStatement' :: ExecuteStatement -> Text
statement} -> Text
statement) (\s :: ExecuteStatement
s@ExecuteStatement' {} Text
a -> ExecuteStatement
s {$sel:statement:ExecuteStatement' :: Text
statement = 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 ConsumedCapacity
-> Maybe [HashMap Text AttributeValue]
-> Maybe (HashMap Text AttributeValue)
-> Maybe Text
-> 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
"ConsumedCapacity")
            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
"Items" 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
"LastEvaluatedKey"
                            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
"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))
      )

instance Prelude.Hashable ExecuteStatement where
  hashWithSalt :: Int -> ExecuteStatement -> Int
hashWithSalt Int
_salt ExecuteStatement' {Maybe Bool
Maybe Natural
Maybe (NonEmpty AttributeValue)
Maybe Text
Maybe ReturnConsumedCapacity
Text
statement :: Text
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
parameters :: Maybe (NonEmpty AttributeValue)
nextToken :: Maybe Text
limit :: Maybe Natural
consistentRead :: Maybe Bool
$sel:statement:ExecuteStatement' :: ExecuteStatement -> Text
$sel:returnConsumedCapacity:ExecuteStatement' :: ExecuteStatement -> Maybe ReturnConsumedCapacity
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe (NonEmpty AttributeValue)
$sel:nextToken:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:limit:ExecuteStatement' :: ExecuteStatement -> Maybe Natural
$sel:consistentRead:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
consistentRead
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty AttributeValue)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReturnConsumedCapacity
returnConsumedCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
statement

instance Prelude.NFData ExecuteStatement where
  rnf :: ExecuteStatement -> ()
rnf ExecuteStatement' {Maybe Bool
Maybe Natural
Maybe (NonEmpty AttributeValue)
Maybe Text
Maybe ReturnConsumedCapacity
Text
statement :: Text
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
parameters :: Maybe (NonEmpty AttributeValue)
nextToken :: Maybe Text
limit :: Maybe Natural
consistentRead :: Maybe Bool
$sel:statement:ExecuteStatement' :: ExecuteStatement -> Text
$sel:returnConsumedCapacity:ExecuteStatement' :: ExecuteStatement -> Maybe ReturnConsumedCapacity
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe (NonEmpty AttributeValue)
$sel:nextToken:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:limit:ExecuteStatement' :: ExecuteStatement -> Maybe Natural
$sel:consistentRead:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
consistentRead
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      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 (NonEmpty AttributeValue)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReturnConsumedCapacity
returnConsumedCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
statement

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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DynamoDB_20120810.ExecuteStatement" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ExecuteStatement where
  toJSON :: ExecuteStatement -> Value
toJSON ExecuteStatement' {Maybe Bool
Maybe Natural
Maybe (NonEmpty AttributeValue)
Maybe Text
Maybe ReturnConsumedCapacity
Text
statement :: Text
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
parameters :: Maybe (NonEmpty AttributeValue)
nextToken :: Maybe Text
limit :: Maybe Natural
consistentRead :: Maybe Bool
$sel:statement:ExecuteStatement' :: ExecuteStatement -> Text
$sel:returnConsumedCapacity:ExecuteStatement' :: ExecuteStatement -> Maybe ReturnConsumedCapacity
$sel:parameters:ExecuteStatement' :: ExecuteStatement -> Maybe (NonEmpty AttributeValue)
$sel:nextToken:ExecuteStatement' :: ExecuteStatement -> Maybe Text
$sel:limit:ExecuteStatement' :: ExecuteStatement -> Maybe Natural
$sel:consistentRead:ExecuteStatement' :: ExecuteStatement -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConsistentRead" 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
consistentRead,
            (Key
"Limit" 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
limit,
            (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
"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 (NonEmpty AttributeValue)
parameters,
            (Key
"ReturnConsumedCapacity" 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 ReturnConsumedCapacity
returnConsumedCapacity,
            forall a. a -> Maybe a
Prelude.Just (Key
"Statement" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
statement)
          ]
      )

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

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

-- | /See:/ 'newExecuteStatementResponse' smart constructor.
data ExecuteStatementResponse = ExecuteStatementResponse'
  { ExecuteStatementResponse -> Maybe ConsumedCapacity
consumedCapacity :: Prelude.Maybe ConsumedCapacity,
    -- | If a read operation was used, this property will contain the result of
    -- the read operation; a map of attribute names and their values. For the
    -- write operations this value will be empty.
    ExecuteStatementResponse -> Maybe [HashMap Text AttributeValue]
items :: Prelude.Maybe [Prelude.HashMap Prelude.Text AttributeValue],
    -- | The primary key of the item where the operation stopped, inclusive of
    -- the previous result set. Use this value to start a new operation,
    -- excluding this value in the new request. If @LastEvaluatedKey@ is empty,
    -- then the \"last page\" of results has been processed and there is no
    -- more data to be retrieved. If @LastEvaluatedKey@ is not empty, it does
    -- not necessarily mean that there is more data in the result set. The only
    -- way to know when you have reached the end of the result set is when
    -- @LastEvaluatedKey@ is empty.
    ExecuteStatementResponse -> Maybe (HashMap Text AttributeValue)
lastEvaluatedKey :: Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeValue),
    -- | If the response of a read request exceeds the response payload limit
    -- DynamoDB will set this value in the response. If set, you can use that
    -- this value in the subsequent request to get the remaining results.
    ExecuteStatementResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | 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:
--
-- 'consumedCapacity', 'executeStatementResponse_consumedCapacity' - Undocumented member.
--
-- 'items', 'executeStatementResponse_items' - If a read operation was used, this property will contain the result of
-- the read operation; a map of attribute names and their values. For the
-- write operations this value will be empty.
--
-- 'lastEvaluatedKey', 'executeStatementResponse_lastEvaluatedKey' - The primary key of the item where the operation stopped, inclusive of
-- the previous result set. Use this value to start a new operation,
-- excluding this value in the new request. If @LastEvaluatedKey@ is empty,
-- then the \"last page\" of results has been processed and there is no
-- more data to be retrieved. If @LastEvaluatedKey@ is not empty, it does
-- not necessarily mean that there is more data in the result set. The only
-- way to know when you have reached the end of the result set is when
-- @LastEvaluatedKey@ is empty.
--
-- 'nextToken', 'executeStatementResponse_nextToken' - If the response of a read request exceeds the response payload limit
-- DynamoDB will set this value in the response. If set, you can use that
-- this value in the subsequent request to get the remaining results.
--
-- 'httpStatus', 'executeStatementResponse_httpStatus' - The response's http status code.
newExecuteStatementResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExecuteStatementResponse
newExecuteStatementResponse :: Int -> ExecuteStatementResponse
newExecuteStatementResponse Int
pHttpStatus_ =
  ExecuteStatementResponse'
    { $sel:consumedCapacity:ExecuteStatementResponse' :: Maybe ConsumedCapacity
consumedCapacity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:items:ExecuteStatementResponse' :: Maybe [HashMap Text AttributeValue]
items = forall a. Maybe a
Prelude.Nothing,
      $sel:lastEvaluatedKey:ExecuteStatementResponse' :: Maybe (HashMap Text AttributeValue)
lastEvaluatedKey = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ExecuteStatementResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExecuteStatementResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
executeStatementResponse_consumedCapacity :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe ConsumedCapacity)
executeStatementResponse_consumedCapacity :: Lens' ExecuteStatementResponse (Maybe ConsumedCapacity)
executeStatementResponse_consumedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe ConsumedCapacity
consumedCapacity :: Maybe ConsumedCapacity
$sel:consumedCapacity:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe ConsumedCapacity
consumedCapacity} -> Maybe ConsumedCapacity
consumedCapacity) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe ConsumedCapacity
a -> ExecuteStatementResponse
s {$sel:consumedCapacity:ExecuteStatementResponse' :: Maybe ConsumedCapacity
consumedCapacity = Maybe ConsumedCapacity
a} :: ExecuteStatementResponse)

-- | If a read operation was used, this property will contain the result of
-- the read operation; a map of attribute names and their values. For the
-- write operations this value will be empty.
executeStatementResponse_items :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe [Prelude.HashMap Prelude.Text AttributeValue])
executeStatementResponse_items :: Lens'
  ExecuteStatementResponse (Maybe [HashMap Text AttributeValue])
executeStatementResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe [HashMap Text AttributeValue]
items :: Maybe [HashMap Text AttributeValue]
$sel:items:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [HashMap Text AttributeValue]
items} -> Maybe [HashMap Text AttributeValue]
items) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe [HashMap Text AttributeValue]
a -> ExecuteStatementResponse
s {$sel:items:ExecuteStatementResponse' :: Maybe [HashMap Text AttributeValue]
items = Maybe [HashMap Text AttributeValue]
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 primary key of the item where the operation stopped, inclusive of
-- the previous result set. Use this value to start a new operation,
-- excluding this value in the new request. If @LastEvaluatedKey@ is empty,
-- then the \"last page\" of results has been processed and there is no
-- more data to be retrieved. If @LastEvaluatedKey@ is not empty, it does
-- not necessarily mean that there is more data in the result set. The only
-- way to know when you have reached the end of the result set is when
-- @LastEvaluatedKey@ is empty.
executeStatementResponse_lastEvaluatedKey :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeValue))
executeStatementResponse_lastEvaluatedKey :: Lens'
  ExecuteStatementResponse (Maybe (HashMap Text AttributeValue))
executeStatementResponse_lastEvaluatedKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe (HashMap Text AttributeValue)
lastEvaluatedKey :: Maybe (HashMap Text AttributeValue)
$sel:lastEvaluatedKey:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe (HashMap Text AttributeValue)
lastEvaluatedKey} -> Maybe (HashMap Text AttributeValue)
lastEvaluatedKey) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe (HashMap Text AttributeValue)
a -> ExecuteStatementResponse
s {$sel:lastEvaluatedKey:ExecuteStatementResponse' :: Maybe (HashMap Text AttributeValue)
lastEvaluatedKey = Maybe (HashMap Text AttributeValue)
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

-- | If the response of a read request exceeds the response payload limit
-- DynamoDB will set this value in the response. If set, you can use that
-- this value in the subsequent request to get the remaining results.
executeStatementResponse_nextToken :: Lens.Lens' ExecuteStatementResponse (Prelude.Maybe Prelude.Text)
executeStatementResponse_nextToken :: Lens' ExecuteStatementResponse (Maybe Text)
executeStatementResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteStatementResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ExecuteStatementResponse
s@ExecuteStatementResponse' {} Maybe Text
a -> ExecuteStatementResponse
s {$sel:nextToken:ExecuteStatementResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ExecuteStatementResponse)

-- | 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 [HashMap Text AttributeValue]
Maybe Text
Maybe (HashMap Text AttributeValue)
Maybe ConsumedCapacity
httpStatus :: Int
nextToken :: Maybe Text
lastEvaluatedKey :: Maybe (HashMap Text AttributeValue)
items :: Maybe [HashMap Text AttributeValue]
consumedCapacity :: Maybe ConsumedCapacity
$sel:httpStatus:ExecuteStatementResponse' :: ExecuteStatementResponse -> Int
$sel:nextToken:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe Text
$sel:lastEvaluatedKey:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe (HashMap Text AttributeValue)
$sel:items:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe [HashMap Text AttributeValue]
$sel:consumedCapacity:ExecuteStatementResponse' :: ExecuteStatementResponse -> Maybe ConsumedCapacity
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConsumedCapacity
consumedCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [HashMap Text AttributeValue]
items
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text AttributeValue)
lastEvaluatedKey
      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 Int
httpStatus