{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.KeySchemaElement
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.DynamoDB.Types.KeySchemaElement 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.AttributeValue
import Amazonka.DynamoDB.Types.KeyType
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | Represents /a single element/ of a key schema. A key schema specifies
-- the attributes that make up the primary key of a table, or the key
-- attributes of an index.
--
-- A @KeySchemaElement@ represents exactly one attribute of the primary
-- key. For example, a simple primary key would be represented by one
-- @KeySchemaElement@ (for the partition key). A composite primary key
-- would require one @KeySchemaElement@ for the partition key, and another
-- @KeySchemaElement@ for the sort key.
--
-- A @KeySchemaElement@ must be a scalar, top-level attribute (not a nested
-- attribute). The data type must be one of String, Number, or Binary. The
-- attribute cannot be nested within a List or a Map.
--
-- /See:/ 'newKeySchemaElement' smart constructor.
data KeySchemaElement = KeySchemaElement'
  { -- | The name of a key attribute.
    KeySchemaElement -> Text
attributeName :: Prelude.Text,
    -- | The role that this key attribute will assume:
    --
    -- -   @HASH@ - partition key
    --
    -- -   @RANGE@ - sort key
    --
    -- The partition key of an item is also known as its /hash attribute/. The
    -- term \"hash attribute\" derives from DynamoDB\'s usage of an internal
    -- hash function to evenly distribute data items across partitions, based
    -- on their partition key values.
    --
    -- The sort key of an item is also known as its /range attribute/. The term
    -- \"range attribute\" derives from the way DynamoDB stores items with the
    -- same partition key physically close together, in sorted order by the
    -- sort key value.
    KeySchemaElement -> KeyType
keyType :: KeyType
  }
  deriving (KeySchemaElement -> KeySchemaElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeySchemaElement -> KeySchemaElement -> Bool
$c/= :: KeySchemaElement -> KeySchemaElement -> Bool
== :: KeySchemaElement -> KeySchemaElement -> Bool
$c== :: KeySchemaElement -> KeySchemaElement -> Bool
Prelude.Eq, ReadPrec [KeySchemaElement]
ReadPrec KeySchemaElement
Int -> ReadS KeySchemaElement
ReadS [KeySchemaElement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeySchemaElement]
$creadListPrec :: ReadPrec [KeySchemaElement]
readPrec :: ReadPrec KeySchemaElement
$creadPrec :: ReadPrec KeySchemaElement
readList :: ReadS [KeySchemaElement]
$creadList :: ReadS [KeySchemaElement]
readsPrec :: Int -> ReadS KeySchemaElement
$creadsPrec :: Int -> ReadS KeySchemaElement
Prelude.Read, Int -> KeySchemaElement -> ShowS
[KeySchemaElement] -> ShowS
KeySchemaElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeySchemaElement] -> ShowS
$cshowList :: [KeySchemaElement] -> ShowS
show :: KeySchemaElement -> String
$cshow :: KeySchemaElement -> String
showsPrec :: Int -> KeySchemaElement -> ShowS
$cshowsPrec :: Int -> KeySchemaElement -> ShowS
Prelude.Show, forall x. Rep KeySchemaElement x -> KeySchemaElement
forall x. KeySchemaElement -> Rep KeySchemaElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeySchemaElement x -> KeySchemaElement
$cfrom :: forall x. KeySchemaElement -> Rep KeySchemaElement x
Prelude.Generic)

-- |
-- Create a value of 'KeySchemaElement' 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:
--
-- 'attributeName', 'keySchemaElement_attributeName' - The name of a key attribute.
--
-- 'keyType', 'keySchemaElement_keyType' - The role that this key attribute will assume:
--
-- -   @HASH@ - partition key
--
-- -   @RANGE@ - sort key
--
-- The partition key of an item is also known as its /hash attribute/. The
-- term \"hash attribute\" derives from DynamoDB\'s usage of an internal
-- hash function to evenly distribute data items across partitions, based
-- on their partition key values.
--
-- The sort key of an item is also known as its /range attribute/. The term
-- \"range attribute\" derives from the way DynamoDB stores items with the
-- same partition key physically close together, in sorted order by the
-- sort key value.
newKeySchemaElement ::
  -- | 'attributeName'
  Prelude.Text ->
  -- | 'keyType'
  KeyType ->
  KeySchemaElement
newKeySchemaElement :: Text -> KeyType -> KeySchemaElement
newKeySchemaElement Text
pAttributeName_ KeyType
pKeyType_ =
  KeySchemaElement'
    { $sel:attributeName:KeySchemaElement' :: Text
attributeName = Text
pAttributeName_,
      $sel:keyType:KeySchemaElement' :: KeyType
keyType = KeyType
pKeyType_
    }

-- | The name of a key attribute.
keySchemaElement_attributeName :: Lens.Lens' KeySchemaElement Prelude.Text
keySchemaElement_attributeName :: Lens' KeySchemaElement Text
keySchemaElement_attributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySchemaElement' {Text
attributeName :: Text
$sel:attributeName:KeySchemaElement' :: KeySchemaElement -> Text
attributeName} -> Text
attributeName) (\s :: KeySchemaElement
s@KeySchemaElement' {} Text
a -> KeySchemaElement
s {$sel:attributeName:KeySchemaElement' :: Text
attributeName = Text
a} :: KeySchemaElement)

-- | The role that this key attribute will assume:
--
-- -   @HASH@ - partition key
--
-- -   @RANGE@ - sort key
--
-- The partition key of an item is also known as its /hash attribute/. The
-- term \"hash attribute\" derives from DynamoDB\'s usage of an internal
-- hash function to evenly distribute data items across partitions, based
-- on their partition key values.
--
-- The sort key of an item is also known as its /range attribute/. The term
-- \"range attribute\" derives from the way DynamoDB stores items with the
-- same partition key physically close together, in sorted order by the
-- sort key value.
keySchemaElement_keyType :: Lens.Lens' KeySchemaElement KeyType
keySchemaElement_keyType :: Lens' KeySchemaElement KeyType
keySchemaElement_keyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySchemaElement' {KeyType
keyType :: KeyType
$sel:keyType:KeySchemaElement' :: KeySchemaElement -> KeyType
keyType} -> KeyType
keyType) (\s :: KeySchemaElement
s@KeySchemaElement' {} KeyType
a -> KeySchemaElement
s {$sel:keyType:KeySchemaElement' :: KeyType
keyType = KeyType
a} :: KeySchemaElement)

instance Data.FromJSON KeySchemaElement where
  parseJSON :: Value -> Parser KeySchemaElement
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"KeySchemaElement"
      ( \Object
x ->
          Text -> KeyType -> KeySchemaElement
KeySchemaElement'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"AttributeName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"KeyType")
      )

instance Prelude.Hashable KeySchemaElement where
  hashWithSalt :: Int -> KeySchemaElement -> Int
hashWithSalt Int
_salt KeySchemaElement' {Text
KeyType
keyType :: KeyType
attributeName :: Text
$sel:keyType:KeySchemaElement' :: KeySchemaElement -> KeyType
$sel:attributeName:KeySchemaElement' :: KeySchemaElement -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` KeyType
keyType

instance Prelude.NFData KeySchemaElement where
  rnf :: KeySchemaElement -> ()
rnf KeySchemaElement' {Text
KeyType
keyType :: KeyType
attributeName :: Text
$sel:keyType:KeySchemaElement' :: KeySchemaElement -> KeyType
$sel:attributeName:KeySchemaElement' :: KeySchemaElement -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
attributeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf KeyType
keyType

instance Data.ToJSON KeySchemaElement where
  toJSON :: KeySchemaElement -> Value
toJSON KeySchemaElement' {Text
KeyType
keyType :: KeyType
attributeName :: Text
$sel:keyType:KeySchemaElement' :: KeySchemaElement -> KeyType
$sel:attributeName:KeySchemaElement' :: KeySchemaElement -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"AttributeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
attributeName),
            forall a. a -> Maybe a
Prelude.Just (Key
"KeyType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= KeyType
keyType)
          ]
      )