{-# 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.RedshiftDestinationUpdate
-- 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.RedshiftDestinationUpdate 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.CloudWatchLoggingOptions
import Amazonka.Firehose.Types.CopyCommand
import Amazonka.Firehose.Types.ProcessingConfiguration
import Amazonka.Firehose.Types.RedshiftRetryOptions
import Amazonka.Firehose.Types.RedshiftS3BackupMode
import Amazonka.Firehose.Types.S3DestinationUpdate
import qualified Amazonka.Prelude as Prelude

-- | Describes an update for a destination in Amazon Redshift.
--
-- /See:/ 'newRedshiftDestinationUpdate' smart constructor.
data RedshiftDestinationUpdate = RedshiftDestinationUpdate'
  { -- | The Amazon CloudWatch logging options for your delivery stream.
    RedshiftDestinationUpdate -> Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions :: Prelude.Maybe CloudWatchLoggingOptions,
    -- | The database connection string.
    RedshiftDestinationUpdate -> Maybe Text
clusterJDBCURL :: Prelude.Maybe Prelude.Text,
    -- | The @COPY@ command.
    RedshiftDestinationUpdate -> Maybe CopyCommand
copyCommand :: Prelude.Maybe CopyCommand,
    -- | The user password.
    RedshiftDestinationUpdate -> Maybe (Sensitive Text)
password :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The data processing configuration.
    RedshiftDestinationUpdate -> Maybe ProcessingConfiguration
processingConfiguration :: Prelude.Maybe ProcessingConfiguration,
    -- | The retry behavior in case Kinesis Data Firehose is unable to deliver
    -- documents to Amazon Redshift. Default value is 3600 (60 minutes).
    RedshiftDestinationUpdate -> Maybe RedshiftRetryOptions
retryOptions :: Prelude.Maybe RedshiftRetryOptions,
    -- | 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>.
    RedshiftDestinationUpdate -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text,
    -- | You can update a delivery stream to enable Amazon S3 backup if it is
    -- disabled. If backup is enabled, you can\'t update the delivery stream to
    -- disable it.
    RedshiftDestinationUpdate -> Maybe RedshiftS3BackupMode
s3BackupMode :: Prelude.Maybe RedshiftS3BackupMode,
    -- | The Amazon S3 destination for backup.
    RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
s3BackupUpdate :: Prelude.Maybe S3DestinationUpdate,
    -- | The Amazon S3 destination.
    --
    -- The compression formats @SNAPPY@ or @ZIP@ cannot be specified in
    -- @RedshiftDestinationUpdate.S3Update@ because the Amazon Redshift @COPY@
    -- operation that reads from the S3 bucket doesn\'t support these
    -- compression formats.
    RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
s3Update :: Prelude.Maybe S3DestinationUpdate,
    -- | The name of the user.
    RedshiftDestinationUpdate -> Maybe (Sensitive Text)
username :: Prelude.Maybe (Data.Sensitive Prelude.Text)
  }
  deriving (RedshiftDestinationUpdate -> RedshiftDestinationUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedshiftDestinationUpdate -> RedshiftDestinationUpdate -> Bool
$c/= :: RedshiftDestinationUpdate -> RedshiftDestinationUpdate -> Bool
== :: RedshiftDestinationUpdate -> RedshiftDestinationUpdate -> Bool
$c== :: RedshiftDestinationUpdate -> RedshiftDestinationUpdate -> Bool
Prelude.Eq, Int -> RedshiftDestinationUpdate -> ShowS
[RedshiftDestinationUpdate] -> ShowS
RedshiftDestinationUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedshiftDestinationUpdate] -> ShowS
$cshowList :: [RedshiftDestinationUpdate] -> ShowS
show :: RedshiftDestinationUpdate -> String
$cshow :: RedshiftDestinationUpdate -> String
showsPrec :: Int -> RedshiftDestinationUpdate -> ShowS
$cshowsPrec :: Int -> RedshiftDestinationUpdate -> ShowS
Prelude.Show, forall x.
Rep RedshiftDestinationUpdate x -> RedshiftDestinationUpdate
forall x.
RedshiftDestinationUpdate -> Rep RedshiftDestinationUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RedshiftDestinationUpdate x -> RedshiftDestinationUpdate
$cfrom :: forall x.
RedshiftDestinationUpdate -> Rep RedshiftDestinationUpdate x
Prelude.Generic)

-- |
-- Create a value of 'RedshiftDestinationUpdate' 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:
--
-- 'cloudWatchLoggingOptions', 'redshiftDestinationUpdate_cloudWatchLoggingOptions' - The Amazon CloudWatch logging options for your delivery stream.
--
-- 'clusterJDBCURL', 'redshiftDestinationUpdate_clusterJDBCURL' - The database connection string.
--
-- 'copyCommand', 'redshiftDestinationUpdate_copyCommand' - The @COPY@ command.
--
-- 'password', 'redshiftDestinationUpdate_password' - The user password.
--
-- 'processingConfiguration', 'redshiftDestinationUpdate_processingConfiguration' - The data processing configuration.
--
-- 'retryOptions', 'redshiftDestinationUpdate_retryOptions' - The retry behavior in case Kinesis Data Firehose is unable to deliver
-- documents to Amazon Redshift. Default value is 3600 (60 minutes).
--
-- 'roleARN', 'redshiftDestinationUpdate_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>.
--
-- 's3BackupMode', 'redshiftDestinationUpdate_s3BackupMode' - You can update a delivery stream to enable Amazon S3 backup if it is
-- disabled. If backup is enabled, you can\'t update the delivery stream to
-- disable it.
--
-- 's3BackupUpdate', 'redshiftDestinationUpdate_s3BackupUpdate' - The Amazon S3 destination for backup.
--
-- 's3Update', 'redshiftDestinationUpdate_s3Update' - The Amazon S3 destination.
--
-- The compression formats @SNAPPY@ or @ZIP@ cannot be specified in
-- @RedshiftDestinationUpdate.S3Update@ because the Amazon Redshift @COPY@
-- operation that reads from the S3 bucket doesn\'t support these
-- compression formats.
--
-- 'username', 'redshiftDestinationUpdate_username' - The name of the user.
newRedshiftDestinationUpdate ::
  RedshiftDestinationUpdate
newRedshiftDestinationUpdate :: RedshiftDestinationUpdate
newRedshiftDestinationUpdate =
  RedshiftDestinationUpdate'
    { $sel:cloudWatchLoggingOptions:RedshiftDestinationUpdate' :: Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterJDBCURL:RedshiftDestinationUpdate' :: Maybe Text
clusterJDBCURL = forall a. Maybe a
Prelude.Nothing,
      $sel:copyCommand:RedshiftDestinationUpdate' :: Maybe CopyCommand
copyCommand = forall a. Maybe a
Prelude.Nothing,
      $sel:password:RedshiftDestinationUpdate' :: Maybe (Sensitive Text)
password = forall a. Maybe a
Prelude.Nothing,
      $sel:processingConfiguration:RedshiftDestinationUpdate' :: Maybe ProcessingConfiguration
processingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:retryOptions:RedshiftDestinationUpdate' :: Maybe RedshiftRetryOptions
retryOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:RedshiftDestinationUpdate' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing,
      $sel:s3BackupMode:RedshiftDestinationUpdate' :: Maybe RedshiftS3BackupMode
s3BackupMode = forall a. Maybe a
Prelude.Nothing,
      $sel:s3BackupUpdate:RedshiftDestinationUpdate' :: Maybe S3DestinationUpdate
s3BackupUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Update:RedshiftDestinationUpdate' :: Maybe S3DestinationUpdate
s3Update = forall a. Maybe a
Prelude.Nothing,
      $sel:username:RedshiftDestinationUpdate' :: Maybe (Sensitive Text)
username = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The database connection string.
redshiftDestinationUpdate_clusterJDBCURL :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe Prelude.Text)
redshiftDestinationUpdate_clusterJDBCURL :: Lens' RedshiftDestinationUpdate (Maybe Text)
redshiftDestinationUpdate_clusterJDBCURL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe Text
clusterJDBCURL :: Maybe Text
$sel:clusterJDBCURL:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
clusterJDBCURL} -> Maybe Text
clusterJDBCURL) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe Text
a -> RedshiftDestinationUpdate
s {$sel:clusterJDBCURL:RedshiftDestinationUpdate' :: Maybe Text
clusterJDBCURL = Maybe Text
a} :: RedshiftDestinationUpdate)

-- | The @COPY@ command.
redshiftDestinationUpdate_copyCommand :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe CopyCommand)
redshiftDestinationUpdate_copyCommand :: Lens' RedshiftDestinationUpdate (Maybe CopyCommand)
redshiftDestinationUpdate_copyCommand = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe CopyCommand
copyCommand :: Maybe CopyCommand
$sel:copyCommand:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe CopyCommand
copyCommand} -> Maybe CopyCommand
copyCommand) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe CopyCommand
a -> RedshiftDestinationUpdate
s {$sel:copyCommand:RedshiftDestinationUpdate' :: Maybe CopyCommand
copyCommand = Maybe CopyCommand
a} :: RedshiftDestinationUpdate)

-- | The user password.
redshiftDestinationUpdate_password :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe Prelude.Text)
redshiftDestinationUpdate_password :: Lens' RedshiftDestinationUpdate (Maybe Text)
redshiftDestinationUpdate_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe (Sensitive Text)
password :: Maybe (Sensitive Text)
$sel:password:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
password} -> Maybe (Sensitive Text)
password) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe (Sensitive Text)
a -> RedshiftDestinationUpdate
s {$sel:password:RedshiftDestinationUpdate' :: Maybe (Sensitive Text)
password = Maybe (Sensitive Text)
a} :: RedshiftDestinationUpdate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The data processing configuration.
redshiftDestinationUpdate_processingConfiguration :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe ProcessingConfiguration)
redshiftDestinationUpdate_processingConfiguration :: Lens' RedshiftDestinationUpdate (Maybe ProcessingConfiguration)
redshiftDestinationUpdate_processingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe ProcessingConfiguration
processingConfiguration :: Maybe ProcessingConfiguration
$sel:processingConfiguration:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe ProcessingConfiguration
processingConfiguration} -> Maybe ProcessingConfiguration
processingConfiguration) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe ProcessingConfiguration
a -> RedshiftDestinationUpdate
s {$sel:processingConfiguration:RedshiftDestinationUpdate' :: Maybe ProcessingConfiguration
processingConfiguration = Maybe ProcessingConfiguration
a} :: RedshiftDestinationUpdate)

-- | The retry behavior in case Kinesis Data Firehose is unable to deliver
-- documents to Amazon Redshift. Default value is 3600 (60 minutes).
redshiftDestinationUpdate_retryOptions :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe RedshiftRetryOptions)
redshiftDestinationUpdate_retryOptions :: Lens' RedshiftDestinationUpdate (Maybe RedshiftRetryOptions)
redshiftDestinationUpdate_retryOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe RedshiftRetryOptions
retryOptions :: Maybe RedshiftRetryOptions
$sel:retryOptions:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftRetryOptions
retryOptions} -> Maybe RedshiftRetryOptions
retryOptions) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe RedshiftRetryOptions
a -> RedshiftDestinationUpdate
s {$sel:retryOptions:RedshiftDestinationUpdate' :: Maybe RedshiftRetryOptions
retryOptions = Maybe RedshiftRetryOptions
a} :: RedshiftDestinationUpdate)

-- | 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>.
redshiftDestinationUpdate_roleARN :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe Prelude.Text)
redshiftDestinationUpdate_roleARN :: Lens' RedshiftDestinationUpdate (Maybe Text)
redshiftDestinationUpdate_roleARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe Text
roleARN :: Maybe Text
$sel:roleARN:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
roleARN} -> Maybe Text
roleARN) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe Text
a -> RedshiftDestinationUpdate
s {$sel:roleARN:RedshiftDestinationUpdate' :: Maybe Text
roleARN = Maybe Text
a} :: RedshiftDestinationUpdate)

-- | You can update a delivery stream to enable Amazon S3 backup if it is
-- disabled. If backup is enabled, you can\'t update the delivery stream to
-- disable it.
redshiftDestinationUpdate_s3BackupMode :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe RedshiftS3BackupMode)
redshiftDestinationUpdate_s3BackupMode :: Lens' RedshiftDestinationUpdate (Maybe RedshiftS3BackupMode)
redshiftDestinationUpdate_s3BackupMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe RedshiftS3BackupMode
s3BackupMode :: Maybe RedshiftS3BackupMode
$sel:s3BackupMode:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftS3BackupMode
s3BackupMode} -> Maybe RedshiftS3BackupMode
s3BackupMode) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe RedshiftS3BackupMode
a -> RedshiftDestinationUpdate
s {$sel:s3BackupMode:RedshiftDestinationUpdate' :: Maybe RedshiftS3BackupMode
s3BackupMode = Maybe RedshiftS3BackupMode
a} :: RedshiftDestinationUpdate)

-- | The Amazon S3 destination for backup.
redshiftDestinationUpdate_s3BackupUpdate :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe S3DestinationUpdate)
redshiftDestinationUpdate_s3BackupUpdate :: Lens' RedshiftDestinationUpdate (Maybe S3DestinationUpdate)
redshiftDestinationUpdate_s3BackupUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe S3DestinationUpdate
s3BackupUpdate :: Maybe S3DestinationUpdate
$sel:s3BackupUpdate:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
s3BackupUpdate} -> Maybe S3DestinationUpdate
s3BackupUpdate) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe S3DestinationUpdate
a -> RedshiftDestinationUpdate
s {$sel:s3BackupUpdate:RedshiftDestinationUpdate' :: Maybe S3DestinationUpdate
s3BackupUpdate = Maybe S3DestinationUpdate
a} :: RedshiftDestinationUpdate)

-- | The Amazon S3 destination.
--
-- The compression formats @SNAPPY@ or @ZIP@ cannot be specified in
-- @RedshiftDestinationUpdate.S3Update@ because the Amazon Redshift @COPY@
-- operation that reads from the S3 bucket doesn\'t support these
-- compression formats.
redshiftDestinationUpdate_s3Update :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe S3DestinationUpdate)
redshiftDestinationUpdate_s3Update :: Lens' RedshiftDestinationUpdate (Maybe S3DestinationUpdate)
redshiftDestinationUpdate_s3Update = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe S3DestinationUpdate
s3Update :: Maybe S3DestinationUpdate
$sel:s3Update:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
s3Update} -> Maybe S3DestinationUpdate
s3Update) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe S3DestinationUpdate
a -> RedshiftDestinationUpdate
s {$sel:s3Update:RedshiftDestinationUpdate' :: Maybe S3DestinationUpdate
s3Update = Maybe S3DestinationUpdate
a} :: RedshiftDestinationUpdate)

-- | The name of the user.
redshiftDestinationUpdate_username :: Lens.Lens' RedshiftDestinationUpdate (Prelude.Maybe Prelude.Text)
redshiftDestinationUpdate_username :: Lens' RedshiftDestinationUpdate (Maybe Text)
redshiftDestinationUpdate_username = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RedshiftDestinationUpdate' {Maybe (Sensitive Text)
username :: Maybe (Sensitive Text)
$sel:username:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
username} -> Maybe (Sensitive Text)
username) (\s :: RedshiftDestinationUpdate
s@RedshiftDestinationUpdate' {} Maybe (Sensitive Text)
a -> RedshiftDestinationUpdate
s {$sel:username:RedshiftDestinationUpdate' :: Maybe (Sensitive Text)
username = Maybe (Sensitive Text)
a} :: RedshiftDestinationUpdate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Prelude.Hashable RedshiftDestinationUpdate where
  hashWithSalt :: Int -> RedshiftDestinationUpdate -> Int
hashWithSalt Int
_salt RedshiftDestinationUpdate' {Maybe Text
Maybe (Sensitive Text)
Maybe CloudWatchLoggingOptions
Maybe CopyCommand
Maybe ProcessingConfiguration
Maybe RedshiftRetryOptions
Maybe RedshiftS3BackupMode
Maybe S3DestinationUpdate
username :: Maybe (Sensitive Text)
s3Update :: Maybe S3DestinationUpdate
s3BackupUpdate :: Maybe S3DestinationUpdate
s3BackupMode :: Maybe RedshiftS3BackupMode
roleARN :: Maybe Text
retryOptions :: Maybe RedshiftRetryOptions
processingConfiguration :: Maybe ProcessingConfiguration
password :: Maybe (Sensitive Text)
copyCommand :: Maybe CopyCommand
clusterJDBCURL :: Maybe Text
cloudWatchLoggingOptions :: Maybe CloudWatchLoggingOptions
$sel:username:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
$sel:s3Update:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
$sel:s3BackupUpdate:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
$sel:s3BackupMode:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftS3BackupMode
$sel:roleARN:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
$sel:retryOptions:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftRetryOptions
$sel:processingConfiguration:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe ProcessingConfiguration
$sel:password:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
$sel:copyCommand:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe CopyCommand
$sel:clusterJDBCURL:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
$sel:cloudWatchLoggingOptions:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe CloudWatchLoggingOptions
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchLoggingOptions
cloudWatchLoggingOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterJDBCURL
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CopyCommand
copyCommand
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
password
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProcessingConfiguration
processingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RedshiftRetryOptions
retryOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RedshiftS3BackupMode
s3BackupMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3DestinationUpdate
s3BackupUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3DestinationUpdate
s3Update
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
username

instance Prelude.NFData RedshiftDestinationUpdate where
  rnf :: RedshiftDestinationUpdate -> ()
rnf RedshiftDestinationUpdate' {Maybe Text
Maybe (Sensitive Text)
Maybe CloudWatchLoggingOptions
Maybe CopyCommand
Maybe ProcessingConfiguration
Maybe RedshiftRetryOptions
Maybe RedshiftS3BackupMode
Maybe S3DestinationUpdate
username :: Maybe (Sensitive Text)
s3Update :: Maybe S3DestinationUpdate
s3BackupUpdate :: Maybe S3DestinationUpdate
s3BackupMode :: Maybe RedshiftS3BackupMode
roleARN :: Maybe Text
retryOptions :: Maybe RedshiftRetryOptions
processingConfiguration :: Maybe ProcessingConfiguration
password :: Maybe (Sensitive Text)
copyCommand :: Maybe CopyCommand
clusterJDBCURL :: Maybe Text
cloudWatchLoggingOptions :: Maybe CloudWatchLoggingOptions
$sel:username:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
$sel:s3Update:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
$sel:s3BackupUpdate:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
$sel:s3BackupMode:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftS3BackupMode
$sel:roleARN:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
$sel:retryOptions:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftRetryOptions
$sel:processingConfiguration:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe ProcessingConfiguration
$sel:password:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
$sel:copyCommand:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe CopyCommand
$sel:clusterJDBCURL:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
$sel:cloudWatchLoggingOptions:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe CloudWatchLoggingOptions
..} =
    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 Text
clusterJDBCURL
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CopyCommand
copyCommand
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
password
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProcessingConfiguration
processingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RedshiftRetryOptions
retryOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RedshiftS3BackupMode
s3BackupMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3DestinationUpdate
s3BackupUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3DestinationUpdate
s3Update
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
username

instance Data.ToJSON RedshiftDestinationUpdate where
  toJSON :: RedshiftDestinationUpdate -> Value
toJSON RedshiftDestinationUpdate' {Maybe Text
Maybe (Sensitive Text)
Maybe CloudWatchLoggingOptions
Maybe CopyCommand
Maybe ProcessingConfiguration
Maybe RedshiftRetryOptions
Maybe RedshiftS3BackupMode
Maybe S3DestinationUpdate
username :: Maybe (Sensitive Text)
s3Update :: Maybe S3DestinationUpdate
s3BackupUpdate :: Maybe S3DestinationUpdate
s3BackupMode :: Maybe RedshiftS3BackupMode
roleARN :: Maybe Text
retryOptions :: Maybe RedshiftRetryOptions
processingConfiguration :: Maybe ProcessingConfiguration
password :: Maybe (Sensitive Text)
copyCommand :: Maybe CopyCommand
clusterJDBCURL :: Maybe Text
cloudWatchLoggingOptions :: Maybe CloudWatchLoggingOptions
$sel:username:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
$sel:s3Update:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
$sel:s3BackupUpdate:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe S3DestinationUpdate
$sel:s3BackupMode:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftS3BackupMode
$sel:roleARN:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
$sel:retryOptions:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe RedshiftRetryOptions
$sel:processingConfiguration:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe ProcessingConfiguration
$sel:password:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe (Sensitive Text)
$sel:copyCommand:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe CopyCommand
$sel:clusterJDBCURL:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe Text
$sel:cloudWatchLoggingOptions:RedshiftDestinationUpdate' :: RedshiftDestinationUpdate -> Maybe CloudWatchLoggingOptions
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"ClusterJDBCURL" 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
clusterJDBCURL,
            (Key
"CopyCommand" 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 CopyCommand
copyCommand,
            (Key
"Password" 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 (Sensitive Text)
password,
            (Key
"ProcessingConfiguration" 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 ProcessingConfiguration
processingConfiguration,
            (Key
"RetryOptions" 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 RedshiftRetryOptions
retryOptions,
            (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,
            (Key
"S3BackupMode" 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 RedshiftS3BackupMode
s3BackupMode,
            (Key
"S3BackupUpdate" 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 S3DestinationUpdate
s3BackupUpdate,
            (Key
"S3Update" 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 S3DestinationUpdate
s3Update,
            (Key
"Username" 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 (Sensitive Text)
username
          ]
      )