{-# 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.ReplicationRule
-- 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.ReplicationRule 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.DeleteMarkerReplication
import Amazonka.S3.Types.Destination
import Amazonka.S3.Types.ExistingObjectReplication
import Amazonka.S3.Types.ReplicationRuleFilter
import Amazonka.S3.Types.ReplicationRuleStatus
import Amazonka.S3.Types.SourceSelectionCriteria

-- | Specifies which Amazon S3 objects to replicate and where to store the
-- replicas.
--
-- /See:/ 'newReplicationRule' smart constructor.
data ReplicationRule = ReplicationRule'
  { ReplicationRule -> Maybe DeleteMarkerReplication
deleteMarkerReplication :: Prelude.Maybe DeleteMarkerReplication,
    ReplicationRule -> Maybe ExistingObjectReplication
existingObjectReplication :: Prelude.Maybe ExistingObjectReplication,
    ReplicationRule -> Maybe ReplicationRuleFilter
filter' :: Prelude.Maybe ReplicationRuleFilter,
    -- | A unique identifier for the rule. The maximum value is 255 characters.
    ReplicationRule -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | An object key name prefix that identifies the object or objects to which
    -- the rule applies. The maximum prefix length is 1,024 characters. To
    -- include all objects in a bucket, specify an empty string.
    --
    -- Replacement must be made for object keys containing special characters
    -- (such as carriage returns) when using XML requests. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/object-keys.html#object-key-xml-related-constraints XML related object key constraints>.
    ReplicationRule -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | The priority indicates which rule has precedence whenever two or more
    -- replication rules conflict. Amazon S3 will attempt to replicate objects
    -- according to all replication rules. However, if there are two or more
    -- rules with the same destination bucket, then objects will be replicated
    -- according to the rule with the highest priority. The higher the number,
    -- the higher the priority.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/replication.html Replication>
    -- in the /Amazon S3 User Guide/.
    ReplicationRule -> Maybe Int
priority :: Prelude.Maybe Prelude.Int,
    -- | 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).
    ReplicationRule -> Maybe SourceSelectionCriteria
sourceSelectionCriteria :: Prelude.Maybe SourceSelectionCriteria,
    -- | Specifies whether the rule is enabled.
    ReplicationRule -> ReplicationRuleStatus
status :: ReplicationRuleStatus,
    -- | A container for information about the replication destination and its
    -- configurations including enabling the S3 Replication Time Control (S3
    -- RTC).
    ReplicationRule -> Destination
destination :: Destination
  }
  deriving (ReplicationRule -> ReplicationRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplicationRule -> ReplicationRule -> Bool
$c/= :: ReplicationRule -> ReplicationRule -> Bool
== :: ReplicationRule -> ReplicationRule -> Bool
$c== :: ReplicationRule -> ReplicationRule -> Bool
Prelude.Eq, ReadPrec [ReplicationRule]
ReadPrec ReplicationRule
Int -> ReadS ReplicationRule
ReadS [ReplicationRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplicationRule]
$creadListPrec :: ReadPrec [ReplicationRule]
readPrec :: ReadPrec ReplicationRule
$creadPrec :: ReadPrec ReplicationRule
readList :: ReadS [ReplicationRule]
$creadList :: ReadS [ReplicationRule]
readsPrec :: Int -> ReadS ReplicationRule
$creadsPrec :: Int -> ReadS ReplicationRule
Prelude.Read, Int -> ReplicationRule -> ShowS
[ReplicationRule] -> ShowS
ReplicationRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplicationRule] -> ShowS
$cshowList :: [ReplicationRule] -> ShowS
show :: ReplicationRule -> String
$cshow :: ReplicationRule -> String
showsPrec :: Int -> ReplicationRule -> ShowS
$cshowsPrec :: Int -> ReplicationRule -> ShowS
Prelude.Show, forall x. Rep ReplicationRule x -> ReplicationRule
forall x. ReplicationRule -> Rep ReplicationRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplicationRule x -> ReplicationRule
$cfrom :: forall x. ReplicationRule -> Rep ReplicationRule x
Prelude.Generic)

