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

-- | The description of the Time to Live (TTL) status on the specified table.
--
-- /See:/ 'newTimeToLiveDescription' smart constructor.
data TimeToLiveDescription = TimeToLiveDescription'
  { -- | The name of the TTL attribute for items in the table.
    TimeToLiveDescription -> Maybe Text
attributeName :: Prelude.Maybe Prelude.Text,
    -- | The TTL status for the table.
    TimeToLiveDescription -> Maybe TimeToLiveStatus
timeToLiveStatus :: Prelude.Maybe TimeToLiveStatus
  }
  deriving (TimeToLiveDescription -> TimeToLiveDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeToLiveDescription -> TimeToLiveDescription -> Bool
$c/= :: TimeToLiveDescription -> TimeToLiveDescription -> Bool
== :: TimeToLiveDescription -> TimeToLiveDescription -> Bool
$c== :: TimeToLiveDescription -> TimeToLiveDescription -> Bool
Prelude.Eq, ReadPrec [TimeToLiveDescription]
ReadPrec TimeToLiveDescription
Int -> ReadS TimeToLiveDescription
ReadS [TimeToLiveDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TimeToLiveDescription]
$creadListPrec :: ReadPrec [TimeToLiveDescription]
readPrec :: ReadPrec TimeToLiveDescription
$creadPrec :: ReadPrec TimeToLiveDescription
readList :: ReadS [TimeToLiveDescription]
$creadList :: ReadS [TimeToLiveDescription]
readsPrec :: Int -> ReadS TimeToLiveDescription
$creadsPrec :: Int -> ReadS TimeToLiveDescription
Prelude.Read, Int -> TimeToLiveDescription -> ShowS
[TimeToLiveDescription] -> ShowS
TimeToLiveDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeToLiveDescription] -> ShowS
$cshowList :: [TimeToLiveDescription] -> ShowS
show :: TimeToLiveDescription -> String
$cshow :: TimeToLiveDescription -> String
showsPrec :: Int -> TimeToLiveDescription -> ShowS
$cshowsPrec :: Int -> TimeToLiveDescription -> ShowS
Prelude.Show, forall x. Rep TimeToLiveDescription x -> TimeToLiveDescription
forall x. TimeToLiveDescription -> Rep TimeToLiveDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeToLiveDescription x -> TimeToLiveDescription
$cfrom :: forall x. TimeToLiveDescription -> Rep TimeToLiveDescription x
Prelude.Generic)

-- |
-- Create a value of 'TimeToLiveDescription' 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', 'timeToLiveDescription_attributeName' - The name of the TTL attribute for items in the table.
--
-- 'timeToLiveStatus', 'timeToLiveDescription_timeToLiveStatus' - The TTL status for the table.
newTimeToLiveDescription ::
  TimeToLiveDescription
newTimeToLiveDescription :: TimeToLiveDescription
newTimeToLiveDescription =
  TimeToLiveDescription'
    { $sel:attributeName:TimeToLiveDescription' :: Maybe Text
attributeName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:timeToLiveStatus:TimeToLiveDescription' :: Maybe TimeToLiveStatus
timeToLiveStatus = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the TTL attribute for items in the table.
timeToLiveDescription_attributeName :: Lens.Lens' TimeToLiveDescription (Prelude.Maybe Prelude.Text)
timeToLiveDescription_attributeName :: Lens' TimeToLiveDescription (Maybe Text)
timeToLiveDescription_attributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TimeToLiveDescription' {Maybe Text
attributeName :: Maybe Text
$sel:attributeName:TimeToLiveDescription' :: TimeToLiveDescription -> Maybe Text
attributeName} -> Maybe Text
attributeName) (\s :: TimeToLiveDescription
s@TimeToLiveDescription' {} Maybe Text
a -> TimeToLiveDescription
s {$sel:attributeName:TimeToLiveDescription' :: Maybe Text
attributeName = Maybe Text
a} :: TimeToLiveDescription)

-- | The TTL status for the table.
timeToLiveDescription_timeToLiveStatus :: Lens.Lens' TimeToLiveDescription (Prelude.Maybe TimeToLiveStatus)
timeToLiveDescription_timeToLiveStatus :: Lens' TimeToLiveDescription (Maybe TimeToLiveStatus)
timeToLiveDescription_timeToLiveStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TimeToLiveDescription' {Maybe TimeToLiveStatus
timeToLiveStatus :: Maybe TimeToLiveStatus
$sel:timeToLiveStatus:TimeToLiveDescription' :: TimeToLiveDescription -> Maybe TimeToLiveStatus
timeToLiveStatus} -> Maybe TimeToLiveStatus
timeToLiveStatus) (\s :: TimeToLiveDescription
s@TimeToLiveDescription' {} Maybe TimeToLiveStatus
a -> TimeToLiveDescription
s {$sel:timeToLiveStatus:TimeToLiveDescription' :: Maybe TimeToLiveStatus
timeToLiveStatus = Maybe TimeToLiveStatus
a} :: TimeToLiveDescription)

instance Data.FromJSON TimeToLiveDescription where
  parseJSON :: Value -> Parser TimeToLiveDescription
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TimeToLiveDescription"
      ( \Object
x ->
          Maybe Text -> Maybe TimeToLiveStatus -> TimeToLiveDescription
TimeToLiveDescription'
            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
"AttributeName")
            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
"TimeToLiveStatus")
      )

instance Prelude.Hashable TimeToLiveDescription where
  hashWithSalt :: Int -> TimeToLiveDescription -> Int
hashWithSalt Int
_salt TimeToLiveDescription' {Maybe Text
Maybe TimeToLiveStatus
timeToLiveStatus :: Maybe TimeToLiveStatus
attributeName :: Maybe Text
$sel:timeToLiveStatus:TimeToLiveDescription' :: TimeToLiveDescription -> Maybe TimeToLiveStatus
$sel:attributeName:TimeToLiveDescription' :: TimeToLiveDescription -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
attributeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeToLiveStatus
timeToLiveStatus

instance Prelude.NFData TimeToLiveDescription where
  rnf :: TimeToLiveDescription -> ()
rnf TimeToLiveDescription' {Maybe Text
Maybe TimeToLiveStatus
timeToLiveStatus :: Maybe TimeToLiveStatus
attributeName :: Maybe Text
$sel:timeToLiveStatus:TimeToLiveDescription' :: TimeToLiveDescription -> Maybe TimeToLiveStatus
$sel:attributeName:TimeToLiveDescription' :: TimeToLiveDescription -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
attributeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeToLiveStatus
timeToLiveStatus