{-# 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.IoTEvents.UpdateAlarmModel
-- 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 an alarm model. Any alarms that were created based on the
-- previous version are deleted and then created again as new data arrives.
module Amazonka.IoTEvents.UpdateAlarmModel
  ( -- * Creating a Request
    UpdateAlarmModel (..),
    newUpdateAlarmModel,

    -- * Request Lenses
    updateAlarmModel_alarmCapabilities,
    updateAlarmModel_alarmEventActions,
    updateAlarmModel_alarmModelDescription,
    updateAlarmModel_alarmNotification,
    updateAlarmModel_severity,
    updateAlarmModel_alarmModelName,
    updateAlarmModel_roleArn,
    updateAlarmModel_alarmRule,

    -- * Destructuring the Response
    UpdateAlarmModelResponse (..),
    newUpdateAlarmModelResponse,

    -- * Response Lenses
    updateAlarmModelResponse_alarmModelArn,
    updateAlarmModelResponse_alarmModelVersion,
    updateAlarmModelResponse_creationTime,
    updateAlarmModelResponse_lastUpdateTime,
    updateAlarmModelResponse_status,
    updateAlarmModelResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateAlarmModel' smart constructor.
data UpdateAlarmModel = UpdateAlarmModel'
  { -- | Contains the configuration information of alarm state changes.
    UpdateAlarmModel -> Maybe AlarmCapabilities
alarmCapabilities :: Prelude.Maybe AlarmCapabilities,
    -- | Contains information about one or more alarm actions.
    UpdateAlarmModel -> Maybe AlarmEventActions
alarmEventActions :: Prelude.Maybe AlarmEventActions,
    -- | The description of the alarm model.
    UpdateAlarmModel -> Maybe Text
alarmModelDescription :: Prelude.Maybe Prelude.Text,
    -- | Contains information about one or more notification actions.
    UpdateAlarmModel -> Maybe AlarmNotification
alarmNotification :: Prelude.Maybe AlarmNotification,
    -- | A non-negative integer that reflects the severity level of the alarm.
    UpdateAlarmModel -> Maybe Natural
severity :: Prelude.Maybe Prelude.Natural,
    -- | The name of the alarm model.
    UpdateAlarmModel -> Text
alarmModelName :: Prelude.Text,
    -- | The ARN of the IAM role that allows the alarm to perform actions and
    -- access AWS resources. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- in the /AWS General Reference/.
    UpdateAlarmModel -> Text
roleArn :: Prelude.Text,
    -- | Defines when your alarm is invoked.
    UpdateAlarmModel -> AlarmRule
alarmRule :: AlarmRule
  }
  deriving (UpdateAlarmModel -> UpdateAlarmModel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAlarmModel -> UpdateAlarmModel -> Bool
$c/= :: UpdateAlarmModel -> UpdateAlarmModel -> Bool
== :: UpdateAlarmModel -> UpdateAlarmModel -> Bool
$c== :: UpdateAlarmModel -> UpdateAlarmModel -> Bool
Prelude.Eq, ReadPrec [UpdateAlarmModel]
ReadPrec UpdateAlarmModel
Int -> ReadS UpdateAlarmModel
ReadS [UpdateAlarmModel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAlarmModel]
$creadListPrec :: ReadPrec [UpdateAlarmModel]
readPrec :: ReadPrec UpdateAlarmModel
$creadPrec :: ReadPrec UpdateAlarmModel
readList :: ReadS [UpdateAlarmModel]
$creadList :: ReadS [UpdateAlarmModel]
readsPrec :: Int -> ReadS UpdateAlarmModel
$creadsPrec :: Int -> ReadS UpdateAlarmModel
Prelude.Read, Int -> UpdateAlarmModel -> ShowS
[UpdateAlarmModel] -> ShowS
UpdateAlarmModel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAlarmModel] -> ShowS
$cshowList :: [UpdateAlarmModel] -> ShowS
show :: UpdateAlarmModel -> String
$cshow :: UpdateAlarmModel -> String
showsPrec :: Int -> UpdateAlarmModel -> ShowS
$cshowsPrec :: Int -> UpdateAlarmModel -> ShowS
Prelude.Show, forall x. Rep UpdateAlarmModel x -> UpdateAlarmModel
forall x. UpdateAlarmModel -> Rep UpdateAlarmModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAlarmModel x -> UpdateAlarmModel
$cfrom :: forall x. UpdateAlarmModel -> Rep UpdateAlarmModel x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAlarmModel' 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:
--
-- 'alarmCapabilities', 'updateAlarmModel_alarmCapabilities' - Contains the configuration information of alarm state changes.
--
-- 'alarmEventActions', 'updateAlarmModel_alarmEventActions' - Contains information about one or more alarm actions.
--
-- 'alarmModelDescription', 'updateAlarmModel_alarmModelDescription' - The description of the alarm model.
--
-- 'alarmNotification', 'updateAlarmModel_alarmNotification' - Contains information about one or more notification actions.
--
-- 'severity', 'updateAlarmModel_severity' - A non-negative integer that reflects the severity level of the alarm.
--
-- 'alarmModelName', 'updateAlarmModel_alarmModelName' - The name of the alarm model.
--
-- 'roleArn', 'updateAlarmModel_roleArn' - The ARN of the IAM role that allows the alarm to perform actions and
-- access AWS resources. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /AWS General Reference/.
--
-- 'alarmRule', 'updateAlarmModel_alarmRule' - Defines when your alarm is invoked.
newUpdateAlarmModel ::
  -- | 'alarmModelName'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'alarmRule'
  AlarmRule ->
  UpdateAlarmModel
newUpdateAlarmModel :: Text -> Text -> AlarmRule -> UpdateAlarmModel
newUpdateAlarmModel
  Text
pAlarmModelName_
  Text
pRoleArn_
  AlarmRule
pAlarmRule_ =
    UpdateAlarmModel'
      { $sel:alarmCapabilities:UpdateAlarmModel' :: Maybe AlarmCapabilities
alarmCapabilities =
          forall a. Maybe a
Prelude.Nothing,
        $sel:alarmEventActions:UpdateAlarmModel' :: Maybe AlarmEventActions
alarmEventActions = forall a. Maybe a
Prelude.Nothing,
        $sel:alarmModelDescription:UpdateAlarmModel' :: Maybe Text
alarmModelDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:alarmNotification:UpdateAlarmModel' :: Maybe AlarmNotification
alarmNotification = forall a. Maybe a
Prelude.Nothing,
        $sel:severity:UpdateAlarmModel' :: Maybe Natural
severity = forall a. Maybe a
Prelude.Nothing,
        $sel:alarmModelName:UpdateAlarmModel' :: Text
alarmModelName = Text
pAlarmModelName_,
        $sel:roleArn:UpdateAlarmModel' :: Text
roleArn = Text
pRoleArn_,
        $sel:alarmRule:UpdateAlarmModel' :: AlarmRule
alarmRule = AlarmRule
pAlarmRule_
      }

-- | Contains the configuration information of alarm state changes.
updateAlarmModel_alarmCapabilities :: Lens.Lens' UpdateAlarmModel (Prelude.Maybe AlarmCapabilities)
updateAlarmModel_alarmCapabilities :: Lens' UpdateAlarmModel (Maybe AlarmCapabilities)
updateAlarmModel_alarmCapabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {Maybe AlarmCapabilities
alarmCapabilities :: Maybe AlarmCapabilities
$sel:alarmCapabilities:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmCapabilities
alarmCapabilities} -> Maybe AlarmCapabilities
alarmCapabilities) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} Maybe AlarmCapabilities
a -> UpdateAlarmModel
s {$sel:alarmCapabilities:UpdateAlarmModel' :: Maybe AlarmCapabilities
alarmCapabilities = Maybe AlarmCapabilities
a} :: UpdateAlarmModel)

-- | Contains information about one or more alarm actions.
updateAlarmModel_alarmEventActions :: Lens.Lens' UpdateAlarmModel (Prelude.Maybe AlarmEventActions)
updateAlarmModel_alarmEventActions :: Lens' UpdateAlarmModel (Maybe AlarmEventActions)
updateAlarmModel_alarmEventActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {Maybe AlarmEventActions
alarmEventActions :: Maybe AlarmEventActions
$sel:alarmEventActions:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmEventActions
alarmEventActions} -> Maybe AlarmEventActions
alarmEventActions) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} Maybe AlarmEventActions
a -> UpdateAlarmModel
s {$sel:alarmEventActions:UpdateAlarmModel' :: Maybe AlarmEventActions
alarmEventActions = Maybe AlarmEventActions
a} :: UpdateAlarmModel)

-- | The description of the alarm model.
updateAlarmModel_alarmModelDescription :: Lens.Lens' UpdateAlarmModel (Prelude.Maybe Prelude.Text)
updateAlarmModel_alarmModelDescription :: Lens' UpdateAlarmModel (Maybe Text)
updateAlarmModel_alarmModelDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {Maybe Text
alarmModelDescription :: Maybe Text
$sel:alarmModelDescription:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Text
alarmModelDescription} -> Maybe Text
alarmModelDescription) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} Maybe Text
a -> UpdateAlarmModel
s {$sel:alarmModelDescription:UpdateAlarmModel' :: Maybe Text
alarmModelDescription = Maybe Text
a} :: UpdateAlarmModel)

