{-# 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.GlobalSecondaryIndexInfo
-- 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.GlobalSecondaryIndexInfo 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.ProvisionedThroughput
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | Represents the properties of a global secondary index for the table when
-- the backup was created.
--
-- /See:/ 'newGlobalSecondaryIndexInfo' smart constructor.
data GlobalSecondaryIndexInfo = GlobalSecondaryIndexInfo'
  { -- | The name of the global secondary index.
    GlobalSecondaryIndexInfo -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The complete key schema for a global secondary index, which consists 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.
    GlobalSecondaryIndexInfo -> Maybe (NonEmpty KeySchemaElement)
keySchema :: Prelude.Maybe (Prelude.NonEmpty KeySchemaElement),
    -- | Represents attributes that are copied (projected) from the table into
    -- the global secondary index. These are in addition to the primary key
    -- attributes and index key attributes, which are automatically projected.
    GlobalSecondaryIndexInfo -> Maybe Projection
projection :: Prelude.Maybe Projection,
    -- | Represents the provisioned throughput settings for the specified global
    -- secondary index.
    GlobalSecondaryIndexInfo -> Maybe ProvisionedThroughput
provisionedThroughput :: Prelude.Maybe ProvisionedThroughput
  }
  deriving (GlobalSecondaryIndexInfo -> GlobalSecondaryIndexInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalSecondaryIndexInfo -> GlobalSecondaryIndexInfo -> Bool
$c/= :: GlobalSecondaryIndexInfo -> GlobalSecondaryIndexInfo -> Bool
== :: GlobalSecondaryIndexInfo -> GlobalSecondaryIndexInfo -> Bool
$c== :: GlobalSecondaryIndexInfo -> GlobalSecondaryIndexInfo -> Bool
Prelude.Eq, ReadPrec [GlobalSecondaryIndexInfo]
ReadPrec GlobalSecondaryIndexInfo
Int -> ReadS GlobalSecondaryIndexInfo
ReadS [GlobalSecondaryIndexInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlobalSecondaryIndexInfo]
$creadListPrec :: ReadPrec [GlobalSecondaryIndexInfo]
readPrec :: ReadPrec GlobalSecondaryIndexInfo
$creadPrec :: ReadPrec GlobalSecondaryIndexInfo
readList :: ReadS [GlobalSecondaryIndexInfo]
$creadList :: ReadS [GlobalSecondaryIndexInfo]
readsPrec :: Int -> ReadS GlobalSecondaryIndexInfo
$creadsPrec :: Int -> ReadS GlobalSecondaryIndexInfo
Prelude.Read, Int -> GlobalSecondaryIndexInfo -> ShowS
[GlobalSecondaryIndexInfo] -> ShowS
GlobalSecondaryIndexInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalSecondaryIndexInfo] -> ShowS
$cshowList :: [GlobalSecondaryIndexInfo] -> ShowS
show :: GlobalSecondaryIndexInfo -> String
$cshow :: GlobalSecondaryIndexInfo -> String
showsPrec :: Int -> GlobalSecondaryIndexInfo -> ShowS
$cshowsPrec :: Int -> GlobalSecondaryIndexInfo -> ShowS
Prelude.Show, forall x.
Rep GlobalSecondaryIndexInfo x -> GlobalSecondaryIndexInfo
forall x.
GlobalSecondaryIndexInfo -> Rep GlobalSecondaryIndexInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GlobalSecondaryIndexInfo x -> GlobalSecondaryIndexInfo
$cfrom :: forall x.
GlobalSecondaryIndexInfo -> Rep GlobalSecondaryIndexInfo x
Prelude.Generic)

-- |
-- Create a value of 'GlobalSecondaryIndexInfo' 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', 'globalSecondaryIndexInfo_indexName' - The name of the global secondary index.
--
-- 'keySchema', 'globalSecondaryIndexInfo_keySchema' - The complete key schema for a global secondary index, which consists 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', 'globalSecondaryIndexInfo_projection' - Represents attributes that are copied (projected) from the table into
-- the global secondary index. These are in addition to the primary key
-- attributes and index key attributes, which are automatically projected.
--
-- 'provisionedThroughput', 'globalSecondaryIndexInfo_provisionedThroughput' - Represents the provisioned throughput settings for the specified global
-- secondary index.
newGlobalSecondaryIndexInfo ::
  GlobalSecondaryIndexInfo