-- |
-- Create a value of 'ReplicationRule' 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:
--
-- 'deleteMarkerReplication', 'replicationRule_deleteMarkerReplication' - Undocumented member.
--
-- 'existingObjectReplication', 'replicationRule_existingObjectReplication' -
--
-- 'filter'', 'replicationRule_filter' - Undocumented member.
--
-- 'id', 'replicationRule_id' - A unique identifier for the rule. The maximum value is 255 characters.
--
-- 'prefix', 'replicationRule_prefix' - An object key name prefix that identifies the object or objects to which
-- the rule applies. The maximum prefix length is 1,024 characters. To
-- include all objects in a bucket, specify an empty string.
--
-- Replacement must be made for object keys containing special characters
-- (such as carriage returns) when using XML requests. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/object-keys.html#object-key-xml-related-constraints XML related object key constraints>.
--
-- 'priority', 'replicationRule_priority' - The priority indicates which rule has precedence whenever two or more
-- replication rules conflict. Amazon S3 will attempt to replicate objects
-- according to all replication rules. However, if there are two or more
-- rules with the same destination bucket, then objects will be replicated
-- according to the rule with the highest priority. The higher the number,
-- the higher the priority.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/replication.html Replication>
-- in the /Amazon S3 User Guide/.
--
-- 'sourceSelectionCriteria', 'replicationRule_sourceSelectionCriteria' - 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).
--
-- 'status', 'replicationRule_status' - Specifies whether the rule is enabled.
--
-- 'destination', 'replicationRule_destination' - A container for information about the replication destination and its
-- configurations including enabling the S3 Replication Time Control (S3
-- RTC).
newReplicationRule ::
  -- | 'status'
  ReplicationRuleStatus ->
  -- | 'destination'
  Destination ->
  ReplicationRule
newReplicationRule :: ReplicationRuleStatus -> Destination -> ReplicationRule
newReplicationRule ReplicationRuleStatus
pStatus_ Destination
pDestination_ =
  ReplicationRule'
    { $sel:deleteMarkerReplication:ReplicationRule' :: Maybe DeleteMarkerReplication
deleteMarkerReplication =
        forall a. Maybe a
Prelude.Nothing,
      $sel:existingObjectReplication:ReplicationRule' :: Maybe ExistingObjectReplication
existingObjectReplication = forall a. Maybe a
Prelude.Nothing,
      $sel:filter':ReplicationRule' :: Maybe ReplicationRuleFilter
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:id:ReplicationRule' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:ReplicationRule' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:priority:ReplicationRule' :: Maybe Int
priority = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceSelectionCriteria:ReplicationRule' :: Maybe SourceSelectionCriteria
sourceSelectionCriteria = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ReplicationRule' :: ReplicationRuleStatus
status = ReplicationRuleStatus
pStatus_,
      $sel:destination:ReplicationRule' :: Destination
destination = Destination
pDestination_
    }

-- | Undocumented member.
replicationRule_deleteMarkerReplication :: Lens.Lens' ReplicationRule (Prelude.Maybe DeleteMarkerReplication)
replicationRule_deleteMarkerReplication :: Lens' ReplicationRule (Maybe DeleteMarkerReplication)
replicationRule_deleteMarkerReplication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Maybe DeleteMarkerReplication
deleteMarkerReplication :: Maybe DeleteMarkerReplication
$sel:deleteMarkerReplication:ReplicationRule' :: ReplicationRule -> Maybe DeleteMarkerReplication
deleteMarkerReplication} -> Maybe DeleteMarkerReplication
deleteMarkerReplication) (\s :: ReplicationRule
s@ReplicationRule' {} Maybe DeleteMarkerReplication
a -> ReplicationRule
s {$sel:deleteMarkerReplication:ReplicationRule' :: Maybe DeleteMarkerReplication
deleteMarkerReplication = Maybe DeleteMarkerReplication
a} :: ReplicationRule)

replicationRule_existingObjectReplication :: Lens.Lens' ReplicationRule (Prelude.Maybe ExistingObjectReplication)
replicationRule_existingObjectReplication :: Lens' ReplicationRule (Maybe ExistingObjectReplication)
replicationRule_existingObjectReplication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Maybe ExistingObjectReplication
existingObjectReplication :: Maybe ExistingObjectReplication
$sel:existingObjectReplication:ReplicationRule' :: ReplicationRule -> Maybe ExistingObjectReplication
existingObjectReplication} -> Maybe ExistingObjectReplication
existingObjectReplication) (\s :: ReplicationRule
s@ReplicationRule' {} Maybe ExistingObjectReplication
a -> ReplicationRule
s {$sel:existingObjectReplication:ReplicationRule' :: Maybe ExistingObjectReplication
existingObjectReplication = Maybe ExistingObjectReplication
a} :: ReplicationRule)