-- | Contains information about one or more notification actions.
updateAlarmModel_alarmNotification :: Lens.Lens' UpdateAlarmModel (Prelude.Maybe AlarmNotification)
updateAlarmModel_alarmNotification :: Lens' UpdateAlarmModel (Maybe AlarmNotification)
updateAlarmModel_alarmNotification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {Maybe AlarmNotification
alarmNotification :: Maybe AlarmNotification
$sel:alarmNotification:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmNotification
alarmNotification} -> Maybe AlarmNotification
alarmNotification) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} Maybe AlarmNotification
a -> UpdateAlarmModel
s {$sel:alarmNotification:UpdateAlarmModel' :: Maybe AlarmNotification
alarmNotification = Maybe AlarmNotification
a} :: UpdateAlarmModel)

-- | A non-negative integer that reflects the severity level of the alarm.
updateAlarmModel_severity :: Lens.Lens' UpdateAlarmModel (Prelude.Maybe Prelude.Natural)
updateAlarmModel_severity :: Lens' UpdateAlarmModel (Maybe Natural)
updateAlarmModel_severity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {Maybe Natural
severity :: Maybe Natural
$sel:severity:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Natural
severity} -> Maybe Natural
severity) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} Maybe Natural
a -> UpdateAlarmModel
s {$sel:severity:UpdateAlarmModel' :: Maybe Natural
severity = Maybe Natural
a} :: UpdateAlarmModel)

-- | The name of the alarm model.
updateAlarmModel_alarmModelName :: Lens.Lens' UpdateAlarmModel Prelude.Text
updateAlarmModel_alarmModelName :: Lens' UpdateAlarmModel Text
updateAlarmModel_alarmModelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {Text
alarmModelName :: Text
$sel:alarmModelName:UpdateAlarmModel' :: UpdateAlarmModel -> Text
alarmModelName} -> Text
alarmModelName) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} Text
a -> UpdateAlarmModel
s {$sel:alarmModelName:UpdateAlarmModel' :: Text
alarmModelName = Text
a} :: UpdateAlarmModel)

-- | The ARN of the IAM role that allows the alarm to perform actions and
-- access AWS resources. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /AWS General Reference/.
updateAlarmModel_roleArn :: Lens.Lens' UpdateAlarmModel Prelude.Text
updateAlarmModel_roleArn :: Lens' UpdateAlarmModel Text
updateAlarmModel_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {Text
roleArn :: Text
$sel:roleArn:UpdateAlarmModel' :: UpdateAlarmModel -> Text
roleArn} -> Text
roleArn) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} Text
a -> UpdateAlarmModel
s {$sel:roleArn:UpdateAlarmModel' :: Text
roleArn = Text
a} :: UpdateAlarmModel)

-- | Defines when your alarm is invoked.
updateAlarmModel_alarmRule :: Lens.Lens' UpdateAlarmModel AlarmRule
updateAlarmModel_alarmRule :: Lens' UpdateAlarmModel AlarmRule
updateAlarmModel_alarmRule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModel' {AlarmRule
alarmRule :: AlarmRule
$sel:alarmRule:UpdateAlarmModel' :: UpdateAlarmModel -> AlarmRule
alarmRule} -> AlarmRule
alarmRule) (\s :: UpdateAlarmModel
s@UpdateAlarmModel' {} AlarmRule
a -> UpdateAlarmModel
s {$sel:alarmRule:UpdateAlarmModel' :: AlarmRule
alarmRule = AlarmRule
a} :: UpdateAlarmModel)

instance Core.AWSRequest UpdateAlarmModel where
  type
    AWSResponse UpdateAlarmModel =
      UpdateAlarmModelResponse
  request :: (Service -> Service)
-> UpdateAlarmModel -> Request UpdateAlarmModel
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 UpdateAlarmModel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateAlarmModel)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe AlarmModelVersionStatus
-> Int
-> UpdateAlarmModelResponse
UpdateAlarmModelResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"alarmModelArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"alarmModelVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"creationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"lastUpdateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateAlarmModel where
  hashWithSalt :: Int -> UpdateAlarmModel -> Int
hashWithSalt Int
_salt UpdateAlarmModel' {Maybe Natural
Maybe Text
Maybe AlarmCapabilities
Maybe AlarmNotification
Maybe AlarmEventActions
Text
AlarmRule
alarmRule :: AlarmRule
roleArn :: Text
alarmModelName :: Text
severity :: Maybe Natural
alarmNotification :: Maybe AlarmNotification
alarmModelDescription :: Maybe Text
alarmEventActions :: Maybe AlarmEventActions
alarmCapabilities :: Maybe AlarmCapabilities
$sel:alarmRule:UpdateAlarmModel' :: UpdateAlarmModel -> AlarmRule
$sel:roleArn:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:alarmModelName:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:severity:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Natural
$sel:alarmNotification:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmNotification
$sel:alarmModelDescription:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Text
$sel:alarmEventActions:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmEventActions
$sel:alarmCapabilities:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmCapabilities
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmCapabilities
alarmCapabilities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmEventActions
alarmEventActions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
alarmModelDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmNotification
alarmNotification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
severity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
alarmModelName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AlarmRule
alarmRule

instance Prelude.NFData UpdateAlarmModel where
  rnf :: UpdateAlarmModel -> ()
rnf UpdateAlarmModel' {Maybe Natural
Maybe Text
Maybe AlarmCapabilities
Maybe AlarmNotification
Maybe AlarmEventActions
Text
AlarmRule
alarmRule :: AlarmRule
roleArn :: Text
alarmModelName :: Text
severity :: Maybe Natural
alarmNotification :: Maybe AlarmNotification
alarmModelDescription :: Maybe Text
alarmEventActions :: Maybe AlarmEventActions
alarmCapabilities :: Maybe AlarmCapabilities
$sel:alarmRule:UpdateAlarmModel' :: UpdateAlarmModel -> AlarmRule
$sel:roleArn:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:alarmModelName:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:severity:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Natural
$sel:alarmNotification:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmNotification
$sel:alarmModelDescription:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Text
$sel:alarmEventActions:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmEventActions
$sel:alarmCapabilities:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmCapabilities
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmCapabilities
alarmCapabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmEventActions
alarmEventActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
alarmModelDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmNotification
alarmNotification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
severity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
alarmModelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AlarmRule
alarmRule

instance Data.ToHeaders UpdateAlarmModel where
  toHeaders :: UpdateAlarmModel -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateAlarmModel where
  toJSON :: UpdateAlarmModel -> Value
toJSON UpdateAlarmModel' {Maybe Natural
Maybe Text
Maybe AlarmCapabilities
Maybe AlarmNotification
Maybe AlarmEventActions
Text
AlarmRule
alarmRule :: AlarmRule
roleArn :: Text
alarmModelName :: Text
severity :: Maybe Natural
alarmNotification :: Maybe AlarmNotification
alarmModelDescription :: Maybe Text
alarmEventActions :: Maybe AlarmEventActions
alarmCapabilities :: Maybe AlarmCapabilities
$sel:alarmRule:UpdateAlarmModel' :: UpdateAlarmModel -> AlarmRule
$sel:roleArn:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:alarmModelName:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:severity:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Natural
$sel:alarmNotification:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmNotification
$sel:alarmModelDescription:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Text
$sel:alarmEventActions:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmEventActions
$sel:alarmCapabilities:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmCapabilities
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"alarmCapabilities" 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 AlarmCapabilities
alarmCapabilities,
            (Key
"alarmEventActions" 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 AlarmEventActions
alarmEventActions,
            (Key
"alarmModelDescription" 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
alarmModelDescription,
            (Key
"alarmNotification" 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 AlarmNotification
alarmNotification,
            (Key
"severity" 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
severity,
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"alarmRule" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AlarmRule
alarmRule)
          ]
      )

instance Data.ToPath UpdateAlarmModel where
  toPath :: UpdateAlarmModel -> ByteString
toPath UpdateAlarmModel' {Maybe Natural
Maybe Text
Maybe AlarmCapabilities
Maybe AlarmNotification
Maybe AlarmEventActions
Text
AlarmRule
alarmRule :: AlarmRule
roleArn :: Text
alarmModelName :: Text
severity :: Maybe Natural
alarmNotification :: Maybe AlarmNotification
alarmModelDescription :: Maybe Text
alarmEventActions :: Maybe AlarmEventActions
alarmCapabilities :: Maybe AlarmCapabilities
$sel:alarmRule:UpdateAlarmModel' :: UpdateAlarmModel -> AlarmRule
$sel:roleArn:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:alarmModelName:UpdateAlarmModel' :: UpdateAlarmModel -> Text
$sel:severity:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Natural
$sel:alarmNotification:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmNotification
$sel:alarmModelDescription:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe Text
$sel:alarmEventActions:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmEventActions
$sel:alarmCapabilities:UpdateAlarmModel' :: UpdateAlarmModel -> Maybe AlarmCapabilities
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/alarm-models/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
alarmModelName]

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