newGlobalSecondaryIndexInfo :: GlobalSecondaryIndexInfo
newGlobalSecondaryIndexInfo =
  GlobalSecondaryIndexInfo'
    { $sel:indexName:GlobalSecondaryIndexInfo' :: Maybe Text
indexName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:keySchema:GlobalSecondaryIndexInfo' :: Maybe (NonEmpty KeySchemaElement)
keySchema = forall a. Maybe a
Prelude.Nothing,
      $sel:projection:GlobalSecondaryIndexInfo' :: Maybe Projection
projection = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedThroughput:GlobalSecondaryIndexInfo' :: Maybe ProvisionedThroughput
provisionedThroughput = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the global secondary index.
globalSecondaryIndexInfo_indexName :: Lens.Lens' GlobalSecondaryIndexInfo (Prelude.Maybe Prelude.Text)
globalSecondaryIndexInfo_indexName :: Lens' GlobalSecondaryIndexInfo (Maybe Text)
globalSecondaryIndexInfo_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GlobalSecondaryIndexInfo' {Maybe Text
indexName :: Maybe Text
$sel:indexName:GlobalSecondaryIndexInfo' :: GlobalSecondaryIndexInfo -> Maybe Text
indexName} -> Maybe Text
indexName) (\s :: GlobalSecondaryIndexInfo
s@GlobalSecondaryIndexInfo' {} Maybe Text
a -> GlobalSecondaryIndexInfo
s {$sel:indexName:GlobalSecondaryIndexInfo' :: Maybe Text
indexName = Maybe Text
a} :: GlobalSecondaryIndexInfo)

-- | The complete key schema for a global secondary index, which consists 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.
globalSecondaryIndexInfo_keySchema :: Lens.Lens' GlobalSecondaryIndexInfo (Prelude.Maybe (Prelude.NonEmpty KeySchemaElement))
globalSecondaryIndexInfo_keySchema :: Lens' GlobalSecondaryIndexInfo (Maybe (NonEmpty KeySchemaElement))
globalSecondaryIndexInfo_keySchema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GlobalSecondaryIndexInfo' {Maybe (NonEmpty KeySchemaElement)
keySchema :: Maybe (NonEmpty KeySchemaElement)
$sel:keySchema:GlobalSecondaryIndexInfo' :: GlobalSecondaryIndexInfo -> Maybe (NonEmpty KeySchemaElement)
keySchema} -> Maybe (NonEmpty KeySchemaElement)
keySchema) (\s :: GlobalSecondaryIndexInfo
s@GlobalSecondaryIndexInfo' {} Maybe (NonEmpty KeySchemaElement)
a -> GlobalSecondaryIndexInfo
s {$sel:keySchema:GlobalSecondaryIndexInfo' :: Maybe (NonEmpty KeySchemaElement)
keySchema = Maybe (NonEmpty KeySchemaElement)
a} :: GlobalSecondaryIndexInfo) 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

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

-- | Represents the provisioned throughput settings for the specified global
-- secondary index.
globalSecondaryIndexInfo_provisionedThroughput :: Lens.Lens' GlobalSecondaryIndexInfo (Prelude.Maybe ProvisionedThroughput)
globalSecondaryIndexInfo_provisionedThroughput :: Lens' GlobalSecondaryIndexInfo (Maybe ProvisionedThroughput)
globalSecondaryIndexInfo_provisionedThroughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GlobalSecondaryIndexInfo' {Maybe ProvisionedThroughput
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:provisionedThroughput:GlobalSecondaryIndexInfo' :: GlobalSecondaryIndexInfo -> Maybe ProvisionedThroughput
provisionedThroughput} -> Maybe ProvisionedThroughput
provisionedThroughput) (\s :: GlobalSecondaryIndexInfo
s@GlobalSecondaryIndexInfo' {} Maybe ProvisionedThroughput
a -> GlobalSecondaryIndexInfo
s {$sel:provisionedThroughput:GlobalSecondaryIndexInfo' :: Maybe ProvisionedThroughput
provisionedThroughput = Maybe ProvisionedThroughput
a} :: GlobalSecondaryIndexInfo)

instance Data.FromJSON GlobalSecondaryIndexInfo where
  parseJSON :: Value -> Parser GlobalSecondaryIndexInfo
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"GlobalSecondaryIndexInfo"
      ( \Object
x ->
          Maybe Text
-> Maybe (NonEmpty KeySchemaElement)
-> Maybe Projection
-> Maybe ProvisionedThroughput
-> GlobalSecondaryIndexInfo
GlobalSecondaryIndexInfo'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"IndexName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"KeySchema")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Projection")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ProvisionedThroughput")
      )

instance Prelude.Hashable GlobalSecondaryIndexInfo where
  hashWithSalt :: Int -> GlobalSecondaryIndexInfo -> Int
hashWithSalt Int
_salt GlobalSecondaryIndexInfo' {Maybe (NonEmpty KeySchemaElement)
Maybe Text
Maybe ProvisionedThroughput
Maybe Projection
provisionedThroughput :: Maybe ProvisionedThroughput
projection :: Maybe Projection
keySchema :: Maybe (NonEmpty KeySchemaElement)
indexName :: Maybe Text
$sel:provisionedThroughput:GlobalSecondaryIndexInfo' :: GlobalSecondaryIndexInfo -> Maybe ProvisionedThroughput
$sel:projection:GlobalSecondaryIndexInfo' :: GlobalSecondaryIndexInfo -> Maybe Projection
$sel:keySchema:GlobalSecondaryIndexInfo' :: GlobalSecondaryIndexInfo -> Maybe (NonEmpty KeySchemaElement)
$sel:indexName:GlobalSecondaryIndexInfo' :: GlobalSecondaryIndexInfo -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty KeySchemaElement)
keySchema
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Projection
projection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisionedThroughput
provisionedThroughput

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