{-# 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.TransactGetItems
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- @TransactGetItems@ is a synchronous operation that atomically retrieves
-- multiple items from one or more tables (but not from indexes) in a
-- single account and Region. A @TransactGetItems@ call can contain up to
-- 100 @TransactGetItem@ objects, each of which contains a @Get@ structure
-- that specifies an item to retrieve from a table in the account and
-- Region. A call to @TransactGetItems@ cannot retrieve items from tables
-- in more than one Amazon Web Services account or Region. The aggregate
-- size of the items in the transaction cannot exceed 4 MB.
--
-- DynamoDB rejects the entire @TransactGetItems@ request if any of the
-- following is true:
--
-- -   A conflicting operation is in the process of updating an item to be
--     read.
--
-- -   There is insufficient provisioned capacity for the transaction to be
--     completed.
--
-- -   There is a user error, such as an invalid data format.
--
-- -   The aggregate size of the items in the transaction cannot exceed 4
--     MB.
module Amazonka.DynamoDB.TransactGetItems
  ( -- * Creating a Request
    TransactGetItems (..),
    newTransactGetItems,

    -- * Request Lenses
    transactGetItems_returnConsumedCapacity,
    transactGetItems_transactItems,

    -- * Destructuring the Response
    TransactGetItemsResponse (..),
    newTransactGetItemsResponse,

    -- * Response Lenses
    transactGetItemsResponse_consumedCapacity,
    transactGetItemsResponse_responses,
    transactGetItemsResponse_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:/ 'newTransactGetItems' smart constructor.
data TransactGetItems = TransactGetItems'
  { -- | A value of @TOTAL@ causes consumed capacity information to be returned,
    -- and a value of @NONE@ prevents that information from being returned. No
    -- other value is valid.
    TransactGetItems -> Maybe ReturnConsumedCapacity
returnConsumedCapacity :: Prelude.Maybe ReturnConsumedCapacity,
    -- | An ordered array of up to 100 @TransactGetItem@ objects, each of which
    -- contains a @Get@ structure.
    TransactGetItems -> NonEmpty TransactGetItem
transactItems :: Prelude.NonEmpty TransactGetItem
  }
  deriving (TransactGetItems -> TransactGetItems -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactGetItems -> TransactGetItems -> Bool
$c/= :: TransactGetItems -> TransactGetItems -> Bool
== :: TransactGetItems -> TransactGetItems -> Bool
$c== :: TransactGetItems -> TransactGetItems -> Bool
Prelude.Eq, ReadPrec [TransactGetItems]
ReadPrec TransactGetItems
Int -> ReadS TransactGetItems
ReadS [TransactGetItems]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransactGetItems]
$creadListPrec :: ReadPrec [TransactGetItems]
readPrec :: ReadPrec TransactGetItems
$creadPrec :: ReadPrec TransactGetItems
readList :: ReadS [TransactGetItems]
$creadList :: ReadS [TransactGetItems]
readsPrec :: Int -> ReadS TransactGetItems
$creadsPrec :: Int -> ReadS TransactGetItems
Prelude.Read, Int -> TransactGetItems -> ShowS
[TransactGetItems] -> ShowS
TransactGetItems -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactGetItems] -> ShowS
$cshowList :: [TransactGetItems] -> ShowS
show :: TransactGetItems -> String
$cshow :: TransactGetItems -> String
showsPrec :: Int -> TransactGetItems -> ShowS
$cshowsPrec :: Int -> TransactGetItems -> ShowS
Prelude.Show, forall x. Rep TransactGetItems x -> TransactGetItems
forall x. TransactGetItems -> Rep TransactGetItems x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransactGetItems x -> TransactGetItems
$cfrom :: forall x. TransactGetItems -> Rep TransactGetItems x
Prelude.Generic)

-- |
-- Create a value of 'TransactGetItems' 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:
--
-- 'returnConsumedCapacity', 'transactGetItems_returnConsumedCapacity' - A value of @TOTAL@ causes consumed capacity information to be returned,
-- and a value of @NONE@ prevents that information from being returned. No
-- other value is valid.
--
-- 'transactItems', 'transactGetItems_transactItems' - An ordered array of up to 100 @TransactGetItem@ objects, each of which
-- contains a @Get@ structure.
newTransactGetItems ::
  -- | 'transactItems'
  Prelude.NonEmpty TransactGetItem ->
  TransactGetItems
