{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.IoTEvents.Types.Action
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.IoTEvents.Types.Action where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTEvents.Types.ClearTimerAction
import Amazonka.IoTEvents.Types.DynamoDBAction
import Amazonka.IoTEvents.Types.DynamoDBv2Action
import Amazonka.IoTEvents.Types.FirehoseAction
import Amazonka.IoTEvents.Types.IotEventsAction
import Amazonka.IoTEvents.Types.IotSiteWiseAction
import Amazonka.IoTEvents.Types.IotTopicPublishAction
import Amazonka.IoTEvents.Types.LambdaAction
import Amazonka.IoTEvents.Types.ResetTimerAction
import Amazonka.IoTEvents.Types.SNSTopicPublishAction
import Amazonka.IoTEvents.Types.SetTimerAction
import Amazonka.IoTEvents.Types.SetVariableAction
import Amazonka.IoTEvents.Types.SqsAction
import qualified Amazonka.Prelude as Prelude

-- | An action to be performed when the @condition@ is TRUE.
--
-- /See:/ 'newAction' smart constructor.
data Action = Action'
  { -- | Information needed to clear the timer.
    Action -> Maybe ClearTimerAction
clearTimer :: Prelude.Maybe ClearTimerAction,
    -- | Writes to the DynamoDB table that you created. The default action
    -- payload contains all attribute-value pairs that have the information
    -- about the detector model instance and the event that triggered the
    -- action. You can customize the
    -- <https://docs.aws.amazon.com/iotevents/latest/apireference/API_Payload.html payload>.
    -- One column of the DynamoDB table receives all attribute-value pairs in
    -- the payload that you specify. For more information, see
    -- <https://docs.aws.amazon.com/iotevents/latest/developerguide/iotevents-event-actions.html Actions>
    -- in /AWS IoT Events Developer Guide/.
    Action -> Maybe DynamoDBAction
dynamoDB :: Prelude.Maybe DynamoDBAction,
    -- | Writes to the DynamoDB table that you created. The default action
    -- payload contains all attribute-value pairs that have the information
    -- about the detector model instance and the event that triggered the
    -- action. You can customize the
    -- <https://docs.aws.amazon.com/iotevents/latest/apireference/API_Payload.html payload>.
    -- A separate column of the DynamoDB table receives one attribute-value
    -- pair in the payload that you specify. For more information, see
    -- <https://docs.aws.amazon.com/iotevents/latest/developerguide/iotevents-event-actions.html Actions>
    -- in /AWS IoT Events Developer Guide/.
    Action -> Maybe DynamoDBv2Action
dynamoDBv2 :: Prelude.Maybe DynamoDBv2Action,
    -- | Sends information about the detector model instance and the event that
    -- triggered the action to an Amazon Kinesis Data Firehose delivery stream.
    Action -> Maybe FirehoseAction
firehose :: Prelude.Maybe FirehoseAction,
    -- | Sends AWS IoT Events input, which passes information about the detector
    -- model instance and the event that triggered the action.
    Action -> Maybe IotEventsAction
iotEvents :: Prelude.Maybe IotEventsAction,
    -- | Sends information about the detector model instance and the event that
    -- triggered the action to an asset property in AWS IoT SiteWise .
    Action -> Maybe IotSiteWiseAction
iotSiteWise :: Prelude.Maybe IotSiteWiseAction,
    -- | Publishes an MQTT message with the given topic to the AWS IoT message
    -- broker.
    Action -> Maybe IotTopicPublishAction
iotTopicPublish :: Prelude.Maybe IotTopicPublishAction,
    -- | Calls a Lambda function, passing in information about the detector model
    -- instance and the event that triggered the action.
    Action -> Maybe LambdaAction
lambda :: Prelude.Maybe LambdaAction,
    -- | Information needed to reset the timer.
    Action -> Maybe ResetTimerAction
resetTimer :: Prelude.Maybe ResetTimerAction,
    -- | Information needed to set the timer.
    Action -> Maybe SetTimerAction
setTimer :: Prelude.Maybe SetTimerAction,
    -- | Sets a variable to a specified value.
    Action -> Maybe SetVariableAction
setVariable :: Prelude.Maybe SetVariableAction,
    -- | Sends an Amazon SNS message.
    Action -> Maybe SNSTopicPublishAction
sns :: Prelude.Maybe SNSTopicPublishAction,
    -- | Sends information about the detector model instance and the event that
    -- triggered the action to an Amazon SQS queue.
    Action -> Maybe SqsAction
sqs :: Prelude.Maybe SqsAction
  }
  deriving (Action -> Action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Prelude.Eq, ReadPrec [Action]
ReadPrec Action
Int -> ReadS Action
ReadS [Action]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Action]
$creadListPrec :: ReadPrec [Action]
readPrec :: ReadPrec Action
$creadPrec :: ReadPrec Action
readList :: ReadS [Action]
$creadList :: ReadS [Action]
readsPrec :: Int -> ReadS Action
$creadsPrec :: Int -> ReadS Action
Prelude.Read, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Prelude.Show, forall x. Rep Action x -> Action
forall x. Action -> Rep Action x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Action x -> Action
$cfrom :: forall x. Action -> Rep Action x
Prelude.Generic)

