{-# 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.LocalSecondaryIndex
-- 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.LocalSecondaryIndex 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.KeySchemaElement
import Amazonka.DynamoDB.Types.Projection
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | Represents the properties of a local secondary index.
--
-- /See:/ 'newLocalSecondaryIndex' smart constructor.
data LocalSecondaryIndex = LocalSecondaryIndex'
  { -- | The name of the local secondary index. The name must be unique among all
    -- other indexes on this table.
    LocalSecondaryIndex -> Text
indexName :: Prelude.Text,
    -- | The complete key schema for the local secondary index, consisting of one
    -- or more pairs of attribute names and key types:
    --
    -- -   @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.
    LocalSecondaryIndex -> NonEmpty KeySchemaElement
keySchema :: Prelude.NonEmpty KeySchemaElement,
    -- | Represents attributes that are copied (projected) from the table into
    -- the local secondary index. These are in addition to the primary key
    -- attributes and index key attributes, which are automatically projected.
    LocalSecondaryIndex -> Projection
projection :: Projection
  }
  deriving (LocalSecondaryIndex -> LocalSecondaryIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalSecondaryIndex -> LocalSecondaryIndex -> Bool
$c/= :: LocalSecondaryIndex -> LocalSecondaryIndex -> Bool
== :: LocalSecondaryIndex -> LocalSecondaryIndex -> Bool
$c== :: LocalSecondaryIndex -> LocalSecondaryIndex -> Bool
Prelude.Eq, ReadPrec [LocalSecondaryIndex]
ReadPrec LocalSecondaryIndex
Int -> ReadS LocalSecondaryIndex
ReadS [LocalSecondaryIndex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LocalSecondaryIndex]
$creadListPrec :: ReadPrec [LocalSecondaryIndex]
readPrec :: ReadPrec LocalSecondaryIndex
$creadPrec :: ReadPrec LocalSecondaryIndex
readList :: ReadS [LocalSecondaryIndex]
$creadList :: ReadS [LocalSecondaryIndex]
readsPrec :: Int -> ReadS LocalSecondaryIndex
$creadsPrec :: Int -> ReadS LocalSecondaryIndex
Prelude.Read, Int -> LocalSecondaryIndex -> ShowS
[LocalSecondaryIndex] -> ShowS
LocalSecondaryIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalSecondaryIndex] -> ShowS
$cshowList :: [LocalSecondaryIndex] -> ShowS
show :: LocalSecondaryIndex -> String
$cshow :: LocalSecondaryIndex -> String
showsPrec :: Int -> LocalSecondaryIndex -> ShowS
$cshowsPrec :: Int -> LocalSecondaryIndex -> ShowS
Prelude.Show, forall x. Rep LocalSecondaryIndex x -> LocalSecondaryIndex
forall x. LocalSecondaryIndex -> Rep LocalSecondaryIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalSecondaryIndex x -> LocalSecondaryIndex
$cfrom :: forall x. LocalSecondaryIndex -> Rep LocalSecondaryIndex x
Prelude.Generic)

-- |
-- Create a value of 'LocalSecondaryIndex' 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:
--
-- 'indexName', 'localSecondaryIndex_indexName' - The name of the local secondary index. The name must be unique among all
-- other indexes on this table.
--
-- 'keySchema', 'localSecondaryIndex_keySchema' - The complete key schema for the local secondary index, consisting of one
-- or more pairs of attribute names and key types:
--
-- -   @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.
--
-- 'projection', 'localSecondaryIndex_projection' - Represents attributes that are copied (projected) from the table into
-- the local secondary index. These are in addition to the primary key
-- attributes and index key attributes, which are automatically projected.
newLocalSecondaryIndex ::
  -- | 'indexName'
  Prelude.Text ->
  -- | 'keySchema'
  Prelude.NonEmpty KeySchemaElement ->
  -- | 'projection'
  Projection ->
  LocalSecondaryIndex
newLocalSecondaryIndex :: Text
-> NonEmpty KeySchemaElement -> Projection -> LocalSecondaryIndex
newLocalSecondaryIndex
  Text
pIndexName_
  NonEmpty KeySchemaElement
pKeySchema_
  Projection
pProjection_ =
    LocalSecondaryIndex'
      { $sel:indexName:LocalSecondaryIndex' :: Text
indexName = Text
pIndexName_,
        $sel:keySchema:LocalSecondaryIndex' :: NonEmpty KeySchemaElement
keySchema = 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 KeySchemaElement
pKeySchema_,
        $sel:projection:LocalSecondaryIndex' :: Projection
projection = Projection
pProjection_
      }

-- | The name of the local secondary index. The name must be unique among all
-- other indexes on this table.
localSecondaryIndex_indexName :: Lens.Lens' LocalSecondaryIndex Prelude.Text
localSecondaryIndex_indexName :: Lens' LocalSecondaryIndex Text
localSecondaryIndex_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LocalSecondaryIndex' {Text
indexName :: Text
$sel:indexName:LocalSecondaryIndex' :: LocalSecondaryIndex -> Text
indexName} -> Text
indexName) (\s :: LocalSecondaryIndex
s@LocalSecondaryIndex' {} Text
a -> LocalSecondaryIndex
s {$sel:indexName:LocalSecondaryIndex' :: Text
indexName = Text
a} :: LocalSecondaryIndex)

-- | The complete key schema for the local secondary index, consisting of one
-- or more pairs of attribute names and key types:
--
-- -   @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.
localSecondaryIndex_keySchema :: Lens.Lens' LocalSecondaryIndex (Prelude.NonEmpty KeySchemaElement)
localSecondaryIndex_keySchema :: Lens' LocalSecondaryIndex (NonEmpty KeySchemaElement)
localSecondaryIndex_keySchema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LocalSecondaryIndex' {NonEmpty KeySchemaElement
keySchema :: NonEmpty KeySchemaElement
$sel:keySchema:LocalSecondaryIndex' :: LocalSecondaryIndex -> NonEmpty KeySchemaElement
keySchema} -> NonEmpty KeySchemaElement
keySchema) (\s :: LocalSecondaryIndex
s@LocalSecondaryIndex' {} NonEmpty KeySchemaElement
a -> LocalSecondaryIndex
s {$sel:keySchema:LocalSecondaryIndex' :: NonEmpty KeySchemaElement
keySchema = NonEmpty KeySchemaElement
a} :: LocalSecondaryIndex) 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

-- | Represents attributes that are copied (projected) from the table into
-- the local secondary index. These are in addition to the primary key
-- attributes and index key attributes, which are automatically projected.
localSecondaryIndex_projection :: Lens.Lens' LocalSecondaryIndex Projection
localSecondaryIndex_projection :: Lens' LocalSecondaryIndex Projection
localSecondaryIndex_projection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LocalSecondaryIndex' {Projection
projection :: Projection
$sel:projection:LocalSecondaryIndex' :: LocalSecondaryIndex -> Projection
projection} -> Projection
projection) (\s :: LocalSecondaryIndex
s@LocalSecondaryIndex' {} Projection
a -> LocalSecondaryIndex
s {$sel:projection:LocalSecondaryIndex' :: Projection
projection = Projection
a} :: LocalSecondaryIndex)

instance Prelude.Hashable LocalSecondaryIndex where
  hashWithSalt :: Int -> LocalSecondaryIndex -> Int
hashWithSalt Int
_salt LocalSecondaryIndex' {NonEmpty KeySchemaElement
Text
Projection
projection :: Projection
keySchema :: NonEmpty KeySchemaElement
indexName :: Text
$sel:projection:LocalSecondaryIndex' :: LocalSecondaryIndex -> Projection
$sel:keySchema:LocalSecondaryIndex' :: LocalSecondaryIndex -> NonEmpty KeySchemaElement
$sel:indexName:LocalSecondaryIndex' :: LocalSecondaryIndex -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty KeySchemaElement
keySchema
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Projection
projection

instance Prelude.NFData LocalSecondaryIndex where
  rnf :: LocalSecondaryIndex -> ()
rnf LocalSecondaryIndex' {NonEmpty KeySchemaElement
Text
Projection
projection :: Projection
keySchema :: NonEmpty KeySchemaElement
indexName :: Text
$sel:projection:LocalSecondaryIndex' :: LocalSecondaryIndex -> Projection
$sel:keySchema:LocalSecondaryIndex' :: LocalSecondaryIndex -> NonEmpty KeySchemaElement
$sel:indexName:LocalSecondaryIndex' :: LocalSecondaryIndex -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
indexName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty KeySchemaElement
keySchema
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Projection
projection

instance Data.ToJSON LocalSecondaryIndex where
  toJSON :: LocalSecondaryIndex -> Value
toJSON LocalSecondaryIndex' {NonEmpty KeySchemaElement
Text
Projection
projection :: Projection
keySchema :: NonEmpty KeySchemaElement
indexName :: Text
$sel:projection:LocalSecondaryIndex' :: LocalSecondaryIndex -> Projection
$sel:keySchema:LocalSecondaryIndex' :: LocalSecondaryIndex -> NonEmpty KeySchemaElement
$sel:indexName:LocalSecondaryIndex' :: LocalSecondaryIndex -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"IndexName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
indexName),
            forall a. a -> Maybe a
Prelude.Just (Key
"KeySchema" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty KeySchemaElement
keySchema),
            forall a. a -> Maybe a
Prelude.Just (Key
"Projection" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Projection
projection)
          ]
      )