{-# 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.Connect.CreateRule
-- 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 for the specified Amazon Connect instance.
--
-- Use the
-- <https://docs.aws.amazon.com/connect/latest/APIReference/connect-rules-language.html Rules Function language>
-- to code conditions for the rule.
module Amazonka.Connect.CreateRule
  ( -- * Creating a Request
    CreateRule (..),
    newCreateRule,

    -- * Request Lenses
    createRule_clientToken,
    createRule_instanceId,
    createRule_name,
    createRule_triggerEventSource,
    createRule_function,
    createRule_actions,
    createRule_publishStatus,

    -- * Destructuring the Response
    CreateRuleResponse (..),
    newCreateRuleResponse,

    -- * Response Lenses
    createRuleResponse_httpStatus,
    createRuleResponse_ruleArn,
    createRuleResponse_ruleId,
  )
where

import Amazonka.Connect.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:/ 'newCreateRule' smart constructor.
data CreateRule = CreateRule'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If not provided, the Amazon Web Services SDK
    -- populates this field. For more information about idempotency, see
    -- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
    CreateRule -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    CreateRule -> Text
instanceId :: Prelude.Text,
    -- | A unique name for the rule.
    CreateRule -> Text
name :: Prelude.Text,
    -- | The event source to trigger the rule.
    CreateRule -> RuleTriggerEventSource
triggerEventSource :: RuleTriggerEventSource,
    -- | The conditions of the rule.
    CreateRule -> Text
function :: Prelude.Text,
    -- | A list of actions to be run when the rule is triggered.
    CreateRule -> [RuleAction]
actions :: [RuleAction],
    -- | The publish status of the rule.
    CreateRule -> RulePublishStatus
publishStatus :: RulePublishStatus
  }
  deriving (CreateRule -> CreateRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRule -> CreateRule -> Bool
$c/= :: CreateRule -> CreateRule -> Bool
== :: CreateRule -> CreateRule -> Bool
$c== :: CreateRule -> CreateRule -> Bool
Prelude.Eq, ReadPrec [CreateRule]
ReadPrec CreateRule
Int -> ReadS CreateRule
ReadS [CreateRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRule]
$creadListPrec :: ReadPrec [CreateRule]
readPrec :: ReadPrec CreateRule
$creadPrec :: ReadPrec CreateRule
readList :: ReadS [CreateRule]
$creadList :: ReadS [CreateRule]
readsPrec :: Int -> ReadS CreateRule
$creadsPrec :: Int -> ReadS CreateRule
Prelude.Read, Int -> CreateRule -> ShowS
[CreateRule] -> ShowS
CreateRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRule] -> ShowS
$cshowList :: [CreateRule] -> ShowS
show :: CreateRule -> String
$cshow :: CreateRule -> String
showsPrec :: Int -> CreateRule -> ShowS
$cshowsPrec :: Int -> CreateRule -> ShowS
Prelude.Show, forall x. Rep CreateRule x -> CreateRule
forall x. CreateRule -> Rep CreateRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRule x -> CreateRule
$cfrom :: forall x. CreateRule -> Rep CreateRule x
Prelude.Generic)

-- |
-- Create a value of 'CreateRule' 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:
--
-- 'clientToken', 'createRule_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
--
-- 'instanceId', 'createRule_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'name', 'createRule_name' - A unique name for the rule.
--
-- 'triggerEventSource', 'createRule_triggerEventSource' - The event source to trigger the rule.
--
-- 'function', 'createRule_function' - The conditions of the rule.
--
-- 'actions', 'createRule_actions' - A list of actions to be run when the rule is triggered.
--
-- 'publishStatus', 'createRule_publishStatus' - The publish status of the rule.
newCreateRule ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'triggerEventSource'
  RuleTriggerEventSource ->
  -- | 'function'
  Prelude.Text ->
  -- | 'publishStatus'
  RulePublishStatus ->
  CreateRule
newCreateRule :: Text
-> Text
-> RuleTriggerEventSource
-> Text
-> RulePublishStatus
-> CreateRule
newCreateRule
  Text
pInstanceId_
  Text
pName_
  RuleTriggerEventSource
pTriggerEventSource_
  Text
pFunction_
  RulePublishStatus
pPublishStatus_ =
    CreateRule'
      { $sel:clientToken:CreateRule' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:instanceId:CreateRule' :: Text
instanceId = Text
pInstanceId_,
        $sel:name:CreateRule' :: Text
name = Text
pName_,
        $sel:triggerEventSource:CreateRule' :: RuleTriggerEventSource
triggerEventSource = RuleTriggerEventSource
pTriggerEventSource_,
        $sel:function:CreateRule' :: Text
function = Text
pFunction_,
        $sel:actions:CreateRule' :: [RuleAction]
actions = forall a. Monoid a => a
Prelude.mempty,
        $sel:publishStatus:CreateRule' :: RulePublishStatus
publishStatus = RulePublishStatus
pPublishStatus_
      }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
createRule_clientToken :: Lens.Lens' CreateRule (Prelude.Maybe Prelude.Text)
createRule_clientToken :: Lens' CreateRule (Maybe Text)
createRule_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRule' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateRule' :: CreateRule -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateRule
s@CreateRule' {} Maybe Text
a -> CreateRule
s {$sel:clientToken:CreateRule' :: Maybe Text
clientToken = Maybe Text
a} :: CreateRule)

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
createRule_instanceId :: Lens.Lens' CreateRule Prelude.Text
createRule_instanceId :: Lens' CreateRule Text
createRule_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRule' {Text
instanceId :: Text
$sel:instanceId:CreateRule' :: CreateRule -> Text
instanceId} -> Text
instanceId) (\s :: CreateRule
s@CreateRule' {} Text
a -> CreateRule
s {$sel:instanceId:CreateRule' :: Text
instanceId = Text
a} :: CreateRule)

-- | A unique name for the rule.
createRule_name :: Lens.Lens' CreateRule Prelude.Text
createRule_name :: Lens' CreateRule Text
createRule_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRule' {Text
name :: Text
$sel:name:CreateRule' :: CreateRule -> Text
name} -> Text
name) (\s :: CreateRule
s@CreateRule' {} Text
a -> CreateRule
s {$sel:name:CreateRule' :: Text
name = Text
a} :: CreateRule)

-- | The event source to trigger the rule.
createRule_triggerEventSource :: Lens.Lens' CreateRule RuleTriggerEventSource
createRule_triggerEventSource :: Lens' CreateRule RuleTriggerEventSource
createRule_triggerEventSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRule' {RuleTriggerEventSource
triggerEventSource :: RuleTriggerEventSource
$sel:triggerEventSource:CreateRule' :: CreateRule -> RuleTriggerEventSource
triggerEventSource} -> RuleTriggerEventSource
triggerEventSource) (\s :: CreateRule
s@CreateRule' {} RuleTriggerEventSource
a -> CreateRule
s {$sel:triggerEventSource:CreateRule' :: RuleTriggerEventSource
triggerEventSource = RuleTriggerEventSource
a} :: CreateRule)

-- | The conditions of the rule.
createRule_function :: Lens.Lens' CreateRule Prelude.Text
createRule_function :: Lens' CreateRule Text
createRule_function = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRule' {Text
function :: Text
$sel:function:CreateRule' :: CreateRule -> Text
function} -> Text
function) (\s :: CreateRule
s@CreateRule' {} Text
a -> CreateRule
s {$sel:function:CreateRule' :: Text
function = Text
a} :: CreateRule)

-- | A list of actions to be run when the rule is triggered.
createRule_actions :: Lens.Lens' CreateRule [RuleAction]
createRule_actions :: Lens' CreateRule [RuleAction]
createRule_actions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRule' {[RuleAction]
actions :: [RuleAction]
$sel:actions:CreateRule' :: CreateRule -> [RuleAction]
actions} -> [RuleAction]
actions) (\s :: CreateRule
s@CreateRule' {} [RuleAction]
a -> CreateRule
s {$sel:actions:CreateRule' :: [RuleAction]
actions = [RuleAction]
a} :: CreateRule) 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 publish status of the rule.
createRule_publishStatus :: Lens.Lens' CreateRule RulePublishStatus
createRule_publishStatus :: Lens' CreateRule RulePublishStatus
createRule_publishStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRule' {RulePublishStatus
publishStatus :: RulePublishStatus
$sel:publishStatus:CreateRule' :: CreateRule -> RulePublishStatus
publishStatus} -> RulePublishStatus
publishStatus) (\s :: CreateRule
s@CreateRule' {} RulePublishStatus
a -> CreateRule
s {$sel:publishStatus:CreateRule' :: RulePublishStatus
publishStatus = RulePublishStatus
a} :: CreateRule)

instance Core.AWSRequest CreateRule where
  type AWSResponse CreateRule = CreateRuleResponse
  request :: (Service -> Service) -> CreateRule -> Request CreateRule
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 CreateRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateRule)))
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 ->
          Int -> Text -> Text -> CreateRuleResponse
CreateRuleResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RuleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RuleId")
      )

instance Prelude.Hashable CreateRule where
  hashWithSalt :: Int -> CreateRule -> Int
hashWithSalt Int
_salt CreateRule' {[RuleAction]
Maybe Text
Text
RulePublishStatus
RuleTriggerEventSource
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
triggerEventSource :: RuleTriggerEventSource
name :: Text
instanceId :: Text
clientToken :: Maybe Text
$sel:publishStatus:CreateRule' :: CreateRule -> RulePublishStatus
$sel:actions:CreateRule' :: CreateRule -> [RuleAction]
$sel:function:CreateRule' :: CreateRule -> Text
$sel:triggerEventSource:CreateRule' :: CreateRule -> RuleTriggerEventSource
$sel:name:CreateRule' :: CreateRule -> Text
$sel:instanceId:CreateRule' :: CreateRule -> Text
$sel:clientToken:CreateRule' :: CreateRule -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RuleTriggerEventSource
triggerEventSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
function
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [RuleAction]
actions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RulePublishStatus
publishStatus

instance Prelude.NFData CreateRule where
  rnf :: CreateRule -> ()
rnf CreateRule' {[RuleAction]
Maybe Text
Text
RulePublishStatus
RuleTriggerEventSource
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
triggerEventSource :: RuleTriggerEventSource
name :: Text
instanceId :: Text
clientToken :: Maybe Text
$sel:publishStatus:CreateRule' :: CreateRule -> RulePublishStatus
$sel:actions:CreateRule' :: CreateRule -> [RuleAction]
$sel:function:CreateRule' :: CreateRule -> Text
$sel:triggerEventSource:CreateRule' :: CreateRule -> RuleTriggerEventSource
$sel:name:CreateRule' :: CreateRule -> Text
$sel:instanceId:CreateRule' :: CreateRule -> Text
$sel:clientToken:CreateRule' :: CreateRule -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RuleTriggerEventSource
triggerEventSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
function
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [RuleAction]
actions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RulePublishStatus
publishStatus

instance Data.ToHeaders CreateRule where
  toHeaders :: CreateRule -> 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 CreateRule where
  toJSON :: CreateRule -> Value
toJSON CreateRule' {[RuleAction]
Maybe Text
Text
RulePublishStatus
RuleTriggerEventSource
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
triggerEventSource :: RuleTriggerEventSource
name :: Text
instanceId :: Text
clientToken :: Maybe Text
$sel:publishStatus:CreateRule' :: CreateRule -> RulePublishStatus
$sel:actions:CreateRule' :: CreateRule -> [RuleAction]
$sel:function:CreateRule' :: CreateRule -> Text
$sel:triggerEventSource:CreateRule' :: CreateRule -> RuleTriggerEventSource
$sel:name:CreateRule' :: CreateRule -> Text
$sel:instanceId:CreateRule' :: CreateRule -> Text
$sel:clientToken:CreateRule' :: CreateRule -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TriggerEventSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RuleTriggerEventSource
triggerEventSource),
            forall a. a -> Maybe a
Prelude.Just (Key
"Function" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
function),
            forall a. a -> Maybe a
Prelude.Just (Key
"Actions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [RuleAction]
actions),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PublishStatus" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RulePublishStatus
publishStatus)
          ]
      )

instance Data.ToPath CreateRule where
  toPath :: CreateRule -> ByteString
toPath CreateRule' {[RuleAction]
Maybe Text
Text
RulePublishStatus
RuleTriggerEventSource
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
triggerEventSource :: RuleTriggerEventSource
name :: Text
instanceId :: Text
clientToken :: Maybe Text
$sel:publishStatus:CreateRule' :: CreateRule -> RulePublishStatus
$sel:actions:CreateRule' :: CreateRule -> [RuleAction]
$sel:function:CreateRule' :: CreateRule -> Text
$sel:triggerEventSource:CreateRule' :: CreateRule -> RuleTriggerEventSource
$sel:name:CreateRule' :: CreateRule -> Text
$sel:instanceId:CreateRule' :: CreateRule -> Text
$sel:clientToken:CreateRule' :: CreateRule -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/rules/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId]

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

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

-- |
-- Create a value of 'CreateRuleResponse' 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', 'createRuleResponse_httpStatus' - The response's http status code.
--
-- 'ruleArn', 'createRuleResponse_ruleArn' - The Amazon Resource Name (ARN) of the rule.
--
-- 'ruleId', 'createRuleResponse_ruleId' - A unique identifier for the rule.
newCreateRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'ruleArn'
  Prelude.Text ->
  -- | 'ruleId'
  Prelude.Text ->
  CreateRuleResponse
newCreateRuleResponse :: Int -> Text -> Text -> CreateRuleResponse
newCreateRuleResponse Int
pHttpStatus_ Text
pRuleArn_ Text
pRuleId_ =
  CreateRuleResponse'
    { $sel:httpStatus:CreateRuleResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:ruleArn:CreateRuleResponse' :: Text
ruleArn = Text
pRuleArn_,
      $sel:ruleId:CreateRuleResponse' :: Text
ruleId = Text
pRuleId_
    }

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

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

-- | A unique identifier for the rule.
createRuleResponse_ruleId :: Lens.Lens' CreateRuleResponse Prelude.Text
createRuleResponse_ruleId :: Lens' CreateRuleResponse Text
createRuleResponse_ruleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRuleResponse' {Text
ruleId :: Text
$sel:ruleId:CreateRuleResponse' :: CreateRuleResponse -> Text
ruleId} -> Text
ruleId) (\s :: CreateRuleResponse
s@CreateRuleResponse' {} Text
a -> CreateRuleResponse
s {$sel:ruleId:CreateRuleResponse' :: Text
ruleId = Text
a} :: CreateRuleResponse)

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