{-# 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.LookoutMetrics.UpdateAlert
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Make changes to an existing alert.
module Amazonka.LookoutMetrics.UpdateAlert
  ( -- * Creating a Request
    UpdateAlert (..),
    newUpdateAlert,

    -- * Request Lenses
    updateAlert_action,
    updateAlert_alertDescription,
    updateAlert_alertFilters,
    updateAlert_alertSensitivityThreshold,
    updateAlert_alertArn,

    -- * Destructuring the Response
    UpdateAlertResponse (..),
    newUpdateAlertResponse,

    -- * Response Lenses
    updateAlertResponse_alertArn,
    updateAlertResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateAlert' smart constructor.
data UpdateAlert = UpdateAlert'
  { -- | Action that will be triggered when there is an alert.
    UpdateAlert -> Maybe Action
action :: Prelude.Maybe Action,
    -- | A description of the alert.
    UpdateAlert -> Maybe Text
alertDescription :: Prelude.Maybe Prelude.Text,
    -- | The configuration of the alert filters, containing MetricList and
    -- DimensionFilterList.
    UpdateAlert -> Maybe AlertFilters
alertFilters :: Prelude.Maybe AlertFilters,
    -- | An integer from 0 to 100 specifying the alert sensitivity threshold.
    UpdateAlert -> Maybe Natural
alertSensitivityThreshold :: Prelude.Maybe Prelude.Natural,
    -- | The ARN of the alert to update.
    UpdateAlert -> Text
alertArn :: Prelude.Text
  }
  deriving (UpdateAlert -> UpdateAlert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAlert -> UpdateAlert -> Bool
$c/= :: UpdateAlert -> UpdateAlert -> Bool
== :: UpdateAlert -> UpdateAlert -> Bool
$c== :: UpdateAlert -> UpdateAlert -> Bool
Prelude.Eq, ReadPrec [UpdateAlert]
ReadPrec UpdateAlert
Int -> ReadS UpdateAlert
ReadS [UpdateAlert]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAlert]
$creadListPrec :: ReadPrec [UpdateAlert]
readPrec :: ReadPrec UpdateAlert
$creadPrec :: ReadPrec UpdateAlert
readList :: ReadS [UpdateAlert]
$creadList :: ReadS [UpdateAlert]
readsPrec :: Int -> ReadS UpdateAlert
$creadsPrec :: Int -> ReadS UpdateAlert
Prelude.Read, Int -> UpdateAlert -> ShowS
[UpdateAlert] -> ShowS
UpdateAlert -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAlert] -> ShowS
$cshowList :: [UpdateAlert] -> ShowS
show :: UpdateAlert -> String
$cshow :: UpdateAlert -> String
showsPrec :: Int -> UpdateAlert -> ShowS
$cshowsPrec :: Int -> UpdateAlert -> ShowS
Prelude.Show, forall x. Rep UpdateAlert x -> UpdateAlert
forall x. UpdateAlert -> Rep UpdateAlert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAlert x -> UpdateAlert
$cfrom :: forall x. UpdateAlert -> Rep UpdateAlert x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAlert' 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:
--
-- 'action', 'updateAlert_action' - Action that will be triggered when there is an alert.
--
-- 'alertDescription', 'updateAlert_alertDescription' - A description of the alert.
--
-- 'alertFilters', 'updateAlert_alertFilters' - The configuration of the alert filters, containing MetricList and
-- DimensionFilterList.
--
-- 'alertSensitivityThreshold', 'updateAlert_alertSensitivityThreshold' - An integer from 0 to 100 specifying the alert sensitivity threshold.
--
-- 'alertArn', 'updateAlert_alertArn' - The ARN of the alert to update.
newUpdateAlert ::
  -- | 'alertArn'
  Prelude.Text ->
  UpdateAlert
newUpdateAlert :: Text -> UpdateAlert
newUpdateAlert Text
pAlertArn_ =
  UpdateAlert'
    { $sel:action:UpdateAlert' :: Maybe Action
action = forall a. Maybe a
Prelude.Nothing,
      $sel:alertDescription:UpdateAlert' :: Maybe Text
alertDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:alertFilters:UpdateAlert' :: Maybe AlertFilters
alertFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:alertSensitivityThreshold:UpdateAlert' :: Maybe Natural
alertSensitivityThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:alertArn:UpdateAlert' :: Text
alertArn = Text
pAlertArn_
    }

-- | Action that will be triggered when there is an alert.
updateAlert_action :: Lens.Lens' UpdateAlert (Prelude.Maybe Action)
updateAlert_action :: Lens' UpdateAlert (Maybe Action)
updateAlert_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlert' {Maybe Action
action :: Maybe Action
$sel:action:UpdateAlert' :: UpdateAlert -> Maybe Action
action} -> Maybe Action
action) (\s :: UpdateAlert
s@UpdateAlert' {} Maybe Action
a -> UpdateAlert
s {$sel:action:UpdateAlert' :: Maybe Action
action = Maybe Action
a} :: UpdateAlert)

-- | A description of the alert.
updateAlert_alertDescription :: Lens.Lens' UpdateAlert (Prelude.Maybe Prelude.Text)
updateAlert_alertDescription :: Lens' UpdateAlert (Maybe Text)
updateAlert_alertDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlert' {Maybe Text
alertDescription :: Maybe Text
$sel:alertDescription:UpdateAlert' :: UpdateAlert -> Maybe Text
alertDescription} -> Maybe Text
alertDescription) (\s :: UpdateAlert
s@UpdateAlert' {} Maybe Text
a -> UpdateAlert
s {$sel:alertDescription:UpdateAlert' :: Maybe Text
alertDescription = Maybe Text
a} :: UpdateAlert)

-- | The configuration of the alert filters, containing MetricList and
-- DimensionFilterList.
updateAlert_alertFilters :: Lens.Lens' UpdateAlert (Prelude.Maybe AlertFilters)
updateAlert_alertFilters :: Lens' UpdateAlert (Maybe AlertFilters)
updateAlert_alertFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlert' {Maybe AlertFilters
alertFilters :: Maybe AlertFilters
$sel:alertFilters:UpdateAlert' :: UpdateAlert -> Maybe AlertFilters
alertFilters} -> Maybe AlertFilters
alertFilters) (\s :: UpdateAlert
s@UpdateAlert' {} Maybe AlertFilters
a -> UpdateAlert
s {$sel:alertFilters:UpdateAlert' :: Maybe AlertFilters
alertFilters = Maybe AlertFilters
a} :: UpdateAlert)

-- | An integer from 0 to 100 specifying the alert sensitivity threshold.
updateAlert_alertSensitivityThreshold :: Lens.Lens' UpdateAlert (Prelude.Maybe Prelude.Natural)
updateAlert_alertSensitivityThreshold :: Lens' UpdateAlert (Maybe Natural)
updateAlert_alertSensitivityThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlert' {Maybe Natural
alertSensitivityThreshold :: Maybe Natural
$sel:alertSensitivityThreshold:UpdateAlert' :: UpdateAlert -> Maybe Natural
alertSensitivityThreshold} -> Maybe Natural
alertSensitivityThreshold) (\s :: UpdateAlert
s@UpdateAlert' {} Maybe Natural
a -> UpdateAlert
s {$sel:alertSensitivityThreshold:UpdateAlert' :: Maybe Natural
alertSensitivityThreshold = Maybe Natural
a} :: UpdateAlert)

-- | The ARN of the alert to update.
updateAlert_alertArn :: Lens.Lens' UpdateAlert Prelude.Text
updateAlert_alertArn :: Lens' UpdateAlert Text
updateAlert_alertArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlert' {Text
alertArn :: Text
$sel:alertArn:UpdateAlert' :: UpdateAlert -> Text
alertArn} -> Text
alertArn) (\s :: UpdateAlert
s@UpdateAlert' {} Text
a -> UpdateAlert
s {$sel:alertArn:UpdateAlert' :: Text
alertArn = Text
a} :: UpdateAlert)

instance Core.AWSRequest UpdateAlert where
  type AWSResponse UpdateAlert = UpdateAlertResponse
  request :: (Service -> Service) -> UpdateAlert -> Request UpdateAlert
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 UpdateAlert
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateAlert)))
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 -> UpdateAlertResponse
UpdateAlertResponse'
            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
"AlertArn")
            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 UpdateAlert where
  hashWithSalt :: Int -> UpdateAlert -> Int
hashWithSalt Int
_salt UpdateAlert' {Maybe Natural
Maybe Text
Maybe AlertFilters
Maybe Action
Text
alertArn :: Text
alertSensitivityThreshold :: Maybe Natural
alertFilters :: Maybe AlertFilters
alertDescription :: Maybe Text
action :: Maybe Action
$sel:alertArn:UpdateAlert' :: UpdateAlert -> Text
$sel:alertSensitivityThreshold:UpdateAlert' :: UpdateAlert -> Maybe Natural
$sel:alertFilters:UpdateAlert' :: UpdateAlert -> Maybe AlertFilters
$sel:alertDescription:UpdateAlert' :: UpdateAlert -> Maybe Text
$sel:action:UpdateAlert' :: UpdateAlert -> Maybe Action
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Action
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
alertDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlertFilters
alertFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
alertSensitivityThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
alertArn

instance Prelude.NFData UpdateAlert where
  rnf :: UpdateAlert -> ()
rnf UpdateAlert' {Maybe Natural
Maybe Text
Maybe AlertFilters
Maybe Action
Text
alertArn :: Text
alertSensitivityThreshold :: Maybe Natural
alertFilters :: Maybe AlertFilters
alertDescription :: Maybe Text
action :: Maybe Action
$sel:alertArn:UpdateAlert' :: UpdateAlert -> Text
$sel:alertSensitivityThreshold:UpdateAlert' :: UpdateAlert -> Maybe Natural
$sel:alertFilters:UpdateAlert' :: UpdateAlert -> Maybe AlertFilters
$sel:alertDescription:UpdateAlert' :: UpdateAlert -> Maybe Text
$sel:action:UpdateAlert' :: UpdateAlert -> Maybe Action
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Action
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
alertDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AlertFilters
alertFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
alertSensitivityThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
alertArn

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

instance Data.ToJSON UpdateAlert where
  toJSON :: UpdateAlert -> Value
toJSON UpdateAlert' {Maybe Natural
Maybe Text
Maybe AlertFilters
Maybe Action
Text
alertArn :: Text
alertSensitivityThreshold :: Maybe Natural
alertFilters :: Maybe AlertFilters
alertDescription :: Maybe Text
action :: Maybe Action
$sel:alertArn:UpdateAlert' :: UpdateAlert -> Text
$sel:alertSensitivityThreshold:UpdateAlert' :: UpdateAlert -> Maybe Natural
$sel:alertFilters:UpdateAlert' :: UpdateAlert -> Maybe AlertFilters
$sel:alertDescription:UpdateAlert' :: UpdateAlert -> Maybe Text
$sel:action:UpdateAlert' :: UpdateAlert -> Maybe Action
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Action" 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 Action
action,
            (Key
"AlertDescription" 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
alertDescription,
            (Key
"AlertFilters" 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 AlertFilters
alertFilters,
            (Key
"AlertSensitivityThreshold" 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
alertSensitivityThreshold,
            forall a. a -> Maybe a
Prelude.Just (Key
"AlertArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
alertArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateAlertResponse' 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:
--
-- 'alertArn', 'updateAlertResponse_alertArn' - The ARN of the updated alert.
--
-- 'httpStatus', 'updateAlertResponse_httpStatus' - The response's http status code.
newUpdateAlertResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAlertResponse
newUpdateAlertResponse :: Int -> UpdateAlertResponse
newUpdateAlertResponse Int
pHttpStatus_ =
  UpdateAlertResponse'
    { $sel:alertArn:UpdateAlertResponse' :: Maybe Text
alertArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAlertResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the updated alert.
updateAlertResponse_alertArn :: Lens.Lens' UpdateAlertResponse (Prelude.Maybe Prelude.Text)
updateAlertResponse_alertArn :: Lens' UpdateAlertResponse (Maybe Text)
updateAlertResponse_alertArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlertResponse' {Maybe Text
alertArn :: Maybe Text
$sel:alertArn:UpdateAlertResponse' :: UpdateAlertResponse -> Maybe Text
alertArn} -> Maybe Text
alertArn) (\s :: UpdateAlertResponse
s@UpdateAlertResponse' {} Maybe Text
a -> UpdateAlertResponse
s {$sel:alertArn:UpdateAlertResponse' :: Maybe Text
alertArn = Maybe Text
a} :: UpdateAlertResponse)

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

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