{-# 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.IoT.Types.BehaviorCriteria
-- 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.IoT.Types.BehaviorCriteria where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types.ComparisonOperator
import Amazonka.IoT.Types.MachineLearningDetectionConfig
import Amazonka.IoT.Types.MetricValue
import Amazonka.IoT.Types.StatisticalThreshold
import qualified Amazonka.Prelude as Prelude

-- | The criteria by which the behavior is determined to be normal.
--
-- /See:/ 'newBehaviorCriteria' smart constructor.
data BehaviorCriteria = BehaviorCriteria'
  { -- | The operator that relates the thing measured (@metric@) to the criteria
    -- (containing a @value@ or @statisticalThreshold@). Valid operators
    -- include:
    --
    -- -   @string-list@: @in-set@ and @not-in-set@
    --
    -- -   @number-list@: @in-set@ and @not-in-set@
    --
    -- -   @ip-address-list@: @in-cidr-set@ and @not-in-cidr-set@
    --
    -- -   @number@: @less-than@, @less-than-equals@, @greater-than@, and
    --     @greater-than-equals@
    BehaviorCriteria -> Maybe ComparisonOperator
comparisonOperator :: Prelude.Maybe ComparisonOperator,
    -- | If a device is in violation of the behavior for the specified number of
    -- consecutive datapoints, an alarm occurs. If not specified, the default
    -- is 1.
    BehaviorCriteria -> Maybe Natural
consecutiveDatapointsToAlarm :: Prelude.Maybe Prelude.Natural,
    -- | If an alarm has occurred and the offending device is no longer in
    -- violation of the behavior for the specified number of consecutive
    -- datapoints, the alarm is cleared. If not specified, the default is 1.
    BehaviorCriteria -> Maybe Natural
consecutiveDatapointsToClear :: Prelude.Maybe Prelude.Natural,
    -- | Use this to specify the time duration over which the behavior is
    -- evaluated, for those criteria that have a time dimension (for example,
    -- @NUM_MESSAGES_SENT@). For a @statisticalThreshhold@ metric comparison,
    -- measurements from all devices are accumulated over this time duration
    -- before being used to calculate percentiles, and later, measurements from
    -- an individual device are also accumulated over this time duration before
    -- being given a percentile rank. Cannot be used with list-based metric
    -- datatypes.
    BehaviorCriteria -> Maybe Int
durationSeconds :: Prelude.Maybe Prelude.Int,
    -- | The configuration of an ML Detect
    BehaviorCriteria -> Maybe MachineLearningDetectionConfig
mlDetectionConfig :: Prelude.Maybe MachineLearningDetectionConfig,
    -- | A statistical ranking (percentile)that indicates a threshold value by
    -- which a behavior is determined to be in compliance or in violation of
    -- the behavior.
    BehaviorCriteria -> Maybe StatisticalThreshold
statisticalThreshold :: Prelude.Maybe StatisticalThreshold,
    -- | The value to be compared with the @metric@.
    BehaviorCriteria -> Maybe MetricValue
value :: Prelude.Maybe MetricValue
  }
  deriving (BehaviorCriteria -> BehaviorCriteria -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BehaviorCriteria -> BehaviorCriteria -> Bool
$c/= :: BehaviorCriteria -> BehaviorCriteria -> Bool
== :: BehaviorCriteria -> BehaviorCriteria -> Bool
$c== :: BehaviorCriteria -> BehaviorCriteria -> Bool
Prelude.Eq, ReadPrec [BehaviorCriteria]
ReadPrec BehaviorCriteria
Int -> ReadS BehaviorCriteria
ReadS [BehaviorCriteria]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BehaviorCriteria]
$creadListPrec :: ReadPrec [BehaviorCriteria]
readPrec :: ReadPrec BehaviorCriteria
$creadPrec :: ReadPrec BehaviorCriteria
readList :: ReadS [BehaviorCriteria]
$creadList :: ReadS [BehaviorCriteria]
readsPrec :: Int -> ReadS BehaviorCriteria
$creadsPrec :: Int -> ReadS BehaviorCriteria
Prelude.Read, Int -> BehaviorCriteria -> ShowS
[BehaviorCriteria] -> ShowS
BehaviorCriteria -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BehaviorCriteria] -> ShowS
$cshowList :: [BehaviorCriteria] -> ShowS
show :: BehaviorCriteria -> String
$cshow :: BehaviorCriteria -> String
showsPrec :: Int -> BehaviorCriteria -> ShowS
$cshowsPrec :: Int -> BehaviorCriteria -> ShowS
Prelude.Show, forall x. Rep BehaviorCriteria x -> BehaviorCriteria
forall x. BehaviorCriteria -> Rep BehaviorCriteria x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BehaviorCriteria x -> BehaviorCriteria
$cfrom :: forall x. BehaviorCriteria -> Rep BehaviorCriteria x
Prelude.Generic)

