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

-- | Represents the DynamoDB Streams configuration for a table in DynamoDB.
--
-- /See:/ 'newStreamSpecification' smart constructor.
data StreamSpecification = StreamSpecification'
  { -- | When an item in the table is modified, @StreamViewType@ determines what
    -- information is written to the stream for this table. Valid values for
    -- @StreamViewType@ are:
    --
    -- -   @KEYS_ONLY@ - Only the key attributes of the modified item are
    --     written to the stream.
    --
    -- -   @NEW_IMAGE@ - The entire item, as it appears after it was modified,
    --     is written to the stream.
    --
    -- -   @OLD_IMAGE@ - The entire item, as it appeared before it was
    --     modified, is written to the stream.
    --
    -- -   @NEW_AND_OLD_IMAGES@ - Both the new and the old item images of the
    --     item are written to the stream.
    StreamSpecification -> Maybe StreamViewType
streamViewType :: Prelude.Maybe StreamViewType,
    -- | Indicates whether DynamoDB Streams is enabled (true) or disabled (false)
    -- on the table.
    StreamSpecification -> Bool
streamEnabled :: Prelude.Bool
  }
  deriving (StreamSpecification -> StreamSpecification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamSpecification -> StreamSpecification -> Bool
$c/= :: StreamSpecification -> StreamSpecification -> Bool
== :: StreamSpecification -> StreamSpecification -> Bool
$c== :: StreamSpecification -> StreamSpecification -> Bool
Prelude.Eq, ReadPrec [StreamSpecification]
ReadPrec StreamSpecification
Int -> ReadS StreamSpecification
ReadS [StreamSpecification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StreamSpecification]
$creadListPrec :: ReadPrec [StreamSpecification]
readPrec :: ReadPrec StreamSpecification
$creadPrec :: ReadPrec StreamSpecification
readList :: ReadS [StreamSpecification]
$creadList :: ReadS [StreamSpecification]
readsPrec :: Int -> ReadS StreamSpecification
$creadsPrec :: Int -> ReadS StreamSpecification
Prelude.Read, Int -> StreamSpecification -> ShowS
[StreamSpecification] -> ShowS
StreamSpecification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamSpecification] -> ShowS
$cshowList :: [StreamSpecification] -> ShowS
show :: StreamSpecification -> String
$cshow :: StreamSpecification -> String
showsPrec :: Int -> StreamSpecification -> ShowS
$cshowsPrec :: Int -> StreamSpecification -> ShowS
Prelude.Show, forall x. Rep StreamSpecification x -> StreamSpecification
forall x. StreamSpecification -> Rep StreamSpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StreamSpecification x -> StreamSpecification
$cfrom :: forall x. StreamSpecification -> Rep StreamSpecification x
Prelude.Generic)

-- |
-- Create a value of 'StreamSpecification' 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:
--
-- 'streamViewType', 'streamSpecification_streamViewType' - When an item in the table is modified, @StreamViewType@ determines what
-- information is written to the stream for this table. Valid values for
-- @StreamViewType@ are:
--
-- -   @KEYS_ONLY@ - Only the key attributes of the modified item are
--     written to the stream.
--
-- -   @NEW_IMAGE@ - The entire item, as it appears after it was modified,
--     is written to the stream.
--
-- -   @OLD_IMAGE@ - The entire item, as it appeared before it was
--     modified, is written to the stream.
--
-- -   @NEW_AND_OLD_IMAGES@ - Both the new and the old item images of the
--     item are written to the stream.
--
-- 'streamEnabled', 'streamSpecification_streamEnabled' - Indicates whether DynamoDB Streams is enabled (true) or disabled (false)
-- on the table.
newStreamSpecification ::
  -- | 'streamEnabled'
  Prelude.Bool ->
  StreamSpecification
newStreamSpecification :: Bool -> StreamSpecification
newStreamSpecification Bool
pStreamEnabled_ =
  StreamSpecification'
    { $sel:streamViewType:StreamSpecification' :: Maybe StreamViewType
streamViewType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:streamEnabled:StreamSpecification' :: Bool
streamEnabled = Bool
pStreamEnabled_
    }

-- | When an item in the table is modified, @StreamViewType@ determines what
-- information is written to the stream for this table. Valid values for
-- @StreamViewType@ are:
--
-- -   @KEYS_ONLY@ - Only the key attributes of the modified item are
--     written to the stream.
--
-- -   @NEW_IMAGE@ - The entire item, as it appears after it was modified,
--     is written to the stream.
--
-- -   @OLD_IMAGE@ - The entire item, as it appeared before it was
--     modified, is written to the stream.
--
-- -   @NEW_AND_OLD_IMAGES@ - Both the new and the old item images of the
--     item are written to the stream.
streamSpecification_streamViewType :: Lens.Lens' StreamSpecification (Prelude.Maybe StreamViewType)
streamSpecification_streamViewType :: Lens' StreamSpecification (Maybe StreamViewType)
streamSpecification_streamViewType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamSpecification' {Maybe StreamViewType
streamViewType :: Maybe StreamViewType
$sel:streamViewType:StreamSpecification' :: StreamSpecification -> Maybe StreamViewType
streamViewType} -> Maybe StreamViewType
streamViewType) (\s :: StreamSpecification
s@StreamSpecification' {} Maybe StreamViewType
a -> StreamSpecification
s {$sel:streamViewType:StreamSpecification' :: Maybe StreamViewType
streamViewType = Maybe StreamViewType
a} :: StreamSpecification)

-- | Indicates whether DynamoDB Streams is enabled (true) or disabled (false)
-- on the table.
streamSpecification_streamEnabled :: Lens.Lens' StreamSpecification Prelude.Bool
streamSpecification_streamEnabled :: Lens' StreamSpecification Bool
streamSpecification_streamEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamSpecification' {Bool
streamEnabled :: Bool
$sel:streamEnabled:StreamSpecification' :: StreamSpecification -> Bool
streamEnabled} -> Bool
streamEnabled) (\s :: StreamSpecification
s@StreamSpecification' {} Bool
a -> StreamSpecification
s {$sel:streamEnabled:StreamSpecification' :: Bool
streamEnabled = Bool
a} :: StreamSpecification)

instance Data.FromJSON StreamSpecification where
  parseJSON :: Value -> Parser StreamSpecification
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StreamSpecification"
      ( \Object
x ->
          Maybe StreamViewType -> Bool -> StreamSpecification
StreamSpecification'
            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
"StreamViewType")
            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
"StreamEnabled")
      )

instance Prelude.Hashable StreamSpecification where
  hashWithSalt :: Int -> StreamSpecification -> Int
hashWithSalt Int
_salt StreamSpecification' {Bool
Maybe StreamViewType
streamEnabled :: Bool
streamViewType :: Maybe StreamViewType
$sel:streamEnabled:StreamSpecification' :: StreamSpecification -> Bool
$sel:streamViewType:StreamSpecification' :: StreamSpecification -> Maybe StreamViewType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamViewType
streamViewType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
streamEnabled

instance Prelude.NFData StreamSpecification where
  rnf :: StreamSpecification -> ()
rnf StreamSpecification' {Bool
Maybe StreamViewType
streamEnabled :: Bool
streamViewType :: Maybe StreamViewType
$sel:streamEnabled:StreamSpecification' :: StreamSpecification -> Bool
$sel:streamViewType:StreamSpecification' :: StreamSpecification -> Maybe StreamViewType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamViewType
streamViewType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
streamEnabled

instance Data.ToJSON StreamSpecification where
  toJSON :: StreamSpecification -> Value
toJSON StreamSpecification' {Bool
Maybe StreamViewType
streamEnabled :: Bool
streamViewType :: Maybe StreamViewType
$sel:streamEnabled:StreamSpecification' :: StreamSpecification -> Bool
$sel:streamViewType:StreamSpecification' :: StreamSpecification -> Maybe StreamViewType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"StreamViewType" 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 StreamViewType
streamViewType,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StreamEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
streamEnabled)
          ]
      )