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

-- | Represents the settings used to enable server-side encryption.
--
-- /See:/ 'newSSESpecification' smart constructor.
data SSESpecification = SSESpecification'
  { -- | Indicates whether server-side encryption is done using an Amazon Web
    -- Services managed key or an Amazon Web Services owned key. If enabled
    -- (true), server-side encryption type is set to @KMS@ and an Amazon Web
    -- Services managed key is used (KMS charges apply). If disabled (false) or
    -- not specified, server-side encryption is set to Amazon Web Services
    -- owned key.
    SSESpecification -> Maybe Bool
enabled :: Prelude.Maybe Prelude.Bool,
    -- | The KMS key that should be used for the KMS encryption. To specify a
    -- key, use its key ID, Amazon Resource Name (ARN), alias name, or alias
    -- ARN. Note that you should only provide this parameter if the key is
    -- different from the default DynamoDB key @alias\/aws\/dynamodb@.
    SSESpecification -> Maybe Text
kmsMasterKeyId :: Prelude.Maybe Prelude.Text,
    -- | Server-side encryption type. The only supported value is:
    --
    -- -   @KMS@ - Server-side encryption that uses Key Management Service. The
    --     key is stored in your account and is managed by KMS (KMS charges
    --     apply).
    SSESpecification -> Maybe SSEType
sSEType :: Prelude.Maybe SSEType
  }
  deriving (SSESpecification -> SSESpecification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SSESpecification -> SSESpecification -> Bool
$c/= :: SSESpecification -> SSESpecification -> Bool
== :: SSESpecification -> SSESpecification -> Bool
$c== :: SSESpecification -> SSESpecification -> Bool
Prelude.Eq, ReadPrec [SSESpecification]
ReadPrec SSESpecification
Int -> ReadS SSESpecification
ReadS [SSESpecification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SSESpecification]
$creadListPrec :: ReadPrec [SSESpecification]
readPrec :: ReadPrec SSESpecification
$creadPrec :: ReadPrec SSESpecification
readList :: ReadS [SSESpecification]
$creadList :: ReadS [SSESpecification]
readsPrec :: Int -> ReadS SSESpecification
$creadsPrec :: Int -> ReadS SSESpecification
Prelude.Read, Int -> SSESpecification -> ShowS
[SSESpecification] -> ShowS
SSESpecification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SSESpecification] -> ShowS
$cshowList :: [SSESpecification] -> ShowS
show :: SSESpecification -> String
$cshow :: SSESpecification -> String
showsPrec :: Int -> SSESpecification -> ShowS
$cshowsPrec :: Int -> SSESpecification -> ShowS
Prelude.Show, forall x. Rep SSESpecification x -> SSESpecification
forall x. SSESpecification -> Rep SSESpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SSESpecification x -> SSESpecification
$cfrom :: forall x. SSESpecification -> Rep SSESpecification x
Prelude.Generic)

-- |
-- Create a value of 'SSESpecification' 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:
--
-- 'enabled', 'sSESpecification_enabled' - Indicates whether server-side encryption is done using an Amazon Web
-- Services managed key or an Amazon Web Services owned key. If enabled
-- (true), server-side encryption type is set to @KMS@ and an Amazon Web
-- Services managed key is used (KMS charges apply). If disabled (false) or
-- not specified, server-side encryption is set to Amazon Web Services
-- owned key.
--
-- 'kmsMasterKeyId', 'sSESpecification_kmsMasterKeyId' - The KMS key that should be used for the KMS encryption. To specify a
-- key, use its key ID, Amazon Resource Name (ARN), alias name, or alias
-- ARN. Note that you should only provide this parameter if the key is
-- different from the default DynamoDB key @alias\/aws\/dynamodb@.
--
-- 'sSEType', 'sSESpecification_sSEType' - Server-side encryption type. The only supported value is:
--
-- -   @KMS@ - Server-side encryption that uses Key Management Service. The
--     key is stored in your account and is managed by KMS (KMS charges
--     apply).
newSSESpecification ::
  SSESpecification
newSSESpecification :: SSESpecification
newSSESpecification =
  SSESpecification'
    { $sel:enabled:SSESpecification' :: Maybe Bool
enabled = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsMasterKeyId:SSESpecification' :: Maybe Text
kmsMasterKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:sSEType:SSESpecification' :: Maybe SSEType
sSEType = forall a. Maybe a
Prelude.Nothing
    }

