{-# 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.Firehose.Types.S3DestinationUpdate
-- 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.Firehose.Types.S3DestinationUpdate where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Firehose.Types.BufferingHints
import Amazonka.Firehose.Types.CloudWatchLoggingOptions
import Amazonka.Firehose.Types.CompressionFormat
import Amazonka.Firehose.Types.EncryptionConfiguration
import qualified Amazonka.Prelude as Prelude

-- | Describes an update for a destination in Amazon S3.
--
-- /See:/ 'newS3DestinationUpdate' smart constructor.
data S3DestinationUpdate = S3DestinationUpdate'
  { -- | The ARN of the S3 bucket. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
    S3DestinationUpdate -> Maybe Text
bucketARN :: Prelude.Maybe Prelude.Text,
    -- | The buffering option. If no value is specified, @BufferingHints@ object
    -- default values are used.
    S3DestinationUpdate -> Maybe BufferingHints
bufferingHints :: Prelude.Maybe BufferingHints,
    -- | The CloudWatch logging options for your delivery stream.
    S3DestinationUpdate -> Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions :: Prelude.Maybe CloudWatchLoggingOptions,
    -- | The compression format. If no value is specified, the default is
    -- @UNCOMPRESSED@.
    --
    -- The compression formats @SNAPPY@ or @ZIP@ cannot be specified for Amazon
    -- Redshift destinations because they are not supported by the Amazon
    -- Redshift @COPY@ operation that reads from the S3 bucket.
    S3DestinationUpdate -> Maybe CompressionFormat
compressionFormat :: Prelude.Maybe CompressionFormat,
    -- | The encryption configuration. If no value is specified, the default is
    -- no encryption.
    S3DestinationUpdate -> Maybe EncryptionConfiguration
encryptionConfiguration :: Prelude.Maybe EncryptionConfiguration,
    -- | A prefix that Kinesis Data Firehose evaluates and adds to failed records
    -- before writing them to S3. This prefix appears immediately following the
    -- bucket name. For information about how to specify this prefix, see
    -- <https://docs.aws.amazon.com/firehose/latest/dev/s3-prefixes.html Custom Prefixes for Amazon S3 Objects>.
    S3DestinationUpdate -> Maybe Text
errorOutputPrefix :: Prelude.Maybe Prelude.Text,
    -- | The \"YYYY\/MM\/DD\/HH\" time format prefix is automatically used for
    -- delivered Amazon S3 files. You can also specify a custom prefix, as
    -- described in
    -- <https://docs.aws.amazon.com/firehose/latest/dev/s3-prefixes.html Custom Prefixes for Amazon S3 Objects>.
    S3DestinationUpdate -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Amazon Web Services credentials.
    -- For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
    S3DestinationUpdate -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text
  }
  deriving (S3DestinationUpdate -> S3DestinationUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3DestinationUpdate -> S3DestinationUpdate -> Bool
$c/= :: S3DestinationUpdate -> S3DestinationUpdate -> Bool
== :: S3DestinationUpdate -> S3DestinationUpdate -> Bool
$c== :: S3DestinationUpdate -> S3DestinationUpdate -> Bool
Prelude.Eq, ReadPrec [S3DestinationUpdate]
ReadPrec S3DestinationUpdate
Int -> ReadS S3DestinationUpdate
ReadS [S3DestinationUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [S3DestinationUpdate]
$creadListPrec :: ReadPrec [S3DestinationUpdate]
readPrec :: ReadPrec S3DestinationUpdate
$creadPrec :: ReadPrec S3DestinationUpdate
readList :: ReadS [S3DestinationUpdate]
$creadList :: ReadS [S3DestinationUpdate]
readsPrec :: Int -> ReadS S3DestinationUpdate
$creadsPrec :: Int -> ReadS S3DestinationUpdate
Prelude.Read, Int -> S3DestinationUpdate -> ShowS
[S3DestinationUpdate] -> ShowS
S3DestinationUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3DestinationUpdate] -> ShowS
$cshowList :: [S3DestinationUpdate] -> ShowS
show :: S3DestinationUpdate -> String
$cshow :: S3DestinationUpdate -> String
showsPrec :: Int -> S3DestinationUpdate -> ShowS
$cshowsPrec :: Int -> S3DestinationUpdate -> ShowS
Prelude.Show, forall x. Rep S3DestinationUpdate x -> S3DestinationUpdate
forall x. S3DestinationUpdate -> Rep S3DestinationUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3DestinationUpdate x -> S3DestinationUpdate
$cfrom :: forall x. S3DestinationUpdate -> Rep S3DestinationUpdate x
Prelude.Generic)

-- |
-- Create a value of 'S3DestinationUpdate' 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:
--
-- 'bucketARN', 's3DestinationUpdate_bucketARN' - The ARN of the S3 bucket. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
--
-- 'bufferingHints', 's3DestinationUpdate_bufferingHints' - The buffering option. If no value is specified, @BufferingHints@ object
-- default values are used.
--
-- 'cloudWatchLoggingOptions', 's3DestinationUpdate_cloudWatchLoggingOptions' - The CloudWatch logging options for your delivery stream.
--
-- 'compressionFormat', 's3DestinationUpdate_compressionFormat' - The compression format. If no value is specified, the default is
-- @UNCOMPRESSED@.
--
-- The compression formats @SNAPPY@ or @ZIP@ cannot be specified for Amazon
-- Redshift destinations because they are not supported by the Amazon
-- Redshift @COPY@ operation that reads from the S3 bucket.
--
-- 'encryptionConfiguration', 's3DestinationUpdate_encryptionConfiguration' - The encryption configuration. If no value is specified, the default is
-- no encryption.
--
-- 'errorOutputPrefix', 's3DestinationUpdate_errorOutputPrefix' - A prefix that Kinesis Data Firehose evaluates and adds to failed records
-- before writing them to S3. This prefix appears immediately following the
-- bucket name. For information about how to specify this prefix, see
-- <https://docs.aws.amazon.com/firehose/latest/dev/s3-prefixes.html Custom Prefixes for Amazon S3 Objects>.
--
-- 'prefix', 's3DestinationUpdate_prefix' - The \"YYYY\/MM\/DD\/HH\" time format prefix is automatically used for
-- delivered Amazon S3 files. You can also specify a custom prefix, as
-- described in
-- <https://docs.aws.amazon.com/firehose/latest/dev/s3-prefixes.html Custom Prefixes for Amazon S3 Objects>.
--
-- 'roleARN', 's3DestinationUpdate_roleARN' - The Amazon Resource Name (ARN) of the Amazon Web Services credentials.
-- For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
newS3DestinationUpdate ::
  S3DestinationUpdate
newS3DestinationUpdate :: S3DestinationUpdate
newS3DestinationUpdate =
  S3DestinationUpdate'
    { $sel:bucketARN:S3DestinationUpdate' :: Maybe Text
bucketARN = forall a. Maybe a
Prelude.Nothing,
      $sel:bufferingHints:S3DestinationUpdate' :: Maybe BufferingHints
bufferingHints = forall a. Maybe a
Prelude.Nothing,
      $sel:cloudWatchLoggingOptions:S3DestinationUpdate' :: Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:compressionFormat:S3DestinationUpdate' :: Maybe CompressionFormat
compressionFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionConfiguration:S3DestinationUpdate' :: Maybe EncryptionConfiguration
encryptionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:errorOutputPrefix:S3DestinationUpdate' :: Maybe Text
errorOutputPrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:S3DestinationUpdate' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:S3DestinationUpdate' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing
    }

-- | The ARN of the S3 bucket. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
s3DestinationUpdate_bucketARN :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe Prelude.Text)
s3DestinationUpdate_bucketARN :: Lens' S3DestinationUpdate (Maybe Text)
s3DestinationUpdate_bucketARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe Text
bucketARN :: Maybe Text
$sel:bucketARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
bucketARN} -> Maybe Text
bucketARN) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe Text
a -> S3DestinationUpdate
s {$sel:bucketARN:S3DestinationUpdate' :: Maybe Text
bucketARN = Maybe Text
a} :: S3DestinationUpdate)

-- | The buffering option. If no value is specified, @BufferingHints@ object
-- default values are used.
s3DestinationUpdate_bufferingHints :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe BufferingHints)
s3DestinationUpdate_bufferingHints :: Lens' S3DestinationUpdate (Maybe BufferingHints)
s3DestinationUpdate_bufferingHints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe BufferingHints
bufferingHints :: Maybe BufferingHints
$sel:bufferingHints:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe BufferingHints
bufferingHints} -> Maybe BufferingHints
bufferingHints) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe BufferingHints
a -> S3DestinationUpdate
s {$sel:bufferingHints:S3DestinationUpdate' :: Maybe BufferingHints
bufferingHints = Maybe BufferingHints
a} :: S3DestinationUpdate)

-- | The CloudWatch logging options for your delivery stream.
s3DestinationUpdate_cloudWatchLoggingOptions :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe CloudWatchLoggingOptions)
s3DestinationUpdate_cloudWatchLoggingOptions :: Lens' S3DestinationUpdate (Maybe CloudWatchLoggingOptions)
s3DestinationUpdate_cloudWatchLoggingOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions :: Maybe CloudWatchLoggingOptions
$sel:cloudWatchLoggingOptions:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions} -> Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe CloudWatchLoggingOptions
a -> S3DestinationUpdate
s {$sel:cloudWatchLoggingOptions:S3DestinationUpdate' :: Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions = Maybe CloudWatchLoggingOptions
a} :: S3DestinationUpdate)

-- | The compression format. If no value is specified, the default is
-- @UNCOMPRESSED@.
--
-- The compression formats @SNAPPY@ or @ZIP@ cannot be specified for Amazon
-- Redshift destinations because they are not supported by the Amazon
-- Redshift @COPY@ operation that reads from the S3 bucket.
s3DestinationUpdate_compressionFormat :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe CompressionFormat)
s3DestinationUpdate_compressionFormat :: Lens' S3DestinationUpdate (Maybe CompressionFormat)
s3DestinationUpdate_compressionFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe CompressionFormat
compressionFormat :: Maybe CompressionFormat
$sel:compressionFormat:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CompressionFormat
compressionFormat} -> Maybe CompressionFormat
compressionFormat) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe CompressionFormat
a -> S3DestinationUpdate
s {$sel:compressionFormat:S3DestinationUpdate' :: Maybe CompressionFormat
compressionFormat = Maybe CompressionFormat
a} :: S3DestinationUpdate)

-- | The encryption configuration. If no value is specified, the default is
-- no encryption.
s3DestinationUpdate_encryptionConfiguration :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe EncryptionConfiguration)
s3DestinationUpdate_encryptionConfiguration :: Lens' S3DestinationUpdate (Maybe EncryptionConfiguration)
s3DestinationUpdate_encryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe EncryptionConfiguration
encryptionConfiguration :: Maybe EncryptionConfiguration
$sel:encryptionConfiguration:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe EncryptionConfiguration
encryptionConfiguration} -> Maybe EncryptionConfiguration
encryptionConfiguration) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe EncryptionConfiguration
a -> S3DestinationUpdate
s {$sel:encryptionConfiguration:S3DestinationUpdate' :: Maybe EncryptionConfiguration
encryptionConfiguration = Maybe EncryptionConfiguration
a} :: S3DestinationUpdate)

-- | A prefix that Kinesis Data Firehose evaluates and adds to failed records
-- before writing them to S3. This prefix appears immediately following the
-- bucket name. For information about how to specify this prefix, see
-- <https://docs.aws.amazon.com/firehose/latest/dev/s3-prefixes.html Custom Prefixes for Amazon S3 Objects>.
s3DestinationUpdate_errorOutputPrefix :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe Prelude.Text)
s3DestinationUpdate_errorOutputPrefix :: Lens' S3DestinationUpdate (Maybe Text)
s3DestinationUpdate_errorOutputPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe Text
errorOutputPrefix :: Maybe Text
$sel:errorOutputPrefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
errorOutputPrefix} -> Maybe Text
errorOutputPrefix) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe Text
a -> S3DestinationUpdate
s {$sel:errorOutputPrefix:S3DestinationUpdate' :: Maybe Text
errorOutputPrefix = Maybe Text
a} :: S3DestinationUpdate)

-- | The \"YYYY\/MM\/DD\/HH\" time format prefix is automatically used for
-- delivered Amazon S3 files. You can also specify a custom prefix, as
-- described in
-- <https://docs.aws.amazon.com/firehose/latest/dev/s3-prefixes.html Custom Prefixes for Amazon S3 Objects>.
s3DestinationUpdate_prefix :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe Prelude.Text)
s3DestinationUpdate_prefix :: Lens' S3DestinationUpdate (Maybe Text)
s3DestinationUpdate_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe Text
prefix :: Maybe Text
$sel:prefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe Text
a -> S3DestinationUpdate
s {$sel:prefix:S3DestinationUpdate' :: Maybe Text
prefix = Maybe Text
a} :: S3DestinationUpdate)

-- | The Amazon Resource Name (ARN) of the Amazon Web Services credentials.
-- For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
s3DestinationUpdate_roleARN :: Lens.Lens' S3DestinationUpdate (Prelude.Maybe Prelude.Text)
s3DestinationUpdate_roleARN :: Lens' S3DestinationUpdate (Maybe Text)
s3DestinationUpdate_roleARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3DestinationUpdate' {Maybe Text
roleARN :: Maybe Text
$sel:roleARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
roleARN} -> Maybe Text
roleARN) (\s :: S3DestinationUpdate
s@S3DestinationUpdate' {} Maybe Text
a -> S3DestinationUpdate
s {$sel:roleARN:S3DestinationUpdate' :: Maybe Text
roleARN = Maybe Text
a} :: S3DestinationUpdate)

instance Prelude.Hashable S3DestinationUpdate where
  hashWithSalt :: Int -> S3DestinationUpdate -> Int
hashWithSalt Int
_salt S3DestinationUpdate' {Maybe Text
Maybe BufferingHints
Maybe CloudWatchLoggingOptions
Maybe CompressionFormat
Maybe EncryptionConfiguration
roleARN :: Maybe Text
prefix :: Maybe Text
errorOutputPrefix :: Maybe Text
encryptionConfiguration :: Maybe EncryptionConfiguration
compressionFormat :: Maybe CompressionFormat
cloudWatchLoggingOptions :: Maybe CloudWatchLoggingOptions
bufferingHints :: Maybe BufferingHints
bucketARN :: Maybe Text
$sel:roleARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:prefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:errorOutputPrefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:encryptionConfiguration:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe EncryptionConfiguration
$sel:compressionFormat:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CompressionFormat
$sel:cloudWatchLoggingOptions:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CloudWatchLoggingOptions
$sel:bufferingHints:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe BufferingHints
$sel:bucketARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bucketARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BufferingHints
bufferingHints
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CompressionFormat
compressionFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionConfiguration
encryptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
errorOutputPrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleARN

instance Prelude.NFData S3DestinationUpdate where
  rnf :: S3DestinationUpdate -> ()
rnf S3DestinationUpdate' {Maybe Text
Maybe BufferingHints
Maybe CloudWatchLoggingOptions
Maybe CompressionFormat
Maybe EncryptionConfiguration
roleARN :: Maybe Text
prefix :: Maybe Text
errorOutputPrefix :: Maybe Text
encryptionConfiguration :: Maybe EncryptionConfiguration
compressionFormat :: Maybe CompressionFormat
cloudWatchLoggingOptions :: Maybe CloudWatchLoggingOptions
bufferingHints :: Maybe BufferingHints
bucketARN :: Maybe Text
$sel:roleARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:prefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:errorOutputPrefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:encryptionConfiguration:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe EncryptionConfiguration
$sel:compressionFormat:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CompressionFormat
$sel:cloudWatchLoggingOptions:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CloudWatchLoggingOptions
$sel:bufferingHints:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe BufferingHints
$sel:bucketARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bucketARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BufferingHints
bufferingHints
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CompressionFormat
compressionFormat
      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 Text
errorOutputPrefix
      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 Text
roleARN

instance Data.ToJSON S3DestinationUpdate where
  toJSON :: S3DestinationUpdate -> Value
toJSON S3DestinationUpdate' {Maybe Text
Maybe BufferingHints
Maybe CloudWatchLoggingOptions
Maybe CompressionFormat
Maybe EncryptionConfiguration
roleARN :: Maybe Text
prefix :: Maybe Text
errorOutputPrefix :: Maybe Text
encryptionConfiguration :: Maybe EncryptionConfiguration
compressionFormat :: Maybe CompressionFormat
cloudWatchLoggingOptions :: Maybe CloudWatchLoggingOptions
bufferingHints :: Maybe BufferingHints
bucketARN :: Maybe Text
$sel:roleARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:prefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:errorOutputPrefix:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
$sel:encryptionConfiguration:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe EncryptionConfiguration
$sel:compressionFormat:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CompressionFormat
$sel:cloudWatchLoggingOptions:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe CloudWatchLoggingOptions
$sel:bufferingHints:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe BufferingHints
$sel:bucketARN:S3DestinationUpdate' :: S3DestinationUpdate -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BucketARN" 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
bucketARN,
            (Key
"BufferingHints" 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 BufferingHints
bufferingHints,
            (Key
"CloudWatchLoggingOptions" 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 CloudWatchLoggingOptions
cloudWatchLoggingOptions,
            (Key
"CompressionFormat" 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 CompressionFormat
compressionFormat,
            (Key
"EncryptionConfiguration" 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 EncryptionConfiguration
encryptionConfiguration,
            (Key
"ErrorOutputPrefix" 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
errorOutputPrefix,
            (Key
"Prefix" 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
prefix,
            (Key
"RoleARN" 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
roleARN
          ]
      )