{-# 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.SageMaker.UpdateMonitoringAlert
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update the parameters of a model monitor alert.
module Amazonka.SageMaker.UpdateMonitoringAlert
  ( -- * Creating a Request
    UpdateMonitoringAlert (..),
    newUpdateMonitoringAlert,

    -- * Request Lenses
    updateMonitoringAlert_monitoringScheduleName,
    updateMonitoringAlert_monitoringAlertName,
    updateMonitoringAlert_datapointsToAlert,
    updateMonitoringAlert_evaluationPeriod,

    -- * Destructuring the Response
    UpdateMonitoringAlertResponse (..),
    newUpdateMonitoringAlertResponse,

    -- * Response Lenses
    updateMonitoringAlertResponse_monitoringAlertName,
    updateMonitoringAlertResponse_httpStatus,
    updateMonitoringAlertResponse_monitoringScheduleArn,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SageMaker.Types

-- | /See:/ 'newUpdateMonitoringAlert' smart constructor.
data UpdateMonitoringAlert = UpdateMonitoringAlert'
  { -- | The name of a monitoring schedule.
    UpdateMonitoringAlert -> Text
monitoringScheduleName :: Prelude.Text,
    -- | The name of a monitoring alert.
    UpdateMonitoringAlert -> Text
monitoringAlertName :: Prelude.Text,
    -- | Within @EvaluationPeriod@, how many execution failures will raise an
    -- alert.
    UpdateMonitoringAlert -> Natural
datapointsToAlert :: Prelude.Natural,
    -- | The number of most recent monitoring executions to consider when
    -- evaluating alert status.
    UpdateMonitoringAlert -> Natural
evaluationPeriod :: Prelude.Natural
  }
  deriving (UpdateMonitoringAlert -> UpdateMonitoringAlert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMonitoringAlert -> UpdateMonitoringAlert -> Bool
$c/= :: UpdateMonitoringAlert -> UpdateMonitoringAlert -> Bool
== :: UpdateMonitoringAlert -> UpdateMonitoringAlert -> Bool
$c== :: UpdateMonitoringAlert -> UpdateMonitoringAlert -> Bool
Prelude.Eq, ReadPrec [UpdateMonitoringAlert]
ReadPrec UpdateMonitoringAlert
Int -> ReadS UpdateMonitoringAlert
ReadS [UpdateMonitoringAlert]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMonitoringAlert]
$creadListPrec :: ReadPrec [UpdateMonitoringAlert]
readPrec :: ReadPrec UpdateMonitoringAlert
$creadPrec :: ReadPrec UpdateMonitoringAlert
readList :: ReadS [UpdateMonitoringAlert]
$creadList :: ReadS [UpdateMonitoringAlert]
readsPrec :: Int -> ReadS UpdateMonitoringAlert
$creadsPrec :: Int -> ReadS UpdateMonitoringAlert
Prelude.Read, Int -> UpdateMonitoringAlert -> ShowS
[UpdateMonitoringAlert] -> ShowS
UpdateMonitoringAlert -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMonitoringAlert] -> ShowS
$cshowList :: [UpdateMonitoringAlert] -> ShowS
show :: UpdateMonitoringAlert -> String
$cshow :: UpdateMonitoringAlert -> String
showsPrec :: Int -> UpdateMonitoringAlert -> ShowS
$cshowsPrec :: Int -> UpdateMonitoringAlert -> ShowS
Prelude.Show, forall x. Rep UpdateMonitoringAlert x -> UpdateMonitoringAlert
forall x. UpdateMonitoringAlert -> Rep UpdateMonitoringAlert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMonitoringAlert x -> UpdateMonitoringAlert
$cfrom :: forall x. UpdateMonitoringAlert -> Rep UpdateMonitoringAlert x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMonitoringAlert' 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:
--
-- 'monitoringScheduleName', 'updateMonitoringAlert_monitoringScheduleName' - The name of a monitoring schedule.
--
-- 'monitoringAlertName', 'updateMonitoringAlert_monitoringAlertName' - The name of a monitoring alert.
--
-- 'datapointsToAlert', 'updateMonitoringAlert_datapointsToAlert' - Within @EvaluationPeriod@, how many execution failures will raise an
-- alert.
--
-- 'evaluationPeriod', 'updateMonitoringAlert_evaluationPeriod' - The number of most recent monitoring executions to consider when
-- evaluating alert status.
newUpdateMonitoringAlert ::
  -- | 'monitoringScheduleName'
  Prelude.Text ->
  -- | 'monitoringAlertName'
  Prelude.Text ->
  -- | 'datapointsToAlert'
  Prelude.Natural ->
  -- | 'evaluationPeriod'
  Prelude.Natural ->
  UpdateMonitoringAlert
newUpdateMonitoringAlert :: Text -> Text -> Natural -> Natural -> UpdateMonitoringAlert
newUpdateMonitoringAlert
  Text
pMonitoringScheduleName_
  Text
pMonitoringAlertName_
  Natural
pDatapointsToAlert_
  Natural
pEvaluationPeriod_ =
    UpdateMonitoringAlert'
      { $sel:monitoringScheduleName:UpdateMonitoringAlert' :: Text
monitoringScheduleName =
          Text
pMonitoringScheduleName_,
        $sel:monitoringAlertName:UpdateMonitoringAlert' :: Text
monitoringAlertName = Text
pMonitoringAlertName_,
        $sel:datapointsToAlert:UpdateMonitoringAlert' :: Natural
datapointsToAlert = Natural
pDatapointsToAlert_,
        $sel:evaluationPeriod:UpdateMonitoringAlert' :: Natural
evaluationPeriod = Natural
pEvaluationPeriod_
      }

-- | The name of a monitoring schedule.
updateMonitoringAlert_monitoringScheduleName :: Lens.Lens' UpdateMonitoringAlert Prelude.Text
updateMonitoringAlert_monitoringScheduleName :: Lens' UpdateMonitoringAlert Text
updateMonitoringAlert_monitoringScheduleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringAlert' {Text
monitoringScheduleName :: Text
$sel:monitoringScheduleName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
monitoringScheduleName} -> Text
monitoringScheduleName) (\s :: UpdateMonitoringAlert
s@UpdateMonitoringAlert' {} Text
a -> UpdateMonitoringAlert
s {$sel:monitoringScheduleName:UpdateMonitoringAlert' :: Text
monitoringScheduleName = Text
a} :: UpdateMonitoringAlert)

-- | The name of a monitoring alert.
updateMonitoringAlert_monitoringAlertName :: Lens.Lens' UpdateMonitoringAlert Prelude.Text
updateMonitoringAlert_monitoringAlertName :: Lens' UpdateMonitoringAlert Text
updateMonitoringAlert_monitoringAlertName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringAlert' {Text
monitoringAlertName :: Text
$sel:monitoringAlertName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
monitoringAlertName} -> Text
monitoringAlertName) (\s :: UpdateMonitoringAlert
s@UpdateMonitoringAlert' {} Text
a -> UpdateMonitoringAlert
s {$sel:monitoringAlertName:UpdateMonitoringAlert' :: Text
monitoringAlertName = Text
a} :: UpdateMonitoringAlert)

-- | Within @EvaluationPeriod@, how many execution failures will raise an
-- alert.
updateMonitoringAlert_datapointsToAlert :: Lens.Lens' UpdateMonitoringAlert Prelude.Natural
updateMonitoringAlert_datapointsToAlert :: Lens' UpdateMonitoringAlert Natural
updateMonitoringAlert_datapointsToAlert = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringAlert' {Natural
datapointsToAlert :: Natural
$sel:datapointsToAlert:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
datapointsToAlert} -> Natural
datapointsToAlert) (\s :: UpdateMonitoringAlert
s@UpdateMonitoringAlert' {} Natural
a -> UpdateMonitoringAlert
s {$sel:datapointsToAlert:UpdateMonitoringAlert' :: Natural
datapointsToAlert = Natural
a} :: UpdateMonitoringAlert)

-- | The number of most recent monitoring executions to consider when
-- evaluating alert status.
updateMonitoringAlert_evaluationPeriod :: Lens.Lens' UpdateMonitoringAlert Prelude.Natural
updateMonitoringAlert_evaluationPeriod :: Lens' UpdateMonitoringAlert Natural
updateMonitoringAlert_evaluationPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringAlert' {Natural
evaluationPeriod :: Natural
$sel:evaluationPeriod:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
evaluationPeriod} -> Natural
evaluationPeriod) (\s :: UpdateMonitoringAlert
s@UpdateMonitoringAlert' {} Natural
a -> UpdateMonitoringAlert
s {$sel:evaluationPeriod:UpdateMonitoringAlert' :: Natural
evaluationPeriod = Natural
a} :: UpdateMonitoringAlert)

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

instance Prelude.Hashable UpdateMonitoringAlert where
  hashWithSalt :: Int -> UpdateMonitoringAlert -> Int
hashWithSalt Int
_salt UpdateMonitoringAlert' {Natural
Text
evaluationPeriod :: Natural
datapointsToAlert :: Natural
monitoringAlertName :: Text
monitoringScheduleName :: Text
$sel:evaluationPeriod:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
$sel:datapointsToAlert:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
$sel:monitoringAlertName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
$sel:monitoringScheduleName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
monitoringScheduleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
monitoringAlertName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
datapointsToAlert
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
evaluationPeriod

instance Prelude.NFData UpdateMonitoringAlert where
  rnf :: UpdateMonitoringAlert -> ()
rnf UpdateMonitoringAlert' {Natural
Text
evaluationPeriod :: Natural
datapointsToAlert :: Natural
monitoringAlertName :: Text
monitoringScheduleName :: Text
$sel:evaluationPeriod:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
$sel:datapointsToAlert:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
$sel:monitoringAlertName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
$sel:monitoringScheduleName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
monitoringScheduleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
monitoringAlertName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
datapointsToAlert
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
evaluationPeriod

instance Data.ToHeaders UpdateMonitoringAlert where
  toHeaders :: UpdateMonitoringAlert -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"SageMaker.UpdateMonitoringAlert" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateMonitoringAlert where
  toJSON :: UpdateMonitoringAlert -> Value
toJSON UpdateMonitoringAlert' {Natural
Text
evaluationPeriod :: Natural
datapointsToAlert :: Natural
monitoringAlertName :: Text
monitoringScheduleName :: Text
$sel:evaluationPeriod:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
$sel:datapointsToAlert:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Natural
$sel:monitoringAlertName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
$sel:monitoringScheduleName:UpdateMonitoringAlert' :: UpdateMonitoringAlert -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"MonitoringScheduleName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
monitoringScheduleName
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"MonitoringAlertName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
monitoringAlertName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DatapointsToAlert" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
datapointsToAlert),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EvaluationPeriod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
evaluationPeriod)
          ]
      )

instance Data.ToPath UpdateMonitoringAlert where
  toPath :: UpdateMonitoringAlert -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdateMonitoringAlertResponse' smart constructor.
data UpdateMonitoringAlertResponse = UpdateMonitoringAlertResponse'
  { -- | The name of a monitoring alert.
    UpdateMonitoringAlertResponse -> Maybe Text
monitoringAlertName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateMonitoringAlertResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the monitoring schedule.
    UpdateMonitoringAlertResponse -> Text
monitoringScheduleArn :: Prelude.Text
  }
  deriving (UpdateMonitoringAlertResponse
-> UpdateMonitoringAlertResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMonitoringAlertResponse
-> UpdateMonitoringAlertResponse -> Bool
$c/= :: UpdateMonitoringAlertResponse
-> UpdateMonitoringAlertResponse -> Bool
== :: UpdateMonitoringAlertResponse
-> UpdateMonitoringAlertResponse -> Bool
$c== :: UpdateMonitoringAlertResponse
-> UpdateMonitoringAlertResponse -> Bool
Prelude.Eq, ReadPrec [UpdateMonitoringAlertResponse]
ReadPrec UpdateMonitoringAlertResponse
Int -> ReadS UpdateMonitoringAlertResponse
ReadS [UpdateMonitoringAlertResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMonitoringAlertResponse]
$creadListPrec :: ReadPrec [UpdateMonitoringAlertResponse]
readPrec :: ReadPrec UpdateMonitoringAlertResponse
$creadPrec :: ReadPrec UpdateMonitoringAlertResponse
readList :: ReadS [UpdateMonitoringAlertResponse]
$creadList :: ReadS [UpdateMonitoringAlertResponse]
readsPrec :: Int -> ReadS UpdateMonitoringAlertResponse
$creadsPrec :: Int -> ReadS UpdateMonitoringAlertResponse
Prelude.Read, Int -> UpdateMonitoringAlertResponse -> ShowS
[UpdateMonitoringAlertResponse] -> ShowS
UpdateMonitoringAlertResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMonitoringAlertResponse] -> ShowS
$cshowList :: [UpdateMonitoringAlertResponse] -> ShowS
show :: UpdateMonitoringAlertResponse -> String
$cshow :: UpdateMonitoringAlertResponse -> String
showsPrec :: Int -> UpdateMonitoringAlertResponse -> ShowS
$cshowsPrec :: Int -> UpdateMonitoringAlertResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateMonitoringAlertResponse x
-> UpdateMonitoringAlertResponse
forall x.
UpdateMonitoringAlertResponse
-> Rep UpdateMonitoringAlertResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateMonitoringAlertResponse x
-> UpdateMonitoringAlertResponse
$cfrom :: forall x.
UpdateMonitoringAlertResponse
-> Rep UpdateMonitoringAlertResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMonitoringAlertResponse' 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:
--
-- 'monitoringAlertName', 'updateMonitoringAlertResponse_monitoringAlertName' - The name of a monitoring alert.
--
-- 'httpStatus', 'updateMonitoringAlertResponse_httpStatus' - The response's http status code.
--
-- 'monitoringScheduleArn', 'updateMonitoringAlertResponse_monitoringScheduleArn' - The Amazon Resource Name (ARN) of the monitoring schedule.
newUpdateMonitoringAlertResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'monitoringScheduleArn'
  Prelude.Text ->
  UpdateMonitoringAlertResponse
newUpdateMonitoringAlertResponse :: Int -> Text -> UpdateMonitoringAlertResponse
newUpdateMonitoringAlertResponse
  Int
pHttpStatus_
  Text
pMonitoringScheduleArn_ =
    UpdateMonitoringAlertResponse'
      { $sel:monitoringAlertName:UpdateMonitoringAlertResponse' :: Maybe Text
monitoringAlertName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:UpdateMonitoringAlertResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:monitoringScheduleArn:UpdateMonitoringAlertResponse' :: Text
monitoringScheduleArn =
          Text
pMonitoringScheduleArn_
      }

-- | The name of a monitoring alert.
updateMonitoringAlertResponse_monitoringAlertName :: Lens.Lens' UpdateMonitoringAlertResponse (Prelude.Maybe Prelude.Text)
updateMonitoringAlertResponse_monitoringAlertName :: Lens' UpdateMonitoringAlertResponse (Maybe Text)
updateMonitoringAlertResponse_monitoringAlertName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringAlertResponse' {Maybe Text
monitoringAlertName :: Maybe Text
$sel:monitoringAlertName:UpdateMonitoringAlertResponse' :: UpdateMonitoringAlertResponse -> Maybe Text
monitoringAlertName} -> Maybe Text
monitoringAlertName) (\s :: UpdateMonitoringAlertResponse
s@UpdateMonitoringAlertResponse' {} Maybe Text
a -> UpdateMonitoringAlertResponse
s {$sel:monitoringAlertName:UpdateMonitoringAlertResponse' :: Maybe Text
monitoringAlertName = Maybe Text
a} :: UpdateMonitoringAlertResponse)

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

-- | The Amazon Resource Name (ARN) of the monitoring schedule.
updateMonitoringAlertResponse_monitoringScheduleArn :: Lens.Lens' UpdateMonitoringAlertResponse Prelude.Text
updateMonitoringAlertResponse_monitoringScheduleArn :: Lens' UpdateMonitoringAlertResponse Text
updateMonitoringAlertResponse_monitoringScheduleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringAlertResponse' {Text
monitoringScheduleArn :: Text
$sel:monitoringScheduleArn:UpdateMonitoringAlertResponse' :: UpdateMonitoringAlertResponse -> Text
monitoringScheduleArn} -> Text
monitoringScheduleArn) (\s :: UpdateMonitoringAlertResponse
s@UpdateMonitoringAlertResponse' {} Text
a -> UpdateMonitoringAlertResponse
s {$sel:monitoringScheduleArn:UpdateMonitoringAlertResponse' :: Text
monitoringScheduleArn = Text
a} :: UpdateMonitoringAlertResponse)

instance Prelude.NFData UpdateMonitoringAlertResponse where
  rnf :: UpdateMonitoringAlertResponse -> ()
rnf UpdateMonitoringAlertResponse' {Int
Maybe Text
Text
monitoringScheduleArn :: Text
httpStatus :: Int
monitoringAlertName :: Maybe Text
$sel:monitoringScheduleArn:UpdateMonitoringAlertResponse' :: UpdateMonitoringAlertResponse -> Text
$sel:httpStatus:UpdateMonitoringAlertResponse' :: UpdateMonitoringAlertResponse -> Int
$sel:monitoringAlertName:UpdateMonitoringAlertResponse' :: UpdateMonitoringAlertResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
monitoringAlertName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
monitoringScheduleArn