{-# 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.CostExplorer.UpdateAnomalySubscription
-- 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 existing cost anomaly monitor subscription.
module Amazonka.CostExplorer.UpdateAnomalySubscription
  ( -- * Creating a Request
    UpdateAnomalySubscription (..),
    newUpdateAnomalySubscription,

    -- * Request Lenses
    updateAnomalySubscription_frequency,
    updateAnomalySubscription_monitorArnList,
    updateAnomalySubscription_subscribers,
    updateAnomalySubscription_subscriptionName,
    updateAnomalySubscription_threshold,
    updateAnomalySubscription_thresholdExpression,
    updateAnomalySubscription_subscriptionArn,

    -- * Destructuring the Response
    UpdateAnomalySubscriptionResponse (..),
    newUpdateAnomalySubscriptionResponse,

    -- * Response Lenses
    updateAnomalySubscriptionResponse_httpStatus,
    updateAnomalySubscriptionResponse_subscriptionArn,
  )
where

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

-- | /See:/ 'newUpdateAnomalySubscription' smart constructor.
data UpdateAnomalySubscription = UpdateAnomalySubscription'
  { -- | The update to the frequency value that subscribers receive
    -- notifications.
    UpdateAnomalySubscription -> Maybe AnomalySubscriptionFrequency
frequency :: Prelude.Maybe AnomalySubscriptionFrequency,
    -- | A list of cost anomaly monitor ARNs.
    UpdateAnomalySubscription -> Maybe [Text]
monitorArnList :: Prelude.Maybe [Prelude.Text],
    -- | The update to the subscriber list.
    UpdateAnomalySubscription -> Maybe [Subscriber]
subscribers :: Prelude.Maybe [Subscriber],
    -- | The new name of the subscription.
    UpdateAnomalySubscription -> Maybe Text
subscriptionName :: Prelude.Maybe Prelude.Text,
    -- | (deprecated)
    --
    -- The update to the threshold value for receiving notifications.
    --
    -- This field has been deprecated. To update a threshold, use
    -- ThresholdExpression. Continued use of Threshold will be treated as
    -- shorthand syntax for a ThresholdExpression.
    UpdateAnomalySubscription -> Maybe Double
threshold :: Prelude.Maybe Prelude.Double,
    -- | The update to the
    -- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>
    -- object used to specify the anomalies that you want to generate alerts
    -- for. This supports dimensions and nested expressions. The supported
    -- dimensions are @ANOMALY_TOTAL_IMPACT_ABSOLUTE@ and
    -- @ANOMALY_TOTAL_IMPACT_PERCENTAGE@. The supported nested expression types
    -- are @AND@ and @OR@. The match option @GREATER_THAN_OR_EQUAL@ is
    -- required. Values must be numbers between 0 and 10,000,000,000.
    --
    -- The following are examples of valid ThresholdExpressions:
    --
    -- -   Absolute threshold:
    --     @{ \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }@
    --
    -- -   Percentage threshold:
    --     @{ \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }@
    --
    -- -   @AND@ two thresholds together:
    --     @{ \"And\": [ { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }, { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } } ] }@
    --
    -- -   @OR@ two thresholds together:
    --     @{ \"Or\": [ { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }, { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } } ] }@
    UpdateAnomalySubscription -> Maybe Expression
thresholdExpression :: Prelude.Maybe Expression,
    -- | A cost anomaly subscription Amazon Resource Name (ARN).
    UpdateAnomalySubscription -> Text
subscriptionArn :: Prelude.Text
  }
  deriving (UpdateAnomalySubscription -> UpdateAnomalySubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAnomalySubscription -> UpdateAnomalySubscription -> Bool
$c/= :: UpdateAnomalySubscription -> UpdateAnomalySubscription -> Bool
== :: UpdateAnomalySubscription -> UpdateAnomalySubscription -> Bool
$c== :: UpdateAnomalySubscription -> UpdateAnomalySubscription -> Bool
Prelude.Eq, ReadPrec [UpdateAnomalySubscription]
ReadPrec UpdateAnomalySubscription
Int -> ReadS UpdateAnomalySubscription
ReadS [UpdateAnomalySubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAnomalySubscription]
$creadListPrec :: ReadPrec [UpdateAnomalySubscription]
readPrec :: ReadPrec UpdateAnomalySubscription
$creadPrec :: ReadPrec UpdateAnomalySubscription
readList :: ReadS [UpdateAnomalySubscription]
$creadList :: ReadS [UpdateAnomalySubscription]
readsPrec :: Int -> ReadS UpdateAnomalySubscription
$creadsPrec :: Int -> ReadS UpdateAnomalySubscription
Prelude.Read, Int -> UpdateAnomalySubscription -> ShowS
[UpdateAnomalySubscription] -> ShowS
UpdateAnomalySubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAnomalySubscription] -> ShowS
$cshowList :: [UpdateAnomalySubscription] -> ShowS
show :: UpdateAnomalySubscription -> String
$cshow :: UpdateAnomalySubscription -> String
showsPrec :: Int -> UpdateAnomalySubscription -> ShowS
$cshowsPrec :: Int -> UpdateAnomalySubscription -> ShowS
Prelude.Show, forall x.
Rep UpdateAnomalySubscription x -> UpdateAnomalySubscription
forall x.
UpdateAnomalySubscription -> Rep UpdateAnomalySubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAnomalySubscription x -> UpdateAnomalySubscription
$cfrom :: forall x.
UpdateAnomalySubscription -> Rep UpdateAnomalySubscription x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAnomalySubscription' 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:
--
-- 'frequency', 'updateAnomalySubscription_frequency' - The update to the frequency value that subscribers receive
-- notifications.
--
-- 'monitorArnList', 'updateAnomalySubscription_monitorArnList' - A list of cost anomaly monitor ARNs.
--
-- 'subscribers', 'updateAnomalySubscription_subscribers' - The update to the subscriber list.
--
-- 'subscriptionName', 'updateAnomalySubscription_subscriptionName' - The new name of the subscription.
--
-- 'threshold', 'updateAnomalySubscription_threshold' - (deprecated)
--
-- The update to the threshold value for receiving notifications.
--
-- This field has been deprecated. To update a threshold, use
-- ThresholdExpression. Continued use of Threshold will be treated as
-- shorthand syntax for a ThresholdExpression.
--
-- 'thresholdExpression', 'updateAnomalySubscription_thresholdExpression' - The update to the
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>
-- object used to specify the anomalies that you want to generate alerts
-- for. This supports dimensions and nested expressions. The supported
-- dimensions are @ANOMALY_TOTAL_IMPACT_ABSOLUTE@ and
-- @ANOMALY_TOTAL_IMPACT_PERCENTAGE@. The supported nested expression types
-- are @AND@ and @OR@. The match option @GREATER_THAN_OR_EQUAL@ is
-- required. Values must be numbers between 0 and 10,000,000,000.
--
-- The following are examples of valid ThresholdExpressions:
--
-- -   Absolute threshold:
--     @{ \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }@
--
-- -   Percentage threshold:
--     @{ \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }@
--
-- -   @AND@ two thresholds together:
--     @{ \"And\": [ { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }, { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } } ] }@
--
-- -   @OR@ two thresholds together:
--     @{ \"Or\": [ { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }, { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } } ] }@
--
-- 'subscriptionArn', 'updateAnomalySubscription_subscriptionArn' - A cost anomaly subscription Amazon Resource Name (ARN).
newUpdateAnomalySubscription ::
  -- | 'subscriptionArn'
  Prelude.Text ->
  UpdateAnomalySubscription
newUpdateAnomalySubscription :: Text -> UpdateAnomalySubscription
newUpdateAnomalySubscription Text
pSubscriptionArn_ =
  UpdateAnomalySubscription'
    { $sel:frequency:UpdateAnomalySubscription' :: Maybe AnomalySubscriptionFrequency
frequency =
        forall a. Maybe a
Prelude.Nothing,
      $sel:monitorArnList:UpdateAnomalySubscription' :: Maybe [Text]
monitorArnList = forall a. Maybe a
Prelude.Nothing,
      $sel:subscribers:UpdateAnomalySubscription' :: Maybe [Subscriber]
subscribers = forall a. Maybe a
Prelude.Nothing,
      $sel:subscriptionName:UpdateAnomalySubscription' :: Maybe Text
subscriptionName = forall a. Maybe a
Prelude.Nothing,
      $sel:threshold:UpdateAnomalySubscription' :: Maybe Double
threshold = forall a. Maybe a
Prelude.Nothing,
      $sel:thresholdExpression:UpdateAnomalySubscription' :: Maybe Expression
thresholdExpression = forall a. Maybe a
Prelude.Nothing,
      $sel:subscriptionArn:UpdateAnomalySubscription' :: Text
subscriptionArn = Text
pSubscriptionArn_
    }

-- | The update to the frequency value that subscribers receive
-- notifications.
updateAnomalySubscription_frequency :: Lens.Lens' UpdateAnomalySubscription (Prelude.Maybe AnomalySubscriptionFrequency)
updateAnomalySubscription_frequency :: Lens'
  UpdateAnomalySubscription (Maybe AnomalySubscriptionFrequency)
updateAnomalySubscription_frequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscription' {Maybe AnomalySubscriptionFrequency
frequency :: Maybe AnomalySubscriptionFrequency
$sel:frequency:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe AnomalySubscriptionFrequency
frequency} -> Maybe AnomalySubscriptionFrequency
frequency) (\s :: UpdateAnomalySubscription
s@UpdateAnomalySubscription' {} Maybe AnomalySubscriptionFrequency
a -> UpdateAnomalySubscription
s {$sel:frequency:UpdateAnomalySubscription' :: Maybe AnomalySubscriptionFrequency
frequency = Maybe AnomalySubscriptionFrequency
a} :: UpdateAnomalySubscription)

-- | A list of cost anomaly monitor ARNs.
updateAnomalySubscription_monitorArnList :: Lens.Lens' UpdateAnomalySubscription (Prelude.Maybe [Prelude.Text])
updateAnomalySubscription_monitorArnList :: Lens' UpdateAnomalySubscription (Maybe [Text])
updateAnomalySubscription_monitorArnList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscription' {Maybe [Text]
monitorArnList :: Maybe [Text]
$sel:monitorArnList:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Text]
monitorArnList} -> Maybe [Text]
monitorArnList) (\s :: UpdateAnomalySubscription
s@UpdateAnomalySubscription' {} Maybe [Text]
a -> UpdateAnomalySubscription
s {$sel:monitorArnList:UpdateAnomalySubscription' :: Maybe [Text]
monitorArnList = Maybe [Text]
a} :: UpdateAnomalySubscription) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The update to the subscriber list.
updateAnomalySubscription_subscribers :: Lens.Lens' UpdateAnomalySubscription (Prelude.Maybe [Subscriber])
updateAnomalySubscription_subscribers :: Lens' UpdateAnomalySubscription (Maybe [Subscriber])
updateAnomalySubscription_subscribers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscription' {Maybe [Subscriber]
subscribers :: Maybe [Subscriber]
$sel:subscribers:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Subscriber]
subscribers} -> Maybe [Subscriber]
subscribers) (\s :: UpdateAnomalySubscription
s@UpdateAnomalySubscription' {} Maybe [Subscriber]
a -> UpdateAnomalySubscription
s {$sel:subscribers:UpdateAnomalySubscription' :: Maybe [Subscriber]
subscribers = Maybe [Subscriber]
a} :: UpdateAnomalySubscription) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The new name of the subscription.
updateAnomalySubscription_subscriptionName :: Lens.Lens' UpdateAnomalySubscription (Prelude.Maybe Prelude.Text)
updateAnomalySubscription_subscriptionName :: Lens' UpdateAnomalySubscription (Maybe Text)
updateAnomalySubscription_subscriptionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscription' {Maybe Text
subscriptionName :: Maybe Text
$sel:subscriptionName:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Text
subscriptionName} -> Maybe Text
subscriptionName) (\s :: UpdateAnomalySubscription
s@UpdateAnomalySubscription' {} Maybe Text
a -> UpdateAnomalySubscription
s {$sel:subscriptionName:UpdateAnomalySubscription' :: Maybe Text
subscriptionName = Maybe Text
a} :: UpdateAnomalySubscription)

-- | (deprecated)
--
-- The update to the threshold value for receiving notifications.
--
-- This field has been deprecated. To update a threshold, use
-- ThresholdExpression. Continued use of Threshold will be treated as
-- shorthand syntax for a ThresholdExpression.
updateAnomalySubscription_threshold :: Lens.Lens' UpdateAnomalySubscription (Prelude.Maybe Prelude.Double)
updateAnomalySubscription_threshold :: Lens' UpdateAnomalySubscription (Maybe Double)
updateAnomalySubscription_threshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscription' {Maybe Double
threshold :: Maybe Double
$sel:threshold:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Double
threshold} -> Maybe Double
threshold) (\s :: UpdateAnomalySubscription
s@UpdateAnomalySubscription' {} Maybe Double
a -> UpdateAnomalySubscription
s {$sel:threshold:UpdateAnomalySubscription' :: Maybe Double
threshold = Maybe Double
a} :: UpdateAnomalySubscription)

-- | The update to the
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>
-- object used to specify the anomalies that you want to generate alerts
-- for. This supports dimensions and nested expressions. The supported
-- dimensions are @ANOMALY_TOTAL_IMPACT_ABSOLUTE@ and
-- @ANOMALY_TOTAL_IMPACT_PERCENTAGE@. The supported nested expression types
-- are @AND@ and @OR@. The match option @GREATER_THAN_OR_EQUAL@ is
-- required. Values must be numbers between 0 and 10,000,000,000.
--
-- The following are examples of valid ThresholdExpressions:
--
-- -   Absolute threshold:
--     @{ \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }@
--
-- -   Percentage threshold:
--     @{ \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }@
--
-- -   @AND@ two thresholds together:
--     @{ \"And\": [ { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }, { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } } ] }@
--
-- -   @OR@ two thresholds together:
--     @{ \"Or\": [ { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_ABSOLUTE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } }, { \"Dimensions\": { \"Key\": \"ANOMALY_TOTAL_IMPACT_PERCENTAGE\", \"MatchOptions\": [ \"GREATER_THAN_OR_EQUAL\" ], \"Values\": [ \"100\" ] } } ] }@
updateAnomalySubscription_thresholdExpression :: Lens.Lens' UpdateAnomalySubscription (Prelude.Maybe Expression)
updateAnomalySubscription_thresholdExpression :: Lens' UpdateAnomalySubscription (Maybe Expression)
updateAnomalySubscription_thresholdExpression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscription' {Maybe Expression
thresholdExpression :: Maybe Expression
$sel:thresholdExpression:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Expression
thresholdExpression} -> Maybe Expression
thresholdExpression) (\s :: UpdateAnomalySubscription
s@UpdateAnomalySubscription' {} Maybe Expression
a -> UpdateAnomalySubscription
s {$sel:thresholdExpression:UpdateAnomalySubscription' :: Maybe Expression
thresholdExpression = Maybe Expression
a} :: UpdateAnomalySubscription)

-- | A cost anomaly subscription Amazon Resource Name (ARN).
updateAnomalySubscription_subscriptionArn :: Lens.Lens' UpdateAnomalySubscription Prelude.Text
updateAnomalySubscription_subscriptionArn :: Lens' UpdateAnomalySubscription Text
updateAnomalySubscription_subscriptionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscription' {Text
subscriptionArn :: Text
$sel:subscriptionArn:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Text
subscriptionArn} -> Text
subscriptionArn) (\s :: UpdateAnomalySubscription
s@UpdateAnomalySubscription' {} Text
a -> UpdateAnomalySubscription
s {$sel:subscriptionArn:UpdateAnomalySubscription' :: Text
subscriptionArn = Text
a} :: UpdateAnomalySubscription)

instance Core.AWSRequest UpdateAnomalySubscription where
  type
    AWSResponse UpdateAnomalySubscription =
      UpdateAnomalySubscriptionResponse
  request :: (Service -> Service)
-> UpdateAnomalySubscription -> Request UpdateAnomalySubscription
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 UpdateAnomalySubscription
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAnomalySubscription)))
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 ->
          Int -> Text -> UpdateAnomalySubscriptionResponse
UpdateAnomalySubscriptionResponse'
            forall (f :: * -> *) a b. Functor 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
"SubscriptionArn")
      )

instance Prelude.Hashable UpdateAnomalySubscription where
  hashWithSalt :: Int -> UpdateAnomalySubscription -> Int
hashWithSalt Int
_salt UpdateAnomalySubscription' {Maybe Double
Maybe [Text]
Maybe [Subscriber]
Maybe Text
Maybe AnomalySubscriptionFrequency
Maybe Expression
Text
subscriptionArn :: Text
thresholdExpression :: Maybe Expression
threshold :: Maybe Double
subscriptionName :: Maybe Text
subscribers :: Maybe [Subscriber]
monitorArnList :: Maybe [Text]
frequency :: Maybe AnomalySubscriptionFrequency
$sel:subscriptionArn:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Text
$sel:thresholdExpression:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Expression
$sel:threshold:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Double
$sel:subscriptionName:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Text
$sel:subscribers:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Subscriber]
$sel:monitorArnList:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Text]
$sel:frequency:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe AnomalySubscriptionFrequency
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AnomalySubscriptionFrequency
frequency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
monitorArnList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Subscriber]
subscribers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subscriptionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
threshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Expression
thresholdExpression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subscriptionArn

instance Prelude.NFData UpdateAnomalySubscription where
  rnf :: UpdateAnomalySubscription -> ()
rnf UpdateAnomalySubscription' {Maybe Double
Maybe [Text]
Maybe [Subscriber]
Maybe Text
Maybe AnomalySubscriptionFrequency
Maybe Expression
Text
subscriptionArn :: Text
thresholdExpression :: Maybe Expression
threshold :: Maybe Double
subscriptionName :: Maybe Text
subscribers :: Maybe [Subscriber]
monitorArnList :: Maybe [Text]
frequency :: Maybe AnomalySubscriptionFrequency
$sel:subscriptionArn:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Text
$sel:thresholdExpression:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Expression
$sel:threshold:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Double
$sel:subscriptionName:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Text
$sel:subscribers:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Subscriber]
$sel:monitorArnList:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Text]
$sel:frequency:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe AnomalySubscriptionFrequency
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AnomalySubscriptionFrequency
frequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
monitorArnList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Subscriber]
subscribers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subscriptionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
threshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Expression
thresholdExpression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
subscriptionArn

instance Data.ToHeaders UpdateAnomalySubscription where
  toHeaders :: UpdateAnomalySubscription -> 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
"AWSInsightsIndexService.UpdateAnomalySubscription" ::
                          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 UpdateAnomalySubscription where
  toJSON :: UpdateAnomalySubscription -> Value
toJSON UpdateAnomalySubscription' {Maybe Double
Maybe [Text]
Maybe [Subscriber]
Maybe Text
Maybe AnomalySubscriptionFrequency
Maybe Expression
Text
subscriptionArn :: Text
thresholdExpression :: Maybe Expression
threshold :: Maybe Double
subscriptionName :: Maybe Text
subscribers :: Maybe [Subscriber]
monitorArnList :: Maybe [Text]
frequency :: Maybe AnomalySubscriptionFrequency
$sel:subscriptionArn:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Text
$sel:thresholdExpression:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Expression
$sel:threshold:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Double
$sel:subscriptionName:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe Text
$sel:subscribers:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Subscriber]
$sel:monitorArnList:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe [Text]
$sel:frequency:UpdateAnomalySubscription' :: UpdateAnomalySubscription -> Maybe AnomalySubscriptionFrequency
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Frequency" 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 AnomalySubscriptionFrequency
frequency,
            (Key
"MonitorArnList" 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]
monitorArnList,
            (Key
"Subscribers" 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 [Subscriber]
subscribers,
            (Key
"SubscriptionName" 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
subscriptionName,
            (Key
"Threshold" 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 Double
threshold,
            (Key
"ThresholdExpression" 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 Expression
thresholdExpression,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SubscriptionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
subscriptionArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateAnomalySubscriptionResponse' 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:
--
-- 'httpStatus', 'updateAnomalySubscriptionResponse_httpStatus' - The response's http status code.
--
-- 'subscriptionArn', 'updateAnomalySubscriptionResponse_subscriptionArn' - A cost anomaly subscription ARN.
newUpdateAnomalySubscriptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'subscriptionArn'
  Prelude.Text ->
  UpdateAnomalySubscriptionResponse
newUpdateAnomalySubscriptionResponse :: Int -> Text -> UpdateAnomalySubscriptionResponse
newUpdateAnomalySubscriptionResponse
  Int
pHttpStatus_
  Text
pSubscriptionArn_ =
    UpdateAnomalySubscriptionResponse'
      { $sel:httpStatus:UpdateAnomalySubscriptionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:subscriptionArn:UpdateAnomalySubscriptionResponse' :: Text
subscriptionArn = Text
pSubscriptionArn_
      }

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

-- | A cost anomaly subscription ARN.
updateAnomalySubscriptionResponse_subscriptionArn :: Lens.Lens' UpdateAnomalySubscriptionResponse Prelude.Text
updateAnomalySubscriptionResponse_subscriptionArn :: Lens' UpdateAnomalySubscriptionResponse Text
updateAnomalySubscriptionResponse_subscriptionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalySubscriptionResponse' {Text
subscriptionArn :: Text
$sel:subscriptionArn:UpdateAnomalySubscriptionResponse' :: UpdateAnomalySubscriptionResponse -> Text
subscriptionArn} -> Text
subscriptionArn) (\s :: UpdateAnomalySubscriptionResponse
s@UpdateAnomalySubscriptionResponse' {} Text
a -> UpdateAnomalySubscriptionResponse
s {$sel:subscriptionArn:UpdateAnomalySubscriptionResponse' :: Text
subscriptionArn = Text
a} :: UpdateAnomalySubscriptionResponse)

instance
  Prelude.NFData
    UpdateAnomalySubscriptionResponse
  where
  rnf :: UpdateAnomalySubscriptionResponse -> ()
rnf UpdateAnomalySubscriptionResponse' {Int
Text
subscriptionArn :: Text
httpStatus :: Int
$sel:subscriptionArn:UpdateAnomalySubscriptionResponse' :: UpdateAnomalySubscriptionResponse -> Text
$sel:httpStatus:UpdateAnomalySubscriptionResponse' :: UpdateAnomalySubscriptionResponse -> Int
..} =
    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
subscriptionArn