-- | Undocumented member.
replicationRule_filter :: Lens.Lens' ReplicationRule (Prelude.Maybe ReplicationRuleFilter)
replicationRule_filter :: Lens' ReplicationRule (Maybe ReplicationRuleFilter)
replicationRule_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Maybe ReplicationRuleFilter
filter' :: Maybe ReplicationRuleFilter
$sel:filter':ReplicationRule' :: ReplicationRule -> Maybe ReplicationRuleFilter
filter'} -> Maybe ReplicationRuleFilter
filter') (\s :: ReplicationRule
s@ReplicationRule' {} Maybe ReplicationRuleFilter
a -> ReplicationRule
s {$sel:filter':ReplicationRule' :: Maybe ReplicationRuleFilter
filter' = Maybe ReplicationRuleFilter
a} :: ReplicationRule)

-- | A unique identifier for the rule. The maximum value is 255 characters.
replicationRule_id :: Lens.Lens' ReplicationRule (Prelude.Maybe Prelude.Text)
replicationRule_id :: Lens' ReplicationRule (Maybe Text)
replicationRule_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Maybe Text
id :: Maybe Text
$sel:id:ReplicationRule' :: ReplicationRule -> Maybe Text
id} -> Maybe Text
id) (\s :: ReplicationRule
s@ReplicationRule' {} Maybe Text
a -> ReplicationRule
s {$sel:id:ReplicationRule' :: Maybe Text
id = Maybe Text
a} :: ReplicationRule)

-- | An object key name prefix that identifies the object or objects to which
-- the rule applies. The maximum prefix length is 1,024 characters. To
-- include all objects in a bucket, specify an empty string.
--
-- Replacement must be made for object keys containing special characters
-- (such as carriage returns) when using XML requests. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/object-keys.html#object-key-xml-related-constraints XML related object key constraints>.
replicationRule_prefix :: Lens.Lens' ReplicationRule (Prelude.Maybe Prelude.Text)
replicationRule_prefix :: Lens' ReplicationRule (Maybe Text)
replicationRule_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Maybe Text
prefix :: Maybe Text
$sel:prefix:ReplicationRule' :: ReplicationRule -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: ReplicationRule
s@ReplicationRule' {} Maybe Text
a -> ReplicationRule
s {$sel:prefix:ReplicationRule' :: Maybe Text
prefix = Maybe Text
a} :: ReplicationRule)

-- | The priority indicates which rule has precedence whenever two or more
-- replication rules conflict. Amazon S3 will attempt to replicate objects
-- according to all replication rules. However, if there are two or more
-- rules with the same destination bucket, then objects will be replicated
-- according to the rule with the highest priority. The higher the number,
-- the higher the priority.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/replication.html Replication>
-- in the /Amazon S3 User Guide/.
replicationRule_priority :: Lens.Lens' ReplicationRule (Prelude.Maybe Prelude.Int)
replicationRule_priority :: Lens' ReplicationRule (Maybe Int)
replicationRule_priority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Maybe Int
priority :: Maybe Int
$sel:priority:ReplicationRule' :: ReplicationRule -> Maybe Int
priority} -> Maybe Int
priority) (\s :: ReplicationRule
s@ReplicationRule' {} Maybe Int
a -> ReplicationRule
s {$sel:priority:ReplicationRule' :: Maybe Int
priority = Maybe Int
a} :: ReplicationRule)

-- | 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).
replicationRule_sourceSelectionCriteria :: Lens.Lens' ReplicationRule (Prelude.Maybe SourceSelectionCriteria)
replicationRule_sourceSelectionCriteria :: Lens' ReplicationRule (Maybe SourceSelectionCriteria)
replicationRule_sourceSelectionCriteria = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Maybe SourceSelectionCriteria
sourceSelectionCriteria :: Maybe SourceSelectionCriteria
$sel:sourceSelectionCriteria:ReplicationRule' :: ReplicationRule -> Maybe SourceSelectionCriteria
sourceSelectionCriteria} -> Maybe SourceSelectionCriteria
sourceSelectionCriteria) (\s :: ReplicationRule
s@ReplicationRule' {} Maybe SourceSelectionCriteria
a -> ReplicationRule
s {$sel:sourceSelectionCriteria:ReplicationRule' :: Maybe SourceSelectionCriteria
sourceSelectionCriteria = Maybe SourceSelectionCriteria
a} :: ReplicationRule)

