{-# 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.GetItem
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The @GetItem@ operation returns a set of attributes for the item with
-- the given primary key. If there is no matching item, @GetItem@ does not
-- return any data and there will be no @Item@ element in the response.
--
-- @GetItem@ provides an eventually consistent read by default. If your
-- application requires a strongly consistent read, set @ConsistentRead@ to
-- @true@. Although a strongly consistent read might take more time than an
-- eventually consistent read, it always returns the last updated value.
module Amazonka.DynamoDB.GetItem
  ( -- * Creating a Request
    GetItem (..),
    newGetItem,

    -- * Request Lenses
    getItem_attributesToGet,
    getItem_consistentRead,
    getItem_expressionAttributeNames,
    getItem_projectionExpression,
    getItem_returnConsumedCapacity,
    getItem_tableName,
    getItem_key,

    -- * Destructuring the Response
    GetItemResponse (..),
    newGetItemResponse,

    -- * Response Lenses
    getItemResponse_consumedCapacity,
    getItemResponse_item,
    getItemResponse_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

-- | Represents the input of a @GetItem@ operation.
--
-- /See:/ 'newGetItem' smart constructor.
data GetItem = GetItem'
  { -- | This is a legacy parameter. Use @ProjectionExpression@ instead. For more
    -- information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/LegacyConditionalParameters.AttributesToGet.html AttributesToGet>
    -- in the /Amazon DynamoDB Developer Guide/.
    GetItem -> Maybe (NonEmpty Text)
attributesToGet :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | Determines the read consistency model: If set to @true@, then the
    -- operation uses strongly consistent reads; otherwise, the operation uses
    -- eventually consistent reads.
    GetItem -> Maybe Bool
consistentRead :: Prelude.Maybe Prelude.Bool,
    -- | One or more substitution tokens for attribute names in an expression.
    -- The following are some use cases for using @ExpressionAttributeNames@:
    --
    -- -   To access an attribute whose name conflicts with a DynamoDB reserved
    --     word.
    --
    -- -   To create a placeholder for repeating occurrences of an attribute
    --     name in an expression.
    --
    -- -   To prevent special characters in an attribute name from being
    --     misinterpreted in an expression.
    --
    -- Use the __#__ character in an expression to dereference an attribute
    -- name. For example, consider the following attribute name:
    --
    -- -   @Percentile@
    --
    -- The name of this attribute conflicts with a reserved word, so it cannot
    -- be used directly in an expression. (For the complete list of reserved
    -- words, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/ReservedWords.html Reserved Words>
    -- in the /Amazon DynamoDB Developer Guide/). To work around this, you
    -- could specify the following for @ExpressionAttributeNames@:
    --
    -- -   @{\"#P\":\"Percentile\"}@
    --
    -- You could then use this substitution in an expression, as in this
    -- example:
    --
    -- -   @#P = :val@
    --
    -- Tokens that begin with the __:__ character are /expression attribute
    -- values/, which are placeholders for the actual value at runtime.
    --
    -- For more information on expression attribute names, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Expressions.AccessingItemAttributes.html Specifying Item Attributes>
    -- in the /Amazon DynamoDB Developer Guide/.
    GetItem -> Maybe (HashMap Text Text)
expressionAttributeNames :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A string that identifies one or more attributes to retrieve from the
    -- table. These attributes can include scalars, sets, or elements of a JSON
    -- document. The attributes in the expression must be separated by commas.
    --
    -- If no attribute names are specified, then all attributes are returned.
    -- If any of the requested attributes are not found, they do not appear in
    -- the result.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Expressions.AccessingItemAttributes.html Specifying Item Attributes>
    -- in the /Amazon DynamoDB Developer Guide/.
    GetItem -> Maybe Text
projectionExpression :: Prelude.Maybe Prelude.Text,
    GetItem -> Maybe ReturnConsumedCapacity
returnConsumedCapacity :: Prelude.Maybe ReturnConsumedCapacity,
    -- | The name of the table containing the requested item.
    GetItem -> Text
tableName :: Prelude.Text,
    -- | A map of attribute names to @AttributeValue@ objects, representing the
    -- primary key of the item to retrieve.
    --
    -- For the primary key, you must provide all of the attributes. For
    -- example, with a simple primary key, you only need to provide a value for
    -- the partition key. For a composite primary key, you must provide values
    -- for both the partition key and the sort key.
    GetItem -> HashMap Text AttributeValue
key :: Prelude.HashMap Prelude.Text AttributeValue
  }
  deriving (GetItem -> GetItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetItem -> GetItem -> Bool
$c/= :: GetItem -> GetItem -> Bool
== :: GetItem -> GetItem -> Bool
$c== :: GetItem -> GetItem -> Bool
Prelude.Eq, ReadPrec [GetItem]
ReadPrec GetItem
Int -> ReadS GetItem
ReadS [GetItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetItem]
$creadListPrec :: ReadPrec [GetItem]
readPrec :: ReadPrec GetItem
$creadPrec :: ReadPrec GetItem
readList :: ReadS [GetItem]
$creadList :: ReadS [GetItem]
readsPrec :: Int -> ReadS GetItem
$creadsPrec :: Int -> ReadS GetItem
Prelude.Read, Int -> GetItem -> ShowS
[GetItem] -> ShowS
GetItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetItem] -> ShowS
$cshowList :: [GetItem] -> ShowS
show :: GetItem -> String
$cshow :: GetItem -> String
showsPrec :: Int -> GetItem -> ShowS
$cshowsPrec :: Int -> GetItem -> ShowS
Prelude.Show, forall x. Rep GetItem x -> GetItem
forall x. GetItem -> Rep GetItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetItem x -> GetItem
$cfrom :: forall x. GetItem -> Rep GetItem x
Prelude.Generic)

-- |
-- Create a value of 'GetItem' 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:
--
-- 'attributesToGet', 'getItem_attributesToGet' - This is a legacy parameter. Use @ProjectionExpression@ instead. For more
-- information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/LegacyConditionalParameters.AttributesToGet.html AttributesToGet>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- 'consistentRead', 'getItem_consistentRead' - Determines the read consistency model: If set to @true@, then the
-- operation uses strongly consistent reads; otherwise, the operation uses
-- eventually consistent reads.
--
-- 'expressionAttributeNames', 'getItem_expressionAttributeNames' - One or more substitution tokens for attribute names in an expression.
-- The following are some use cases for using @ExpressionAttributeNames@:
--
-- -   To access an attribute whose name conflicts with a DynamoDB reserved
--     word.
--
-- -   To create a placeholder for repeating occurrences of an attribute
--     name in an expression.
--
-- -   To prevent special characters in an attribute name from being
--     misinterpreted in an expression.
--
-- Use the __#__ character in an expression to dereference an attribute
-- name. For example, consider the following attribute name:
--
-- -   @Percentile@
--
-- The name of this attribute conflicts with a reserved word, so it cannot
-- be used directly in an expression. (For the complete list of reserved
-- words, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/ReservedWords.html Reserved Words>
-- in the /Amazon DynamoDB Developer Guide/). To work around this, you
-- could specify the following for @ExpressionAttributeNames@:
--
-- -   @{\"#P\":\"Percentile\"}@
--
-- You could then use this substitution in an expression, as in this
-- example:
--
-- -   @#P = :val@
--
-- Tokens that begin with the __:__ character are /expression attribute
-- values/, which are placeholders for the actual value at runtime.
--
-- For more information on expression attribute names, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Expressions.AccessingItemAttributes.html Specifying Item Attributes>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- 'projectionExpression', 'getItem_projectionExpression' - A string that identifies one or more attributes to retrieve from the
-- table. These attributes can include scalars, sets, or elements of a JSON
-- document. The attributes in the expression must be separated by commas.
--
-- If no attribute names are specified, then all attributes are returned.
-- If any of the requested attributes are not found, they do not appear in
-- the result.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Expressions.AccessingItemAttributes.html Specifying Item Attributes>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- 'returnConsumedCapacity', 'getItem_returnConsumedCapacity' - Undocumented member.
--
-- 'tableName', 'getItem_tableName' - The name of the table containing the requested item.
--
-- 'key', 'getItem_key' - A map of attribute names to @AttributeValue@ objects, representing the
-- primary key of the item to retrieve.
--
-- For the primary key, you must provide all of the attributes. For
-- example, with a simple primary key, you only need to provide a value for
-- the partition key. For a composite primary key, you must provide values
-- for both the partition key and the sort key.
newGetItem ::
  -- | 'tableName'
  Prelude.Text ->
  GetItem
newGetItem :: Text -> GetItem
newGetItem Text
pTableName_ =
  GetItem'
    { $sel:attributesToGet:GetItem' :: Maybe (NonEmpty Text)
attributesToGet = forall a. Maybe a
Prelude.Nothing,
      $sel:consistentRead:GetItem' :: Maybe Bool
consistentRead = forall a. Maybe a
Prelude.Nothing,
      $sel:expressionAttributeNames:GetItem' :: Maybe (HashMap Text Text)
expressionAttributeNames = forall a. Maybe a
Prelude.Nothing,
      $sel:projectionExpression:GetItem' :: Maybe Text
projectionExpression = forall a. Maybe a
Prelude.Nothing,
      $sel:returnConsumedCapacity:GetItem' :: Maybe ReturnConsumedCapacity
returnConsumedCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:GetItem' :: Text
tableName = Text
pTableName_,
      $sel:key:GetItem' :: HashMap Text AttributeValue
key = forall a. Monoid a => a
Prelude.mempty
    }

-- | This is a legacy parameter. Use @ProjectionExpression@ instead. For more
-- information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/LegacyConditionalParameters.AttributesToGet.html AttributesToGet>
-- in the /Amazon DynamoDB Developer Guide/.
getItem_attributesToGet :: Lens.Lens' GetItem (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getItem_attributesToGet :: Lens' GetItem (Maybe (NonEmpty Text))
getItem_attributesToGet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItem' {Maybe (NonEmpty Text)
attributesToGet :: Maybe (NonEmpty Text)
$sel:attributesToGet:GetItem' :: GetItem -> Maybe (NonEmpty Text)
attributesToGet} -> Maybe (NonEmpty Text)
attributesToGet) (\s :: GetItem
s@GetItem' {} Maybe (NonEmpty Text)
a -> GetItem
s {$sel:attributesToGet:GetItem' :: Maybe (NonEmpty Text)
attributesToGet = Maybe (NonEmpty Text)
a} :: GetItem) 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

-- | Determines the read consistency model: If set to @true@, then the
-- operation uses strongly consistent reads; otherwise, the operation uses
-- eventually consistent reads.
getItem_consistentRead :: Lens.Lens' GetItem (Prelude.Maybe Prelude.Bool)
getItem_consistentRead :: Lens' GetItem (Maybe Bool)
getItem_consistentRead = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItem' {Maybe Bool
consistentRead :: Maybe Bool
$sel:consistentRead:GetItem' :: GetItem -> Maybe Bool
consistentRead} -> Maybe Bool
consistentRead) (\s :: GetItem
s@GetItem' {} Maybe Bool
a -> GetItem
s {$sel:consistentRead:GetItem' :: Maybe Bool
consistentRead = Maybe Bool
a} :: GetItem)