-- | Indicates whether server-side encryption is done using an Amazon Web
-- Services managed key or an Amazon Web Services owned key. If enabled
-- (true), server-side encryption type is set to @KMS@ and an Amazon Web
-- Services managed key is used (KMS charges apply). If disabled (false) or
-- not specified, server-side encryption is set to Amazon Web Services
-- owned key.
sSESpecification_enabled :: Lens.Lens' SSESpecification (Prelude.Maybe Prelude.Bool)
sSESpecification_enabled :: Lens' SSESpecification (Maybe Bool)
sSESpecification_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SSESpecification' {Maybe Bool
enabled :: Maybe Bool
$sel:enabled:SSESpecification' :: SSESpecification -> Maybe Bool
enabled} -> Maybe Bool
enabled) (\s :: SSESpecification
s@SSESpecification' {} Maybe Bool
a -> SSESpecification
s {$sel:enabled:SSESpecification' :: Maybe Bool
enabled = Maybe Bool
a} :: SSESpecification)

-- | The KMS key that should be used for the KMS encryption. To specify a
-- key, use its key ID, Amazon Resource Name (ARN), alias name, or alias
-- ARN. Note that you should only provide this parameter if the key is
-- different from the default DynamoDB key @alias\/aws\/dynamodb@.
sSESpecification_kmsMasterKeyId :: Lens.Lens' SSESpecification (Prelude.Maybe Prelude.Text)
sSESpecification_kmsMasterKeyId :: Lens' SSESpecification (Maybe Text)
sSESpecification_kmsMasterKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SSESpecification' {Maybe Text
kmsMasterKeyId :: Maybe Text
$sel:kmsMasterKeyId:SSESpecification' :: SSESpecification -> Maybe Text
kmsMasterKeyId} -> Maybe Text
kmsMasterKeyId) (\s :: SSESpecification
s@SSESpecification' {} Maybe Text
a -> SSESpecification
s {$sel:kmsMasterKeyId:SSESpecification' :: Maybe Text
kmsMasterKeyId = Maybe Text
a} :: SSESpecification)

-- | Server-side encryption type. The only supported value is:
--
-- -   @KMS@ - Server-side encryption that uses Key Management Service. The
--     key is stored in your account and is managed by KMS (KMS charges
--     apply).
sSESpecification_sSEType :: Lens.Lens' SSESpecification (Prelude.Maybe SSEType)
sSESpecification_sSEType :: Lens' SSESpecification (Maybe SSEType)
sSESpecification_sSEType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SSESpecification' {Maybe SSEType
sSEType :: Maybe SSEType
$sel:sSEType:SSESpecification' :: SSESpecification -> Maybe SSEType
sSEType} -> Maybe SSEType
sSEType) (\s :: SSESpecification
s@SSESpecification' {} Maybe SSEType
a -> SSESpecification
s {$sel:sSEType:SSESpecification' :: Maybe SSEType
sSEType = Maybe SSEType
a} :: SSESpecification)

instance Data.FromJSON SSESpecification where
  parseJSON :: Value -> Parser SSESpecification
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SSESpecification"
      ( \Object
x ->
          Maybe Bool -> Maybe Text -> Maybe SSEType -> SSESpecification
SSESpecification'
            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
"Enabled")
            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
"KMSMasterKeyId")
            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
"SSEType")
      )

instance Prelude.Hashable SSESpecification where
  hashWithSalt :: Int -> SSESpecification -> Int
hashWithSalt Int
_salt SSESpecification' {Maybe Bool
Maybe Text
Maybe SSEType
sSEType :: Maybe SSEType
kmsMasterKeyId :: Maybe Text
enabled :: Maybe Bool
$sel:sSEType:SSESpecification' :: SSESpecification -> Maybe SSEType
$sel:kmsMasterKeyId:SSESpecification' :: SSESpecification -> Maybe Text
$sel:enabled:SSESpecification' :: SSESpecification -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsMasterKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSEType
sSEType

instance Prelude.NFData SSESpecification where
  rnf :: SSESpecification -> ()
rnf SSESpecification' {Maybe Bool
Maybe Text
Maybe SSEType
sSEType :: Maybe SSEType
kmsMasterKeyId :: Maybe Text
enabled :: Maybe Bool
$sel:sSEType:SSESpecification' :: SSESpecification -> Maybe SSEType
$sel:kmsMasterKeyId:SSESpecification' :: SSESpecification -> Maybe Text
$sel:enabled:SSESpecification' :: SSESpecification -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsMasterKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SSEType
sSEType

instance Data.ToJSON SSESpecification where
  toJSON :: SSESpecification -> Value
toJSON SSESpecification' {Maybe Bool
Maybe Text
Maybe SSEType
sSEType :: Maybe SSEType
kmsMasterKeyId :: Maybe Text
enabled :: Maybe Bool
$sel:sSEType:SSESpecification' :: SSESpecification -> Maybe SSEType
$sel:kmsMasterKeyId:SSESpecification' :: SSESpecification -> Maybe Text
$sel:enabled:SSESpecification' :: SSESpecification -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Enabled" 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 Bool
enabled,
            (Key
"KMSMasterKeyId" 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 Text
kmsMasterKeyId,
            (Key
"SSEType" 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 SSEType
sSEType
          ]
      )