-- | Specifies whether the rule is enabled.
replicationRule_status :: Lens.Lens' ReplicationRule ReplicationRuleStatus
replicationRule_status :: Lens' ReplicationRule ReplicationRuleStatus
replicationRule_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {ReplicationRuleStatus
status :: ReplicationRuleStatus
$sel:status:ReplicationRule' :: ReplicationRule -> ReplicationRuleStatus
status} -> ReplicationRuleStatus
status) (\s :: ReplicationRule
s@ReplicationRule' {} ReplicationRuleStatus
a -> ReplicationRule
s {$sel:status:ReplicationRule' :: ReplicationRuleStatus
status = ReplicationRuleStatus
a} :: ReplicationRule)

-- | A container for information about the replication destination and its
-- configurations including enabling the S3 Replication Time Control (S3
-- RTC).
replicationRule_destination :: Lens.Lens' ReplicationRule Destination
replicationRule_destination :: Lens' ReplicationRule Destination
replicationRule_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationRule' {Destination
destination :: Destination
$sel:destination:ReplicationRule' :: ReplicationRule -> Destination
destination} -> Destination
destination) (\s :: ReplicationRule
s@ReplicationRule' {} Destination
a -> ReplicationRule
s {$sel:destination:ReplicationRule' :: Destination
destination = Destination
a} :: ReplicationRule)

instance Data.FromXML ReplicationRule where
  parseXML :: [Node] -> Either String ReplicationRule
parseXML [Node]
x =
    Maybe DeleteMarkerReplication
-> Maybe ExistingObjectReplication
-> Maybe ReplicationRuleFilter
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe SourceSelectionCriteria
-> ReplicationRuleStatus
-> Destination
-> ReplicationRule
ReplicationRule'
      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
"DeleteMarkerReplication")
      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
"ExistingObjectReplication")
      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
"Filter")
      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
"ID")
      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
"Prefix")
      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
"Priority")
      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
"SourceSelectionCriteria")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Status")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Destination")

instance Prelude.Hashable ReplicationRule where
  hashWithSalt :: Int -> ReplicationRule -> Int
hashWithSalt Int
_salt ReplicationRule' {Maybe Int
Maybe Text
Maybe DeleteMarkerReplication
Maybe ExistingObjectReplication
Maybe SourceSelectionCriteria
Maybe ReplicationRuleFilter
ReplicationRuleStatus
Destination
destination :: Destination
status :: ReplicationRuleStatus
sourceSelectionCriteria :: Maybe SourceSelectionCriteria
priority :: Maybe Int
prefix :: Maybe Text
id :: Maybe Text
filter' :: Maybe ReplicationRuleFilter
existingObjectReplication :: Maybe ExistingObjectReplication
deleteMarkerReplication :: Maybe DeleteMarkerReplication
$sel:destination:ReplicationRule' :: ReplicationRule -> Destination
$sel:status:ReplicationRule' :: ReplicationRule -> ReplicationRuleStatus
$sel:sourceSelectionCriteria:ReplicationRule' :: ReplicationRule -> Maybe SourceSelectionCriteria
$sel:priority:ReplicationRule' :: ReplicationRule -> Maybe Int
$sel:prefix:ReplicationRule' :: ReplicationRule -> Maybe Text
$sel:id:ReplicationRule' :: ReplicationRule -> Maybe Text
$sel:filter':ReplicationRule' :: ReplicationRule -> Maybe ReplicationRuleFilter
$sel:existingObjectReplication:ReplicationRule' :: ReplicationRule -> Maybe ExistingObjectReplication
$sel:deleteMarkerReplication:ReplicationRule' :: ReplicationRule -> Maybe DeleteMarkerReplication
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeleteMarkerReplication
deleteMarkerReplication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExistingObjectReplication
existingObjectReplication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReplicationRuleFilter
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
priority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceSelectionCriteria
sourceSelectionCriteria
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReplicationRuleStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Destination
destination