-- |
-- Create a value of 'BehaviorCriteria' 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:
--
-- 'comparisonOperator', 'behaviorCriteria_comparisonOperator' - The operator that relates the thing measured (@metric@) to the criteria
-- (containing a @value@ or @statisticalThreshold@). Valid operators
-- include:
--
-- -   @string-list@: @in-set@ and @not-in-set@
--
-- -   @number-list@: @in-set@ and @not-in-set@
--
-- -   @ip-address-list@: @in-cidr-set@ and @not-in-cidr-set@
--
-- -   @number@: @less-than@, @less-than-equals@, @greater-than@, and
--     @greater-than-equals@
--
-- 'consecutiveDatapointsToAlarm', 'behaviorCriteria_consecutiveDatapointsToAlarm' - If a device is in violation of the behavior for the specified number of
-- consecutive datapoints, an alarm occurs. If not specified, the default
-- is 1.
--
-- 'consecutiveDatapointsToClear', 'behaviorCriteria_consecutiveDatapointsToClear' - If an alarm has occurred and the offending device is no longer in
-- violation of the behavior for the specified number of consecutive
-- datapoints, the alarm is cleared. If not specified, the default is 1.
--
-- 'durationSeconds', 'behaviorCriteria_durationSeconds' - Use this to specify the time duration over which the behavior is
-- evaluated, for those criteria that have a time dimension (for example,
-- @NUM_MESSAGES_SENT@). For a @statisticalThreshhold@ metric comparison,
-- measurements from all devices are accumulated over this time duration
-- before being used to calculate percentiles, and later, measurements from
-- an individual device are also accumulated over this time duration before
-- being given a percentile rank. Cannot be used with list-based metric
-- datatypes.
--
-- 'mlDetectionConfig', 'behaviorCriteria_mlDetectionConfig' - The configuration of an ML Detect
--
-- 'statisticalThreshold', 'behaviorCriteria_statisticalThreshold' - A statistical ranking (percentile)that indicates a threshold value by
-- which a behavior is determined to be in compliance or in violation of
-- the behavior.
--
-- 'value', 'behaviorCriteria_value' - The value to be compared with the @metric@.
newBehaviorCriteria ::
  BehaviorCriteria
newBehaviorCriteria :: BehaviorCriteria
newBehaviorCriteria =
  BehaviorCriteria'
    { $sel:comparisonOperator:BehaviorCriteria' :: Maybe ComparisonOperator
comparisonOperator =
        forall a. Maybe a
Prelude.Nothing,
      $sel:consecutiveDatapointsToAlarm:BehaviorCriteria' :: Maybe Natural
consecutiveDatapointsToAlarm = forall a. Maybe a
Prelude.Nothing,
      $sel:consecutiveDatapointsToClear:BehaviorCriteria' :: Maybe Natural
consecutiveDatapointsToClear = forall a. Maybe a
Prelude.Nothing,
      $sel:durationSeconds:BehaviorCriteria' :: Maybe Int
durationSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:mlDetectionConfig:BehaviorCriteria' :: Maybe MachineLearningDetectionConfig
mlDetectionConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:statisticalThreshold:BehaviorCriteria' :: Maybe StatisticalThreshold
statisticalThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:value:BehaviorCriteria' :: Maybe MetricValue
value = forall a. Maybe a
Prelude.Nothing
    }

-- | The operator that relates the thing measured (@metric@) to the criteria
-- (containing a @value@ or @statisticalThreshold@). Valid operators
-- include:
--
-- -   @string-list@: @in-set@ and @not-in-set@
--
-- -   @number-list@: @in-set@ and @not-in-set@
--
-- -   @ip-address-list@: @in-cidr-set@ and @not-in-cidr-set@
--
-- -   @number@: @less-than@, @less-than-equals@, @greater-than@, and
--     @greater-than-equals@
behaviorCriteria_comparisonOperator :: Lens.Lens' BehaviorCriteria (Prelude.Maybe ComparisonOperator)
behaviorCriteria_comparisonOperator :: Lens' BehaviorCriteria (Maybe ComparisonOperator)
behaviorCriteria_comparisonOperator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BehaviorCriteria' {Maybe ComparisonOperator
comparisonOperator :: Maybe ComparisonOperator
$sel:comparisonOperator:BehaviorCriteria' :: BehaviorCriteria -> Maybe ComparisonOperator
comparisonOperator} -> Maybe ComparisonOperator
comparisonOperator) (\s :: BehaviorCriteria
s@BehaviorCriteria' {} Maybe ComparisonOperator
a -> BehaviorCriteria
s {$sel:comparisonOperator:BehaviorCriteria' :: Maybe ComparisonOperator
comparisonOperator = Maybe ComparisonOperator
a} :: BehaviorCriteria)

-- | If a device is in violation of the behavior for the specified number of
-- consecutive datapoints, an alarm occurs. If not specified, the default
-- is 1.
behaviorCriteria_consecutiveDatapointsToAlarm :: Lens.Lens' BehaviorCriteria (Prelude.Maybe Prelude.Natural)
behaviorCriteria_consecutiveDatapointsToAlarm :: Lens' BehaviorCriteria (Maybe Natural)
behaviorCriteria_consecutiveDatapointsToAlarm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BehaviorCriteria' {Maybe Natural
consecutiveDatapointsToAlarm :: Maybe Natural
$sel:consecutiveDatapointsToAlarm:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
consecutiveDatapointsToAlarm} -> Maybe Natural
consecutiveDatapointsToAlarm) (\s :: BehaviorCriteria
s@BehaviorCriteria' {} Maybe Natural
a -> BehaviorCriteria
s {$sel:consecutiveDatapointsToAlarm:BehaviorCriteria' :: Maybe Natural
consecutiveDatapointsToAlarm = Maybe Natural
a} :: BehaviorCriteria)

-- | If an alarm has occurred and the offending device is no longer in
-- violation of the behavior for the specified number of consecutive
-- datapoints, the alarm is cleared. If not specified, the default is 1.
behaviorCriteria_consecutiveDatapointsToClear :: Lens.Lens' BehaviorCriteria (Prelude.Maybe Prelude.Natural)
behaviorCriteria_consecutiveDatapointsToClear :: Lens' BehaviorCriteria (Maybe Natural)
behaviorCriteria_consecutiveDatapointsToClear = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BehaviorCriteria' {Maybe Natural
consecutiveDatapointsToClear :: Maybe Natural
$sel:consecutiveDatapointsToClear:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
consecutiveDatapointsToClear} -> Maybe Natural
consecutiveDatapointsToClear) (\s :: BehaviorCriteria
s@BehaviorCriteria' {} Maybe Natural
a -> BehaviorCriteria
s {$sel:consecutiveDatapointsToClear:BehaviorCriteria' :: Maybe Natural
consecutiveDatapointsToClear = Maybe Natural
a} :: BehaviorCriteria)

-- | Use this to specify the time duration over which the behavior is
-- evaluated, for those criteria that have a time dimension (for example,
-- @NUM_MESSAGES_SENT@). For a @statisticalThreshhold@ metric comparison,
-- measurements from all devices are accumulated over this time duration
-- before being used to calculate percentiles, and later, measurements from
-- an individual device are also accumulated over this time duration before
-- being given a percentile rank. Cannot be used with list-based metric
-- datatypes.
behaviorCriteria_durationSeconds :: Lens.Lens' BehaviorCriteria (Prelude.Maybe Prelude.Int)
behaviorCriteria_durationSeconds :: Lens' BehaviorCriteria (Maybe Int)
behaviorCriteria_durationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BehaviorCriteria' {Maybe Int
durationSeconds :: Maybe Int
$sel:durationSeconds:BehaviorCriteria' :: BehaviorCriteria -> Maybe Int
durationSeconds} -> Maybe Int
durationSeconds) (\s :: BehaviorCriteria
s@BehaviorCriteria' {} Maybe Int
a -> BehaviorCriteria
s {$sel:durationSeconds:BehaviorCriteria' :: Maybe Int
durationSeconds = Maybe Int
a} :: BehaviorCriteria)

-- | The configuration of an ML Detect
behaviorCriteria_mlDetectionConfig :: Lens.Lens' BehaviorCriteria (Prelude.Maybe MachineLearningDetectionConfig)
behaviorCriteria_mlDetectionConfig :: Lens' BehaviorCriteria (Maybe MachineLearningDetectionConfig)
behaviorCriteria_mlDetectionConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BehaviorCriteria' {Maybe MachineLearningDetectionConfig
mlDetectionConfig :: Maybe MachineLearningDetectionConfig
$sel:mlDetectionConfig:BehaviorCriteria' :: BehaviorCriteria -> Maybe MachineLearningDetectionConfig
mlDetectionConfig} -> Maybe MachineLearningDetectionConfig
mlDetectionConfig) (\s :: BehaviorCriteria
s@BehaviorCriteria' {} Maybe MachineLearningDetectionConfig
a -> BehaviorCriteria
s {$sel:mlDetectionConfig:BehaviorCriteria' :: Maybe MachineLearningDetectionConfig
mlDetectionConfig = Maybe MachineLearningDetectionConfig
a} :: BehaviorCriteria)

-- | A statistical ranking (percentile)that indicates a threshold value by
-- which a behavior is determined to be in compliance or in violation of
-- the behavior.
behaviorCriteria_statisticalThreshold :: Lens.Lens' BehaviorCriteria (Prelude.Maybe StatisticalThreshold)
behaviorCriteria_statisticalThreshold :: Lens' BehaviorCriteria (Maybe StatisticalThreshold)
behaviorCriteria_statisticalThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BehaviorCriteria' {Maybe StatisticalThreshold
statisticalThreshold :: Maybe StatisticalThreshold
$sel:statisticalThreshold:BehaviorCriteria' :: BehaviorCriteria -> Maybe StatisticalThreshold
statisticalThreshold} -> Maybe StatisticalThreshold
statisticalThreshold) (\s :: BehaviorCriteria
s@BehaviorCriteria' {} Maybe StatisticalThreshold
a -> BehaviorCriteria
s {$sel:statisticalThreshold:BehaviorCriteria' :: Maybe StatisticalThreshold
statisticalThreshold = Maybe StatisticalThreshold
a} :: BehaviorCriteria)

-- | The value to be compared with the @metric@.
behaviorCriteria_value :: Lens.Lens' BehaviorCriteria (Prelude.Maybe MetricValue)
behaviorCriteria_value :: Lens' BehaviorCriteria (Maybe MetricValue)
behaviorCriteria_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BehaviorCriteria' {Maybe MetricValue
value :: Maybe MetricValue
$sel:value:BehaviorCriteria' :: BehaviorCriteria -> Maybe MetricValue
value} -> Maybe MetricValue
value) (\s :: BehaviorCriteria
s@BehaviorCriteria' {} Maybe MetricValue
a -> BehaviorCriteria
s {$sel:value:BehaviorCriteria' :: Maybe MetricValue
value = Maybe MetricValue
a} :: BehaviorCriteria)

instance Data.FromJSON BehaviorCriteria where
  parseJSON :: Value -> Parser BehaviorCriteria
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"BehaviorCriteria"
      ( \Object
x ->
          Maybe ComparisonOperator
-> Maybe Natural
-> Maybe Natural
-> Maybe Int
-> Maybe MachineLearningDetectionConfig
-> Maybe StatisticalThreshold
-> Maybe MetricValue
-> BehaviorCriteria
BehaviorCriteria'
            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
"comparisonOperator")
            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
"consecutiveDatapointsToAlarm")
            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
"consecutiveDatapointsToClear")
            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
"durationSeconds")
            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
"mlDetectionConfig")
            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
"statisticalThreshold")
            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
"value")
      )

instance Prelude.Hashable BehaviorCriteria where
  hashWithSalt :: Int -> BehaviorCriteria -> Int
hashWithSalt Int
_salt BehaviorCriteria' {Maybe Int
Maybe Natural
Maybe ComparisonOperator
Maybe MachineLearningDetectionConfig
Maybe MetricValue
Maybe StatisticalThreshold
value :: Maybe MetricValue
statisticalThreshold :: Maybe StatisticalThreshold
mlDetectionConfig :: Maybe MachineLearningDetectionConfig
durationSeconds :: Maybe Int
consecutiveDatapointsToClear :: Maybe Natural
consecutiveDatapointsToAlarm :: Maybe Natural
comparisonOperator :: Maybe ComparisonOperator
$sel:value:BehaviorCriteria' :: BehaviorCriteria -> Maybe MetricValue
$sel:statisticalThreshold:BehaviorCriteria' :: BehaviorCriteria -> Maybe StatisticalThreshold
$sel:mlDetectionConfig:BehaviorCriteria' :: BehaviorCriteria -> Maybe MachineLearningDetectionConfig
$sel:durationSeconds:BehaviorCriteria' :: BehaviorCriteria -> Maybe Int
$sel:consecutiveDatapointsToClear:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
$sel:consecutiveDatapointsToAlarm:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
$sel:comparisonOperator:BehaviorCriteria' :: BehaviorCriteria -> Maybe ComparisonOperator
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComparisonOperator
comparisonOperator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
consecutiveDatapointsToAlarm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
consecutiveDatapointsToClear
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
durationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MachineLearningDetectionConfig
mlDetectionConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StatisticalThreshold
statisticalThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricValue
value

