{-# 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.S3.Types.InventoryEncryption
-- 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.S3.Types.InventoryEncryption where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.S3.Internal
import Amazonka.S3.Types.SSEKMS
import Amazonka.S3.Types.SSES3

-- | Contains the type of server-side encryption used to encrypt the
-- inventory results.
--
-- /See:/ 'newInventoryEncryption' smart constructor.
data InventoryEncryption = InventoryEncryption'
  { -- | Specifies the use of SSE-KMS to encrypt delivered inventory reports.
    InventoryEncryption -> Maybe SSEKMS
ssekms :: Prelude.Maybe SSEKMS,
    -- | Specifies the use of SSE-S3 to encrypt delivered inventory reports.
    InventoryEncryption -> Maybe SSES3
sses3 :: Prelude.Maybe SSES3
  }
  deriving (InventoryEncryption -> InventoryEncryption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InventoryEncryption -> InventoryEncryption -> Bool
$c/= :: InventoryEncryption -> InventoryEncryption -> Bool
== :: InventoryEncryption -> InventoryEncryption -> Bool
$c== :: InventoryEncryption -> InventoryEncryption -> Bool
Prelude.Eq, Int -> InventoryEncryption -> ShowS
[InventoryEncryption] -> ShowS
InventoryEncryption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InventoryEncryption] -> ShowS
$cshowList :: [InventoryEncryption] -> ShowS
show :: InventoryEncryption -> String
$cshow :: InventoryEncryption -> String
showsPrec :: Int -> InventoryEncryption -> ShowS
$cshowsPrec :: Int -> InventoryEncryption -> ShowS
Prelude.Show, forall x. Rep InventoryEncryption x -> InventoryEncryption
forall x. InventoryEncryption -> Rep InventoryEncryption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InventoryEncryption x -> InventoryEncryption
$cfrom :: forall x. InventoryEncryption -> Rep InventoryEncryption x
Prelude.Generic)

-- |
-- Create a value of 'InventoryEncryption' 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:
--
-- 'ssekms', 'inventoryEncryption_ssekms' - Specifies the use of SSE-KMS to encrypt delivered inventory reports.
--
-- 'sses3', 'inventoryEncryption_sses3' - Specifies the use of SSE-S3 to encrypt delivered inventory reports.
newInventoryEncryption ::
  InventoryEncryption
newInventoryEncryption :: InventoryEncryption
newInventoryEncryption =
  InventoryEncryption'
    { $sel:ssekms:InventoryEncryption' :: Maybe SSEKMS
ssekms = forall a. Maybe a
Prelude.Nothing,
      $sel:sses3:InventoryEncryption' :: Maybe SSES3
sses3 = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies the use of SSE-KMS to encrypt delivered inventory reports.
inventoryEncryption_ssekms :: Lens.Lens' InventoryEncryption (Prelude.Maybe SSEKMS)
inventoryEncryption_ssekms :: Lens' InventoryEncryption (Maybe SSEKMS)
inventoryEncryption_ssekms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryEncryption' {Maybe SSEKMS
ssekms :: Maybe SSEKMS
$sel:ssekms:InventoryEncryption' :: InventoryEncryption -> Maybe SSEKMS
ssekms} -> Maybe SSEKMS
ssekms) (\s :: InventoryEncryption
s@InventoryEncryption' {} Maybe SSEKMS
a -> InventoryEncryption
s {$sel:ssekms:InventoryEncryption' :: Maybe SSEKMS
ssekms = Maybe SSEKMS
a} :: InventoryEncryption)

-- | Specifies the use of SSE-S3 to encrypt delivered inventory reports.
inventoryEncryption_sses3 :: Lens.Lens' InventoryEncryption (Prelude.Maybe SSES3)
inventoryEncryption_sses3 :: Lens' InventoryEncryption (Maybe SSES3)
inventoryEncryption_sses3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryEncryption' {Maybe SSES3
sses3 :: Maybe SSES3
$sel:sses3:InventoryEncryption' :: InventoryEncryption -> Maybe SSES3
sses3} -> Maybe SSES3
sses3) (\s :: InventoryEncryption
s@InventoryEncryption' {} Maybe SSES3
a -> InventoryEncryption
s {$sel:sses3:InventoryEncryption' :: Maybe SSES3
sses3 = Maybe SSES3
a} :: InventoryEncryption)

instance Data.FromXML InventoryEncryption where
  parseXML :: [Node] -> Either String InventoryEncryption
parseXML [Node]
x =
    Maybe SSEKMS -> Maybe SSES3 -> InventoryEncryption
InventoryEncryption'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SSE-KMS")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SSE-S3")

instance Prelude.Hashable InventoryEncryption where
  hashWithSalt :: Int -> InventoryEncryption -> Int
hashWithSalt Int
_salt InventoryEncryption' {Maybe SSEKMS
Maybe SSES3
sses3 :: Maybe SSES3
ssekms :: Maybe SSEKMS
$sel:sses3:InventoryEncryption' :: InventoryEncryption -> Maybe SSES3
$sel:ssekms:InventoryEncryption' :: InventoryEncryption -> Maybe SSEKMS
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSEKMS
ssekms
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSES3
sses3

instance Prelude.NFData InventoryEncryption where
  rnf :: InventoryEncryption -> ()
rnf InventoryEncryption' {Maybe SSEKMS
Maybe SSES3
sses3 :: Maybe SSES3
ssekms :: Maybe SSEKMS
$sel:sses3:InventoryEncryption' :: InventoryEncryption -> Maybe SSES3
$sel:ssekms:InventoryEncryption' :: InventoryEncryption -> Maybe SSEKMS
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SSEKMS
ssekms seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SSES3
sses3

instance Data.ToXML InventoryEncryption where
  toXML :: InventoryEncryption -> XML
toXML InventoryEncryption' {Maybe SSEKMS
Maybe SSES3
sses3 :: Maybe SSES3
ssekms :: Maybe SSEKMS
$sel:sses3:InventoryEncryption' :: InventoryEncryption -> Maybe SSES3
$sel:ssekms:InventoryEncryption' :: InventoryEncryption -> Maybe SSEKMS
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [Name
"SSE-KMS" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe SSEKMS
ssekms, Name
"SSE-S3" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe SSES3
sses3]