newTransactGetItems :: NonEmpty TransactGetItem -> TransactGetItems
newTransactGetItems NonEmpty TransactGetItem
pTransactItems_ =
  TransactGetItems'
    { $sel:returnConsumedCapacity:TransactGetItems' :: Maybe ReturnConsumedCapacity
returnConsumedCapacity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:transactItems:TransactGetItems' :: NonEmpty TransactGetItem
transactItems = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty TransactGetItem
pTransactItems_
    }

-- | A value of @TOTAL@ causes consumed capacity information to be returned,
-- and a value of @NONE@ prevents that information from being returned. No
-- other value is valid.
transactGetItems_returnConsumedCapacity :: Lens.Lens' TransactGetItems (Prelude.Maybe ReturnConsumedCapacity)
transactGetItems_returnConsumedCapacity :: Lens' TransactGetItems (Maybe ReturnConsumedCapacity)
transactGetItems_returnConsumedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactGetItems' {Maybe ReturnConsumedCapacity
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
$sel:returnConsumedCapacity:TransactGetItems' :: TransactGetItems -> Maybe ReturnConsumedCapacity
returnConsumedCapacity} -> Maybe ReturnConsumedCapacity
returnConsumedCapacity) (\s :: TransactGetItems
s@TransactGetItems' {} Maybe ReturnConsumedCapacity
a -> TransactGetItems
s {$sel:returnConsumedCapacity:TransactGetItems' :: Maybe ReturnConsumedCapacity
returnConsumedCapacity = Maybe ReturnConsumedCapacity
a} :: TransactGetItems)

-- | An ordered array of up to 100 @TransactGetItem@ objects, each of which
-- contains a @Get@ structure.
transactGetItems_transactItems :: Lens.Lens' TransactGetItems (Prelude.NonEmpty TransactGetItem)
transactGetItems_transactItems :: Lens' TransactGetItems (NonEmpty TransactGetItem)
transactGetItems_transactItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactGetItems' {NonEmpty TransactGetItem
transactItems :: NonEmpty TransactGetItem
$sel:transactItems:TransactGetItems' :: TransactGetItems -> NonEmpty TransactGetItem
transactItems} -> NonEmpty TransactGetItem
transactItems) (\s :: TransactGetItems
s@TransactGetItems' {} NonEmpty TransactGetItem
a -> TransactGetItems
s {$sel:transactItems:TransactGetItems' :: NonEmpty TransactGetItem
transactItems = NonEmpty TransactGetItem
a} :: TransactGetItems) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest TransactGetItems where
  type
    AWSResponse TransactGetItems =
      TransactGetItemsResponse
  request :: (Service -> Service)
-> TransactGetItems -> Request TransactGetItems
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 TransactGetItems
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TransactGetItems)))
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 (NonEmpty ItemResponse) -> Int -> TransactGetItemsResponse
TransactGetItemsResponse'
            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. 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
"Responses")
            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 TransactGetItems where
  hashWithSalt :: Int -> TransactGetItems -> Int
hashWithSalt Int
_salt TransactGetItems' {Maybe ReturnConsumedCapacity
NonEmpty TransactGetItem
transactItems :: NonEmpty TransactGetItem
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
$sel:transactItems:TransactGetItems' :: TransactGetItems -> NonEmpty TransactGetItem
$sel:returnConsumedCapacity:TransactGetItems' :: TransactGetItems -> Maybe ReturnConsumedCapacity
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReturnConsumedCapacity
returnConsumedCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty TransactGetItem
transactItems

instance Prelude.NFData TransactGetItems where
  rnf :: TransactGetItems -> ()
rnf TransactGetItems' {Maybe ReturnConsumedCapacity
NonEmpty TransactGetItem
transactItems :: NonEmpty TransactGetItem
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
$sel:transactItems:TransactGetItems' :: TransactGetItems -> NonEmpty TransactGetItem
$sel:returnConsumedCapacity:TransactGetItems' :: TransactGetItems -> Maybe ReturnConsumedCapacity
..} =
    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 NonEmpty TransactGetItem
transactItems

instance Data.ToHeaders TransactGetItems where
  toHeaders :: TransactGetItems -> 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.TransactGetItems" ::
                          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 TransactGetItems where
  toJSON :: TransactGetItems -> Value
toJSON TransactGetItems' {Maybe ReturnConsumedCapacity
NonEmpty TransactGetItem
transactItems :: NonEmpty TransactGetItem
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
$sel:transactItems:TransactGetItems' :: TransactGetItems -> NonEmpty TransactGetItem
$sel:returnConsumedCapacity:TransactGetItems' :: TransactGetItems -> Maybe ReturnConsumedCapacity
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"TransactItems" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty TransactGetItem
transactItems)
          ]
      )

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

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

-- | /See:/ 'newTransactGetItemsResponse' smart constructor.
data TransactGetItemsResponse = TransactGetItemsResponse'
  { -- | If the /ReturnConsumedCapacity/ value was @TOTAL@, this is an array of
    -- @ConsumedCapacity@ objects, one for each table addressed by
    -- @TransactGetItem@ objects in the /TransactItems/ parameter. These
    -- @ConsumedCapacity@ objects report the read-capacity units consumed by
    -- the @TransactGetItems@ call in that table.
    TransactGetItemsResponse -> Maybe [ConsumedCapacity]
consumedCapacity :: Prelude.Maybe [ConsumedCapacity],
    -- | An ordered array of up to 100 @ItemResponse@ objects, each of which
    -- corresponds to the @TransactGetItem@ object in the same position in the
    -- /TransactItems/ array. Each @ItemResponse@ object contains a Map of the
    -- name-value pairs that are the projected attributes of the requested
    -- item.
    --
    -- If a requested item could not be retrieved, the corresponding
    -- @ItemResponse@ object is Null, or if the requested item has no projected
    -- attributes, the corresponding @ItemResponse@ object is an empty Map.
    TransactGetItemsResponse -> Maybe (NonEmpty ItemResponse)
responses :: Prelude.Maybe (Prelude.NonEmpty ItemResponse),
    -- | The response's http status code.
    TransactGetItemsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TransactGetItemsResponse -> TransactGetItemsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactGetItemsResponse -> TransactGetItemsResponse -> Bool
$c/= :: TransactGetItemsResponse -> TransactGetItemsResponse -> Bool
== :: TransactGetItemsResponse -> TransactGetItemsResponse -> Bool
$c== :: TransactGetItemsResponse -> TransactGetItemsResponse -> Bool
Prelude.Eq, ReadPrec [TransactGetItemsResponse]
ReadPrec TransactGetItemsResponse
Int -> ReadS TransactGetItemsResponse
ReadS [TransactGetItemsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransactGetItemsResponse]
$creadListPrec :: ReadPrec [TransactGetItemsResponse]
readPrec :: ReadPrec TransactGetItemsResponse
$creadPrec :: ReadPrec TransactGetItemsResponse
readList :: ReadS [TransactGetItemsResponse]
$creadList :: ReadS [TransactGetItemsResponse]
readsPrec :: Int -> ReadS TransactGetItemsResponse
$creadsPrec :: Int -> ReadS TransactGetItemsResponse
Prelude.Read, Int -> TransactGetItemsResponse -> ShowS
[TransactGetItemsResponse] -> ShowS
TransactGetItemsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactGetItemsResponse] -> ShowS
$cshowList :: [TransactGetItemsResponse] -> ShowS
show :: TransactGetItemsResponse -> String
$cshow :: TransactGetItemsResponse -> String
showsPrec :: Int -> TransactGetItemsResponse -> ShowS
$cshowsPrec :: Int -> TransactGetItemsResponse -> ShowS
Prelude.Show, forall x.
Rep TransactGetItemsResponse x -> TransactGetItemsResponse
forall x.
TransactGetItemsResponse -> Rep TransactGetItemsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TransactGetItemsResponse x -> TransactGetItemsResponse
$cfrom :: forall x.
TransactGetItemsResponse -> Rep TransactGetItemsResponse x
Prelude.Generic)