-- | /See:/ 'newUpdateAlarmModelResponse' smart constructor.
data UpdateAlarmModelResponse = UpdateAlarmModelResponse'
  { -- | The ARN of the alarm model. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- in the /AWS General Reference/.
    UpdateAlarmModelResponse -> Maybe Text
alarmModelArn :: Prelude.Maybe Prelude.Text,
    -- | The version of the alarm model.
    UpdateAlarmModelResponse -> Maybe Text
alarmModelVersion :: Prelude.Maybe Prelude.Text,
    -- | The time the alarm model was created, in the Unix epoch format.
    UpdateAlarmModelResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The time the alarm model was last updated, in the Unix epoch format.
    UpdateAlarmModelResponse -> Maybe POSIX
lastUpdateTime :: Prelude.Maybe Data.POSIX,
    -- | The status of the alarm model. The status can be one of the following
    -- values:
    --
    -- -   @ACTIVE@ - The alarm model is active and it\'s ready to evaluate
    --     data.
    --
    -- -   @ACTIVATING@ - AWS IoT Events is activating your alarm model.
    --     Activating an alarm model can take up to a few minutes.
    --
    -- -   @INACTIVE@ - The alarm model is inactive, so it isn\'t ready to
    --     evaluate data. Check your alarm model information and update the
    --     alarm model.
    --
    -- -   @FAILED@ - You couldn\'t create or update the alarm model. Check
    --     your alarm model information and try again.
    UpdateAlarmModelResponse -> Maybe AlarmModelVersionStatus
status :: Prelude.Maybe AlarmModelVersionStatus,
    -- | The response's http status code.
    UpdateAlarmModelResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateAlarmModelResponse -> UpdateAlarmModelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAlarmModelResponse -> UpdateAlarmModelResponse -> Bool
$c/= :: UpdateAlarmModelResponse -> UpdateAlarmModelResponse -> Bool
== :: UpdateAlarmModelResponse -> UpdateAlarmModelResponse -> Bool
$c== :: UpdateAlarmModelResponse -> UpdateAlarmModelResponse -> Bool
Prelude.Eq, ReadPrec [UpdateAlarmModelResponse]
ReadPrec UpdateAlarmModelResponse
Int -> ReadS UpdateAlarmModelResponse
ReadS [UpdateAlarmModelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAlarmModelResponse]
$creadListPrec :: ReadPrec [UpdateAlarmModelResponse]
readPrec :: ReadPrec UpdateAlarmModelResponse
$creadPrec :: ReadPrec UpdateAlarmModelResponse
readList :: ReadS [UpdateAlarmModelResponse]
$creadList :: ReadS [UpdateAlarmModelResponse]
readsPrec :: Int -> ReadS UpdateAlarmModelResponse
$creadsPrec :: Int -> ReadS UpdateAlarmModelResponse
Prelude.Read, Int -> UpdateAlarmModelResponse -> ShowS
[UpdateAlarmModelResponse] -> ShowS
UpdateAlarmModelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAlarmModelResponse] -> ShowS
$cshowList :: [UpdateAlarmModelResponse] -> ShowS
show :: UpdateAlarmModelResponse -> String
$cshow :: UpdateAlarmModelResponse -> String
showsPrec :: Int -> UpdateAlarmModelResponse -> ShowS
$cshowsPrec :: Int -> UpdateAlarmModelResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateAlarmModelResponse x -> UpdateAlarmModelResponse
forall x.
UpdateAlarmModelResponse -> Rep UpdateAlarmModelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAlarmModelResponse x -> UpdateAlarmModelResponse
$cfrom :: forall x.
UpdateAlarmModelResponse -> Rep UpdateAlarmModelResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAlarmModelResponse' 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:
--
-- 'alarmModelArn', 'updateAlarmModelResponse_alarmModelArn' - The ARN of the alarm model. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /AWS General Reference/.
--
-- 'alarmModelVersion', 'updateAlarmModelResponse_alarmModelVersion' - The version of the alarm model.
--
-- 'creationTime', 'updateAlarmModelResponse_creationTime' - The time the alarm model was created, in the Unix epoch format.
--
-- 'lastUpdateTime', 'updateAlarmModelResponse_lastUpdateTime' - The time the alarm model was last updated, in the Unix epoch format.
--
-- 'status', 'updateAlarmModelResponse_status' - The status of the alarm model. The status can be one of the following
-- values:
--
-- -   @ACTIVE@ - The alarm model is active and it\'s ready to evaluate
--     data.
--
-- -   @ACTIVATING@ - AWS IoT Events is activating your alarm model.
--     Activating an alarm model can take up to a few minutes.
--
-- -   @INACTIVE@ - The alarm model is inactive, so it isn\'t ready to
--     evaluate data. Check your alarm model information and update the
--     alarm model.
--
-- -   @FAILED@ - You couldn\'t create or update the alarm model. Check
--     your alarm model information and try again.
--
-- 'httpStatus', 'updateAlarmModelResponse_httpStatus' - The response's http status code.
newUpdateAlarmModelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAlarmModelResponse
newUpdateAlarmModelResponse :: Int -> UpdateAlarmModelResponse
newUpdateAlarmModelResponse Int
pHttpStatus_ =
  UpdateAlarmModelResponse'
    { $sel:alarmModelArn:UpdateAlarmModelResponse' :: Maybe Text
alarmModelArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:alarmModelVersion:UpdateAlarmModelResponse' :: Maybe Text
alarmModelVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:UpdateAlarmModelResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdateTime:UpdateAlarmModelResponse' :: Maybe POSIX
lastUpdateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateAlarmModelResponse' :: Maybe AlarmModelVersionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAlarmModelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the alarm model. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /AWS General Reference/.
updateAlarmModelResponse_alarmModelArn :: Lens.Lens' UpdateAlarmModelResponse (Prelude.Maybe Prelude.Text)
updateAlarmModelResponse_alarmModelArn :: Lens' UpdateAlarmModelResponse (Maybe Text)
updateAlarmModelResponse_alarmModelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModelResponse' {Maybe Text
alarmModelArn :: Maybe Text
$sel:alarmModelArn:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe Text
alarmModelArn} -> Maybe Text
alarmModelArn) (\s :: UpdateAlarmModelResponse
s@UpdateAlarmModelResponse' {} Maybe Text
a -> UpdateAlarmModelResponse
s {$sel:alarmModelArn:UpdateAlarmModelResponse' :: Maybe Text
alarmModelArn = Maybe Text
a} :: UpdateAlarmModelResponse)

-- | The version of the alarm model.
updateAlarmModelResponse_alarmModelVersion :: Lens.Lens' UpdateAlarmModelResponse (Prelude.Maybe Prelude.Text)
updateAlarmModelResponse_alarmModelVersion :: Lens' UpdateAlarmModelResponse (Maybe Text)
updateAlarmModelResponse_alarmModelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModelResponse' {Maybe Text
alarmModelVersion :: Maybe Text
$sel:alarmModelVersion:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe Text
alarmModelVersion} -> Maybe Text
alarmModelVersion) (\s :: UpdateAlarmModelResponse
s@UpdateAlarmModelResponse' {} Maybe Text
a -> UpdateAlarmModelResponse
s {$sel:alarmModelVersion:UpdateAlarmModelResponse' :: Maybe Text
alarmModelVersion = Maybe Text
a} :: UpdateAlarmModelResponse)

-- | The time the alarm model was created, in the Unix epoch format.
updateAlarmModelResponse_creationTime :: Lens.Lens' UpdateAlarmModelResponse (Prelude.Maybe Prelude.UTCTime)
updateAlarmModelResponse_creationTime :: Lens' UpdateAlarmModelResponse (Maybe UTCTime)
updateAlarmModelResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModelResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: UpdateAlarmModelResponse
s@UpdateAlarmModelResponse' {} Maybe POSIX
a -> UpdateAlarmModelResponse
s {$sel:creationTime:UpdateAlarmModelResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: UpdateAlarmModelResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time the alarm model was last updated, in the Unix epoch format.
updateAlarmModelResponse_lastUpdateTime :: Lens.Lens' UpdateAlarmModelResponse (Prelude.Maybe Prelude.UTCTime)
updateAlarmModelResponse_lastUpdateTime :: Lens' UpdateAlarmModelResponse (Maybe UTCTime)
updateAlarmModelResponse_lastUpdateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModelResponse' {Maybe POSIX
lastUpdateTime :: Maybe POSIX
$sel:lastUpdateTime:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe POSIX
lastUpdateTime} -> Maybe POSIX
lastUpdateTime) (\s :: UpdateAlarmModelResponse
s@UpdateAlarmModelResponse' {} Maybe POSIX
a -> UpdateAlarmModelResponse
s {$sel:lastUpdateTime:UpdateAlarmModelResponse' :: Maybe POSIX
lastUpdateTime = Maybe POSIX
a} :: UpdateAlarmModelResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the alarm model. The status can be one of the following
-- values:
--
-- -   @ACTIVE@ - The alarm model is active and it\'s ready to evaluate
--     data.
--
-- -   @ACTIVATING@ - AWS IoT Events is activating your alarm model.
--     Activating an alarm model can take up to a few minutes.
--
-- -   @INACTIVE@ - The alarm model is inactive, so it isn\'t ready to
--     evaluate data. Check your alarm model information and update the
--     alarm model.
--
-- -   @FAILED@ - You couldn\'t create or update the alarm model. Check
--     your alarm model information and try again.
updateAlarmModelResponse_status :: Lens.Lens' UpdateAlarmModelResponse (Prelude.Maybe AlarmModelVersionStatus)
updateAlarmModelResponse_status :: Lens' UpdateAlarmModelResponse (Maybe AlarmModelVersionStatus)
updateAlarmModelResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlarmModelResponse' {Maybe AlarmModelVersionStatus
status :: Maybe AlarmModelVersionStatus
$sel:status:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe AlarmModelVersionStatus
status} -> Maybe AlarmModelVersionStatus
status) (\s :: UpdateAlarmModelResponse
s@UpdateAlarmModelResponse' {} Maybe AlarmModelVersionStatus
a -> UpdateAlarmModelResponse
s {$sel:status:UpdateAlarmModelResponse' :: Maybe AlarmModelVersionStatus
status = Maybe AlarmModelVersionStatus
a} :: UpdateAlarmModelResponse)

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

instance Prelude.NFData UpdateAlarmModelResponse where
  rnf :: UpdateAlarmModelResponse -> ()
rnf UpdateAlarmModelResponse' {Int
Maybe Text
Maybe POSIX
Maybe AlarmModelVersionStatus
httpStatus :: Int
status :: Maybe AlarmModelVersionStatus
lastUpdateTime :: Maybe POSIX
creationTime :: Maybe POSIX
alarmModelVersion :: Maybe Text
alarmModelArn :: Maybe Text
$sel:httpStatus:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Int
$sel:status:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe AlarmModelVersionStatus
$sel:lastUpdateTime:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe POSIX
$sel:creationTime:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe POSIX
$sel:alarmModelVersion:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe Text
$sel:alarmModelArn:UpdateAlarmModelResponse' :: UpdateAlarmModelResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
alarmModelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
alarmModelVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmModelVersionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus