{-# 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.SourceSelectionCriteria
-- 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.SourceSelectionCriteria 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.ReplicaModifications
import Amazonka.S3.Types.SseKmsEncryptedObjects

-- | A container that describes additional filters for identifying the source
-- objects that you want to replicate. You can choose to enable or disable
-- the replication of these objects. Currently, Amazon S3 supports only the
-- filter that you can specify for objects created with server-side
-- encryption using a customer managed key stored in Amazon Web Services
-- Key Management Service (SSE-KMS).
--
-- /See:/ 'newSourceSelectionCriteria' smart constructor.
data SourceSelectionCriteria = SourceSelectionCriteria'
  { -- | A filter that you can specify for selections for modifications on
    -- replicas. Amazon S3 doesn\'t replicate replica modifications by default.
    -- In the latest version of replication configuration (when @Filter@ is
    -- specified), you can specify this element and set the status to @Enabled@
    -- to replicate modifications on replicas.
    --
    -- If you don\'t specify the @Filter@ element, Amazon S3 assumes that the
    -- replication configuration is the earlier version, V1. In the earlier
    -- version, this element is not allowed
    SourceSelectionCriteria -> Maybe ReplicaModifications
replicaModifications :: Prelude.Maybe ReplicaModifications,
    -- | A container for filter information for the selection of Amazon S3
    -- objects encrypted with Amazon Web Services KMS. If you include
    -- @SourceSelectionCriteria@ in the replication configuration, this element
    -- is required.
    SourceSelectionCriteria -> Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects :: Prelude.Maybe SseKmsEncryptedObjects
  }
  deriving (SourceSelectionCriteria -> SourceSelectionCriteria -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceSelectionCriteria -> SourceSelectionCriteria -> Bool
$c/= :: SourceSelectionCriteria -> SourceSelectionCriteria -> Bool
== :: SourceSelectionCriteria -> SourceSelectionCriteria -> Bool
$c== :: SourceSelectionCriteria -> SourceSelectionCriteria -> Bool
Prelude.Eq, ReadPrec [SourceSelectionCriteria]
ReadPrec SourceSelectionCriteria
Int -> ReadS SourceSelectionCriteria
ReadS [SourceSelectionCriteria]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceSelectionCriteria]
$creadListPrec :: ReadPrec [SourceSelectionCriteria]
readPrec :: ReadPrec SourceSelectionCriteria
$creadPrec :: ReadPrec SourceSelectionCriteria
readList :: ReadS [SourceSelectionCriteria]
$creadList :: ReadS [SourceSelectionCriteria]
readsPrec :: Int -> ReadS SourceSelectionCriteria
$creadsPrec :: Int -> ReadS SourceSelectionCriteria
Prelude.Read, Int -> SourceSelectionCriteria -> ShowS
[SourceSelectionCriteria] -> ShowS
SourceSelectionCriteria -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceSelectionCriteria] -> ShowS
$cshowList :: [SourceSelectionCriteria] -> ShowS
show :: SourceSelectionCriteria -> String
$cshow :: SourceSelectionCriteria -> String
showsPrec :: Int -> SourceSelectionCriteria -> ShowS
$cshowsPrec :: Int -> SourceSelectionCriteria -> ShowS
Prelude.Show, forall x. Rep SourceSelectionCriteria x -> SourceSelectionCriteria
forall x. SourceSelectionCriteria -> Rep SourceSelectionCriteria x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceSelectionCriteria x -> SourceSelectionCriteria
$cfrom :: forall x. SourceSelectionCriteria -> Rep SourceSelectionCriteria x
Prelude.Generic)

-- |
-- Create a value of 'SourceSelectionCriteria' 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:
--
-- 'replicaModifications', 'sourceSelectionCriteria_replicaModifications' - A filter that you can specify for selections for modifications on
-- replicas. Amazon S3 doesn\'t replicate replica modifications by default.
-- In the latest version of replication configuration (when @Filter@ is
-- specified), you can specify this element and set the status to @Enabled@
-- to replicate modifications on replicas.
--
-- If you don\'t specify the @Filter@ element, Amazon S3 assumes that the
-- replication configuration is the earlier version, V1. In the earlier
-- version, this element is not allowed
--
-- 'sseKmsEncryptedObjects', 'sourceSelectionCriteria_sseKmsEncryptedObjects' - A container for filter information for the selection of Amazon S3
-- objects encrypted with Amazon Web Services KMS. If you include
-- @SourceSelectionCriteria@ in the replication configuration, this element
-- is required.
newSourceSelectionCriteria ::
  SourceSelectionCriteria
newSourceSelectionCriteria :: SourceSelectionCriteria
newSourceSelectionCriteria =
  SourceSelectionCriteria'
    { $sel:replicaModifications:SourceSelectionCriteria' :: Maybe ReplicaModifications
replicaModifications =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sseKmsEncryptedObjects:SourceSelectionCriteria' :: Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects = forall a. Maybe a
Prelude.Nothing
    }

-- | A filter that you can specify for selections for modifications on
-- replicas. Amazon S3 doesn\'t replicate replica modifications by default.
-- In the latest version of replication configuration (when @Filter@ is
-- specified), you can specify this element and set the status to @Enabled@
-- to replicate modifications on replicas.
--
-- If you don\'t specify the @Filter@ element, Amazon S3 assumes that the
-- replication configuration is the earlier version, V1. In the earlier
-- version, this element is not allowed
sourceSelectionCriteria_replicaModifications :: Lens.Lens' SourceSelectionCriteria (Prelude.Maybe ReplicaModifications)
sourceSelectionCriteria_replicaModifications :: Lens' SourceSelectionCriteria (Maybe ReplicaModifications)
sourceSelectionCriteria_replicaModifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SourceSelectionCriteria' {Maybe ReplicaModifications
replicaModifications :: Maybe ReplicaModifications
$sel:replicaModifications:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe ReplicaModifications
replicaModifications} -> Maybe ReplicaModifications
replicaModifications) (\s :: SourceSelectionCriteria
s@SourceSelectionCriteria' {} Maybe ReplicaModifications
a -> SourceSelectionCriteria
s {$sel:replicaModifications:SourceSelectionCriteria' :: Maybe ReplicaModifications
replicaModifications = Maybe ReplicaModifications
a} :: SourceSelectionCriteria)

-- | A container for filter information for the selection of Amazon S3
-- objects encrypted with Amazon Web Services KMS. If you include
-- @SourceSelectionCriteria@ in the replication configuration, this element
-- is required.
sourceSelectionCriteria_sseKmsEncryptedObjects :: Lens.Lens' SourceSelectionCriteria (Prelude.Maybe SseKmsEncryptedObjects)
sourceSelectionCriteria_sseKmsEncryptedObjects :: Lens' SourceSelectionCriteria (Maybe SseKmsEncryptedObjects)
sourceSelectionCriteria_sseKmsEncryptedObjects = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SourceSelectionCriteria' {Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects :: Maybe SseKmsEncryptedObjects
$sel:sseKmsEncryptedObjects:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects} -> Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects) (\s :: SourceSelectionCriteria
s@SourceSelectionCriteria' {} Maybe SseKmsEncryptedObjects
a -> SourceSelectionCriteria
s {$sel:sseKmsEncryptedObjects:SourceSelectionCriteria' :: Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects = Maybe SseKmsEncryptedObjects
a} :: SourceSelectionCriteria)

instance Data.FromXML SourceSelectionCriteria where
  parseXML :: [Node] -> Either String SourceSelectionCriteria
parseXML [Node]
x =
    Maybe ReplicaModifications
-> Maybe SseKmsEncryptedObjects -> SourceSelectionCriteria
SourceSelectionCriteria'
      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
"ReplicaModifications")
      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
"SseKmsEncryptedObjects")

instance Prelude.Hashable SourceSelectionCriteria where
  hashWithSalt :: Int -> SourceSelectionCriteria -> Int
hashWithSalt Int
_salt SourceSelectionCriteria' {Maybe ReplicaModifications
Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects :: Maybe SseKmsEncryptedObjects
replicaModifications :: Maybe ReplicaModifications
$sel:sseKmsEncryptedObjects:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe SseKmsEncryptedObjects
$sel:replicaModifications:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe ReplicaModifications
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReplicaModifications
replicaModifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects

instance Prelude.NFData SourceSelectionCriteria where
  rnf :: SourceSelectionCriteria -> ()
rnf SourceSelectionCriteria' {Maybe ReplicaModifications
Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects :: Maybe SseKmsEncryptedObjects
replicaModifications :: Maybe ReplicaModifications
$sel:sseKmsEncryptedObjects:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe SseKmsEncryptedObjects
$sel:replicaModifications:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe ReplicaModifications
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicaModifications
replicaModifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects

instance Data.ToXML SourceSelectionCriteria where
  toXML :: SourceSelectionCriteria -> XML
toXML SourceSelectionCriteria' {Maybe ReplicaModifications
Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects :: Maybe SseKmsEncryptedObjects
replicaModifications :: Maybe ReplicaModifications
$sel:sseKmsEncryptedObjects:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe SseKmsEncryptedObjects
$sel:replicaModifications:SourceSelectionCriteria' :: SourceSelectionCriteria -> Maybe ReplicaModifications
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"ReplicaModifications" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe ReplicaModifications
replicaModifications,
        Name
"SseKmsEncryptedObjects"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe SseKmsEncryptedObjects
sseKmsEncryptedObjects
      ]