{-# 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.UpdateRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates 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.UpdateRule
  ( -- * Creating a Request
    UpdateRule (..),
    newUpdateRule,

    -- * Request Lenses
    updateRule_ruleId,
    updateRule_instanceId,
    updateRule_name,
    updateRule_function,
    updateRule_actions,
    updateRule_publishStatus,

    -- * Destructuring the Response
    UpdateRuleResponse (..),
    newUpdateRuleResponse,
  )
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:/ 'newUpdateRule' smart constructor.
data UpdateRule = UpdateRule'
  { -- | A unique identifier for the rule.
    UpdateRule -> Text
ruleId :: Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    UpdateRule -> Text
instanceId :: Prelude.Text,
    -- | The name of the rule. You can change the name only if
    -- @TriggerEventSource@ is one of the following values:
    -- @OnZendeskTicketCreate@ | @OnZendeskTicketStatusUpdate@ |
    -- @OnSalesforceCaseCreate@
    UpdateRule -> Text
name :: Prelude.Text,
    -- | The conditions of the rule.
    UpdateRule -> Text
function :: Prelude.Text,
    -- | A list of actions to be run when the rule is triggered.
    UpdateRule -> [RuleAction]
actions :: [RuleAction],
    -- | The publish status of the rule.
    UpdateRule -> RulePublishStatus
publishStatus :: RulePublishStatus
  }
  deriving (UpdateRule -> UpdateRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRule -> UpdateRule -> Bool
$c/= :: UpdateRule -> UpdateRule -> Bool
== :: UpdateRule -> UpdateRule -> Bool
$c== :: UpdateRule -> UpdateRule -> Bool
Prelude.Eq, ReadPrec [UpdateRule]
ReadPrec UpdateRule
Int -> ReadS UpdateRule
ReadS [UpdateRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRule]
$creadListPrec :: ReadPrec [UpdateRule]
readPrec :: ReadPrec UpdateRule
$creadPrec :: ReadPrec UpdateRule
readList :: ReadS [UpdateRule]
$creadList :: ReadS [UpdateRule]
readsPrec :: Int -> ReadS UpdateRule
$creadsPrec :: Int -> ReadS UpdateRule
Prelude.Read, Int -> UpdateRule -> ShowS
[UpdateRule] -> ShowS
UpdateRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRule] -> ShowS
$cshowList :: [UpdateRule] -> ShowS
show :: UpdateRule -> String
$cshow :: UpdateRule -> String
showsPrec :: Int -> UpdateRule -> ShowS
$cshowsPrec :: Int -> UpdateRule -> ShowS
Prelude.Show, forall x. Rep UpdateRule x -> UpdateRule
forall x. UpdateRule -> Rep UpdateRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRule x -> UpdateRule
$cfrom :: forall x. UpdateRule -> Rep UpdateRule x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRule' 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:
--
-- 'ruleId', 'updateRule_ruleId' - A unique identifier for the rule.
--
-- 'instanceId', 'updateRule_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'name', 'updateRule_name' - The name of the rule. You can change the name only if
-- @TriggerEventSource@ is one of the following values:
-- @OnZendeskTicketCreate@ | @OnZendeskTicketStatusUpdate@ |
-- @OnSalesforceCaseCreate@
--
-- 'function', 'updateRule_function' - The conditions of the rule.
--
-- 'actions', 'updateRule_actions' - A list of actions to be run when the rule is triggered.
--
-- 'publishStatus', 'updateRule_publishStatus' - The publish status of the rule.
newUpdateRule ::
  -- | 'ruleId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'function'
  Prelude.Text ->
  -- | 'publishStatus'
  RulePublishStatus ->
  UpdateRule
newUpdateRule :: Text -> Text -> Text -> Text -> RulePublishStatus -> UpdateRule
newUpdateRule
  Text
pRuleId_
  Text
pInstanceId_
  Text
pName_
  Text
pFunction_
  RulePublishStatus
pPublishStatus_ =
    UpdateRule'
      { $sel:ruleId:UpdateRule' :: Text
ruleId = Text
pRuleId_,
        $sel:instanceId:UpdateRule' :: Text
instanceId = Text
pInstanceId_,
        $sel:name:UpdateRule' :: Text
name = Text
pName_,
        $sel:function:UpdateRule' :: Text
function = Text
pFunction_,
        $sel:actions:UpdateRule' :: [RuleAction]
actions = forall a. Monoid a => a
Prelude.mempty,
        $sel:publishStatus:UpdateRule' :: RulePublishStatus
publishStatus = RulePublishStatus
pPublishStatus_
      }

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

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

-- | The name of the rule. You can change the name only if
-- @TriggerEventSource@ is one of the following values:
-- @OnZendeskTicketCreate@ | @OnZendeskTicketStatusUpdate@ |
-- @OnSalesforceCaseCreate@
updateRule_name :: Lens.Lens' UpdateRule Prelude.Text
updateRule_name :: Lens' UpdateRule Text
updateRule_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRule' {Text
name :: Text
$sel:name:UpdateRule' :: UpdateRule -> Text
name} -> Text
name) (\s :: UpdateRule
s@UpdateRule' {} Text
a -> UpdateRule
s {$sel:name:UpdateRule' :: Text
name = Text
a} :: UpdateRule)

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

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

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

instance Prelude.Hashable UpdateRule where
  hashWithSalt :: Int -> UpdateRule -> Int
hashWithSalt Int
_salt UpdateRule' {[RuleAction]
Text
RulePublishStatus
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
name :: Text
instanceId :: Text
ruleId :: Text
$sel:publishStatus:UpdateRule' :: UpdateRule -> RulePublishStatus
$sel:actions:UpdateRule' :: UpdateRule -> [RuleAction]
$sel:function:UpdateRule' :: UpdateRule -> Text
$sel:name:UpdateRule' :: UpdateRule -> Text
$sel:instanceId:UpdateRule' :: UpdateRule -> Text
$sel:ruleId:UpdateRule' :: UpdateRule -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleId
      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` 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 UpdateRule where
  rnf :: UpdateRule -> ()
rnf UpdateRule' {[RuleAction]
Text
RulePublishStatus
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
name :: Text
instanceId :: Text
ruleId :: Text
$sel:publishStatus:UpdateRule' :: UpdateRule -> RulePublishStatus
$sel:actions:UpdateRule' :: UpdateRule -> [RuleAction]
$sel:function:UpdateRule' :: UpdateRule -> Text
$sel:name:UpdateRule' :: UpdateRule -> Text
$sel:instanceId:UpdateRule' :: UpdateRule -> Text
$sel:ruleId:UpdateRule' :: UpdateRule -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
ruleId
      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 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 UpdateRule where
  toHeaders :: UpdateRule -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateRule where
  toJSON :: UpdateRule -> Value
toJSON UpdateRule' {[RuleAction]
Text
RulePublishStatus
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
name :: Text
instanceId :: Text
ruleId :: Text
$sel:publishStatus:UpdateRule' :: UpdateRule -> RulePublishStatus
$sel:actions:UpdateRule' :: UpdateRule -> [RuleAction]
$sel:function:UpdateRule' :: UpdateRule -> Text
$sel:name:UpdateRule' :: UpdateRule -> Text
$sel:instanceId:UpdateRule' :: UpdateRule -> Text
$sel:ruleId:UpdateRule' :: UpdateRule -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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
"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 UpdateRule where
  toPath :: UpdateRule -> ByteString
toPath UpdateRule' {[RuleAction]
Text
RulePublishStatus
publishStatus :: RulePublishStatus
actions :: [RuleAction]
function :: Text
name :: Text
instanceId :: Text
ruleId :: Text
$sel:publishStatus:UpdateRule' :: UpdateRule -> RulePublishStatus
$sel:actions:UpdateRule' :: UpdateRule -> [RuleAction]
$sel:function:UpdateRule' :: UpdateRule -> Text
$sel:name:UpdateRule' :: UpdateRule -> Text
$sel:instanceId:UpdateRule' :: UpdateRule -> Text
$sel:ruleId:UpdateRule' :: UpdateRule -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/rules/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
ruleId
      ]

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

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

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

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