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

    -- * Request Lenses
    getTopicRule_ruleName,

    -- * Destructuring the Response
    GetTopicRuleResponse (..),
    newGetTopicRuleResponse,

    -- * Response Lenses
    getTopicRuleResponse_rule,
    getTopicRuleResponse_ruleArn,
    getTopicRuleResponse_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

-- | The input for the GetTopicRule operation.
--
-- /See:/ 'newGetTopicRule' smart constructor.
data GetTopicRule = GetTopicRule'
  { -- | The name of the rule.
    GetTopicRule -> Text
ruleName :: Prelude.Text
  }
  deriving (GetTopicRule -> GetTopicRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTopicRule -> GetTopicRule -> Bool
$c/= :: GetTopicRule -> GetTopicRule -> Bool
== :: GetTopicRule -> GetTopicRule -> Bool
$c== :: GetTopicRule -> GetTopicRule -> Bool
Prelude.Eq, ReadPrec [GetTopicRule]
ReadPrec GetTopicRule
Int -> ReadS GetTopicRule
ReadS [GetTopicRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTopicRule]
$creadListPrec :: ReadPrec [GetTopicRule]
readPrec :: ReadPrec GetTopicRule
$creadPrec :: ReadPrec GetTopicRule
readList :: ReadS [GetTopicRule]
$creadList :: ReadS [GetTopicRule]
readsPrec :: Int -> ReadS GetTopicRule
$creadsPrec :: Int -> ReadS GetTopicRule
Prelude.Read, Int -> GetTopicRule -> ShowS
[GetTopicRule] -> ShowS
GetTopicRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTopicRule] -> ShowS
$cshowList :: [GetTopicRule] -> ShowS
show :: GetTopicRule -> String
$cshow :: GetTopicRule -> String
showsPrec :: Int -> GetTopicRule -> ShowS
$cshowsPrec :: Int -> GetTopicRule -> ShowS
Prelude.Show, forall x. Rep GetTopicRule x -> GetTopicRule
forall x. GetTopicRule -> Rep GetTopicRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTopicRule x -> GetTopicRule
$cfrom :: forall x. GetTopicRule -> Rep GetTopicRule x
Prelude.Generic)

-- |
-- Create a value of 'GetTopicRule' 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:
--
-- 'ruleName', 'getTopicRule_ruleName' - The name of the rule.
newGetTopicRule ::
  -- | 'ruleName'
  Prelude.Text ->
  GetTopicRule
newGetTopicRule :: Text -> GetTopicRule
newGetTopicRule Text
pRuleName_ =
  GetTopicRule' {$sel:ruleName:GetTopicRule' :: Text
ruleName = Text
pRuleName_}

-- | The name of the rule.
getTopicRule_ruleName :: Lens.Lens' GetTopicRule Prelude.Text
getTopicRule_ruleName :: Lens' GetTopicRule Text
getTopicRule_ruleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTopicRule' {Text
ruleName :: Text
$sel:ruleName:GetTopicRule' :: GetTopicRule -> Text
ruleName} -> Text
ruleName) (\s :: GetTopicRule
s@GetTopicRule' {} Text
a -> GetTopicRule
s {$sel:ruleName:GetTopicRule' :: Text
ruleName = Text
a} :: GetTopicRule)

instance Core.AWSRequest GetTopicRule where
  type AWSResponse GetTopicRule = GetTopicRuleResponse
  request :: (Service -> Service) -> GetTopicRule -> Request GetTopicRule
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 GetTopicRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTopicRule)))
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 TopicRule -> Maybe Text -> Int -> GetTopicRuleResponse
GetTopicRuleResponse'
            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
"rule")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ruleArn")
            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 GetTopicRule where
  hashWithSalt :: Int -> GetTopicRule -> Int
hashWithSalt Int
_salt GetTopicRule' {Text
ruleName :: Text
$sel:ruleName:GetTopicRule' :: GetTopicRule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleName

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

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

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

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

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

-- |
-- Create a value of 'GetTopicRuleResponse' 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:
--
-- 'rule', 'getTopicRuleResponse_rule' - The rule.
--
-- 'ruleArn', 'getTopicRuleResponse_ruleArn' - The rule ARN.
--
-- 'httpStatus', 'getTopicRuleResponse_httpStatus' - The response's http status code.
newGetTopicRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTopicRuleResponse
newGetTopicRuleResponse :: Int -> GetTopicRuleResponse
newGetTopicRuleResponse Int
pHttpStatus_ =
  GetTopicRuleResponse'
    { $sel:rule:GetTopicRuleResponse' :: Maybe TopicRule
rule = forall a. Maybe a
Prelude.Nothing,
      $sel:ruleArn:GetTopicRuleResponse' :: Maybe Text
ruleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTopicRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The rule.
getTopicRuleResponse_rule :: Lens.Lens' GetTopicRuleResponse (Prelude.Maybe TopicRule)
getTopicRuleResponse_rule :: Lens' GetTopicRuleResponse (Maybe TopicRule)
getTopicRuleResponse_rule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTopicRuleResponse' {Maybe TopicRule
rule :: Maybe TopicRule
$sel:rule:GetTopicRuleResponse' :: GetTopicRuleResponse -> Maybe TopicRule
rule} -> Maybe TopicRule
rule) (\s :: GetTopicRuleResponse
s@GetTopicRuleResponse' {} Maybe TopicRule
a -> GetTopicRuleResponse
s {$sel:rule:GetTopicRuleResponse' :: Maybe TopicRule
rule = Maybe TopicRule
a} :: GetTopicRuleResponse)

-- | The rule ARN.
getTopicRuleResponse_ruleArn :: Lens.Lens' GetTopicRuleResponse (Prelude.Maybe Prelude.Text)
getTopicRuleResponse_ruleArn :: Lens' GetTopicRuleResponse (Maybe Text)
getTopicRuleResponse_ruleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTopicRuleResponse' {Maybe Text
ruleArn :: Maybe Text
$sel:ruleArn:GetTopicRuleResponse' :: GetTopicRuleResponse -> Maybe Text
ruleArn} -> Maybe Text
ruleArn) (\s :: GetTopicRuleResponse
s@GetTopicRuleResponse' {} Maybe Text
a -> GetTopicRuleResponse
s {$sel:ruleArn:GetTopicRuleResponse' :: Maybe Text
ruleArn = Maybe Text
a} :: GetTopicRuleResponse)

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

instance Prelude.NFData GetTopicRuleResponse where
  rnf :: GetTopicRuleResponse -> ()
rnf GetTopicRuleResponse' {Int
Maybe Text
Maybe TopicRule
httpStatus :: Int
ruleArn :: Maybe Text
rule :: Maybe TopicRule
$sel:httpStatus:GetTopicRuleResponse' :: GetTopicRuleResponse -> Int
$sel:ruleArn:GetTopicRuleResponse' :: GetTopicRuleResponse -> Maybe Text
$sel:rule:GetTopicRuleResponse' :: GetTopicRuleResponse -> Maybe TopicRule
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TopicRule
rule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ruleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus