{-# 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.Destination
-- 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.Destination 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.AccessControlTranslation
import Amazonka.S3.Types.EncryptionConfiguration
import Amazonka.S3.Types.Metrics
import Amazonka.S3.Types.ReplicationTime
import Amazonka.S3.Types.StorageClass

-- | Specifies information about where to publish analysis or configuration
-- results for an Amazon S3 bucket and S3 Replication Time Control (S3
-- RTC).
--
-- /See:/ 'newDestination' smart constructor.
data Destination = Destination'
  { -- | Specify this only in a cross-account scenario (where source and
    -- destination bucket owners are not the same), and you want to change
    -- replica ownership to the Amazon Web Services account that owns the
    -- destination bucket. If this is not specified in the replication
    -- configuration, the replicas are owned by same Amazon Web Services
    -- account that owns the source object.
    Destination -> Maybe AccessControlTranslation
accessControlTranslation :: Prelude.Maybe AccessControlTranslation,
    -- | Destination bucket owner account ID. In a cross-account scenario, if you
    -- direct Amazon S3 to change replica ownership to the Amazon Web Services
    -- account that owns the destination bucket by specifying the
    -- @AccessControlTranslation@ property, this is the account ID of the
    -- destination bucket owner. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/replication-change-owner.html Replication Additional Configuration: Changing the Replica Owner>
    -- in the /Amazon S3 User Guide/.
    Destination -> Maybe Text
account :: Prelude.Maybe Prelude.Text,
    -- | A container that provides information about encryption. If
    -- @SourceSelectionCriteria@ is specified, you must specify this element.
    Destination -> Maybe EncryptionConfiguration
encryptionConfiguration :: Prelude.Maybe EncryptionConfiguration,
    -- | A container specifying replication metrics-related settings enabling
    -- replication metrics and events.
    Destination -> Maybe Metrics
metrics :: Prelude.Maybe Metrics,
    -- | A container specifying S3 Replication Time Control (S3 RTC), including
    -- whether S3 RTC is enabled and the time when all objects and operations
    -- on objects must be replicated. Must be specified together with a
    -- @Metrics@ block.
    Destination -> Maybe ReplicationTime
replicationTime :: Prelude.Maybe ReplicationTime,
    -- | The storage class to use when replicating objects, such as S3 Standard
    -- or reduced redundancy. By default, Amazon S3 uses the storage class of
    -- the source object to create the object replica.
    --
    -- For valid values, see the @StorageClass@ element of the
    -- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTreplication.html PUT Bucket replication>
    -- action in the /Amazon S3 API Reference/.
    Destination -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | The Amazon Resource Name (ARN) of the bucket where you want Amazon S3 to
    -- store the results.
    Destination -> BucketName
bucket :: BucketName
  }
  deriving (Destination -> Destination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Destination -> Destination -> Bool
$c/= :: Destination -> Destination -> Bool
== :: Destination -> Destination -> Bool
$c== :: Destination -> Destination -> Bool
Prelude.Eq, ReadPrec [Destination]
ReadPrec Destination
Int -> ReadS Destination
ReadS [Destination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Destination]
$creadListPrec :: ReadPrec [Destination]
readPrec :: ReadPrec Destination
$creadPrec :: ReadPrec Destination
readList :: ReadS [Destination]
$creadList :: ReadS [Destination]
readsPrec :: Int -> ReadS Destination
$creadsPrec :: Int -> ReadS Destination
Prelude.Read, Int -> Destination -> ShowS
[Destination] -> ShowS
Destination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Destination] -> ShowS
$cshowList :: [Destination] -> ShowS
show :: Destination -> String
$cshow :: Destination -> String
showsPrec :: Int -> Destination -> ShowS
$cshowsPrec :: Int -> Destination -> ShowS
Prelude.Show, forall x. Rep Destination x -> Destination
forall x. Destination -> Rep Destination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Destination x -> Destination
$cfrom :: forall x. Destination -> Rep Destination x
Prelude.Generic)

