{-# 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.CodeStarNotifications.CreateNotificationRule
-- 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 notification rule for a resource. The rule specifies the
-- events you want notifications about and the targets (such as Chatbot
-- topics or Chatbot clients configured for Slack) where you want to
-- receive them.
module Amazonka.CodeStarNotifications.CreateNotificationRule
  ( -- * Creating a Request
    CreateNotificationRule (..),
    newCreateNotificationRule,

    -- * Request Lenses
    createNotificationRule_clientRequestToken,
    createNotificationRule_status,
    createNotificationRule_tags,
    createNotificationRule_name,
    createNotificationRule_eventTypeIds,
    createNotificationRule_resource,
    createNotificationRule_targets,
    createNotificationRule_detailType,

    -- * Destructuring the Response
    CreateNotificationRuleResponse (..),
    newCreateNotificationRuleResponse,

    -- * Response Lenses
    createNotificationRuleResponse_arn,
    createNotificationRuleResponse_httpStatus,
  )
where

import Amazonka.CodeStarNotifications.Types
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

-- | /See:/ 'newCreateNotificationRule' smart constructor.
data CreateNotificationRule = CreateNotificationRule'
  { -- | A unique, client-generated idempotency token that, when provided in a
    -- request, ensures the request cannot be repeated with a changed
    -- parameter. If a request with the same parameters is received and a token
    -- is included, the request returns information about the initial request
    -- that used that token.
    --
    -- The Amazon Web Services SDKs prepopulate client request tokens. If you
    -- are using an Amazon Web Services SDK, an idempotency token is created
    -- for you.
    CreateNotificationRule -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The status of the notification rule. The default value is @ENABLED@. If
    -- the status is set to @DISABLED@, notifications aren\'t sent for the
    -- notification rule.
    CreateNotificationRule -> Maybe NotificationRuleStatus
status :: Prelude.Maybe NotificationRuleStatus,
    -- | A list of tags to apply to this notification rule. Key names cannot
    -- start with \"@aws@\".
    CreateNotificationRule -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name for the notification rule. Notification rule names must be
    -- unique in your Amazon Web Services account.
    CreateNotificationRule -> Sensitive Text
name :: Data.Sensitive Prelude.Text,
    -- | A list of event types associated with this notification rule. For a list
    -- of allowed events, see EventTypeSummary.
    CreateNotificationRule -> [Text]
eventTypeIds :: [Prelude.Text],
    -- | The Amazon Resource Name (ARN) of the resource to associate with the
    -- notification rule. Supported resources include pipelines in
    -- CodePipeline, repositories in CodeCommit, and build projects in
    -- CodeBuild.
    CreateNotificationRule -> Text
resource :: Prelude.Text,
    -- | A list of Amazon Resource Names (ARNs) of Amazon Simple Notification
    -- Service topics and Chatbot clients to associate with the notification
    -- rule.
    CreateNotificationRule -> [Target]
targets :: [Target],
    -- | The level of detail to include in the notifications for this resource.
    -- @BASIC@ will include only the contents of the event as it would appear
    -- in Amazon CloudWatch. @FULL@ will include any supplemental information
    -- provided by AWS CodeStar Notifications and\/or the service for the
    -- resource for which the notification is created.
    CreateNotificationRule -> DetailType
detailType :: DetailType
  }
  deriving (CreateNotificationRule -> CreateNotificationRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNotificationRule -> CreateNotificationRule -> Bool
$c/= :: CreateNotificationRule -> CreateNotificationRule -> Bool
== :: CreateNotificationRule -> CreateNotificationRule -> Bool
$c== :: CreateNotificationRule -> CreateNotificationRule -> Bool
Prelude.Eq, Int -> CreateNotificationRule -> ShowS
[CreateNotificationRule] -> ShowS
CreateNotificationRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNotificationRule] -> ShowS
$cshowList :: [CreateNotificationRule] -> ShowS
show :: CreateNotificationRule -> String
$cshow :: CreateNotificationRule -> String
showsPrec :: Int -> CreateNotificationRule -> ShowS
$cshowsPrec :: Int -> CreateNotificationRule -> ShowS
Prelude.Show, forall x. Rep CreateNotificationRule x -> CreateNotificationRule
forall x. CreateNotificationRule -> Rep CreateNotificationRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateNotificationRule x -> CreateNotificationRule
$cfrom :: forall x. CreateNotificationRule -> Rep CreateNotificationRule x
Prelude.Generic)

-- |
-- Create a value of 'CreateNotificationRule' 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:
--
-- 'clientRequestToken', 'createNotificationRule_clientRequestToken' - A unique, client-generated idempotency token that, when provided in a
-- request, ensures the request cannot be repeated with a changed
-- parameter. If a request with the same parameters is received and a token
-- is included, the request returns information about the initial request
-- that used that token.
--
-- The Amazon Web Services SDKs prepopulate client request tokens. If you
-- are using an Amazon Web Services SDK, an idempotency token is created
-- for you.
--
-- 'status', 'createNotificationRule_status' - The status of the notification rule. The default value is @ENABLED@. If
-- the status is set to @DISABLED@, notifications aren\'t sent for the
-- notification rule.
--
-- 'tags', 'createNotificationRule_tags' - A list of tags to apply to this notification rule. Key names cannot
-- start with \"@aws@\".
--
-- 'name', 'createNotificationRule_name' - The name for the notification rule. Notification rule names must be
-- unique in your Amazon Web Services account.
--
-- 'eventTypeIds', 'createNotificationRule_eventTypeIds' - A list of event types associated with this notification rule. For a list
-- of allowed events, see EventTypeSummary.
--
-- 'resource', 'createNotificationRule_resource' - The Amazon Resource Name (ARN) of the resource to associate with the
-- notification rule. Supported resources include pipelines in
-- CodePipeline, repositories in CodeCommit, and build projects in
-- CodeBuild.
--
-- 'targets', 'createNotificationRule_targets' - A list of Amazon Resource Names (ARNs) of Amazon Simple Notification
-- Service topics and Chatbot clients to associate with the notification
-- rule.
--
-- 'detailType', 'createNotificationRule_detailType' - The level of detail to include in the notifications for this resource.
-- @BASIC@ will include only the contents of the event as it would appear
-- in Amazon CloudWatch. @FULL@ will include any supplemental information
-- provided by AWS CodeStar Notifications and\/or the service for the
-- resource for which the notification is created.
newCreateNotificationRule ::
  -- | 'name'
  Prelude.Text ->
  -- | 'resource'
  Prelude.Text ->
  -- | 'detailType'
  DetailType ->
  CreateNotificationRule
newCreateNotificationRule :: Text -> Text -> DetailType -> CreateNotificationRule
newCreateNotificationRule
  Text
pName_
  Text
pResource_
  DetailType
pDetailType_ =
    CreateNotificationRule'
      { $sel:clientRequestToken:CreateNotificationRule' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:status:CreateNotificationRule' :: Maybe NotificationRuleStatus
status = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateNotificationRule' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateNotificationRule' :: Sensitive Text
name = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pName_,
        $sel:eventTypeIds:CreateNotificationRule' :: [Text]
eventTypeIds = forall a. Monoid a => a
Prelude.mempty,
        $sel:resource:CreateNotificationRule' :: Text
resource = Text
pResource_,
        $sel:targets:CreateNotificationRule' :: [Target]
targets = forall a. Monoid a => a
Prelude.mempty,
        $sel:detailType:CreateNotificationRule' :: DetailType
detailType = DetailType
pDetailType_
      }

-- | A unique, client-generated idempotency token that, when provided in a
-- request, ensures the request cannot be repeated with a changed
-- parameter. If a request with the same parameters is received and a token
-- is included, the request returns information about the initial request
-- that used that token.
--
-- The Amazon Web Services SDKs prepopulate client request tokens. If you
-- are using an Amazon Web Services SDK, an idempotency token is created
-- for you.
createNotificationRule_clientRequestToken :: Lens.Lens' CreateNotificationRule (Prelude.Maybe Prelude.Text)
createNotificationRule_clientRequestToken :: Lens' CreateNotificationRule (Maybe Text)
createNotificationRule_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateNotificationRule' :: CreateNotificationRule -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} Maybe Text
a -> CreateNotificationRule
s {$sel:clientRequestToken:CreateNotificationRule' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateNotificationRule)

-- | The status of the notification rule. The default value is @ENABLED@. If
-- the status is set to @DISABLED@, notifications aren\'t sent for the
-- notification rule.
createNotificationRule_status :: Lens.Lens' CreateNotificationRule (Prelude.Maybe NotificationRuleStatus)
createNotificationRule_status :: Lens' CreateNotificationRule (Maybe NotificationRuleStatus)
createNotificationRule_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {Maybe NotificationRuleStatus
status :: Maybe NotificationRuleStatus
$sel:status:CreateNotificationRule' :: CreateNotificationRule -> Maybe NotificationRuleStatus
status} -> Maybe NotificationRuleStatus
status) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} Maybe NotificationRuleStatus
a -> CreateNotificationRule
s {$sel:status:CreateNotificationRule' :: Maybe NotificationRuleStatus
status = Maybe NotificationRuleStatus
a} :: CreateNotificationRule)

-- | A list of tags to apply to this notification rule. Key names cannot
-- start with \"@aws@\".
createNotificationRule_tags :: Lens.Lens' CreateNotificationRule (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createNotificationRule_tags :: Lens' CreateNotificationRule (Maybe (HashMap Text Text))
createNotificationRule_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateNotificationRule' :: CreateNotificationRule -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} Maybe (HashMap Text Text)
a -> CreateNotificationRule
s {$sel:tags:CreateNotificationRule' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateNotificationRule) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name for the notification rule. Notification rule names must be
-- unique in your Amazon Web Services account.
createNotificationRule_name :: Lens.Lens' CreateNotificationRule Prelude.Text
createNotificationRule_name :: Lens' CreateNotificationRule Text
createNotificationRule_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {Sensitive Text
name :: Sensitive Text
$sel:name:CreateNotificationRule' :: CreateNotificationRule -> Sensitive Text
name} -> Sensitive Text
name) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} Sensitive Text
a -> CreateNotificationRule
s {$sel:name:CreateNotificationRule' :: Sensitive Text
name = Sensitive Text
a} :: CreateNotificationRule) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | A list of event types associated with this notification rule. For a list
-- of allowed events, see EventTypeSummary.
createNotificationRule_eventTypeIds :: Lens.Lens' CreateNotificationRule [Prelude.Text]
createNotificationRule_eventTypeIds :: Lens' CreateNotificationRule [Text]
createNotificationRule_eventTypeIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {[Text]
eventTypeIds :: [Text]
$sel:eventTypeIds:CreateNotificationRule' :: CreateNotificationRule -> [Text]
eventTypeIds} -> [Text]
eventTypeIds) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} [Text]
a -> CreateNotificationRule
s {$sel:eventTypeIds:CreateNotificationRule' :: [Text]
eventTypeIds = [Text]
a} :: CreateNotificationRule) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Resource Name (ARN) of the resource to associate with the
-- notification rule. Supported resources include pipelines in
-- CodePipeline, repositories in CodeCommit, and build projects in
-- CodeBuild.
createNotificationRule_resource :: Lens.Lens' CreateNotificationRule Prelude.Text
createNotificationRule_resource :: Lens' CreateNotificationRule Text
createNotificationRule_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {Text
resource :: Text
$sel:resource:CreateNotificationRule' :: CreateNotificationRule -> Text
resource} -> Text
resource) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} Text
a -> CreateNotificationRule
s {$sel:resource:CreateNotificationRule' :: Text
resource = Text
a} :: CreateNotificationRule)

-- | A list of Amazon Resource Names (ARNs) of Amazon Simple Notification
-- Service topics and Chatbot clients to associate with the notification
-- rule.
createNotificationRule_targets :: Lens.Lens' CreateNotificationRule [Target]
createNotificationRule_targets :: Lens' CreateNotificationRule [Target]
createNotificationRule_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {[Target]
targets :: [Target]
$sel:targets:CreateNotificationRule' :: CreateNotificationRule -> [Target]
targets} -> [Target]
targets) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} [Target]
a -> CreateNotificationRule
s {$sel:targets:CreateNotificationRule' :: [Target]
targets = [Target]
a} :: CreateNotificationRule) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The level of detail to include in the notifications for this resource.
-- @BASIC@ will include only the contents of the event as it would appear
-- in Amazon CloudWatch. @FULL@ will include any supplemental information
-- provided by AWS CodeStar Notifications and\/or the service for the
-- resource for which the notification is created.
createNotificationRule_detailType :: Lens.Lens' CreateNotificationRule DetailType
createNotificationRule_detailType :: Lens' CreateNotificationRule DetailType
createNotificationRule_detailType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRule' {DetailType
detailType :: DetailType
$sel:detailType:CreateNotificationRule' :: CreateNotificationRule -> DetailType
detailType} -> DetailType
detailType) (\s :: CreateNotificationRule
s@CreateNotificationRule' {} DetailType
a -> CreateNotificationRule
s {$sel:detailType:CreateNotificationRule' :: DetailType
detailType = DetailType
a} :: CreateNotificationRule)

instance Core.AWSRequest CreateNotificationRule where
  type
    AWSResponse CreateNotificationRule =
      CreateNotificationRuleResponse
  request :: (Service -> Service)
-> CreateNotificationRule -> Request CreateNotificationRule
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 CreateNotificationRule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateNotificationRule)))
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 Text -> Int -> CreateNotificationRuleResponse
CreateNotificationRuleResponse'
            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
"Arn")
            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 CreateNotificationRule where
  hashWithSalt :: Int -> CreateNotificationRule -> Int
hashWithSalt Int
_salt CreateNotificationRule' {[Text]
[Target]
Maybe Text
Maybe (HashMap Text Text)
Maybe NotificationRuleStatus
Text
Sensitive Text
DetailType
detailType :: DetailType
targets :: [Target]
resource :: Text
eventTypeIds :: [Text]
name :: Sensitive Text
tags :: Maybe (HashMap Text Text)
status :: Maybe NotificationRuleStatus
clientRequestToken :: Maybe Text
$sel:detailType:CreateNotificationRule' :: CreateNotificationRule -> DetailType
$sel:targets:CreateNotificationRule' :: CreateNotificationRule -> [Target]
$sel:resource:CreateNotificationRule' :: CreateNotificationRule -> Text
$sel:eventTypeIds:CreateNotificationRule' :: CreateNotificationRule -> [Text]
$sel:name:CreateNotificationRule' :: CreateNotificationRule -> Sensitive Text
$sel:tags:CreateNotificationRule' :: CreateNotificationRule -> Maybe (HashMap Text Text)
$sel:status:CreateNotificationRule' :: CreateNotificationRule -> Maybe NotificationRuleStatus
$sel:clientRequestToken:CreateNotificationRule' :: CreateNotificationRule -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotificationRuleStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
eventTypeIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Target]
targets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DetailType
detailType

instance Prelude.NFData CreateNotificationRule where
  rnf :: CreateNotificationRule -> ()
rnf CreateNotificationRule' {[Text]
[Target]
Maybe Text
Maybe (HashMap Text Text)
Maybe NotificationRuleStatus
Text
Sensitive Text
DetailType
detailType :: DetailType
targets :: [Target]
resource :: Text
eventTypeIds :: [Text]
name :: Sensitive Text
tags :: Maybe (HashMap Text Text)
status :: Maybe NotificationRuleStatus
clientRequestToken :: Maybe Text
$sel:detailType:CreateNotificationRule' :: CreateNotificationRule -> DetailType
$sel:targets:CreateNotificationRule' :: CreateNotificationRule -> [Target]
$sel:resource:CreateNotificationRule' :: CreateNotificationRule -> Text
$sel:eventTypeIds:CreateNotificationRule' :: CreateNotificationRule -> [Text]
$sel:name:CreateNotificationRule' :: CreateNotificationRule -> Sensitive Text
$sel:tags:CreateNotificationRule' :: CreateNotificationRule -> Maybe (HashMap Text Text)
$sel:status:CreateNotificationRule' :: CreateNotificationRule -> Maybe NotificationRuleStatus
$sel:clientRequestToken:CreateNotificationRule' :: CreateNotificationRule -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NotificationRuleStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
eventTypeIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Target]
targets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DetailType
detailType

instance Data.ToHeaders CreateNotificationRule where
  toHeaders :: CreateNotificationRule -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateNotificationRule where
  toJSON :: CreateNotificationRule -> Value
toJSON CreateNotificationRule' {[Text]
[Target]
Maybe Text
Maybe (HashMap Text Text)
Maybe NotificationRuleStatus
Text
Sensitive Text
DetailType
detailType :: DetailType
targets :: [Target]
resource :: Text
eventTypeIds :: [Text]
name :: Sensitive Text
tags :: Maybe (HashMap Text Text)
status :: Maybe NotificationRuleStatus
clientRequestToken :: Maybe Text
$sel:detailType:CreateNotificationRule' :: CreateNotificationRule -> DetailType
$sel:targets:CreateNotificationRule' :: CreateNotificationRule -> [Target]
$sel:resource:CreateNotificationRule' :: CreateNotificationRule -> Text
$sel:eventTypeIds:CreateNotificationRule' :: CreateNotificationRule -> [Text]
$sel:name:CreateNotificationRule' :: CreateNotificationRule -> Sensitive Text
$sel:tags:CreateNotificationRule' :: CreateNotificationRule -> Maybe (HashMap Text Text)
$sel:status:CreateNotificationRule' :: CreateNotificationRule -> Maybe NotificationRuleStatus
$sel:clientRequestToken:CreateNotificationRule' :: CreateNotificationRule -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientRequestToken,
            (Key
"Status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe NotificationRuleStatus
status,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"EventTypeIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
eventTypeIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"Resource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resource),
            forall a. a -> Maybe a
Prelude.Just (Key
"Targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Target]
targets),
            forall a. a -> Maybe a
Prelude.Just (Key
"DetailType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DetailType
detailType)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateNotificationRuleResponse' 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', 'createNotificationRuleResponse_arn' - The Amazon Resource Name (ARN) of the notification rule.
--
-- 'httpStatus', 'createNotificationRuleResponse_httpStatus' - The response's http status code.
newCreateNotificationRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateNotificationRuleResponse
newCreateNotificationRuleResponse :: Int -> CreateNotificationRuleResponse
newCreateNotificationRuleResponse Int
pHttpStatus_ =
  CreateNotificationRuleResponse'
    { $sel:arn:CreateNotificationRuleResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateNotificationRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the notification rule.
createNotificationRuleResponse_arn :: Lens.Lens' CreateNotificationRuleResponse (Prelude.Maybe Prelude.Text)
createNotificationRuleResponse_arn :: Lens' CreateNotificationRuleResponse (Maybe Text)
createNotificationRuleResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNotificationRuleResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateNotificationRuleResponse' :: CreateNotificationRuleResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateNotificationRuleResponse
s@CreateNotificationRuleResponse' {} Maybe Text
a -> CreateNotificationRuleResponse
s {$sel:arn:CreateNotificationRuleResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateNotificationRuleResponse)

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

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