{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.UpdateDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified destination of the specified delivery stream.
--
-- Use this operation to change the destination type (for example, to
-- replace the Amazon S3 destination with Amazon Redshift) or change the
-- parameters associated with a destination (for example, to change the
-- bucket name of the Amazon S3 destination). The update might not occur
-- immediately. The target delivery stream remains active while the
-- configurations are updated, so data writes to the delivery stream can
-- continue during this process. The updated configurations are usually
-- effective within a few minutes.
--
-- Switching between Amazon ES and other services is not supported. For an
-- Amazon ES destination, you can only update to another Amazon ES
-- destination.
--
-- If the destination type is the same, Kinesis Data Firehose merges the
-- configuration parameters specified with the destination configuration
-- that already exists on the delivery stream. If any of the parameters are
-- not specified in the call, the existing values are retained. For
-- example, in the Amazon S3 destination, if EncryptionConfiguration is not
-- specified, then the existing @EncryptionConfiguration@ is maintained on
-- the destination.
--
-- If the destination type is not the same, for example, changing the
-- destination from Amazon S3 to Amazon Redshift, Kinesis Data Firehose
-- does not merge any parameters. In this case, all parameters must be
-- specified.
--
-- Kinesis Data Firehose uses @CurrentDeliveryStreamVersionId@ to avoid
-- race conditions and conflicting merges. This is a required field, and
-- the service updates the configuration only if the existing configuration
-- has a version ID that matches. After the update is applied successfully,
-- the version ID is updated, and can be retrieved using
-- DescribeDeliveryStream. Use the new version ID to set
-- @CurrentDeliveryStreamVersionId@ in the next call.
module Amazonka.Firehose.UpdateDestination
  ( -- * Creating a Request
    UpdateDestination (..),
    newUpdateDestination,

    -- * Request Lenses
    updateDestination_amazonOpenSearchServerlessDestinationUpdate,
    updateDestination_amazonopensearchserviceDestinationUpdate,
    updateDestination_elasticsearchDestinationUpdate,
    updateDestination_extendedS3DestinationUpdate,
    updateDestination_httpEndpointDestinationUpdate,
    updateDestination_redshiftDestinationUpdate,
    updateDestination_s3DestinationUpdate,
    updateDestination_splunkDestinationUpdate,
    updateDestination_deliveryStreamName,
    updateDestination_currentDeliveryStreamVersionId,
    updateDestination_destinationId,

    -- * Destructuring the Response
    UpdateDestinationResponse (..),
    newUpdateDestinationResponse,

    -- * Response Lenses
    updateDestinationResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateDestination' smart constructor.
data UpdateDestination = UpdateDestination'
  { -- | Describes an update for a destination in the Serverless offering for
    -- Amazon OpenSearch Service.
    UpdateDestination
-> Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate :: Prelude.Maybe AmazonOpenSearchServerlessDestinationUpdate,
    -- | Describes an update for a destination in Amazon OpenSearch Service.
    UpdateDestination -> Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate :: Prelude.Maybe AmazonopensearchserviceDestinationUpdate,
    -- | Describes an update for a destination in Amazon ES.
    UpdateDestination -> Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate :: Prelude.Maybe ElasticsearchDestinationUpdate,
    -- | Describes an update for a destination in Amazon S3.
    UpdateDestination -> Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate :: Prelude.Maybe ExtendedS3DestinationUpdate,
    -- | Describes an update to the specified HTTP endpoint destination.
    UpdateDestination -> Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate :: Prelude.Maybe HttpEndpointDestinationUpdate,
    -- | Describes an update for a destination in Amazon Redshift.
    UpdateDestination -> Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate :: Prelude.Maybe RedshiftDestinationUpdate,
    -- | [Deprecated] Describes an update for a destination in Amazon S3.
    UpdateDestination -> Maybe S3DestinationUpdate
s3DestinationUpdate :: Prelude.Maybe S3DestinationUpdate,
    -- | Describes an update for a destination in Splunk.
    UpdateDestination -> Maybe SplunkDestinationUpdate
splunkDestinationUpdate :: Prelude.Maybe SplunkDestinationUpdate,
    -- | The name of the delivery stream.
    UpdateDestination -> Text
deliveryStreamName :: Prelude.Text,
    -- | Obtain this value from the @VersionId@ result of
    -- DeliveryStreamDescription. This value is required, and helps the service
    -- perform conditional operations. For example, if there is an interleaving
    -- update and this value is null, then the update destination fails. After
    -- the update is successful, the @VersionId@ value is updated. The service
    -- then performs a merge of the old configuration with the new
    -- configuration.
    UpdateDestination -> Text
currentDeliveryStreamVersionId :: Prelude.Text,
    -- | The ID of the destination.
    UpdateDestination -> Text
destinationId :: Prelude.Text
  }
  deriving (UpdateDestination -> UpdateDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDestination -> UpdateDestination -> Bool
$c/= :: UpdateDestination -> UpdateDestination -> Bool
== :: UpdateDestination -> UpdateDestination -> Bool
$c== :: UpdateDestination -> UpdateDestination -> Bool
Prelude.Eq, Int -> UpdateDestination -> ShowS
[UpdateDestination] -> ShowS
UpdateDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDestination] -> ShowS
$cshowList :: [UpdateDestination] -> ShowS
show :: UpdateDestination -> String
$cshow :: UpdateDestination -> String
showsPrec :: Int -> UpdateDestination -> ShowS
$cshowsPrec :: Int -> UpdateDestination -> ShowS
Prelude.Show, forall x. Rep UpdateDestination x -> UpdateDestination
forall x. UpdateDestination -> Rep UpdateDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDestination x -> UpdateDestination
$cfrom :: forall x. UpdateDestination -> Rep UpdateDestination x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDestination' 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:
--
-- 'amazonOpenSearchServerlessDestinationUpdate', 'updateDestination_amazonOpenSearchServerlessDestinationUpdate' - Describes an update for a destination in the Serverless offering for
-- Amazon OpenSearch Service.
--
-- 'amazonopensearchserviceDestinationUpdate', 'updateDestination_amazonopensearchserviceDestinationUpdate' - Describes an update for a destination in Amazon OpenSearch Service.
--
-- 'elasticsearchDestinationUpdate', 'updateDestination_elasticsearchDestinationUpdate' - Describes an update for a destination in Amazon ES.
--
-- 'extendedS3DestinationUpdate', 'updateDestination_extendedS3DestinationUpdate' - Describes an update for a destination in Amazon S3.
--
-- 'httpEndpointDestinationUpdate', 'updateDestination_httpEndpointDestinationUpdate' - Describes an update to the specified HTTP endpoint destination.
--
-- 'redshiftDestinationUpdate', 'updateDestination_redshiftDestinationUpdate' - Describes an update for a destination in Amazon Redshift.
--
-- 's3DestinationUpdate', 'updateDestination_s3DestinationUpdate' - [Deprecated] Describes an update for a destination in Amazon S3.
--
-- 'splunkDestinationUpdate', 'updateDestination_splunkDestinationUpdate' - Describes an update for a destination in Splunk.
--
-- 'deliveryStreamName', 'updateDestination_deliveryStreamName' - The name of the delivery stream.
--
-- 'currentDeliveryStreamVersionId', 'updateDestination_currentDeliveryStreamVersionId' - Obtain this value from the @VersionId@ result of
-- DeliveryStreamDescription. This value is required, and helps the service
-- perform conditional operations. For example, if there is an interleaving
-- update and this value is null, then the update destination fails. After
-- the update is successful, the @VersionId@ value is updated. The service
-- then performs a merge of the old configuration with the new
-- configuration.
--
-- 'destinationId', 'updateDestination_destinationId' - The ID of the destination.
newUpdateDestination ::
  -- | 'deliveryStreamName'
  Prelude.Text ->
  -- | 'currentDeliveryStreamVersionId'
  Prelude.Text ->
  -- | 'destinationId'
  Prelude.Text ->
  UpdateDestination
newUpdateDestination :: Text -> Text -> Text -> UpdateDestination
newUpdateDestination
  Text
pDeliveryStreamName_
  Text
pCurrentDeliveryStreamVersionId_
  Text
pDestinationId_ =
    UpdateDestination'
      { $sel:amazonOpenSearchServerlessDestinationUpdate:UpdateDestination' :: Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate =
          forall a. Maybe a
Prelude.Nothing,
        $sel:amazonopensearchserviceDestinationUpdate:UpdateDestination' :: Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate =
          forall a. Maybe a
Prelude.Nothing,
        $sel:elasticsearchDestinationUpdate:UpdateDestination' :: Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate = forall a. Maybe a
Prelude.Nothing,
        $sel:extendedS3DestinationUpdate:UpdateDestination' :: Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate = forall a. Maybe a
Prelude.Nothing,
        $sel:httpEndpointDestinationUpdate:UpdateDestination' :: Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate = forall a. Maybe a
Prelude.Nothing,
        $sel:redshiftDestinationUpdate:UpdateDestination' :: Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate = forall a. Maybe a
Prelude.Nothing,
        $sel:s3DestinationUpdate:UpdateDestination' :: Maybe S3DestinationUpdate
s3DestinationUpdate = forall a. Maybe a
Prelude.Nothing,
        $sel:splunkDestinationUpdate:UpdateDestination' :: Maybe SplunkDestinationUpdate
splunkDestinationUpdate = forall a. Maybe a
Prelude.Nothing,
        $sel:deliveryStreamName:UpdateDestination' :: Text
deliveryStreamName = Text
pDeliveryStreamName_,
        $sel:currentDeliveryStreamVersionId:UpdateDestination' :: Text
currentDeliveryStreamVersionId =
          Text
pCurrentDeliveryStreamVersionId_,
        $sel:destinationId:UpdateDestination' :: Text
destinationId = Text
pDestinationId_
      }

-- | Describes an update for a destination in the Serverless offering for
-- Amazon OpenSearch Service.
updateDestination_amazonOpenSearchServerlessDestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe AmazonOpenSearchServerlessDestinationUpdate)
updateDestination_amazonOpenSearchServerlessDestinationUpdate :: Lens'
  UpdateDestination
  (Maybe AmazonOpenSearchServerlessDestinationUpdate)
updateDestination_amazonOpenSearchServerlessDestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate :: Maybe AmazonOpenSearchServerlessDestinationUpdate
$sel:amazonOpenSearchServerlessDestinationUpdate:UpdateDestination' :: UpdateDestination
-> Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate} -> Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe AmazonOpenSearchServerlessDestinationUpdate
a -> UpdateDestination
s {$sel:amazonOpenSearchServerlessDestinationUpdate:UpdateDestination' :: Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate = Maybe AmazonOpenSearchServerlessDestinationUpdate
a} :: UpdateDestination)