-- |
-- Create a value of 'Action' 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:
--
-- 'clearTimer', 'action_clearTimer' - Information needed to clear the timer.
--
-- 'dynamoDB', 'action_dynamoDB' - Writes to the DynamoDB table that you created. The default action
-- payload contains all attribute-value pairs that have the information
-- about the detector model instance and the event that triggered the
-- action. You can customize the
-- <https://docs.aws.amazon.com/iotevents/latest/apireference/API_Payload.html payload>.
-- One column of the DynamoDB table receives all attribute-value pairs in
-- the payload that you specify. For more information, see
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/iotevents-event-actions.html Actions>
-- in /AWS IoT Events Developer Guide/.
--
-- 'dynamoDBv2', 'action_dynamoDBv2' - Writes to the DynamoDB table that you created. The default action
-- payload contains all attribute-value pairs that have the information
-- about the detector model instance and the event that triggered the
-- action. You can customize the
-- <https://docs.aws.amazon.com/iotevents/latest/apireference/API_Payload.html payload>.
-- A separate column of the DynamoDB table receives one attribute-value
-- pair in the payload that you specify. For more information, see
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/iotevents-event-actions.html Actions>
-- in /AWS IoT Events Developer Guide/.
--
-- 'firehose', 'action_firehose' - Sends information about the detector model instance and the event that
-- triggered the action to an Amazon Kinesis Data Firehose delivery stream.
--
-- 'iotEvents', 'action_iotEvents' - Sends AWS IoT Events input, which passes information about the detector
-- model instance and the event that triggered the action.
--
-- 'iotSiteWise', 'action_iotSiteWise' - Sends information about the detector model instance and the event that
-- triggered the action to an asset property in AWS IoT SiteWise .
--
-- 'iotTopicPublish', 'action_iotTopicPublish' - Publishes an MQTT message with the given topic to the AWS IoT message
-- broker.
--
-- 'lambda', 'action_lambda' - Calls a Lambda function, passing in information about the detector model
-- instance and the event that triggered the action.
--
-- 'resetTimer', 'action_resetTimer' - Information needed to reset the timer.
--
-- 'setTimer', 'action_setTimer' - Information needed to set the timer.
--
-- 'setVariable', 'action_setVariable' - Sets a variable to a specified value.
--
-- 'sns', 'action_sns' - Sends an Amazon SNS message.
--
-- 'sqs', 'action_sqs' - Sends information about the detector model instance and the event that
-- triggered the action to an Amazon SQS queue.
newAction ::
  Action
newAction :: Action
newAction =
  Action'
    { $sel:clearTimer:Action' :: Maybe ClearTimerAction
clearTimer = forall a. Maybe a
Prelude.Nothing,
      $sel:dynamoDB:Action' :: Maybe DynamoDBAction
dynamoDB = forall a. Maybe a
Prelude.Nothing,
      $sel:dynamoDBv2:Action' :: Maybe DynamoDBv2Action
dynamoDBv2 = forall a. Maybe a
Prelude.Nothing,
      $sel:firehose:Action' :: Maybe FirehoseAction
firehose = forall a. Maybe a
Prelude.Nothing,
      $sel:iotEvents:Action' :: Maybe IotEventsAction
iotEvents = forall a. Maybe a
Prelude.Nothing,
      $sel:iotSiteWise:Action' :: Maybe IotSiteWiseAction
iotSiteWise = forall a. Maybe a
Prelude.Nothing,
      $sel:iotTopicPublish:Action' :: Maybe IotTopicPublishAction
iotTopicPublish = forall a. Maybe a
Prelude.Nothing,
      $sel:lambda:Action' :: Maybe LambdaAction
lambda = forall a. Maybe a
Prelude.Nothing,
      $sel:resetTimer:Action' :: Maybe ResetTimerAction
resetTimer = forall a. Maybe a
Prelude.Nothing,
      $sel:setTimer:Action' :: Maybe SetTimerAction
setTimer = forall a. Maybe a
Prelude.Nothing,
      $sel:setVariable:Action' :: Maybe SetVariableAction
setVariable = forall a. Maybe a
Prelude.Nothing,
      $sel:sns:Action' :: Maybe SNSTopicPublishAction
sns = forall a. Maybe a
Prelude.Nothing,
      $sel:sqs:Action' :: Maybe SqsAction
sqs = forall a. Maybe a
Prelude.Nothing
    }

-- | Information needed to clear the timer.
action_clearTimer :: Lens.Lens' Action (Prelude.Maybe ClearTimerAction)
action_clearTimer :: Lens' Action (Maybe ClearTimerAction)
action_clearTimer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe ClearTimerAction
clearTimer :: Maybe ClearTimerAction
$sel:clearTimer:Action' :: Action -> Maybe ClearTimerAction
clearTimer} -> Maybe ClearTimerAction
clearTimer) (\s :: Action
s@Action' {} Maybe ClearTimerAction
a -> Action
s {$sel:clearTimer:Action' :: Maybe ClearTimerAction
clearTimer = Maybe ClearTimerAction
a} :: Action)

-- | Writes to the DynamoDB table that you created. The default action
-- payload contains all attribute-value pairs that have the information
-- about the detector model instance and the event that triggered the
-- action. You can customize the
-- <https://docs.aws.amazon.com/iotevents/latest/apireference/API_Payload.html payload>.
-- One column of the DynamoDB table receives all attribute-value pairs in
-- the payload that you specify. For more information, see
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/iotevents-event-actions.html Actions>
-- in /AWS IoT Events Developer Guide/.
action_dynamoDB :: Lens.Lens' Action (Prelude.Maybe DynamoDBAction)
action_dynamoDB :: Lens' Action (Maybe DynamoDBAction)
action_dynamoDB = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe DynamoDBAction
dynamoDB :: Maybe DynamoDBAction
$sel:dynamoDB:Action' :: Action -> Maybe DynamoDBAction
dynamoDB} -> Maybe DynamoDBAction
dynamoDB) (\s :: Action
s@Action' {} Maybe DynamoDBAction
a -> Action
s {$sel:dynamoDB:Action' :: Maybe DynamoDBAction
dynamoDB = Maybe DynamoDBAction
a} :: Action)

-- | Writes to the DynamoDB table that you created. The default action
-- payload contains all attribute-value pairs that have the information
-- about the detector model instance and the event that triggered the
-- action. You can customize the
-- <https://docs.aws.amazon.com/iotevents/latest/apireference/API_Payload.html payload>.
-- A separate column of the DynamoDB table receives one attribute-value
-- pair in the payload that you specify. For more information, see
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/iotevents-event-actions.html Actions>
-- in /AWS IoT Events Developer Guide/.
action_dynamoDBv2 :: Lens.Lens' Action (Prelude.Maybe DynamoDBv2Action)
action_dynamoDBv2 :: Lens' Action (Maybe DynamoDBv2Action)
action_dynamoDBv2 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe DynamoDBv2Action
dynamoDBv2 :: Maybe DynamoDBv2Action
$sel:dynamoDBv2:Action' :: Action -> Maybe DynamoDBv2Action
dynamoDBv2} -> Maybe DynamoDBv2Action
dynamoDBv2) (\s :: Action
s@Action' {} Maybe DynamoDBv2Action
a -> Action
s {$sel:dynamoDBv2:Action' :: Maybe DynamoDBv2Action
dynamoDBv2 = Maybe DynamoDBv2Action
a} :: Action)

-- | Sends information about the detector model instance and the event that
-- triggered the action to an Amazon Kinesis Data Firehose delivery stream.
action_firehose :: Lens.Lens' Action (Prelude.Maybe FirehoseAction)
action_firehose :: Lens' Action (Maybe FirehoseAction)
action_firehose = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe FirehoseAction
firehose :: Maybe FirehoseAction
$sel:firehose:Action' :: Action -> Maybe FirehoseAction
firehose} -> Maybe FirehoseAction
firehose) (\s :: Action
s@Action' {} Maybe FirehoseAction
a -> Action
s {$sel:firehose:Action' :: Maybe FirehoseAction
firehose = Maybe FirehoseAction
a} :: Action)

-- | Sends AWS IoT Events input, which passes information about the detector
-- model instance and the event that triggered the action.
action_iotEvents :: Lens.Lens' Action (Prelude.Maybe IotEventsAction)
action_iotEvents :: Lens' Action (Maybe IotEventsAction)
action_iotEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe IotEventsAction
iotEvents :: Maybe IotEventsAction
$sel:iotEvents:Action' :: Action -> Maybe IotEventsAction
iotEvents} -> Maybe IotEventsAction
iotEvents) (\s :: Action
s@Action' {} Maybe IotEventsAction
a -> Action
s {$sel:iotEvents:Action' :: Maybe IotEventsAction
iotEvents = Maybe IotEventsAction
a} :: Action)

-- | Sends information about the detector model instance and the event that
-- triggered the action to an asset property in AWS IoT SiteWise .
action_iotSiteWise :: Lens.Lens' Action (Prelude.Maybe IotSiteWiseAction)
action_iotSiteWise :: Lens' Action (Maybe IotSiteWiseAction)
action_iotSiteWise = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe IotSiteWiseAction
iotSiteWise :: Maybe IotSiteWiseAction
$sel:iotSiteWise:Action' :: Action -> Maybe IotSiteWiseAction
iotSiteWise} -> Maybe IotSiteWiseAction
iotSiteWise) (\s :: Action
s@Action' {} Maybe IotSiteWiseAction
a -> Action
s {$sel:iotSiteWise:Action' :: Maybe IotSiteWiseAction
iotSiteWise = Maybe IotSiteWiseAction
a} :: Action)

-- | Publishes an MQTT message with the given topic to the AWS IoT message
-- broker.
action_iotTopicPublish :: Lens.Lens' Action (Prelude.Maybe IotTopicPublishAction)
action_iotTopicPublish :: Lens' Action (Maybe IotTopicPublishAction)
action_iotTopicPublish = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe IotTopicPublishAction
iotTopicPublish :: Maybe IotTopicPublishAction
$sel:iotTopicPublish:Action' :: Action -> Maybe IotTopicPublishAction
iotTopicPublish} -> Maybe IotTopicPublishAction
iotTopicPublish) (\s :: Action
s@Action' {} Maybe IotTopicPublishAction
a -> Action
s {$sel:iotTopicPublish:Action' :: Maybe IotTopicPublishAction
iotTopicPublish = Maybe IotTopicPublishAction
a} :: Action)

-- | Calls a Lambda function, passing in information about the detector model
-- instance and the event that triggered the action.
action_lambda :: Lens.Lens' Action (Prelude.Maybe LambdaAction)
action_lambda :: Lens' Action (Maybe LambdaAction)
action_lambda = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe LambdaAction
lambda :: Maybe LambdaAction
$sel:lambda:Action' :: Action -> Maybe LambdaAction
lambda} -> Maybe LambdaAction
lambda) (\s :: Action
s@Action' {} Maybe LambdaAction
a -> Action
s {$sel:lambda:Action' :: Maybe LambdaAction
lambda = Maybe LambdaAction
a} :: Action)

-- | Information needed to reset the timer.
action_resetTimer :: Lens.Lens' Action (Prelude.Maybe ResetTimerAction)
action_resetTimer :: Lens' Action (Maybe ResetTimerAction)
action_resetTimer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe ResetTimerAction
resetTimer :: Maybe ResetTimerAction
$sel:resetTimer:Action' :: Action -> Maybe ResetTimerAction
resetTimer} -> Maybe ResetTimerAction
resetTimer) (\s :: Action
s@Action' {} Maybe ResetTimerAction
a -> Action
s {$sel:resetTimer:Action' :: Maybe ResetTimerAction
resetTimer = Maybe ResetTimerAction
a} :: Action)

-- | Information needed to set the timer.
action_setTimer :: Lens.Lens' Action (Prelude.Maybe SetTimerAction)
action_setTimer :: Lens' Action (Maybe SetTimerAction)
action_setTimer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe SetTimerAction
setTimer :: Maybe SetTimerAction
$sel:setTimer:Action' :: Action -> Maybe SetTimerAction
setTimer} -> Maybe SetTimerAction
setTimer) (\s :: Action
s@Action' {} Maybe SetTimerAction
a -> Action
s {$sel:setTimer:Action' :: Maybe SetTimerAction
setTimer = Maybe SetTimerAction
a} :: Action)

-- | Sets a variable to a specified value.
action_setVariable :: Lens.Lens' Action (Prelude.Maybe SetVariableAction)
action_setVariable :: Lens' Action (Maybe SetVariableAction)
action_setVariable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe SetVariableAction
setVariable :: Maybe SetVariableAction
$sel:setVariable:Action' :: Action -> Maybe SetVariableAction
setVariable} -> Maybe SetVariableAction
setVariable) (\s :: Action
s@Action' {} Maybe SetVariableAction
a -> Action
s {$sel:setVariable:Action' :: Maybe SetVariableAction
setVariable = Maybe SetVariableAction
a} :: Action)

-- | Sends an Amazon SNS message.
action_sns :: Lens.Lens' Action (Prelude.Maybe SNSTopicPublishAction)
action_sns :: Lens' Action (Maybe SNSTopicPublishAction)
action_sns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe SNSTopicPublishAction
sns :: Maybe SNSTopicPublishAction
$sel:sns:Action' :: Action -> Maybe SNSTopicPublishAction
sns} -> Maybe SNSTopicPublishAction
sns) (\s :: Action
s@Action' {} Maybe SNSTopicPublishAction
a -> Action
s {$sel:sns:Action' :: Maybe SNSTopicPublishAction
sns = Maybe SNSTopicPublishAction
a} :: Action)

-- | Sends information about the detector model instance and the event that
-- triggered the action to an Amazon SQS queue.
action_sqs :: Lens.Lens' Action (Prelude.Maybe SqsAction)
action_sqs :: Lens' Action (Maybe SqsAction)
action_sqs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Maybe SqsAction
sqs :: Maybe SqsAction
$sel:sqs:Action' :: Action -> Maybe SqsAction
sqs} -> Maybe SqsAction
sqs) (\s :: Action
s@Action' {} Maybe SqsAction
a -> Action
s {$sel:sqs:Action' :: Maybe SqsAction
sqs = Maybe SqsAction
a} :: Action)

instance Data.FromJSON Action where
  parseJSON :: Value -> Parser Action
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Action"
      ( \Object
x ->
          Maybe ClearTimerAction
-> Maybe DynamoDBAction
-> Maybe DynamoDBv2Action
-> Maybe FirehoseAction
-> Maybe IotEventsAction
-> Maybe IotSiteWiseAction
-> Maybe IotTopicPublishAction
-> Maybe LambdaAction
-> Maybe ResetTimerAction
-> Maybe SetTimerAction
-> Maybe SetVariableAction
-> Maybe SNSTopicPublishAction
-> Maybe SqsAction
-> Action
Action'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"clearTimer")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"dynamoDB")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"dynamoDBv2")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"firehose")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"iotEvents")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"iotSiteWise")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"iotTopicPublish")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"lambda")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"resetTimer")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"setTimer")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"setVariable")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"sns")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"sqs")
      )

instance Prelude.Hashable Action where
  hashWithSalt :: Int -> Action -> Int
hashWithSalt Int
_salt Action' {Maybe ClearTimerAction
Maybe IotSiteWiseAction
Maybe LambdaAction
Maybe IotTopicPublishAction
Maybe IotEventsAction
Maybe FirehoseAction
Maybe DynamoDBv2Action
Maybe DynamoDBAction
Maybe ResetTimerAction
Maybe SNSTopicPublishAction
Maybe SetTimerAction
Maybe SetVariableAction
Maybe SqsAction
sqs :: Maybe SqsAction
sns :: Maybe SNSTopicPublishAction
setVariable :: Maybe SetVariableAction
setTimer :: Maybe SetTimerAction
resetTimer :: Maybe ResetTimerAction
lambda :: Maybe LambdaAction
iotTopicPublish :: Maybe IotTopicPublishAction
iotSiteWise :: Maybe IotSiteWiseAction
iotEvents :: Maybe IotEventsAction
firehose :: Maybe FirehoseAction
dynamoDBv2 :: Maybe DynamoDBv2Action
dynamoDB :: Maybe DynamoDBAction
clearTimer :: Maybe ClearTimerAction
$sel:sqs:Action' :: Action -> Maybe SqsAction
$sel:sns:Action' :: Action -> Maybe SNSTopicPublishAction
$sel:setVariable:Action' :: Action -> Maybe SetVariableAction
$sel:setTimer:Action' :: Action -> Maybe SetTimerAction
$sel:resetTimer:Action' :: Action -> Maybe ResetTimerAction
$sel:lambda:Action' :: Action -> Maybe LambdaAction
$sel:iotTopicPublish:Action' :: Action -> Maybe IotTopicPublishAction
$sel:iotSiteWise:Action' :: Action -> Maybe IotSiteWiseAction
$sel:iotEvents:Action' :: Action -> Maybe IotEventsAction
$sel:firehose:Action' :: Action -> Maybe FirehoseAction
$sel:dynamoDBv2:Action' :: Action -> Maybe DynamoDBv2Action
$sel:dynamoDB:Action' :: Action -> Maybe DynamoDBAction
$sel:clearTimer:Action' :: Action -> Maybe ClearTimerAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClearTimerAction
clearTimer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DynamoDBAction
dynamoDB
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DynamoDBv2Action
dynamoDBv2
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FirehoseAction
firehose
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IotEventsAction
iotEvents
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IotSiteWiseAction
iotSiteWise
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IotTopicPublishAction
iotTopicPublish
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LambdaAction
lambda
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResetTimerAction
resetTimer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SetTimerAction
setTimer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SetVariableAction
setVariable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SNSTopicPublishAction
sns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SqsAction
sqs

instance Prelude.NFData Action where
  rnf :: Action -> ()
rnf Action' {Maybe ClearTimerAction
Maybe IotSiteWiseAction
Maybe LambdaAction
Maybe IotTopicPublishAction
Maybe IotEventsAction
Maybe FirehoseAction
Maybe DynamoDBv2Action
Maybe DynamoDBAction
Maybe ResetTimerAction
Maybe SNSTopicPublishAction
Maybe SetTimerAction
Maybe SetVariableAction
Maybe SqsAction
sqs :: Maybe SqsAction
sns :: Maybe SNSTopicPublishAction
setVariable :: Maybe SetVariableAction
setTimer :: Maybe SetTimerAction
resetTimer :: Maybe ResetTimerAction
lambda :: Maybe LambdaAction
iotTopicPublish :: Maybe IotTopicPublishAction
iotSiteWise :: Maybe IotSiteWiseAction
iotEvents :: Maybe IotEventsAction
firehose :: Maybe FirehoseAction
dynamoDBv2 :: Maybe DynamoDBv2Action
dynamoDB :: Maybe DynamoDBAction
clearTimer :: Maybe ClearTimerAction
$sel:sqs:Action' :: Action -> Maybe SqsAction
$sel:sns:Action' :: Action -> Maybe SNSTopicPublishAction
$sel:setVariable:Action' :: Action -> Maybe SetVariableAction
$sel:setTimer:Action' :: Action -> Maybe SetTimerAction
$sel:resetTimer:Action' :: Action -> Maybe ResetTimerAction
$sel:lambda:Action' :: Action -> Maybe LambdaAction
$sel:iotTopicPublish:Action' :: Action -> Maybe IotTopicPublishAction
$sel:iotSiteWise:Action' :: Action -> Maybe IotSiteWiseAction
$sel:iotEvents:Action' :: Action -> Maybe IotEventsAction
$sel:firehose:Action' :: Action -> Maybe FirehoseAction
$sel:dynamoDBv2:Action' :: Action -> Maybe DynamoDBv2Action
$sel:dynamoDB:Action' :: Action -> Maybe DynamoDBAction
$sel:clearTimer:Action' :: Action -> Maybe ClearTimerAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ClearTimerAction
clearTimer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DynamoDBAction
dynamoDB
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DynamoDBv2Action
dynamoDBv2
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FirehoseAction
firehose
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IotEventsAction
iotEvents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IotSiteWiseAction
iotSiteWise
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IotTopicPublishAction
iotTopicPublish
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LambdaAction
lambda
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResetTimerAction
resetTimer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SetTimerAction
setTimer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SetVariableAction
setVariable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SNSTopicPublishAction
sns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SqsAction
sqs

instance Data.ToJSON Action where
  toJSON :: Action -> Value
toJSON Action' {Maybe ClearTimerAction
Maybe IotSiteWiseAction
Maybe LambdaAction
Maybe IotTopicPublishAction
Maybe IotEventsAction
Maybe FirehoseAction
Maybe DynamoDBv2Action
Maybe DynamoDBAction
Maybe ResetTimerAction
Maybe SNSTopicPublishAction
Maybe SetTimerAction
Maybe SetVariableAction
Maybe SqsAction
sqs :: Maybe SqsAction
sns :: Maybe SNSTopicPublishAction
setVariable :: Maybe SetVariableAction
setTimer :: Maybe SetTimerAction
resetTimer :: Maybe ResetTimerAction
lambda :: Maybe LambdaAction
iotTopicPublish :: Maybe IotTopicPublishAction
iotSiteWise :: Maybe IotSiteWiseAction
iotEvents :: Maybe IotEventsAction
firehose :: Maybe FirehoseAction
dynamoDBv2 :: Maybe DynamoDBv2Action
dynamoDB :: Maybe DynamoDBAction
clearTimer :: Maybe ClearTimerAction
$sel:sqs:Action' :: Action -> Maybe SqsAction
$sel:sns:Action' :: Action -> Maybe SNSTopicPublishAction
$sel:setVariable:Action' :: Action -> Maybe SetVariableAction
$sel:setTimer:Action' :: Action -> Maybe SetTimerAction
$sel:resetTimer:Action' :: Action -> Maybe ResetTimerAction
$sel:lambda:Action' :: Action -> Maybe LambdaAction
$sel:iotTopicPublish:Action' :: Action -> Maybe IotTopicPublishAction
$sel:iotSiteWise:Action' :: Action -> Maybe IotSiteWiseAction
$sel:iotEvents:Action' :: Action -> Maybe IotEventsAction
$sel:firehose:Action' :: Action -> Maybe FirehoseAction
$sel:dynamoDBv2:Action' :: Action -> Maybe DynamoDBv2Action
$sel:dynamoDB:Action' :: Action -> Maybe DynamoDBAction
$sel:clearTimer:Action' :: Action -> Maybe ClearTimerAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clearTimer" 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 ClearTimerAction
clearTimer,
            (Key
"dynamoDB" 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 DynamoDBAction
dynamoDB,
            (Key
"dynamoDBv2" 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 DynamoDBv2Action
dynamoDBv2,
            (Key
"firehose" 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 FirehoseAction
firehose,
            (Key
"iotEvents" 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 IotEventsAction
iotEvents,
            (Key
"iotSiteWise" 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 IotSiteWiseAction
iotSiteWise,
            (Key
"iotTopicPublish" 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 IotTopicPublishAction
iotTopicPublish,
            (Key
"lambda" 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 LambdaAction
lambda,
            (Key
"resetTimer" 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 ResetTimerAction
resetTimer,
            (Key
"setTimer" 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 SetTimerAction
setTimer,
            (Key
"setVariable" 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 SetVariableAction
setVariable,
            (Key
"sns" 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 SNSTopicPublishAction
sns,
            (Key
"sqs" 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 SqsAction
sqs
          ]
      )