-- |
-- Create a value of 'TransactGetItemsResponse' 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', 'transactGetItemsResponse_consumedCapacity' - If the /ReturnConsumedCapacity/ value was @TOTAL@, this is an array of
-- @ConsumedCapacity@ objects, one for each table addressed by
-- @TransactGetItem@ objects in the /TransactItems/ parameter. These
-- @ConsumedCapacity@ objects report the read-capacity units consumed by
-- the @TransactGetItems@ call in that table.
--
-- 'responses', 'transactGetItemsResponse_responses' - An ordered array of up to 100 @ItemResponse@ objects, each of which
-- corresponds to the @TransactGetItem@ object in the same position in the
-- /TransactItems/ array. Each @ItemResponse@ object contains a Map of the
-- name-value pairs that are the projected attributes of the requested
-- item.
--
-- If a requested item could not be retrieved, the corresponding
-- @ItemResponse@ object is Null, or if the requested item has no projected
-- attributes, the corresponding @ItemResponse@ object is an empty Map.
--
-- 'httpStatus', 'transactGetItemsResponse_httpStatus' - The response's http status code.
newTransactGetItemsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TransactGetItemsResponse
newTransactGetItemsResponse :: Int -> TransactGetItemsResponse
newTransactGetItemsResponse Int
pHttpStatus_ =
  TransactGetItemsResponse'
    { $sel:consumedCapacity:TransactGetItemsResponse' :: Maybe [ConsumedCapacity]
consumedCapacity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:responses:TransactGetItemsResponse' :: Maybe (NonEmpty ItemResponse)
responses = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TransactGetItemsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the /ReturnConsumedCapacity/ value was @TOTAL@, this is an array of
-- @ConsumedCapacity@ objects, one for each table addressed by
-- @TransactGetItem@ objects in the /TransactItems/ parameter. These
-- @ConsumedCapacity@ objects report the read-capacity units consumed by
-- the @TransactGetItems@ call in that table.
transactGetItemsResponse_consumedCapacity :: Lens.Lens' TransactGetItemsResponse (Prelude.Maybe [ConsumedCapacity])
transactGetItemsResponse_consumedCapacity :: Lens' TransactGetItemsResponse (Maybe [ConsumedCapacity])
transactGetItemsResponse_consumedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactGetItemsResponse' {Maybe [ConsumedCapacity]
consumedCapacity :: Maybe [ConsumedCapacity]
$sel:consumedCapacity:TransactGetItemsResponse' :: TransactGetItemsResponse -> Maybe [ConsumedCapacity]
consumedCapacity} -> Maybe [ConsumedCapacity]
consumedCapacity) (\s :: TransactGetItemsResponse
s@TransactGetItemsResponse' {} Maybe [ConsumedCapacity]
a -> TransactGetItemsResponse
s {$sel:consumedCapacity:TransactGetItemsResponse' :: Maybe [ConsumedCapacity]
consumedCapacity = Maybe [ConsumedCapacity]
a} :: TransactGetItemsResponse) 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

-- | An ordered array of up to 100 @ItemResponse@ objects, each of which
-- corresponds to the @TransactGetItem@ object in the same position in the
-- /TransactItems/ array. Each @ItemResponse@ object contains a Map of the
-- name-value pairs that are the projected attributes of the requested
-- item.
--
-- If a requested item could not be retrieved, the corresponding
-- @ItemResponse@ object is Null, or if the requested item has no projected
-- attributes, the corresponding @ItemResponse@ object is an empty Map.
transactGetItemsResponse_responses :: Lens.Lens' TransactGetItemsResponse (Prelude.Maybe (Prelude.NonEmpty ItemResponse))
transactGetItemsResponse_responses :: Lens' TransactGetItemsResponse (Maybe (NonEmpty ItemResponse))
transactGetItemsResponse_responses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactGetItemsResponse' {Maybe (NonEmpty ItemResponse)
responses :: Maybe (NonEmpty ItemResponse)
$sel:responses:TransactGetItemsResponse' :: TransactGetItemsResponse -> Maybe (NonEmpty ItemResponse)
responses} -> Maybe (NonEmpty ItemResponse)
responses) (\s :: TransactGetItemsResponse
s@TransactGetItemsResponse' {} Maybe (NonEmpty ItemResponse)
a -> TransactGetItemsResponse
s {$sel:responses:TransactGetItemsResponse' :: Maybe (NonEmpty ItemResponse)
responses = Maybe (NonEmpty ItemResponse)
a} :: TransactGetItemsResponse) 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.
transactGetItemsResponse_httpStatus :: Lens.Lens' TransactGetItemsResponse Prelude.Int
transactGetItemsResponse_httpStatus :: Lens' TransactGetItemsResponse Int
transactGetItemsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactGetItemsResponse' {Int
httpStatus :: Int
$sel:httpStatus:TransactGetItemsResponse' :: TransactGetItemsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: TransactGetItemsResponse
s@TransactGetItemsResponse' {} Int
a -> TransactGetItemsResponse
s {$sel:httpStatus:TransactGetItemsResponse' :: Int
httpStatus = Int
a} :: TransactGetItemsResponse)

instance Prelude.NFData TransactGetItemsResponse where
  rnf :: TransactGetItemsResponse -> ()
rnf TransactGetItemsResponse' {Int
Maybe [ConsumedCapacity]
Maybe (NonEmpty ItemResponse)
httpStatus :: Int
responses :: Maybe (NonEmpty ItemResponse)
consumedCapacity :: Maybe [ConsumedCapacity]
$sel:httpStatus:TransactGetItemsResponse' :: TransactGetItemsResponse -> Int
$sel:responses:TransactGetItemsResponse' :: TransactGetItemsResponse -> Maybe (NonEmpty ItemResponse)
$sel:consumedCapacity:TransactGetItemsResponse' :: TransactGetItemsResponse -> 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 (NonEmpty ItemResponse)
responses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus