{-# 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.DeleteTopic
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a topic and all its subscriptions. Deleting a topic might
-- prevent some messages previously sent to the topic from being delivered
-- to subscribers. This action is idempotent, so deleting a topic that does
-- not exist does not result in an error.
module Amazonka.SNS.DeleteTopic
  ( -- * Creating a Request
    DeleteTopic (..),
    newDeleteTopic,

    -- * Request Lenses
    deleteTopic_topicArn,

    -- * Destructuring the Response
    DeleteTopicResponse (..),
    newDeleteTopicResponse,
  )
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

-- | /See:/ 'newDeleteTopic' smart constructor.
data DeleteTopic = DeleteTopic'
  { -- | The ARN of the topic you want to delete.
    DeleteTopic -> Text
topicArn :: Prelude.Text
  }
  deriving (DeleteTopic -> DeleteTopic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteTopic -> DeleteTopic -> Bool
$c/= :: DeleteTopic -> DeleteTopic -> Bool
== :: DeleteTopic -> DeleteTopic -> Bool
$c== :: DeleteTopic -> DeleteTopic -> Bool
Prelude.Eq, ReadPrec [DeleteTopic]
ReadPrec DeleteTopic
Int -> ReadS DeleteTopic
ReadS [DeleteTopic]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteTopic]
$creadListPrec :: ReadPrec [DeleteTopic]
readPrec :: ReadPrec DeleteTopic
$creadPrec :: ReadPrec DeleteTopic
readList :: ReadS [DeleteTopic]
$creadList :: ReadS [DeleteTopic]
readsPrec :: Int -> ReadS DeleteTopic
$creadsPrec :: Int -> ReadS DeleteTopic
Prelude.Read, Int -> DeleteTopic -> ShowS
[DeleteTopic] -> ShowS
DeleteTopic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteTopic] -> ShowS
$cshowList :: [DeleteTopic] -> ShowS
show :: DeleteTopic -> String
$cshow :: DeleteTopic -> String
showsPrec :: Int -> DeleteTopic -> ShowS
$cshowsPrec :: Int -> DeleteTopic -> ShowS
Prelude.Show, forall x. Rep DeleteTopic x -> DeleteTopic
forall x. DeleteTopic -> Rep DeleteTopic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteTopic x -> DeleteTopic
$cfrom :: forall x. DeleteTopic -> Rep DeleteTopic x
Prelude.Generic)

-- |
-- Create a value of 'DeleteTopic' 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:
--
-- 'topicArn', 'deleteTopic_topicArn' - The ARN of the topic you want to delete.
newDeleteTopic ::
  -- | 'topicArn'
  Prelude.Text ->
  DeleteTopic
newDeleteTopic :: Text -> DeleteTopic
newDeleteTopic Text
pTopicArn_ =
  DeleteTopic' {$sel:topicArn:DeleteTopic' :: Text
topicArn = Text
pTopicArn_}

-- | The ARN of the topic you want to delete.
deleteTopic_topicArn :: Lens.Lens' DeleteTopic Prelude.Text
deleteTopic_topicArn :: Lens' DeleteTopic Text
deleteTopic_topicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteTopic' {Text
topicArn :: Text
$sel:topicArn:DeleteTopic' :: DeleteTopic -> Text
topicArn} -> Text
topicArn) (\s :: DeleteTopic
s@DeleteTopic' {} Text
a -> DeleteTopic
s {$sel:topicArn:DeleteTopic' :: Text
topicArn = Text
a} :: DeleteTopic)

instance Core.AWSRequest DeleteTopic where
  type AWSResponse DeleteTopic = DeleteTopicResponse
  request :: (Service -> Service) -> DeleteTopic -> Request DeleteTopic
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 DeleteTopic
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteTopic)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteTopicResponse
DeleteTopicResponse'

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

instance Prelude.NFData DeleteTopic where
  rnf :: DeleteTopic -> ()
rnf DeleteTopic' {Text
topicArn :: Text
$sel:topicArn:DeleteTopic' :: DeleteTopic -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
topicArn

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

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

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

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

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

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