instance Prelude.NFData ReplicationRule where
  rnf :: ReplicationRule -> ()
rnf ReplicationRule' {Maybe Int
Maybe Text
Maybe DeleteMarkerReplication
Maybe ExistingObjectReplication
Maybe SourceSelectionCriteria
Maybe ReplicationRuleFilter
ReplicationRuleStatus
Destination
destination :: Destination
status :: ReplicationRuleStatus
sourceSelectionCriteria :: Maybe SourceSelectionCriteria
priority :: Maybe Int
prefix :: Maybe Text
id :: Maybe Text
filter' :: Maybe ReplicationRuleFilter
existingObjectReplication :: Maybe ExistingObjectReplication
deleteMarkerReplication :: Maybe DeleteMarkerReplication
$sel:destination:ReplicationRule' :: ReplicationRule -> Destination
$sel:status:ReplicationRule' :: ReplicationRule -> ReplicationRuleStatus
$sel:sourceSelectionCriteria:ReplicationRule' :: ReplicationRule -> Maybe SourceSelectionCriteria
$sel:priority:ReplicationRule' :: ReplicationRule -> Maybe Int
$sel:prefix:ReplicationRule' :: ReplicationRule -> Maybe Text
$sel:id:ReplicationRule' :: ReplicationRule -> Maybe Text
$sel:filter':ReplicationRule' :: ReplicationRule -> Maybe ReplicationRuleFilter
$sel:existingObjectReplication:ReplicationRule' :: ReplicationRule -> Maybe ExistingObjectReplication
$sel:deleteMarkerReplication:ReplicationRule' :: ReplicationRule -> Maybe DeleteMarkerReplication
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DeleteMarkerReplication
deleteMarkerReplication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExistingObjectReplication
existingObjectReplication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicationRuleFilter
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
priority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceSelectionCriteria
sourceSelectionCriteria
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReplicationRuleStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Destination
destination

instance Data.ToXML ReplicationRule where
  toXML :: ReplicationRule -> XML
toXML ReplicationRule' {Maybe Int
Maybe Text
Maybe DeleteMarkerReplication
Maybe ExistingObjectReplication
Maybe SourceSelectionCriteria
Maybe ReplicationRuleFilter
ReplicationRuleStatus
Destination
destination :: Destination
status :: ReplicationRuleStatus
sourceSelectionCriteria :: Maybe SourceSelectionCriteria
priority :: Maybe Int
prefix :: Maybe Text
id :: Maybe Text
filter' :: Maybe ReplicationRuleFilter
existingObjectReplication :: Maybe ExistingObjectReplication
deleteMarkerReplication :: Maybe DeleteMarkerReplication
$sel:destination:ReplicationRule' :: ReplicationRule -> Destination
$sel:status:ReplicationRule' :: ReplicationRule -> ReplicationRuleStatus
$sel:sourceSelectionCriteria:ReplicationRule' :: ReplicationRule -> Maybe SourceSelectionCriteria
$sel:priority:ReplicationRule' :: ReplicationRule -> Maybe Int
$sel:prefix:ReplicationRule' :: ReplicationRule -> Maybe Text
$sel:id:ReplicationRule' :: ReplicationRule -> Maybe Text
$sel:filter':ReplicationRule' :: ReplicationRule -> Maybe ReplicationRuleFilter
$sel:existingObjectReplication:ReplicationRule' :: ReplicationRule -> Maybe ExistingObjectReplication
$sel:deleteMarkerReplication:ReplicationRule' :: ReplicationRule -> Maybe DeleteMarkerReplication
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"DeleteMarkerReplication"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe DeleteMarkerReplication
deleteMarkerReplication,
        Name
"ExistingObjectReplication"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe ExistingObjectReplication
existingObjectReplication,
        Name
"Filter" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe ReplicationRuleFilter
filter',
        Name
"ID" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
id,
        Name
"Prefix" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
prefix,
        Name
"Priority" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Int
priority,
        Name
"SourceSelectionCriteria"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe SourceSelectionCriteria
sourceSelectionCriteria,
        Name
"Status" forall a. ToXML a => Name -> a -> XML
Data.@= ReplicationRuleStatus
status,
        Name
"Destination" forall a. ToXML a => Name -> a -> XML
Data.@= Destination
destination
      ]