{-# 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.S3.PutBucketNotificationConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables notifications of specified events for a bucket. For more
-- information about event notifications, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html Configuring Event Notifications>.
--
-- Using this API, you can replace an existing notification configuration.
-- The configuration is an XML file that defines the event types that you
-- want Amazon S3 to publish and the destination where you want Amazon S3
-- to publish an event notification when it detects an event of the
-- specified type.
--
-- By default, your bucket has no event notifications configured. That is,
-- the notification configuration will be an empty
-- @NotificationConfiguration@.
--
-- @\<NotificationConfiguration>@
--
-- @\<\/NotificationConfiguration>@
--
-- This action replaces the existing notification configuration with the
-- configuration you include in the request body.
--
-- After Amazon S3 receives this request, it first verifies that any Amazon
-- Simple Notification Service (Amazon SNS) or Amazon Simple Queue Service
-- (Amazon SQS) destination exists, and that the bucket owner has
-- permission to publish to it by sending a test notification. In the case
-- of Lambda destinations, Amazon S3 verifies that the Lambda function
-- permissions grant Amazon S3 permission to invoke the function from the
-- Amazon S3 bucket. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html Configuring Notifications for Amazon S3 Events>.
--
-- You can disable notifications by adding the empty
-- NotificationConfiguration element.
--
-- For more information about the number of event notification
-- configurations that you can create per bucket, see
-- <https://docs.aws.amazon.com/general/latest/gr/s3.html#limits_s3 Amazon S3 service quotas>
-- in /Amazon Web Services General Reference/.
--
-- By default, only the bucket owner can configure notifications on a
-- bucket. However, bucket owners can use a bucket policy to grant
-- permission to other users to set this configuration with
-- @s3:PutBucketNotification@ permission.
--
-- The PUT notification is an atomic operation. For example, suppose your
-- notification configuration includes SNS topic, SQS queue, and Lambda
-- function configurations. When you send a PUT request with this
-- configuration, Amazon S3 sends test messages to your SNS topic. If the
-- message fails, the entire PUT action will fail, and Amazon S3 will not
-- add the configuration to your bucket.
--
-- __Responses__
--
-- If the configuration in the request body includes only one
-- @TopicConfiguration@ specifying only the
-- @s3:ReducedRedundancyLostObject@ event type, the response will also
-- include the @x-amz-sns-test-message-id@ header containing the message ID
-- of the test notification sent to the topic.
--
-- The following action is related to @PutBucketNotificationConfiguration@:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetBucketNotificationConfiguration.html GetBucketNotificationConfiguration>
module Amazonka.S3.PutBucketNotificationConfiguration
  ( -- * Creating a Request
    PutBucketNotificationConfiguration (..),
    newPutBucketNotificationConfiguration,

    -- * Request Lenses
    putBucketNotificationConfiguration_expectedBucketOwner,
    putBucketNotificationConfiguration_skipDestinationValidation,
    putBucketNotificationConfiguration_bucket,
    putBucketNotificationConfiguration_notificationConfiguration,

    -- * Destructuring the Response
    PutBucketNotificationConfigurationResponse (..),
    newPutBucketNotificationConfigurationResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.S3.Types

-- | /See:/ 'newPutBucketNotificationConfiguration' smart constructor.
data PutBucketNotificationConfiguration = PutBucketNotificationConfiguration'
  { -- | The account ID of the expected bucket owner. If the bucket is owned by a
    -- different account, the request fails with the HTTP status code
    -- @403 Forbidden@ (access denied).
    PutBucketNotificationConfiguration -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | Skips validation of Amazon SQS, Amazon SNS, and Lambda destinations.
    -- True or false value.
    PutBucketNotificationConfiguration -> Maybe Bool
skipDestinationValidation :: Prelude.Maybe Prelude.Bool,
    -- | The name of the bucket.
    PutBucketNotificationConfiguration -> BucketName
bucket :: BucketName,
    PutBucketNotificationConfiguration -> NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
  }
  deriving (PutBucketNotificationConfiguration
-> PutBucketNotificationConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutBucketNotificationConfiguration
-> PutBucketNotificationConfiguration -> Bool
$c/= :: PutBucketNotificationConfiguration
-> PutBucketNotificationConfiguration -> Bool
== :: PutBucketNotificationConfiguration
-> PutBucketNotificationConfiguration -> Bool
$c== :: PutBucketNotificationConfiguration
-> PutBucketNotificationConfiguration -> Bool
Prelude.Eq, ReadPrec [PutBucketNotificationConfiguration]
ReadPrec PutBucketNotificationConfiguration
Int -> ReadS PutBucketNotificationConfiguration
ReadS [PutBucketNotificationConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutBucketNotificationConfiguration]
$creadListPrec :: ReadPrec [PutBucketNotificationConfiguration]
readPrec :: ReadPrec PutBucketNotificationConfiguration
$creadPrec :: ReadPrec PutBucketNotificationConfiguration
readList :: ReadS [PutBucketNotificationConfiguration]
$creadList :: ReadS [PutBucketNotificationConfiguration]
readsPrec :: Int -> ReadS PutBucketNotificationConfiguration
$creadsPrec :: Int -> ReadS PutBucketNotificationConfiguration
Prelude.Read, Int -> PutBucketNotificationConfiguration -> ShowS
[PutBucketNotificationConfiguration] -> ShowS
PutBucketNotificationConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutBucketNotificationConfiguration] -> ShowS
$cshowList :: [PutBucketNotificationConfiguration] -> ShowS
show :: PutBucketNotificationConfiguration -> String
$cshow :: PutBucketNotificationConfiguration -> String
showsPrec :: Int -> PutBucketNotificationConfiguration -> ShowS
$cshowsPrec :: Int -> PutBucketNotificationConfiguration -> ShowS
Prelude.Show, forall x.
Rep PutBucketNotificationConfiguration x
-> PutBucketNotificationConfiguration
forall x.
PutBucketNotificationConfiguration
-> Rep PutBucketNotificationConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutBucketNotificationConfiguration x
-> PutBucketNotificationConfiguration
$cfrom :: forall x.
PutBucketNotificationConfiguration
-> Rep PutBucketNotificationConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PutBucketNotificationConfiguration' 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:
--
-- 'expectedBucketOwner', 'putBucketNotificationConfiguration_expectedBucketOwner' - The account ID of the expected bucket owner. If the bucket is owned by a
-- different account, the request fails with the HTTP status code
-- @403 Forbidden@ (access denied).
--
-- 'skipDestinationValidation', 'putBucketNotificationConfiguration_skipDestinationValidation' - Skips validation of Amazon SQS, Amazon SNS, and Lambda destinations.
-- True or false value.
--
-- 'bucket', 'putBucketNotificationConfiguration_bucket' - The name of the bucket.
--
-- 'notificationConfiguration', 'putBucketNotificationConfiguration_notificationConfiguration' - Undocumented member.
newPutBucketNotificationConfiguration ::
  -- | 'bucket'
  BucketName ->
  -- | 'notificationConfiguration'
  NotificationConfiguration ->
  PutBucketNotificationConfiguration
newPutBucketNotificationConfiguration :: BucketName
-> NotificationConfiguration -> PutBucketNotificationConfiguration
newPutBucketNotificationConfiguration
  BucketName
pBucket_
  NotificationConfiguration
pNotificationConfiguration_ =
    PutBucketNotificationConfiguration'
      { $sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: Maybe Text
expectedBucketOwner =
          forall a. Maybe a
Prelude.Nothing,
        $sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: Maybe Bool
skipDestinationValidation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:bucket:PutBucketNotificationConfiguration' :: BucketName
bucket = BucketName
pBucket_,
        $sel:notificationConfiguration:PutBucketNotificationConfiguration' :: NotificationConfiguration
notificationConfiguration =
          NotificationConfiguration
pNotificationConfiguration_
      }

-- | The account ID of the expected bucket owner. If the bucket is owned by a
-- different account, the request fails with the HTTP status code
-- @403 Forbidden@ (access denied).
putBucketNotificationConfiguration_expectedBucketOwner :: Lens.Lens' PutBucketNotificationConfiguration (Prelude.Maybe Prelude.Text)
putBucketNotificationConfiguration_expectedBucketOwner :: Lens' PutBucketNotificationConfiguration (Maybe Text)
putBucketNotificationConfiguration_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketNotificationConfiguration' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: PutBucketNotificationConfiguration
s@PutBucketNotificationConfiguration' {} Maybe Text
a -> PutBucketNotificationConfiguration
s {$sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: PutBucketNotificationConfiguration)

-- | Skips validation of Amazon SQS, Amazon SNS, and Lambda destinations.
-- True or false value.
putBucketNotificationConfiguration_skipDestinationValidation :: Lens.Lens' PutBucketNotificationConfiguration (Prelude.Maybe Prelude.Bool)
putBucketNotificationConfiguration_skipDestinationValidation :: Lens' PutBucketNotificationConfiguration (Maybe Bool)
putBucketNotificationConfiguration_skipDestinationValidation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketNotificationConfiguration' {Maybe Bool
skipDestinationValidation :: Maybe Bool
$sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Bool
skipDestinationValidation} -> Maybe Bool
skipDestinationValidation) (\s :: PutBucketNotificationConfiguration
s@PutBucketNotificationConfiguration' {} Maybe Bool
a -> PutBucketNotificationConfiguration
s {$sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: Maybe Bool
skipDestinationValidation = Maybe Bool
a} :: PutBucketNotificationConfiguration)

-- | The name of the bucket.
putBucketNotificationConfiguration_bucket :: Lens.Lens' PutBucketNotificationConfiguration BucketName
putBucketNotificationConfiguration_bucket :: Lens' PutBucketNotificationConfiguration BucketName
putBucketNotificationConfiguration_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketNotificationConfiguration' {BucketName
bucket :: BucketName
$sel:bucket:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> BucketName
bucket} -> BucketName
bucket) (\s :: PutBucketNotificationConfiguration
s@PutBucketNotificationConfiguration' {} BucketName
a -> PutBucketNotificationConfiguration
s {$sel:bucket:PutBucketNotificationConfiguration' :: BucketName
bucket = BucketName
a} :: PutBucketNotificationConfiguration)

-- | Undocumented member.
putBucketNotificationConfiguration_notificationConfiguration :: Lens.Lens' PutBucketNotificationConfiguration NotificationConfiguration
putBucketNotificationConfiguration_notificationConfiguration :: Lens' PutBucketNotificationConfiguration NotificationConfiguration
putBucketNotificationConfiguration_notificationConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketNotificationConfiguration' {NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
$sel:notificationConfiguration:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> NotificationConfiguration
notificationConfiguration} -> NotificationConfiguration
notificationConfiguration) (\s :: PutBucketNotificationConfiguration
s@PutBucketNotificationConfiguration' {} NotificationConfiguration
a -> PutBucketNotificationConfiguration
s {$sel:notificationConfiguration:PutBucketNotificationConfiguration' :: NotificationConfiguration
notificationConfiguration = NotificationConfiguration
a} :: PutBucketNotificationConfiguration)

instance
  Core.AWSRequest
    PutBucketNotificationConfiguration
  where
  type
    AWSResponse PutBucketNotificationConfiguration =
      PutBucketNotificationConfigurationResponse
  request :: (Service -> Service)
-> PutBucketNotificationConfiguration
-> Request PutBucketNotificationConfiguration
request Service -> Service
overrides =
    forall a. Request a -> Request a
Request.s3vhost
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.putXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutBucketNotificationConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse PutBucketNotificationConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      PutBucketNotificationConfigurationResponse
PutBucketNotificationConfigurationResponse'

instance
  Prelude.Hashable
    PutBucketNotificationConfiguration
  where
  hashWithSalt :: Int -> PutBucketNotificationConfiguration -> Int
hashWithSalt
    Int
_salt
    PutBucketNotificationConfiguration' {Maybe Bool
Maybe Text
BucketName
NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
bucket :: BucketName
skipDestinationValidation :: Maybe Bool
expectedBucketOwner :: Maybe Text
$sel:notificationConfiguration:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> NotificationConfiguration
$sel:bucket:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> BucketName
$sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Bool
$sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedBucketOwner
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
skipDestinationValidation
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NotificationConfiguration
notificationConfiguration

instance
  Prelude.NFData
    PutBucketNotificationConfiguration
  where
  rnf :: PutBucketNotificationConfiguration -> ()
rnf PutBucketNotificationConfiguration' {Maybe Bool
Maybe Text
BucketName
NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
bucket :: BucketName
skipDestinationValidation :: Maybe Bool
expectedBucketOwner :: Maybe Text
$sel:notificationConfiguration:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> NotificationConfiguration
$sel:bucket:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> BucketName
$sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Bool
$sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expectedBucketOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
skipDestinationValidation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketName
bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NotificationConfiguration
notificationConfiguration

instance
  Data.ToElement
    PutBucketNotificationConfiguration
  where
  toElement :: PutBucketNotificationConfiguration -> Element
toElement PutBucketNotificationConfiguration' {Maybe Bool
Maybe Text
BucketName
NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
bucket :: BucketName
skipDestinationValidation :: Maybe Bool
expectedBucketOwner :: Maybe Text
$sel:notificationConfiguration:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> NotificationConfiguration
$sel:bucket:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> BucketName
$sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Bool
$sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Text
..} =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://s3.amazonaws.com/doc/2006-03-01/}NotificationConfiguration"
      NotificationConfiguration
notificationConfiguration

instance
  Data.ToHeaders
    PutBucketNotificationConfiguration
  where
  toHeaders :: PutBucketNotificationConfiguration -> [Header]
toHeaders PutBucketNotificationConfiguration' {Maybe Bool
Maybe Text
BucketName
NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
bucket :: BucketName
skipDestinationValidation :: Maybe Bool
expectedBucketOwner :: Maybe Text
$sel:notificationConfiguration:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> NotificationConfiguration
$sel:bucket:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> BucketName
$sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Bool
$sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
expectedBucketOwner,
        HeaderName
"x-amz-skip-destination-validation"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Bool
skipDestinationValidation
      ]

instance
  Data.ToPath
    PutBucketNotificationConfiguration
  where
  toPath :: PutBucketNotificationConfiguration -> ByteString
toPath PutBucketNotificationConfiguration' {Maybe Bool
Maybe Text
BucketName
NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
bucket :: BucketName
skipDestinationValidation :: Maybe Bool
expectedBucketOwner :: Maybe Text
$sel:notificationConfiguration:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> NotificationConfiguration
$sel:bucket:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> BucketName
$sel:skipDestinationValidation:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Bool
$sel:expectedBucketOwner:PutBucketNotificationConfiguration' :: PutBucketNotificationConfiguration -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS BucketName
bucket]

instance
  Data.ToQuery
    PutBucketNotificationConfiguration
  where
  toQuery :: PutBucketNotificationConfiguration -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const (forall a. Monoid a => [a] -> a
Prelude.mconcat [QueryString
"notification"])

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

-- |
-- Create a value of 'PutBucketNotificationConfigurationResponse' 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.
newPutBucketNotificationConfigurationResponse ::
  PutBucketNotificationConfigurationResponse
newPutBucketNotificationConfigurationResponse :: PutBucketNotificationConfigurationResponse
newPutBucketNotificationConfigurationResponse =
  PutBucketNotificationConfigurationResponse
PutBucketNotificationConfigurationResponse'

instance
  Prelude.NFData
    PutBucketNotificationConfigurationResponse
  where
  rnf :: PutBucketNotificationConfigurationResponse -> ()
rnf PutBucketNotificationConfigurationResponse
_ = ()