instance Prelude.NFData BehaviorCriteria where
  rnf :: BehaviorCriteria -> ()
rnf BehaviorCriteria' {Maybe Int
Maybe Natural
Maybe ComparisonOperator
Maybe MachineLearningDetectionConfig
Maybe MetricValue
Maybe StatisticalThreshold
value :: Maybe MetricValue
statisticalThreshold :: Maybe StatisticalThreshold
mlDetectionConfig :: Maybe MachineLearningDetectionConfig
durationSeconds :: Maybe Int
consecutiveDatapointsToClear :: Maybe Natural
consecutiveDatapointsToAlarm :: Maybe Natural
comparisonOperator :: Maybe ComparisonOperator
$sel:value:BehaviorCriteria' :: BehaviorCriteria -> Maybe MetricValue
$sel:statisticalThreshold:BehaviorCriteria' :: BehaviorCriteria -> Maybe StatisticalThreshold
$sel:mlDetectionConfig:BehaviorCriteria' :: BehaviorCriteria -> Maybe MachineLearningDetectionConfig
$sel:durationSeconds:BehaviorCriteria' :: BehaviorCriteria -> Maybe Int
$sel:consecutiveDatapointsToClear:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
$sel:consecutiveDatapointsToAlarm:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
$sel:comparisonOperator:BehaviorCriteria' :: BehaviorCriteria -> Maybe ComparisonOperator
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ComparisonOperator
comparisonOperator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
consecutiveDatapointsToAlarm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
consecutiveDatapointsToClear
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
durationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MachineLearningDetectionConfig
mlDetectionConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StatisticalThreshold
statisticalThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricValue
value

instance Data.ToJSON BehaviorCriteria where
  toJSON :: BehaviorCriteria -> Value
toJSON BehaviorCriteria' {Maybe Int
Maybe Natural
Maybe ComparisonOperator
Maybe MachineLearningDetectionConfig
Maybe MetricValue
Maybe StatisticalThreshold
value :: Maybe MetricValue
statisticalThreshold :: Maybe StatisticalThreshold
mlDetectionConfig :: Maybe MachineLearningDetectionConfig
durationSeconds :: Maybe Int
consecutiveDatapointsToClear :: Maybe Natural
consecutiveDatapointsToAlarm :: Maybe Natural
comparisonOperator :: Maybe ComparisonOperator
$sel:value:BehaviorCriteria' :: BehaviorCriteria -> Maybe MetricValue
$sel:statisticalThreshold:BehaviorCriteria' :: BehaviorCriteria -> Maybe StatisticalThreshold
$sel:mlDetectionConfig:BehaviorCriteria' :: BehaviorCriteria -> Maybe MachineLearningDetectionConfig
$sel:durationSeconds:BehaviorCriteria' :: BehaviorCriteria -> Maybe Int
$sel:consecutiveDatapointsToClear:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
$sel:consecutiveDatapointsToAlarm:BehaviorCriteria' :: BehaviorCriteria -> Maybe Natural
$sel:comparisonOperator:BehaviorCriteria' :: BehaviorCriteria -> Maybe ComparisonOperator
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"comparisonOperator" 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 ComparisonOperator
comparisonOperator,
            (Key
"consecutiveDatapointsToAlarm" 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 Natural
consecutiveDatapointsToAlarm,
            (Key
"consecutiveDatapointsToClear" 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 Natural
consecutiveDatapointsToClear,
            (Key
"durationSeconds" 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 Int
durationSeconds,
            (Key
"mlDetectionConfig" 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 MachineLearningDetectionConfig
mlDetectionConfig,
            (Key
"statisticalThreshold" 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 StatisticalThreshold
statisticalThreshold,
            (Key
"value" 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 MetricValue
value
          ]
      )