{-# 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.SNS.SetTopicAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allows a topic owner to set an attribute of the topic to a new value.
--
-- To remove the ability to change topic permissions, you must deny
-- permissions to the @AddPermission@, @RemovePermission@, and
-- @SetTopicAttributes@ actions in your IAM policy.
module Amazonka.SNS.SetTopicAttributes
  ( -- * Creating a Request
    SetTopicAttributes (..),
    newSetTopicAttributes,

    -- * Request Lenses
    setTopicAttributes_attributeValue,
    setTopicAttributes_topicArn,
    setTopicAttributes_attributeName,

    -- * Destructuring the Response
    SetTopicAttributesResponse (..),
    newSetTopicAttributesResponse,
  )
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.SNS.Types

-- | Input for SetTopicAttributes action.
--
-- /See:/ 'newSetTopicAttributes' smart constructor.
data SetTopicAttributes = SetTopicAttributes'
  { -- | The new value for the attribute.
    SetTopicAttributes -> Maybe Text
attributeValue :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the topic to modify.
    SetTopicAttributes -> Text
topicArn :: Prelude.Text,
    -- | A map of attributes with their corresponding values.
    --
    -- The following lists the names, descriptions, and values of the special
    -- request parameters that the @SetTopicAttributes@ action uses:
    --
    -- -   @DeliveryPolicy@ – The policy that defines how Amazon SNS retries
    --     failed deliveries to HTTP\/S endpoints.
    --
    -- -   @DisplayName@ – The display name to use for a topic with SMS
    --     subscriptions.
    --
    -- -   @Policy@ – The policy that defines who can access your topic. By
    --     default, only the topic owner can publish or subscribe to the topic.
    --
    -- -   @TracingConfig@ – Tracing mode of an Amazon SNS topic. By default
    --     @TracingConfig@ is set to @PassThrough@, and the topic passes
    --     through the tracing header it receives from an Amazon SNS publisher
    --     to its subscriptions. If set to Active, Amazon SNS will vend X-Ray
    --     segment data to topic owner account if the sampled flag in the
    --     tracing header is true. This is only supported on standard topics.
    --
    -- The following attribute applies only to
    -- <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html server-side-encryption>:
    --
    -- -   @KmsMasterKeyId@ – The ID of an Amazon Web Services managed customer
    --     master key (CMK) for Amazon SNS or a custom CMK. For more
    --     information, see
    --     <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html#sse-key-terms Key Terms>.
    --     For more examples, see
    --     <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters KeyId>
    --     in the /Key Management Service API Reference/.
    --
    -- -   @SignatureVersion@ – The signature version corresponds to the
    --     hashing algorithm used while creating the signature of the
    --     notifications, subscription confirmations, or unsubscribe
    --     confirmation messages sent by Amazon SNS.
    --
    -- The following attribute applies only to
    -- <https://docs.aws.amazon.com/sns/latest/dg/sns-fifo-topics.html FIFO topics>:
    --
    -- -   @ContentBasedDeduplication@ – Enables content-based deduplication
    --     for FIFO topics.
    --
    --     -   By default, @ContentBasedDeduplication@ is set to @false@. If
    --         you create a FIFO topic and this attribute is @false@, you must
    --         specify a value for the @MessageDeduplicationId@ parameter for
    --         the
    --         <https://docs.aws.amazon.com/sns/latest/api/API_Publish.html Publish>
    --         action.
    --
    --     -   When you set @ContentBasedDeduplication@ to @true@, Amazon SNS
    --         uses a SHA-256 hash to generate the @MessageDeduplicationId@
    --         using the body of the message (but not the attributes of the
    --         message).
    --
    --         (Optional) To override the generated value, you can specify a
    --         value for the @MessageDeduplicationId@ parameter for the
    --         @Publish@ action.
    SetTopicAttributes -> Text
attributeName :: Prelude.Text
  }
  deriving (SetTopicAttributes -> SetTopicAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetTopicAttributes -> SetTopicAttributes -> Bool
$c/= :: SetTopicAttributes -> SetTopicAttributes -> Bool
== :: SetTopicAttributes -> SetTopicAttributes -> Bool
$c== :: SetTopicAttributes -> SetTopicAttributes -> Bool
Prelude.Eq, ReadPrec [SetTopicAttributes]
ReadPrec SetTopicAttributes
Int -> ReadS SetTopicAttributes
ReadS [SetTopicAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetTopicAttributes]
$creadListPrec :: ReadPrec [SetTopicAttributes]
readPrec :: ReadPrec SetTopicAttributes
$creadPrec :: ReadPrec SetTopicAttributes
readList :: ReadS [SetTopicAttributes]
$creadList :: ReadS [SetTopicAttributes]
readsPrec :: Int -> ReadS SetTopicAttributes
$creadsPrec :: Int -> ReadS SetTopicAttributes
Prelude.Read, Int -> SetTopicAttributes -> ShowS
[SetTopicAttributes] -> ShowS
SetTopicAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetTopicAttributes] -> ShowS
$cshowList :: [SetTopicAttributes] -> ShowS
show :: SetTopicAttributes -> String
$cshow :: SetTopicAttributes -> String
showsPrec :: Int -> SetTopicAttributes -> ShowS
$cshowsPrec :: Int -> SetTopicAttributes -> ShowS
Prelude.Show, forall x. Rep SetTopicAttributes x -> SetTopicAttributes
forall x. SetTopicAttributes -> Rep SetTopicAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetTopicAttributes x -> SetTopicAttributes
$cfrom :: forall x. SetTopicAttributes -> Rep SetTopicAttributes x
Prelude.Generic)

-- |
-- Create a value of 'SetTopicAttributes' 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:
--
-- 'attributeValue', 'setTopicAttributes_attributeValue' - The new value for the attribute.
--
-- 'topicArn', 'setTopicAttributes_topicArn' - The ARN of the topic to modify.
--
-- 'attributeName', 'setTopicAttributes_attributeName' - A map of attributes with their corresponding values.
--
-- The following lists the names, descriptions, and values of the special
-- request parameters that the @SetTopicAttributes@ action uses:
--
-- -   @DeliveryPolicy@ – The policy that defines how Amazon SNS retries
--     failed deliveries to HTTP\/S endpoints.
--
-- -   @DisplayName@ – The display name to use for a topic with SMS
--     subscriptions.
--
-- -   @Policy@ – The policy that defines who can access your topic. By
--     default, only the topic owner can publish or subscribe to the topic.
--
-- -   @TracingConfig@ – Tracing mode of an Amazon SNS topic. By default
--     @TracingConfig@ is set to @PassThrough@, and the topic passes
--     through the tracing header it receives from an Amazon SNS publisher
--     to its subscriptions. If set to Active, Amazon SNS will vend X-Ray
--     segment data to topic owner account if the sampled flag in the
--     tracing header is true. This is only supported on standard topics.
--
-- The following attribute applies only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html server-side-encryption>:
--
-- -   @KmsMasterKeyId@ – The ID of an Amazon Web Services managed customer
--     master key (CMK) for Amazon SNS or a custom CMK. For more
--     information, see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html#sse-key-terms Key Terms>.
--     For more examples, see
--     <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters KeyId>
--     in the /Key Management Service API Reference/.
--
-- -   @SignatureVersion@ – The signature version corresponds to the
--     hashing algorithm used while creating the signature of the
--     notifications, subscription confirmations, or unsubscribe
--     confirmation messages sent by Amazon SNS.
--
-- The following attribute applies only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-fifo-topics.html FIFO topics>:
--
-- -   @ContentBasedDeduplication@ – Enables content-based deduplication
--     for FIFO topics.
--
--     -   By default, @ContentBasedDeduplication@ is set to @false@. If
--         you create a FIFO topic and this attribute is @false@, you must
--         specify a value for the @MessageDeduplicationId@ parameter for
--         the
--         <https://docs.aws.amazon.com/sns/latest/api/API_Publish.html Publish>
--         action.
--
--     -   When you set @ContentBasedDeduplication@ to @true@, Amazon SNS
--         uses a SHA-256 hash to generate the @MessageDeduplicationId@
--         using the body of the message (but not the attributes of the
--         message).
--
--         (Optional) To override the generated value, you can specify a
--         value for the @MessageDeduplicationId@ parameter for the
--         @Publish@ action.
newSetTopicAttributes ::
  -- | 'topicArn'
  Prelude.Text ->
  -- | 'attributeName'
  Prelude.Text ->
  SetTopicAttributes
newSetTopicAttributes :: Text -> Text -> SetTopicAttributes
newSetTopicAttributes Text
pTopicArn_ Text
pAttributeName_ =
  SetTopicAttributes'
    { $sel:attributeValue:SetTopicAttributes' :: Maybe Text
attributeValue =
        forall a. Maybe a
Prelude.Nothing,
      $sel:topicArn:SetTopicAttributes' :: Text
topicArn = Text
pTopicArn_,
      $sel:attributeName:SetTopicAttributes' :: Text
attributeName = Text
pAttributeName_
    }

-- | The new value for the attribute.
setTopicAttributes_attributeValue :: Lens.Lens' SetTopicAttributes (Prelude.Maybe Prelude.Text)
setTopicAttributes_attributeValue :: Lens' SetTopicAttributes (Maybe Text)
setTopicAttributes_attributeValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTopicAttributes' {Maybe Text
attributeValue :: Maybe Text
$sel:attributeValue:SetTopicAttributes' :: SetTopicAttributes -> Maybe Text
attributeValue} -> Maybe Text
attributeValue) (\s :: SetTopicAttributes
s@SetTopicAttributes' {} Maybe Text
a -> SetTopicAttributes
s {$sel:attributeValue:SetTopicAttributes' :: Maybe Text
attributeValue = Maybe Text
a} :: SetTopicAttributes)

-- | The ARN of the topic to modify.
setTopicAttributes_topicArn :: Lens.Lens' SetTopicAttributes Prelude.Text
setTopicAttributes_topicArn :: Lens' SetTopicAttributes Text
setTopicAttributes_topicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTopicAttributes' {Text
topicArn :: Text
$sel:topicArn:SetTopicAttributes' :: SetTopicAttributes -> Text
topicArn} -> Text
topicArn) (\s :: SetTopicAttributes
s@SetTopicAttributes' {} Text
a -> SetTopicAttributes
s {$sel:topicArn:SetTopicAttributes' :: Text
topicArn = Text
a} :: SetTopicAttributes)

-- | A map of attributes with their corresponding values.
--
-- The following lists the names, descriptions, and values of the special
-- request parameters that the @SetTopicAttributes@ action uses:
--
-- -   @DeliveryPolicy@ – The policy that defines how Amazon SNS retries
--     failed deliveries to HTTP\/S endpoints.
--
-- -   @DisplayName@ – The display name to use for a topic with SMS
--     subscriptions.
--
-- -   @Policy@ – The policy that defines who can access your topic. By
--     default, only the topic owner can publish or subscribe to the topic.
--
-- -   @TracingConfig@ – Tracing mode of an Amazon SNS topic. By default
--     @TracingConfig@ is set to @PassThrough@, and the topic passes
--     through the tracing header it receives from an Amazon SNS publisher
--     to its subscriptions. If set to Active, Amazon SNS will vend X-Ray
--     segment data to topic owner account if the sampled flag in the
--     tracing header is true. This is only supported on standard topics.
--
-- The following attribute applies only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html server-side-encryption>:
--
-- -   @KmsMasterKeyId@ – The ID of an Amazon Web Services managed customer
--     master key (CMK) for Amazon SNS or a custom CMK. For more
--     information, see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html#sse-key-terms Key Terms>.
--     For more examples, see
--     <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters KeyId>
--     in the /Key Management Service API Reference/.
--
-- -   @SignatureVersion@ – The signature version corresponds to the
--     hashing algorithm used while creating the signature of the
--     notifications, subscription confirmations, or unsubscribe
--     confirmation messages sent by Amazon SNS.
--
-- The following attribute applies only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-fifo-topics.html FIFO topics>:
--
-- -   @ContentBasedDeduplication@ – Enables content-based deduplication
--     for FIFO topics.
--
--     -   By default, @ContentBasedDeduplication@ is set to @false@. If
--         you create a FIFO topic and this attribute is @false@, you must
--         specify a value for the @MessageDeduplicationId@ parameter for
--         the
--         <https://docs.aws.amazon.com/sns/latest/api/API_Publish.html Publish>
--         action.
--
--     -   When you set @ContentBasedDeduplication@ to @true@, Amazon SNS
--         uses a SHA-256 hash to generate the @MessageDeduplicationId@
--         using the body of the message (but not the attributes of the
--         message).
--
--         (Optional) To override the generated value, you can specify a
--         value for the @MessageDeduplicationId@ parameter for the
--         @Publish@ action.
setTopicAttributes_attributeName :: Lens.Lens' SetTopicAttributes Prelude.Text
setTopicAttributes_attributeName :: Lens' SetTopicAttributes Text
setTopicAttributes_attributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTopicAttributes' {Text
attributeName :: Text
$sel:attributeName:SetTopicAttributes' :: SetTopicAttributes -> Text
attributeName} -> Text
attributeName) (\s :: SetTopicAttributes
s@SetTopicAttributes' {} Text
a -> SetTopicAttributes
s {$sel:attributeName:SetTopicAttributes' :: Text
attributeName = Text
a} :: SetTopicAttributes)

instance Core.AWSRequest SetTopicAttributes where
  type
    AWSResponse SetTopicAttributes =
      SetTopicAttributesResponse
  request :: (Service -> Service)
-> SetTopicAttributes -> Request SetTopicAttributes
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy SetTopicAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetTopicAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull SetTopicAttributesResponse
SetTopicAttributesResponse'

instance Prelude.Hashable SetTopicAttributes where
  hashWithSalt :: Int -> SetTopicAttributes -> Int
hashWithSalt Int
_salt SetTopicAttributes' {Maybe Text
Text
attributeName :: Text
topicArn :: Text
attributeValue :: Maybe Text
$sel:attributeName:SetTopicAttributes' :: SetTopicAttributes -> Text
$sel:topicArn:SetTopicAttributes' :: SetTopicAttributes -> Text
$sel:attributeValue:SetTopicAttributes' :: SetTopicAttributes -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
attributeValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
topicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributeName

instance Prelude.NFData SetTopicAttributes where
  rnf :: SetTopicAttributes -> ()
rnf SetTopicAttributes' {Maybe Text
Text
attributeName :: Text
topicArn :: Text
attributeValue :: Maybe Text
$sel:attributeName:SetTopicAttributes' :: SetTopicAttributes -> Text
$sel:topicArn:SetTopicAttributes' :: SetTopicAttributes -> Text
$sel:attributeValue:SetTopicAttributes' :: SetTopicAttributes -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
attributeValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
topicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attributeName

instance Data.ToHeaders SetTopicAttributes where
  toHeaders :: SetTopicAttributes -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery SetTopicAttributes where
  toQuery :: SetTopicAttributes -> QueryString
toQuery SetTopicAttributes' {Maybe Text
Text
attributeName :: Text
topicArn :: Text
attributeValue :: Maybe Text
$sel:attributeName:SetTopicAttributes' :: SetTopicAttributes -> Text
$sel:topicArn:SetTopicAttributes' :: SetTopicAttributes -> Text
$sel:attributeValue:SetTopicAttributes' :: SetTopicAttributes -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SetTopicAttributes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"AttributeValue" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
attributeValue,
        ByteString
"TopicArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
topicArn,
        ByteString
"AttributeName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
attributeName
      ]

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

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

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