{-# 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.GetTopicRuleDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about 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 GetTopicRuleDestination>
-- action.
module Amazonka.IoT.GetTopicRuleDestination
  ( -- * Creating a Request
    GetTopicRuleDestination (..),
    newGetTopicRuleDestination,

    -- * Request Lenses
    getTopicRuleDestination_arn,

    -- * Destructuring the Response
    GetTopicRuleDestinationResponse (..),
    newGetTopicRuleDestinationResponse,

    -- * Response Lenses
    getTopicRuleDestinationResponse_topicRuleDestination,
    getTopicRuleDestinationResponse_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:/ 'newGetTopicRuleDestination' smart constructor.
data GetTopicRuleDestination = GetTopicRuleDestination'
  { -- | The ARN of the topic rule destination.
    GetTopicRuleDestination -> Text
arn :: Prelude.Text
  }
  deriving (GetTopicRuleDestination -> GetTopicRuleDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTopicRuleDestination -> GetTopicRuleDestination -> Bool
$c/= :: GetTopicRuleDestination -> GetTopicRuleDestination -> Bool
== :: GetTopicRuleDestination -> GetTopicRuleDestination -> Bool
$c== :: GetTopicRuleDestination -> GetTopicRuleDestination -> Bool
Prelude.Eq, ReadPrec [GetTopicRuleDestination]
ReadPrec GetTopicRuleDestination
Int -> ReadS GetTopicRuleDestination
ReadS [GetTopicRuleDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTopicRuleDestination]
$creadListPrec :: ReadPrec [GetTopicRuleDestination]
readPrec :: ReadPrec GetTopicRuleDestination
$creadPrec :: ReadPrec GetTopicRuleDestination
readList :: ReadS [GetTopicRuleDestination]
$creadList :: ReadS [GetTopicRuleDestination]
readsPrec :: Int -> ReadS GetTopicRuleDestination
$creadsPrec :: Int -> ReadS GetTopicRuleDestination
Prelude.Read, Int -> GetTopicRuleDestination -> ShowS
[GetTopicRuleDestination] -> ShowS
GetTopicRuleDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTopicRuleDestination] -> ShowS
$cshowList :: [GetTopicRuleDestination] -> ShowS
show :: GetTopicRuleDestination -> String
$cshow :: GetTopicRuleDestination -> String
showsPrec :: Int -> GetTopicRuleDestination -> ShowS
$cshowsPrec :: Int -> GetTopicRuleDestination -> ShowS
Prelude.Show, forall x. Rep GetTopicRuleDestination x -> GetTopicRuleDestination
forall x. GetTopicRuleDestination -> Rep GetTopicRuleDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTopicRuleDestination x -> GetTopicRuleDestination
$cfrom :: forall x. GetTopicRuleDestination -> Rep GetTopicRuleDestination x
Prelude.Generic)

-- |
-- Create a value of 'GetTopicRuleDestination' 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', 'getTopicRuleDestination_arn' - The ARN of the topic rule destination.
newGetTopicRuleDestination ::
  -- | 'arn'
  Prelude.Text ->
  GetTopicRuleDestination
newGetTopicRuleDestination :: Text -> GetTopicRuleDestination
newGetTopicRuleDestination Text
pArn_ =
  GetTopicRuleDestination' {$sel:arn:GetTopicRuleDestination' :: Text
arn = Text
pArn_}

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

instance Core.AWSRequest GetTopicRuleDestination where
  type
    AWSResponse GetTopicRuleDestination =
      GetTopicRuleDestinationResponse
  request :: (Service -> Service)
-> GetTopicRuleDestination -> Request GetTopicRuleDestination
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetTopicRuleDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetTopicRuleDestination)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe TopicRuleDestination
-> Int -> GetTopicRuleDestinationResponse
GetTopicRuleDestinationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"topicRuleDestination")
            forall (f :: * -> *) a b. Applicative f => 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 GetTopicRuleDestination where
  hashWithSalt :: Int -> GetTopicRuleDestination -> Int
hashWithSalt Int
_salt GetTopicRuleDestination' {Text
arn :: Text
$sel:arn:GetTopicRuleDestination' :: GetTopicRuleDestination -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

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

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

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

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

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

-- |
-- Create a value of 'GetTopicRuleDestinationResponse' 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:
--
-- 'topicRuleDestination', 'getTopicRuleDestinationResponse_topicRuleDestination' - The topic rule destination.
--
-- 'httpStatus', 'getTopicRuleDestinationResponse_httpStatus' - The response's http status code.
newGetTopicRuleDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTopicRuleDestinationResponse
newGetTopicRuleDestinationResponse :: Int -> GetTopicRuleDestinationResponse
newGetTopicRuleDestinationResponse Int
pHttpStatus_ =
  GetTopicRuleDestinationResponse'
    { $sel:topicRuleDestination:GetTopicRuleDestinationResponse' :: Maybe TopicRuleDestination
topicRuleDestination =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTopicRuleDestinationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The topic rule destination.
getTopicRuleDestinationResponse_topicRuleDestination :: Lens.Lens' GetTopicRuleDestinationResponse (Prelude.Maybe TopicRuleDestination)
getTopicRuleDestinationResponse_topicRuleDestination :: Lens' GetTopicRuleDestinationResponse (Maybe TopicRuleDestination)
getTopicRuleDestinationResponse_topicRuleDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTopicRuleDestinationResponse' {Maybe TopicRuleDestination
topicRuleDestination :: Maybe TopicRuleDestination
$sel:topicRuleDestination:GetTopicRuleDestinationResponse' :: GetTopicRuleDestinationResponse -> Maybe TopicRuleDestination
topicRuleDestination} -> Maybe TopicRuleDestination
topicRuleDestination) (\s :: GetTopicRuleDestinationResponse
s@GetTopicRuleDestinationResponse' {} Maybe TopicRuleDestination
a -> GetTopicRuleDestinationResponse
s {$sel:topicRuleDestination:GetTopicRuleDestinationResponse' :: Maybe TopicRuleDestination
topicRuleDestination = Maybe TopicRuleDestination
a} :: GetTopicRuleDestinationResponse)

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

instance
  Prelude.NFData
    GetTopicRuleDestinationResponse
  where
  rnf :: GetTopicRuleDestinationResponse -> ()
rnf GetTopicRuleDestinationResponse' {Int
Maybe TopicRuleDestination
httpStatus :: Int
topicRuleDestination :: Maybe TopicRuleDestination
$sel:httpStatus:GetTopicRuleDestinationResponse' :: GetTopicRuleDestinationResponse -> Int
$sel:topicRuleDestination:GetTopicRuleDestinationResponse' :: GetTopicRuleDestinationResponse -> Maybe TopicRuleDestination
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TopicRuleDestination
topicRuleDestination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus