{-# 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.CreateTopicRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a rule. Creating rules is an administrator-level action. Any
-- user who has permission to create rules will be able to access data
-- processed by the rule.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateTopicRule>
-- action.
module Amazonka.IoT.CreateTopicRule
  ( -- * Creating a Request
    CreateTopicRule (..),
    newCreateTopicRule,

    -- * Request Lenses
    createTopicRule_tags,
    createTopicRule_ruleName,
    createTopicRule_topicRulePayload,

    -- * Destructuring the Response
    CreateTopicRuleResponse (..),
    newCreateTopicRuleResponse,
  )
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 CreateTopicRule operation.
--
-- /See:/ 'newCreateTopicRule' smart constructor.
data CreateTopicRule = CreateTopicRule'
  { -- | Metadata which can be used to manage the topic rule.
    --
    -- For URI Request parameters use format: ...key1=value1&key2=value2...
    --
    -- For the CLI command-line parameter use format: --tags
    -- \"key1=value1&key2=value2...\"
    --
    -- For the cli-input-json file use format: \"tags\":
    -- \"key1=value1&key2=value2...\"
    CreateTopicRule -> Maybe Text
tags :: Prelude.Maybe Prelude.Text,
    -- | The name of the rule.
    CreateTopicRule -> Text
ruleName :: Prelude.Text,
    -- | The rule payload.
    CreateTopicRule -> TopicRulePayload
topicRulePayload :: TopicRulePayload
  }
  deriving (CreateTopicRule -> CreateTopicRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTopicRule -> CreateTopicRule -> Bool
$c/= :: CreateTopicRule -> CreateTopicRule -> Bool
== :: CreateTopicRule -> CreateTopicRule -> Bool
$c== :: CreateTopicRule -> CreateTopicRule -> Bool
Prelude.Eq, ReadPrec [CreateTopicRule]
ReadPrec CreateTopicRule
Int -> ReadS CreateTopicRule
ReadS [CreateTopicRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTopicRule]
$creadListPrec :: ReadPrec [CreateTopicRule]
readPrec :: ReadPrec CreateTopicRule
$creadPrec :: ReadPrec CreateTopicRule
readList :: ReadS [CreateTopicRule]
$creadList :: ReadS [CreateTopicRule]
readsPrec :: Int -> ReadS CreateTopicRule
$creadsPrec :: Int -> ReadS CreateTopicRule
Prelude.Read, Int -> CreateTopicRule -> ShowS
[CreateTopicRule] -> ShowS
CreateTopicRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTopicRule] -> ShowS
$cshowList :: [CreateTopicRule] -> ShowS
show :: CreateTopicRule -> String
$cshow :: CreateTopicRule -> String
showsPrec :: Int -> CreateTopicRule -> ShowS
$cshowsPrec :: Int -> CreateTopicRule -> ShowS
Prelude.Show, forall x. Rep CreateTopicRule x -> CreateTopicRule
forall x. CreateTopicRule -> Rep CreateTopicRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTopicRule x -> CreateTopicRule
$cfrom :: forall x. CreateTopicRule -> Rep CreateTopicRule x
Prelude.Generic)

-- |
-- Create a value of 'CreateTopicRule' 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:
--
-- 'tags', 'createTopicRule_tags' - Metadata which can be used to manage the topic rule.
--
-- For URI Request parameters use format: ...key1=value1&key2=value2...
--
-- For the CLI command-line parameter use format: --tags
-- \"key1=value1&key2=value2...\"
--
-- For the cli-input-json file use format: \"tags\":
-- \"key1=value1&key2=value2...\"
--
-- 'ruleName', 'createTopicRule_ruleName' - The name of the rule.
--
-- 'topicRulePayload', 'createTopicRule_topicRulePayload' - The rule payload.
newCreateTopicRule ::
  -- | 'ruleName'
  Prelude.Text ->
  -- | 'topicRulePayload'
  TopicRulePayload ->
  CreateTopicRule
newCreateTopicRule :: Text -> TopicRulePayload -> CreateTopicRule
newCreateTopicRule Text
pRuleName_ TopicRulePayload
pTopicRulePayload_ =
  CreateTopicRule'
    { $sel:tags:CreateTopicRule' :: Maybe Text
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:ruleName:CreateTopicRule' :: Text
ruleName = Text
pRuleName_,
      $sel:topicRulePayload:CreateTopicRule' :: TopicRulePayload
topicRulePayload = TopicRulePayload
pTopicRulePayload_
    }

-- | Metadata which can be used to manage the topic rule.
--
-- For URI Request parameters use format: ...key1=value1&key2=value2...
--
-- For the CLI command-line parameter use format: --tags
-- \"key1=value1&key2=value2...\"
--
-- For the cli-input-json file use format: \"tags\":
-- \"key1=value1&key2=value2...\"
createTopicRule_tags :: Lens.Lens' CreateTopicRule (Prelude.Maybe Prelude.Text)
createTopicRule_tags :: Lens' CreateTopicRule (Maybe Text)
createTopicRule_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTopicRule' {Maybe Text
tags :: Maybe Text
$sel:tags:CreateTopicRule' :: CreateTopicRule -> Maybe Text
tags} -> Maybe Text
tags) (\s :: CreateTopicRule
s@CreateTopicRule' {} Maybe Text
a -> CreateTopicRule
s {$sel:tags:CreateTopicRule' :: Maybe Text
tags = Maybe Text
a} :: CreateTopicRule)

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

-- | The rule payload.
createTopicRule_topicRulePayload :: Lens.Lens' CreateTopicRule TopicRulePayload
createTopicRule_topicRulePayload :: Lens' CreateTopicRule TopicRulePayload
createTopicRule_topicRulePayload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTopicRule' {TopicRulePayload
topicRulePayload :: TopicRulePayload
$sel:topicRulePayload:CreateTopicRule' :: CreateTopicRule -> TopicRulePayload
topicRulePayload} -> TopicRulePayload
topicRulePayload) (\s :: CreateTopicRule
s@CreateTopicRule' {} TopicRulePayload
a -> CreateTopicRule
s {$sel:topicRulePayload:CreateTopicRule' :: TopicRulePayload
topicRulePayload = TopicRulePayload
a} :: CreateTopicRule)

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

instance Prelude.Hashable CreateTopicRule where
  hashWithSalt :: Int -> CreateTopicRule -> Int
hashWithSalt Int
_salt CreateTopicRule' {Maybe Text
Text
TopicRulePayload
topicRulePayload :: TopicRulePayload
ruleName :: Text
tags :: Maybe Text
$sel:topicRulePayload:CreateTopicRule' :: CreateTopicRule -> TopicRulePayload
$sel:ruleName:CreateTopicRule' :: CreateTopicRule -> Text
$sel:tags:CreateTopicRule' :: CreateTopicRule -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TopicRulePayload
topicRulePayload

instance Prelude.NFData CreateTopicRule where
  rnf :: CreateTopicRule -> ()
rnf CreateTopicRule' {Maybe Text
Text
TopicRulePayload
topicRulePayload :: TopicRulePayload
ruleName :: Text
tags :: Maybe Text
$sel:topicRulePayload:CreateTopicRule' :: CreateTopicRule -> TopicRulePayload
$sel:ruleName:CreateTopicRule' :: CreateTopicRule -> Text
$sel:tags:CreateTopicRule' :: CreateTopicRule -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ruleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TopicRulePayload
topicRulePayload

instance Data.ToHeaders CreateTopicRule where
  toHeaders :: CreateTopicRule -> [Header]
toHeaders CreateTopicRule' {Maybe Text
Text
TopicRulePayload
topicRulePayload :: TopicRulePayload
ruleName :: Text
tags :: Maybe Text
$sel:topicRulePayload:CreateTopicRule' :: CreateTopicRule -> TopicRulePayload
$sel:ruleName:CreateTopicRule' :: CreateTopicRule -> Text
$sel:tags:CreateTopicRule' :: CreateTopicRule -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [HeaderName
"x-amz-tagging" forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
tags]

instance Data.ToJSON CreateTopicRule where
  toJSON :: CreateTopicRule -> Value
toJSON CreateTopicRule' {Maybe Text
Text
TopicRulePayload
topicRulePayload :: TopicRulePayload
ruleName :: Text
tags :: Maybe Text
$sel:topicRulePayload:CreateTopicRule' :: CreateTopicRule -> TopicRulePayload
$sel:ruleName:CreateTopicRule' :: CreateTopicRule -> Text
$sel:tags:CreateTopicRule' :: CreateTopicRule -> Maybe Text
..} =
    forall a. ToJSON a => a -> Value
Data.toJSON TopicRulePayload
topicRulePayload

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

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

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

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

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