-- |
-- Create a value of 'Destination' 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:
--
-- 'accessControlTranslation', 'destination_accessControlTranslation' - Specify this only in a cross-account scenario (where source and
-- destination bucket owners are not the same), and you want to change
-- replica ownership to the Amazon Web Services account that owns the
-- destination bucket. If this is not specified in the replication
-- configuration, the replicas are owned by same Amazon Web Services
-- account that owns the source object.
--
-- 'account', 'destination_account' - Destination bucket owner account ID. In a cross-account scenario, if you
-- direct Amazon S3 to change replica ownership to the Amazon Web Services
-- account that owns the destination bucket by specifying the
-- @AccessControlTranslation@ property, this is the account ID of the
-- destination bucket owner. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/replication-change-owner.html Replication Additional Configuration: Changing the Replica Owner>
-- in the /Amazon S3 User Guide/.
--
-- 'encryptionConfiguration', 'destination_encryptionConfiguration' - A container that provides information about encryption. If
-- @SourceSelectionCriteria@ is specified, you must specify this element.
--
-- 'metrics', 'destination_metrics' - A container specifying replication metrics-related settings enabling
-- replication metrics and events.
--
-- 'replicationTime', 'destination_replicationTime' - A container specifying S3 Replication Time Control (S3 RTC), including
-- whether S3 RTC is enabled and the time when all objects and operations
-- on objects must be replicated. Must be specified together with a
-- @Metrics@ block.
--
-- 'storageClass', 'destination_storageClass' - The storage class to use when replicating objects, such as S3 Standard
-- or reduced redundancy. By default, Amazon S3 uses the storage class of
-- the source object to create the object replica.
--
-- For valid values, see the @StorageClass@ element of the
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTreplication.html PUT Bucket replication>
-- action in the /Amazon S3 API Reference/.
--
-- 'bucket', 'destination_bucket' - The Amazon Resource Name (ARN) of the bucket where you want Amazon S3 to
-- store the results.
newDestination ::
  -- | 'bucket'
  BucketName ->
  Destination
newDestination :: BucketName -> Destination
newDestination BucketName
pBucket_ =
  Destination'
    { $sel:accessControlTranslation:Destination' :: Maybe AccessControlTranslation
accessControlTranslation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:account:Destination' :: Maybe Text
account = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionConfiguration:Destination' :: Maybe EncryptionConfiguration
encryptionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:metrics:Destination' :: Maybe Metrics
metrics = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationTime:Destination' :: Maybe ReplicationTime
replicationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:Destination' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:Destination' :: BucketName
bucket = BucketName
pBucket_
    }

-- | Specify this only in a cross-account scenario (where source and
-- destination bucket owners are not the same), and you want to change
-- replica ownership to the Amazon Web Services account that owns the
-- destination bucket. If this is not specified in the replication
-- configuration, the replicas are owned by same Amazon Web Services
-- account that owns the source object.
destination_accessControlTranslation :: Lens.Lens' Destination (Prelude.Maybe AccessControlTranslation)
destination_accessControlTranslation :: Lens' Destination (Maybe AccessControlTranslation)
destination_accessControlTranslation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Destination' {Maybe AccessControlTranslation
accessControlTranslation :: Maybe AccessControlTranslation
$sel:accessControlTranslation:Destination' :: Destination -> Maybe AccessControlTranslation
accessControlTranslation} -> Maybe AccessControlTranslation
accessControlTranslation) (\s :: Destination
s@Destination' {} Maybe AccessControlTranslation
a -> Destination
s {$sel:accessControlTranslation:Destination' :: Maybe AccessControlTranslation
accessControlTranslation = Maybe AccessControlTranslation
a} :: Destination)

-- | Destination bucket owner account ID. In a cross-account scenario, if you
-- direct Amazon S3 to change replica ownership to the Amazon Web Services
-- account that owns the destination bucket by specifying the
-- @AccessControlTranslation@ property, this is the account ID of the
-- destination bucket owner. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/replication-change-owner.html Replication Additional Configuration: Changing the Replica Owner>
-- in the /Amazon S3 User Guide/.
destination_account :: Lens.Lens' Destination (Prelude.Maybe Prelude.Text)
destination_account :: Lens' Destination (Maybe Text)
destination_account = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Destination' {Maybe Text
account :: Maybe Text
$sel:account:Destination' :: Destination -> Maybe Text
account} -> Maybe Text
account) (\s :: Destination
s@Destination' {} Maybe Text
a -> Destination
s {$sel:account:Destination' :: Maybe Text
account = Maybe Text
a} :: Destination)

-- | A container that provides information about encryption. If
-- @SourceSelectionCriteria@ is specified, you must specify this element.
destination_encryptionConfiguration :: Lens.Lens' Destination (Prelude.Maybe EncryptionConfiguration)
destination_encryptionConfiguration :: Lens' Destination (Maybe EncryptionConfiguration)
destination_encryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Destination' {Maybe EncryptionConfiguration
encryptionConfiguration :: Maybe EncryptionConfiguration
$sel:encryptionConfiguration:Destination' :: Destination -> Maybe EncryptionConfiguration
encryptionConfiguration} -> Maybe EncryptionConfiguration
encryptionConfiguration) (\s :: Destination
s@Destination' {} Maybe EncryptionConfiguration
a -> Destination
s {$sel:encryptionConfiguration:Destination' :: Maybe EncryptionConfiguration
encryptionConfiguration = Maybe EncryptionConfiguration
a} :: Destination)

-- | A container specifying replication metrics-related settings enabling
-- replication metrics and events.
destination_metrics :: Lens.Lens' Destination (Prelude.Maybe Metrics)
destination_metrics :: Lens' Destination (Maybe Metrics)
destination_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Destination' {Maybe Metrics
metrics :: Maybe Metrics
$sel:metrics:Destination' :: Destination -> Maybe Metrics
metrics} -> Maybe Metrics
metrics) (\s :: Destination
s@Destination' {} Maybe Metrics
a -> Destination
s {$sel:metrics:Destination' :: Maybe Metrics
metrics = Maybe Metrics
a} :: Destination)

-- | A container specifying S3 Replication Time Control (S3 RTC), including
-- whether S3 RTC is enabled and the time when all objects and operations
-- on objects must be replicated. Must be specified together with a
-- @Metrics@ block.
destination_replicationTime :: Lens.Lens' Destination (Prelude.Maybe ReplicationTime)
destination_replicationTime :: Lens' Destination (Maybe ReplicationTime)
destination_replicationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Destination' {Maybe ReplicationTime
replicationTime :: Maybe ReplicationTime
$sel:replicationTime:Destination' :: Destination -> Maybe ReplicationTime
replicationTime} -> Maybe ReplicationTime
replicationTime) (\s :: Destination
s@Destination' {} Maybe ReplicationTime
a -> Destination
s {$sel:replicationTime:Destination' :: Maybe ReplicationTime
replicationTime = Maybe ReplicationTime
a} :: Destination)

-- | The storage class to use when replicating objects, such as S3 Standard
-- or reduced redundancy. By default, Amazon S3 uses the storage class of
-- the source object to create the object replica.
--
-- For valid values, see the @StorageClass@ element of the
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTreplication.html PUT Bucket replication>
-- action in the /Amazon S3 API Reference/.
destination_storageClass :: Lens.Lens' Destination (Prelude.Maybe StorageClass)
destination_storageClass :: Lens' Destination (Maybe StorageClass)
destination_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Destination' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:Destination' :: Destination -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: Destination
s@Destination' {} Maybe StorageClass
a -> Destination
s {$sel:storageClass:Destination' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: Destination)

-- | The Amazon Resource Name (ARN) of the bucket where you want Amazon S3 to
-- store the results.
destination_bucket :: Lens.Lens' Destination BucketName
destination_bucket :: Lens' Destination BucketName
destination_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Destination' {BucketName
bucket :: BucketName
$sel:bucket:Destination' :: Destination -> BucketName
bucket} -> BucketName
bucket) (\s :: Destination
s@Destination' {} BucketName
a -> Destination
s {$sel:bucket:Destination' :: BucketName
bucket = BucketName
a} :: Destination)

instance Data.FromXML Destination where
  parseXML :: [Node] -> Either String Destination
parseXML [Node]
x =
    Maybe AccessControlTranslation
-> Maybe Text
-> Maybe EncryptionConfiguration
-> Maybe Metrics
-> Maybe ReplicationTime
-> Maybe StorageClass
-> BucketName
-> Destination
Destination'
      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
"AccessControlTranslation")
      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
"Account")
      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
"EncryptionConfiguration")
      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
"Metrics")
      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
"ReplicationTime")
      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
"StorageClass")
      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
"Bucket")

instance Prelude.Hashable Destination where
  hashWithSalt :: Int -> Destination -> Int
hashWithSalt Int
_salt Destination' {Maybe Text
Maybe EncryptionConfiguration
Maybe AccessControlTranslation
Maybe ReplicationTime
Maybe Metrics
Maybe StorageClass
BucketName
bucket :: BucketName
storageClass :: Maybe StorageClass
replicationTime :: Maybe ReplicationTime
metrics :: Maybe Metrics
encryptionConfiguration :: Maybe EncryptionConfiguration
account :: Maybe Text
accessControlTranslation :: Maybe AccessControlTranslation
$sel:bucket:Destination' :: Destination -> BucketName
$sel:storageClass:Destination' :: Destination -> Maybe StorageClass
$sel:replicationTime:Destination' :: Destination -> Maybe ReplicationTime
$sel:metrics:Destination' :: Destination -> Maybe Metrics
$sel:encryptionConfiguration:Destination' :: Destination -> Maybe EncryptionConfiguration
$sel:account:Destination' :: Destination -> Maybe Text
$sel:accessControlTranslation:Destination' :: Destination -> Maybe AccessControlTranslation
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AccessControlTranslation
accessControlTranslation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
account
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionConfiguration
encryptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Metrics
metrics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReplicationTime
replicationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StorageClass
storageClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket

instance Prelude.NFData Destination where
  rnf :: Destination -> ()
rnf Destination' {Maybe Text
Maybe EncryptionConfiguration
Maybe AccessControlTranslation
Maybe ReplicationTime
Maybe Metrics
Maybe StorageClass
BucketName
bucket :: BucketName
storageClass :: Maybe StorageClass
replicationTime :: Maybe ReplicationTime
metrics :: Maybe Metrics
encryptionConfiguration :: Maybe EncryptionConfiguration
account :: Maybe Text
accessControlTranslation :: Maybe AccessControlTranslation
$sel:bucket:Destination' :: Destination -> BucketName
$sel:storageClass:Destination' :: Destination -> Maybe StorageClass
$sel:replicationTime:Destination' :: Destination -> Maybe ReplicationTime
$sel:metrics:Destination' :: Destination -> Maybe Metrics
$sel:encryptionConfiguration:Destination' :: Destination -> Maybe EncryptionConfiguration
$sel:account:Destination' :: Destination -> Maybe Text
$sel:accessControlTranslation:Destination' :: Destination -> Maybe AccessControlTranslation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AccessControlTranslation
accessControlTranslation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
account
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionConfiguration
encryptionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Metrics
metrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicationTime
replicationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageClass
storageClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketName
bucket

instance Data.ToXML Destination where
  toXML :: Destination -> XML
toXML Destination' {Maybe Text
Maybe EncryptionConfiguration
Maybe AccessControlTranslation
Maybe ReplicationTime
Maybe Metrics
Maybe StorageClass
BucketName
bucket :: BucketName
storageClass :: Maybe StorageClass
replicationTime :: Maybe ReplicationTime
metrics :: Maybe Metrics
encryptionConfiguration :: Maybe EncryptionConfiguration
account :: Maybe Text
accessControlTranslation :: Maybe AccessControlTranslation
$sel:bucket:Destination' :: Destination -> BucketName
$sel:storageClass:Destination' :: Destination -> Maybe StorageClass
$sel:replicationTime:Destination' :: Destination -> Maybe ReplicationTime
$sel:metrics:Destination' :: Destination -> Maybe Metrics
$sel:encryptionConfiguration:Destination' :: Destination -> Maybe EncryptionConfiguration
$sel:account:Destination' :: Destination -> Maybe Text
$sel:accessControlTranslation:Destination' :: Destination -> Maybe AccessControlTranslation
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"AccessControlTranslation"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe AccessControlTranslation
accessControlTranslation,
        Name
"Account" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
account,
        Name
"EncryptionConfiguration"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe EncryptionConfiguration
encryptionConfiguration,
        Name
"Metrics" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Metrics
metrics,
        Name
"ReplicationTime" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe ReplicationTime
replicationTime,
        Name
"StorageClass" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe StorageClass
storageClass,
        Name
"Bucket" forall a. ToXML a => Name -> a -> XML
Data.@= BucketName
bucket
      ]