-- | One or more substitution tokens for attribute names in an expression.
-- The following are some use cases for using @ExpressionAttributeNames@:
--
-- -   To access an attribute whose name conflicts with a DynamoDB reserved
--     word.
--
-- -   To create a placeholder for repeating occurrences of an attribute
--     name in an expression.
--
-- -   To prevent special characters in an attribute name from being
--     misinterpreted in an expression.
--
-- Use the __#__ character in an expression to dereference an attribute
-- name. For example, consider the following attribute name:
--
-- -   @Percentile@
--
-- The name of this attribute conflicts with a reserved word, so it cannot
-- be used directly in an expression. (For the complete list of reserved
-- words, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/ReservedWords.html Reserved Words>
-- in the /Amazon DynamoDB Developer Guide/). To work around this, you
-- could specify the following for @ExpressionAttributeNames@:
--
-- -   @{\"#P\":\"Percentile\"}@
--
-- You could then use this substitution in an expression, as in this
-- example:
--
-- -   @#P = :val@
--
-- Tokens that begin with the __:__ character are /expression attribute
-- values/, which are placeholders for the actual value at runtime.
--
-- For more information on expression attribute names, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Expressions.AccessingItemAttributes.html Specifying Item Attributes>
-- in the /Amazon DynamoDB Developer Guide/.
getItem_expressionAttributeNames :: Lens.Lens' GetItem (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getItem_expressionAttributeNames :: Lens' GetItem (Maybe (HashMap Text Text))
getItem_expressionAttributeNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItem' {Maybe (HashMap Text Text)
expressionAttributeNames :: Maybe (HashMap Text Text)
$sel:expressionAttributeNames:GetItem' :: GetItem -> Maybe (HashMap Text Text)
expressionAttributeNames} -> Maybe (HashMap Text Text)
expressionAttributeNames) (\s :: GetItem
s@GetItem' {} Maybe (HashMap Text Text)
a -> GetItem
s {$sel:expressionAttributeNames:GetItem' :: Maybe (HashMap Text Text)
expressionAttributeNames = Maybe (HashMap Text Text)
a} :: GetItem) 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 that identifies one or more attributes to retrieve from the
-- table. These attributes can include scalars, sets, or elements of a JSON
-- document. The attributes in the expression must be separated by commas.
--
-- If no attribute names are specified, then all attributes are returned.
-- If any of the requested attributes are not found, they do not appear in
-- the result.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Expressions.AccessingItemAttributes.html Specifying Item Attributes>
-- in the /Amazon DynamoDB Developer Guide/.
getItem_projectionExpression :: Lens.Lens' GetItem (Prelude.Maybe Prelude.Text)
getItem_projectionExpression :: Lens' GetItem (Maybe Text)
getItem_projectionExpression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItem' {Maybe Text
projectionExpression :: Maybe Text
$sel:projectionExpression:GetItem' :: GetItem -> Maybe Text
projectionExpression} -> Maybe Text
projectionExpression) (\s :: GetItem
s@GetItem' {} Maybe Text
a -> GetItem
s {$sel:projectionExpression:GetItem' :: Maybe Text
projectionExpression = Maybe Text
a} :: GetItem)

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

-- | The name of the table containing the requested item.
getItem_tableName :: Lens.Lens' GetItem Prelude.Text
getItem_tableName :: Lens' GetItem Text
getItem_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItem' {Text
tableName :: Text
$sel:tableName:GetItem' :: GetItem -> Text
tableName} -> Text
tableName) (\s :: GetItem
s@GetItem' {} Text
a -> GetItem
s {$sel:tableName:GetItem' :: Text
tableName = Text
a} :: GetItem)

-- | A map of attribute names to @AttributeValue@ objects, representing the
-- primary key of the item to retrieve.
--
-- For the primary key, you must provide all of the attributes. For
-- example, with a simple primary key, you only need to provide a value for
-- the partition key. For a composite primary key, you must provide values
-- for both the partition key and the sort key.
getItem_key :: Lens.Lens' GetItem (Prelude.HashMap Prelude.Text AttributeValue)
getItem_key :: Lens' GetItem (HashMap Text AttributeValue)
getItem_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItem' {HashMap Text AttributeValue
key :: HashMap Text AttributeValue
$sel:key:GetItem' :: GetItem -> HashMap Text AttributeValue
key} -> HashMap Text AttributeValue
key) (\s :: GetItem
s@GetItem' {} HashMap Text AttributeValue
a -> GetItem
s {$sel:key:GetItem' :: HashMap Text AttributeValue
key = HashMap Text AttributeValue
a} :: GetItem) 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 GetItem where
  type AWSResponse GetItem = GetItemResponse
  request :: (Service -> Service) -> GetItem -> Request GetItem
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 GetItem
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetItem)))
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) -> Int -> GetItemResponse
GetItemResponse'
            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
"Item" 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 GetItem where
  hashWithSalt :: Int -> GetItem -> Int
hashWithSalt Int
_salt GetItem' {Maybe Bool
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe ReturnConsumedCapacity
Text
HashMap Text AttributeValue
key :: HashMap Text AttributeValue
tableName :: Text
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
projectionExpression :: Maybe Text
expressionAttributeNames :: Maybe (HashMap Text Text)
consistentRead :: Maybe Bool
attributesToGet :: Maybe (NonEmpty Text)
$sel:key:GetItem' :: GetItem -> HashMap Text AttributeValue
$sel:tableName:GetItem' :: GetItem -> Text
$sel:returnConsumedCapacity:GetItem' :: GetItem -> Maybe ReturnConsumedCapacity
$sel:projectionExpression:GetItem' :: GetItem -> Maybe Text
$sel:expressionAttributeNames:GetItem' :: GetItem -> Maybe (HashMap Text Text)
$sel:consistentRead:GetItem' :: GetItem -> Maybe Bool
$sel:attributesToGet:GetItem' :: GetItem -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
attributesToGet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
consistentRead
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
expressionAttributeNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
projectionExpression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReturnConsumedCapacity
returnConsumedCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text AttributeValue
key

instance Prelude.NFData GetItem where
  rnf :: GetItem -> ()
rnf GetItem' {Maybe Bool
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe ReturnConsumedCapacity
Text
HashMap Text AttributeValue
key :: HashMap Text AttributeValue
tableName :: Text
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
projectionExpression :: Maybe Text
expressionAttributeNames :: Maybe (HashMap Text Text)
consistentRead :: Maybe Bool
attributesToGet :: Maybe (NonEmpty Text)
$sel:key:GetItem' :: GetItem -> HashMap Text AttributeValue
$sel:tableName:GetItem' :: GetItem -> Text
$sel:returnConsumedCapacity:GetItem' :: GetItem -> Maybe ReturnConsumedCapacity
$sel:projectionExpression:GetItem' :: GetItem -> Maybe Text
$sel:expressionAttributeNames:GetItem' :: GetItem -> Maybe (HashMap Text Text)
$sel:consistentRead:GetItem' :: GetItem -> Maybe Bool
$sel:attributesToGet:GetItem' :: GetItem -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
attributesToGet
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 (HashMap Text Text)
expressionAttributeNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
projectionExpression
      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
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text AttributeValue
key

instance Data.ToHeaders GetItem where
  toHeaders :: GetItem -> 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.GetItem" :: 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 GetItem where
  toJSON :: GetItem -> Value
toJSON GetItem' {Maybe Bool
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe ReturnConsumedCapacity
Text
HashMap Text AttributeValue
key :: HashMap Text AttributeValue
tableName :: Text
returnConsumedCapacity :: Maybe ReturnConsumedCapacity
projectionExpression :: Maybe Text
expressionAttributeNames :: Maybe (HashMap Text Text)
consistentRead :: Maybe Bool
attributesToGet :: Maybe (NonEmpty Text)
$sel:key:GetItem' :: GetItem -> HashMap Text AttributeValue
$sel:tableName:GetItem' :: GetItem -> Text
$sel:returnConsumedCapacity:GetItem' :: GetItem -> Maybe ReturnConsumedCapacity
$sel:projectionExpression:GetItem' :: GetItem -> Maybe Text
$sel:expressionAttributeNames:GetItem' :: GetItem -> Maybe (HashMap Text Text)
$sel:consistentRead:GetItem' :: GetItem -> Maybe Bool
$sel:attributesToGet:GetItem' :: GetItem -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AttributesToGet" 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 Text)
attributesToGet,
            (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
"ExpressionAttributeNames" 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 (HashMap Text Text)
expressionAttributeNames,
            (Key
"ProjectionExpression" 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
projectionExpression,
            (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
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text AttributeValue
key)
          ]
      )

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

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

-- | Represents the output of a @GetItem@ operation.
--
-- /See:/ 'newGetItemResponse' smart constructor.
data GetItemResponse = GetItemResponse'
  { -- | The capacity units consumed by the @GetItem@ operation. The data
    -- returned includes the total provisioned throughput consumed, along with
    -- statistics for the table and any indexes involved in the operation.
    -- @ConsumedCapacity@ is only returned if the @ReturnConsumedCapacity@
    -- parameter was specified. For more information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/ProvisionedThroughputIntro.html Read\/Write Capacity Mode>
    -- in the /Amazon DynamoDB Developer Guide/.
    GetItemResponse -> Maybe ConsumedCapacity
consumedCapacity :: Prelude.Maybe ConsumedCapacity,
    -- | A map of attribute names to @AttributeValue@ objects, as specified by
    -- @ProjectionExpression@.
    GetItemResponse -> Maybe (HashMap Text AttributeValue)
item :: Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeValue),
    -- | The response's http status code.
    GetItemResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetItemResponse -> GetItemResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetItemResponse -> GetItemResponse -> Bool
$c/= :: GetItemResponse -> GetItemResponse -> Bool
== :: GetItemResponse -> GetItemResponse -> Bool
$c== :: GetItemResponse -> GetItemResponse -> Bool
Prelude.Eq, ReadPrec [GetItemResponse]
ReadPrec GetItemResponse
Int -> ReadS GetItemResponse
ReadS [GetItemResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetItemResponse]
$creadListPrec :: ReadPrec [GetItemResponse]
readPrec :: ReadPrec GetItemResponse
$creadPrec :: ReadPrec GetItemResponse
readList :: ReadS [GetItemResponse]
$creadList :: ReadS [GetItemResponse]
readsPrec :: Int -> ReadS GetItemResponse
$creadsPrec :: Int -> ReadS GetItemResponse
Prelude.Read, Int -> GetItemResponse -> ShowS
[GetItemResponse] -> ShowS
GetItemResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetItemResponse] -> ShowS
$cshowList :: [GetItemResponse] -> ShowS
show :: GetItemResponse -> String
$cshow :: GetItemResponse -> String
showsPrec :: Int -> GetItemResponse -> ShowS
$cshowsPrec :: Int -> GetItemResponse -> ShowS
Prelude.Show, forall x. Rep GetItemResponse x -> GetItemResponse
forall x. GetItemResponse -> Rep GetItemResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetItemResponse x -> GetItemResponse
$cfrom :: forall x. GetItemResponse -> Rep GetItemResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetItemResponse' 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', 'getItemResponse_consumedCapacity' - The capacity units consumed by the @GetItem@ operation. The data
-- returned includes the total provisioned throughput consumed, along with
-- statistics for the table and any indexes involved in the operation.
-- @ConsumedCapacity@ is only returned if the @ReturnConsumedCapacity@
-- parameter was specified. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/ProvisionedThroughputIntro.html Read\/Write Capacity Mode>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- 'item', 'getItemResponse_item' - A map of attribute names to @AttributeValue@ objects, as specified by
-- @ProjectionExpression@.
--
-- 'httpStatus', 'getItemResponse_httpStatus' - The response's http status code.
newGetItemResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetItemResponse
newGetItemResponse :: Int -> GetItemResponse
newGetItemResponse Int
pHttpStatus_ =
  GetItemResponse'
    { $sel:consumedCapacity:GetItemResponse' :: Maybe ConsumedCapacity
consumedCapacity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:item:GetItemResponse' :: Maybe (HashMap Text AttributeValue)
item = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetItemResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The capacity units consumed by the @GetItem@ operation. The data
-- returned includes the total provisioned throughput consumed, along with
-- statistics for the table and any indexes involved in the operation.
-- @ConsumedCapacity@ is only returned if the @ReturnConsumedCapacity@
-- parameter was specified. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/ProvisionedThroughputIntro.html Read\/Write Capacity Mode>
-- in the /Amazon DynamoDB Developer Guide/.
getItemResponse_consumedCapacity :: Lens.Lens' GetItemResponse (Prelude.Maybe ConsumedCapacity)
getItemResponse_consumedCapacity :: Lens' GetItemResponse (Maybe ConsumedCapacity)
getItemResponse_consumedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItemResponse' {Maybe ConsumedCapacity
consumedCapacity :: Maybe ConsumedCapacity
$sel:consumedCapacity:GetItemResponse' :: GetItemResponse -> Maybe ConsumedCapacity
consumedCapacity} -> Maybe ConsumedCapacity
consumedCapacity) (\s :: GetItemResponse
s@GetItemResponse' {} Maybe ConsumedCapacity
a -> GetItemResponse
s {$sel:consumedCapacity:GetItemResponse' :: Maybe ConsumedCapacity
consumedCapacity = Maybe ConsumedCapacity
a} :: GetItemResponse)

-- | A map of attribute names to @AttributeValue@ objects, as specified by
-- @ProjectionExpression@.
getItemResponse_item :: Lens.Lens' GetItemResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeValue))
getItemResponse_item :: Lens' GetItemResponse (Maybe (HashMap Text AttributeValue))
getItemResponse_item = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItemResponse' {Maybe (HashMap Text AttributeValue)
item :: Maybe (HashMap Text AttributeValue)
$sel:item:GetItemResponse' :: GetItemResponse -> Maybe (HashMap Text AttributeValue)
item} -> Maybe (HashMap Text AttributeValue)
item) (\s :: GetItemResponse
s@GetItemResponse' {} Maybe (HashMap Text AttributeValue)
a -> GetItemResponse
s {$sel:item:GetItemResponse' :: Maybe (HashMap Text AttributeValue)
item = Maybe (HashMap Text AttributeValue)
a} :: GetItemResponse) 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.
getItemResponse_httpStatus :: Lens.Lens' GetItemResponse Prelude.Int
getItemResponse_httpStatus :: Lens' GetItemResponse Int
getItemResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetItemResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetItemResponse' :: GetItemResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetItemResponse
s@GetItemResponse' {} Int
a -> GetItemResponse
s {$sel:httpStatus:GetItemResponse' :: Int
httpStatus = Int
a} :: GetItemResponse)

instance Prelude.NFData GetItemResponse where
  rnf :: GetItemResponse -> ()
rnf GetItemResponse' {Int
Maybe (HashMap Text AttributeValue)
Maybe ConsumedCapacity
httpStatus :: Int
item :: Maybe (HashMap Text AttributeValue)
consumedCapacity :: Maybe ConsumedCapacity
$sel:httpStatus:GetItemResponse' :: GetItemResponse -> Int
$sel:item:GetItemResponse' :: GetItemResponse -> Maybe (HashMap Text AttributeValue)
$sel:consumedCapacity:GetItemResponse' :: GetItemResponse -> 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)
item
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus