{-# 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.IoT.DeleteTopicRuleDestination
-- 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 rule destination.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DeleteTopicRuleDestination>
-- action.
module Amazonka.IoT.DeleteTopicRuleDestination
  ( -- * Creating a Request
    DeleteTopicRuleDestination (..),
    newDeleteTopicRuleDestination,

    -- * Request Lenses
    deleteTopicRuleDestination_arn,

    -- * Destructuring the Response
    DeleteTopicRuleDestinationResponse (..),
    newDeleteTopicRuleDestinationResponse,

    -- * Response Lenses
    deleteTopicRuleDestinationResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'DeleteTopicRuleDestination' 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:
--
-- 'arn', 'deleteTopicRuleDestination_arn' - The ARN of the topic rule destination to delete.
newDeleteTopicRuleDestination ::
  -- | 'arn'
  Prelude.Text ->
  DeleteTopicRuleDestination
newDeleteTopicRuleDestination :: Text -> DeleteTopicRuleDestination
newDeleteTopicRuleDestination Text
pArn_ =
  DeleteTopicRuleDestination' {$sel:arn:DeleteTopicRuleDestination' :: Text
arn = Text
pArn_}

-- | The ARN of the topic rule destination to delete.
deleteTopicRuleDestination_arn :: Lens.Lens' DeleteTopicRuleDestination Prelude.Text
deleteTopicRuleDestination_arn :: Lens' DeleteTopicRuleDestination Text
deleteTopicRuleDestination_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteTopicRuleDestination' {Text
arn :: Text
$sel:arn:DeleteTopicRuleDestination' :: DeleteTopicRuleDestination -> Text
arn} -> Text
arn) (\s :: DeleteTopicRuleDestination
s@DeleteTopicRuleDestination' {} Text
a -> DeleteTopicRuleDestination
s {$sel:arn:DeleteTopicRuleDestination' :: Text
arn = Text
a} :: DeleteTopicRuleDestination)

instance Core.AWSRequest DeleteTopicRuleDestination where
  type
    AWSResponse DeleteTopicRuleDestination =
      DeleteTopicRuleDestinationResponse
  request :: (Service -> Service)
-> DeleteTopicRuleDestination -> Request DeleteTopicRuleDestination
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteTopicRuleDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteTopicRuleDestination)))
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 -> DeleteTopicRuleDestinationResponse
DeleteTopicRuleDestinationResponse'
            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 DeleteTopicRuleDestination where
  hashWithSalt :: Int -> DeleteTopicRuleDestination -> Int
hashWithSalt Int
_salt DeleteTopicRuleDestination' {Text
arn :: Text
$sel:arn:DeleteTopicRuleDestination' :: DeleteTopicRuleDestination -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

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

instance Data.ToHeaders DeleteTopicRuleDestination where
  toHeaders :: DeleteTopicRuleDestination -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteTopicRuleDestination where
  toPath :: DeleteTopicRuleDestination -> ByteString
toPath DeleteTopicRuleDestination' {Text
arn :: Text
$sel:arn:DeleteTopicRuleDestination' :: DeleteTopicRuleDestination -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/destinations/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
arn]

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

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

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

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

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