-- | Describes an update for a destination in Amazon OpenSearch Service.
updateDestination_amazonopensearchserviceDestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe AmazonopensearchserviceDestinationUpdate)
updateDestination_amazonopensearchserviceDestinationUpdate :: Lens'
  UpdateDestination (Maybe AmazonopensearchserviceDestinationUpdate)
updateDestination_amazonopensearchserviceDestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate :: Maybe AmazonopensearchserviceDestinationUpdate
$sel:amazonopensearchserviceDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate} -> Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe AmazonopensearchserviceDestinationUpdate
a -> UpdateDestination
s {$sel:amazonopensearchserviceDestinationUpdate:UpdateDestination' :: Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate = Maybe AmazonopensearchserviceDestinationUpdate
a} :: UpdateDestination)

-- | Describes an update for a destination in Amazon ES.
updateDestination_elasticsearchDestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe ElasticsearchDestinationUpdate)
updateDestination_elasticsearchDestinationUpdate :: Lens' UpdateDestination (Maybe ElasticsearchDestinationUpdate)
updateDestination_elasticsearchDestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate :: Maybe ElasticsearchDestinationUpdate
$sel:elasticsearchDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate} -> Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe ElasticsearchDestinationUpdate
a -> UpdateDestination
s {$sel:elasticsearchDestinationUpdate:UpdateDestination' :: Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate = Maybe ElasticsearchDestinationUpdate
a} :: UpdateDestination)

-- | Describes an update for a destination in Amazon S3.
updateDestination_extendedS3DestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe ExtendedS3DestinationUpdate)
updateDestination_extendedS3DestinationUpdate :: Lens' UpdateDestination (Maybe ExtendedS3DestinationUpdate)
updateDestination_extendedS3DestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate :: Maybe ExtendedS3DestinationUpdate
$sel:extendedS3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate} -> Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe ExtendedS3DestinationUpdate
a -> UpdateDestination
s {$sel:extendedS3DestinationUpdate:UpdateDestination' :: Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate = Maybe ExtendedS3DestinationUpdate
a} :: UpdateDestination)

-- | Describes an update to the specified HTTP endpoint destination.
updateDestination_httpEndpointDestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe HttpEndpointDestinationUpdate)
updateDestination_httpEndpointDestinationUpdate :: Lens' UpdateDestination (Maybe HttpEndpointDestinationUpdate)
updateDestination_httpEndpointDestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate :: Maybe HttpEndpointDestinationUpdate
$sel:httpEndpointDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate} -> Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe HttpEndpointDestinationUpdate
a -> UpdateDestination
s {$sel:httpEndpointDestinationUpdate:UpdateDestination' :: Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate = Maybe HttpEndpointDestinationUpdate
a} :: UpdateDestination)

-- | Describes an update for a destination in Amazon Redshift.
updateDestination_redshiftDestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe RedshiftDestinationUpdate)
updateDestination_redshiftDestinationUpdate :: Lens' UpdateDestination (Maybe RedshiftDestinationUpdate)
updateDestination_redshiftDestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate :: Maybe RedshiftDestinationUpdate
$sel:redshiftDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate} -> Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe RedshiftDestinationUpdate
a -> UpdateDestination
s {$sel:redshiftDestinationUpdate:UpdateDestination' :: Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate = Maybe RedshiftDestinationUpdate
a} :: UpdateDestination)

-- | [Deprecated] Describes an update for a destination in Amazon S3.
updateDestination_s3DestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe S3DestinationUpdate)
updateDestination_s3DestinationUpdate :: Lens' UpdateDestination (Maybe S3DestinationUpdate)
updateDestination_s3DestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe S3DestinationUpdate
s3DestinationUpdate :: Maybe S3DestinationUpdate
$sel:s3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe S3DestinationUpdate
s3DestinationUpdate} -> Maybe S3DestinationUpdate
s3DestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe S3DestinationUpdate
a -> UpdateDestination
s {$sel:s3DestinationUpdate:UpdateDestination' :: Maybe S3DestinationUpdate
s3DestinationUpdate = Maybe S3DestinationUpdate
a} :: UpdateDestination)

-- | Describes an update for a destination in Splunk.
updateDestination_splunkDestinationUpdate :: Lens.Lens' UpdateDestination (Prelude.Maybe SplunkDestinationUpdate)
updateDestination_splunkDestinationUpdate :: Lens' UpdateDestination (Maybe SplunkDestinationUpdate)
updateDestination_splunkDestinationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe SplunkDestinationUpdate
splunkDestinationUpdate :: Maybe SplunkDestinationUpdate
$sel:splunkDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe SplunkDestinationUpdate
splunkDestinationUpdate} -> Maybe SplunkDestinationUpdate
splunkDestinationUpdate) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe SplunkDestinationUpdate
a -> UpdateDestination
s {$sel:splunkDestinationUpdate:UpdateDestination' :: Maybe SplunkDestinationUpdate
splunkDestinationUpdate = Maybe SplunkDestinationUpdate
a} :: UpdateDestination)

-- | The name of the delivery stream.
updateDestination_deliveryStreamName :: Lens.Lens' UpdateDestination Prelude.Text
updateDestination_deliveryStreamName :: Lens' UpdateDestination Text
updateDestination_deliveryStreamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Text
deliveryStreamName :: Text
$sel:deliveryStreamName:UpdateDestination' :: UpdateDestination -> Text
deliveryStreamName} -> Text
deliveryStreamName) (\s :: UpdateDestination
s@UpdateDestination' {} Text
a -> UpdateDestination
s {$sel:deliveryStreamName:UpdateDestination' :: Text
deliveryStreamName = Text
a} :: UpdateDestination)

-- | Obtain this value from the @VersionId@ result of
-- DeliveryStreamDescription. This value is required, and helps the service
-- perform conditional operations. For example, if there is an interleaving
-- update and this value is null, then the update destination fails. After
-- the update is successful, the @VersionId@ value is updated. The service
-- then performs a merge of the old configuration with the new
-- configuration.
updateDestination_currentDeliveryStreamVersionId :: Lens.Lens' UpdateDestination Prelude.Text
updateDestination_currentDeliveryStreamVersionId :: Lens' UpdateDestination Text
updateDestination_currentDeliveryStreamVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Text
currentDeliveryStreamVersionId :: Text
$sel:currentDeliveryStreamVersionId:UpdateDestination' :: UpdateDestination -> Text
currentDeliveryStreamVersionId} -> Text
currentDeliveryStreamVersionId) (\s :: UpdateDestination
s@UpdateDestination' {} Text
a -> UpdateDestination
s {$sel:currentDeliveryStreamVersionId:UpdateDestination' :: Text
currentDeliveryStreamVersionId = Text
a} :: UpdateDestination)

-- | The ID of the destination.
updateDestination_destinationId :: Lens.Lens' UpdateDestination Prelude.Text
updateDestination_destinationId :: Lens' UpdateDestination Text
updateDestination_destinationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Text
destinationId :: Text
$sel:destinationId:UpdateDestination' :: UpdateDestination -> Text
destinationId} -> Text
destinationId) (\s :: UpdateDestination
s@UpdateDestination' {} Text
a -> UpdateDestination
s {$sel:destinationId:UpdateDestination' :: Text
destinationId = Text
a} :: UpdateDestination)

instance Core.AWSRequest UpdateDestination where
  type
    AWSResponse UpdateDestination =
      UpdateDestinationResponse
  request :: (Service -> Service)
-> UpdateDestination -> Request UpdateDestination
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDestination)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateDestinationResponse
UpdateDestinationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateDestination where
  hashWithSalt :: Int -> UpdateDestination -> Int
hashWithSalt Int
_salt UpdateDestination' {Maybe S3DestinationUpdate
Maybe RedshiftDestinationUpdate
Maybe HttpEndpointDestinationUpdate
Maybe ElasticsearchDestinationUpdate
Maybe AmazonopensearchserviceDestinationUpdate
Maybe AmazonOpenSearchServerlessDestinationUpdate
Maybe ExtendedS3DestinationUpdate
Maybe SplunkDestinationUpdate
Text
destinationId :: Text
currentDeliveryStreamVersionId :: Text
deliveryStreamName :: Text
splunkDestinationUpdate :: Maybe SplunkDestinationUpdate
s3DestinationUpdate :: Maybe S3DestinationUpdate
redshiftDestinationUpdate :: Maybe RedshiftDestinationUpdate
httpEndpointDestinationUpdate :: Maybe HttpEndpointDestinationUpdate
extendedS3DestinationUpdate :: Maybe ExtendedS3DestinationUpdate
elasticsearchDestinationUpdate :: Maybe ElasticsearchDestinationUpdate
amazonopensearchserviceDestinationUpdate :: Maybe AmazonopensearchserviceDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate :: Maybe AmazonOpenSearchServerlessDestinationUpdate
$sel:destinationId:UpdateDestination' :: UpdateDestination -> Text
$sel:currentDeliveryStreamVersionId:UpdateDestination' :: UpdateDestination -> Text
$sel:deliveryStreamName:UpdateDestination' :: UpdateDestination -> Text
$sel:splunkDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe SplunkDestinationUpdate
$sel:s3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe S3DestinationUpdate
$sel:redshiftDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe RedshiftDestinationUpdate
$sel:httpEndpointDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe HttpEndpointDestinationUpdate
$sel:extendedS3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ExtendedS3DestinationUpdate
$sel:elasticsearchDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ElasticsearchDestinationUpdate
$sel:amazonopensearchserviceDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe AmazonopensearchserviceDestinationUpdate
$sel:amazonOpenSearchServerlessDestinationUpdate:UpdateDestination' :: UpdateDestination
-> Maybe AmazonOpenSearchServerlessDestinationUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3DestinationUpdate
s3DestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SplunkDestinationUpdate
splunkDestinationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deliveryStreamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
currentDeliveryStreamVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationId

instance Prelude.NFData UpdateDestination where
  rnf :: UpdateDestination -> ()
rnf UpdateDestination' {Maybe S3DestinationUpdate
Maybe RedshiftDestinationUpdate
Maybe HttpEndpointDestinationUpdate
Maybe ElasticsearchDestinationUpdate
Maybe AmazonopensearchserviceDestinationUpdate
Maybe AmazonOpenSearchServerlessDestinationUpdate
Maybe ExtendedS3DestinationUpdate
Maybe SplunkDestinationUpdate
Text
destinationId :: Text
currentDeliveryStreamVersionId :: Text
deliveryStreamName :: Text
splunkDestinationUpdate :: Maybe SplunkDestinationUpdate
s3DestinationUpdate :: Maybe S3DestinationUpdate
redshiftDestinationUpdate :: Maybe RedshiftDestinationUpdate
httpEndpointDestinationUpdate :: Maybe HttpEndpointDestinationUpdate
extendedS3DestinationUpdate :: Maybe ExtendedS3DestinationUpdate
elasticsearchDestinationUpdate :: Maybe ElasticsearchDestinationUpdate
amazonopensearchserviceDestinationUpdate :: Maybe AmazonopensearchserviceDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate :: Maybe AmazonOpenSearchServerlessDestinationUpdate
$sel:destinationId:UpdateDestination' :: UpdateDestination -> Text
$sel:currentDeliveryStreamVersionId:UpdateDestination' :: UpdateDestination -> Text
$sel:deliveryStreamName:UpdateDestination' :: UpdateDestination -> Text
$sel:splunkDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe SplunkDestinationUpdate
$sel:s3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe S3DestinationUpdate
$sel:redshiftDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe RedshiftDestinationUpdate
$sel:httpEndpointDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe HttpEndpointDestinationUpdate
$sel:extendedS3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ExtendedS3DestinationUpdate
$sel:elasticsearchDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ElasticsearchDestinationUpdate
$sel:amazonopensearchserviceDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe AmazonopensearchserviceDestinationUpdate
$sel:amazonOpenSearchServerlessDestinationUpdate:UpdateDestination' :: UpdateDestination
-> Maybe AmazonOpenSearchServerlessDestinationUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf
      Maybe AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExtendedS3DestinationUpdate
extendedS3DestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RedshiftDestinationUpdate
redshiftDestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3DestinationUpdate
s3DestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SplunkDestinationUpdate
splunkDestinationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deliveryStreamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
currentDeliveryStreamVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationId

instance Data.ToHeaders UpdateDestination where
  toHeaders :: UpdateDestination -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Firehose_20150804.UpdateDestination" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateDestination where
  toJSON :: UpdateDestination -> Value
toJSON UpdateDestination' {Maybe S3DestinationUpdate
Maybe RedshiftDestinationUpdate
Maybe HttpEndpointDestinationUpdate
Maybe ElasticsearchDestinationUpdate
Maybe AmazonopensearchserviceDestinationUpdate
Maybe AmazonOpenSearchServerlessDestinationUpdate
Maybe ExtendedS3DestinationUpdate
Maybe SplunkDestinationUpdate
Text
destinationId :: Text
currentDeliveryStreamVersionId :: Text
deliveryStreamName :: Text
splunkDestinationUpdate :: Maybe SplunkDestinationUpdate
s3DestinationUpdate :: Maybe S3DestinationUpdate
redshiftDestinationUpdate :: Maybe RedshiftDestinationUpdate
httpEndpointDestinationUpdate :: Maybe HttpEndpointDestinationUpdate
extendedS3DestinationUpdate :: Maybe ExtendedS3DestinationUpdate
elasticsearchDestinationUpdate :: Maybe ElasticsearchDestinationUpdate
amazonopensearchserviceDestinationUpdate :: Maybe AmazonopensearchserviceDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate :: Maybe AmazonOpenSearchServerlessDestinationUpdate
$sel:destinationId:UpdateDestination' :: UpdateDestination -> Text
$sel:currentDeliveryStreamVersionId:UpdateDestination' :: UpdateDestination -> Text
$sel:deliveryStreamName:UpdateDestination' :: UpdateDestination -> Text
$sel:splunkDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe SplunkDestinationUpdate
$sel:s3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe S3DestinationUpdate
$sel:redshiftDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe RedshiftDestinationUpdate
$sel:httpEndpointDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe HttpEndpointDestinationUpdate
$sel:extendedS3DestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ExtendedS3DestinationUpdate
$sel:elasticsearchDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe ElasticsearchDestinationUpdate
$sel:amazonopensearchserviceDestinationUpdate:UpdateDestination' :: UpdateDestination -> Maybe AmazonopensearchserviceDestinationUpdate
$sel:amazonOpenSearchServerlessDestinationUpdate:UpdateDestination' :: UpdateDestination
-> Maybe AmazonOpenSearchServerlessDestinationUpdate
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ ( Key
"AmazonOpenSearchServerlessDestinationUpdate"
                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 AmazonOpenSearchServerlessDestinationUpdate
amazonOpenSearchServerlessDestinationUpdate,
            (Key
"AmazonopensearchserviceDestinationUpdate" 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 AmazonopensearchserviceDestinationUpdate
amazonopensearchserviceDestinationUpdate,
            (Key
"ElasticsearchDestinationUpdate" 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 ElasticsearchDestinationUpdate
elasticsearchDestinationUpdate,
            (Key
"ExtendedS3DestinationUpdate" 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 ExtendedS3DestinationUpdate
extendedS3DestinationUpdate,
            (Key
"HttpEndpointDestinationUpdate" 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 HttpEndpointDestinationUpdate
httpEndpointDestinationUpdate,
            (Key
"RedshiftDestinationUpdate" 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 RedshiftDestinationUpdate
redshiftDestinationUpdate,
            (Key
"S3DestinationUpdate" 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
s3DestinationUpdate,
            (Key
"SplunkDestinationUpdate" 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 SplunkDestinationUpdate
splunkDestinationUpdate,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DeliveryStreamName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deliveryStreamName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"CurrentDeliveryStreamVersionId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
currentDeliveryStreamVersionId
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DestinationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationId)
          ]
      )

instance Data.ToPath UpdateDestination where
  toPath :: UpdateDestination -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery UpdateDestination where
  toQuery :: UpdateDestination -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateDestinationResponse' smart constructor.
data UpdateDestinationResponse = UpdateDestinationResponse'
  { -- | The response's http status code.
    UpdateDestinationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDestinationResponse -> UpdateDestinationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDestinationResponse -> UpdateDestinationResponse -> Bool
$c/= :: UpdateDestinationResponse -> UpdateDestinationResponse -> Bool
== :: UpdateDestinationResponse -> UpdateDestinationResponse -> Bool
$c== :: UpdateDestinationResponse -> UpdateDestinationResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDestinationResponse]
ReadPrec UpdateDestinationResponse
Int -> ReadS UpdateDestinationResponse
ReadS [UpdateDestinationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDestinationResponse]
$creadListPrec :: ReadPrec [UpdateDestinationResponse]
readPrec :: ReadPrec UpdateDestinationResponse
$creadPrec :: ReadPrec UpdateDestinationResponse
readList :: ReadS [UpdateDestinationResponse]
$creadList :: ReadS [UpdateDestinationResponse]
readsPrec :: Int -> ReadS UpdateDestinationResponse
$creadsPrec :: Int -> ReadS UpdateDestinationResponse
Prelude.Read, Int -> UpdateDestinationResponse -> ShowS
[UpdateDestinationResponse] -> ShowS
UpdateDestinationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDestinationResponse] -> ShowS
$cshowList :: [UpdateDestinationResponse] -> ShowS
show :: UpdateDestinationResponse -> String
$cshow :: UpdateDestinationResponse -> String
showsPrec :: Int -> UpdateDestinationResponse -> ShowS
$cshowsPrec :: Int -> UpdateDestinationResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateDestinationResponse x -> UpdateDestinationResponse
forall x.
UpdateDestinationResponse -> Rep UpdateDestinationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDestinationResponse x -> UpdateDestinationResponse
$cfrom :: forall x.
UpdateDestinationResponse -> Rep UpdateDestinationResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDestinationResponse' 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:
--
-- 'httpStatus', 'updateDestinationResponse_httpStatus' - The response's http status code.
newUpdateDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDestinationResponse
newUpdateDestinationResponse :: Int -> UpdateDestinationResponse
newUpdateDestinationResponse Int
pHttpStatus_ =
  UpdateDestinationResponse'
    { $sel:httpStatus:UpdateDestinationResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | The response's http status code.
updateDestinationResponse_httpStatus :: Lens.Lens' UpdateDestinationResponse Prelude.Int
updateDestinationResponse_httpStatus :: Lens' UpdateDestinationResponse Int
updateDestinationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestinationResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateDestinationResponse' :: UpdateDestinationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateDestinationResponse
s@UpdateDestinationResponse' {} Int
a -> UpdateDestinationResponse
s {$sel:httpStatus:UpdateDestinationResponse' :: Int
httpStatus = Int
a} :: UpdateDestinationResponse)

instance Prelude.NFData UpdateDestinationResponse where
  rnf :: UpdateDestinationResponse -> ()
rnf UpdateDestinationResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateDestinationResponse' :: UpdateDestinationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus