{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.CostExplorer.Types.Anomaly
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.CostExplorer.Types.Anomaly where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CostExplorer.Types.AnomalyFeedbackType
import Amazonka.CostExplorer.Types.AnomalyScore
import Amazonka.CostExplorer.Types.Impact
import Amazonka.CostExplorer.Types.RootCause
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | An unusual cost pattern. This consists of the detailed metadata and the
-- current status of the anomaly object.
--
-- /See:/ 'newAnomaly' smart constructor.
data Anomaly = Anomaly'
  { -- | The last day the anomaly is detected.
    Anomaly -> Maybe Text
anomalyEndDate :: Prelude.Maybe Prelude.Text,
    -- | The first day the anomaly is detected.
    Anomaly -> Maybe Text
anomalyStartDate :: Prelude.Maybe Prelude.Text,
    -- | The dimension for the anomaly (for example, an Amazon Web Service in a
    -- service monitor).
    Anomaly -> Maybe Text
dimensionValue :: Prelude.Maybe Prelude.Text,
    -- | The feedback value.
    Anomaly -> Maybe AnomalyFeedbackType
feedback :: Prelude.Maybe AnomalyFeedbackType,
    -- | The list of identified root causes for the anomaly.
    Anomaly -> Maybe [RootCause]
rootCauses :: Prelude.Maybe [RootCause],
    -- | The unique identifier for the anomaly.
    Anomaly -> Text
anomalyId :: Prelude.Text,
    -- | The latest and maximum score for the anomaly.
    Anomaly -> AnomalyScore
anomalyScore :: AnomalyScore,
    -- | The dollar impact for the anomaly.
    Anomaly -> Impact
impact :: Impact,
    -- | The Amazon Resource Name (ARN) for the cost monitor that generated this
    -- anomaly.
    Anomaly -> Text
monitorArn :: Prelude.Text
  }
  deriving (Anomaly -> Anomaly -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Anomaly -> Anomaly -> Bool
$c/= :: Anomaly -> Anomaly -> Bool
== :: Anomaly -> Anomaly -> Bool
$c== :: Anomaly -> Anomaly -> Bool
Prelude.Eq, ReadPrec [Anomaly]
ReadPrec Anomaly
Int -> ReadS Anomaly
ReadS [Anomaly]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Anomaly]
$creadListPrec :: ReadPrec [Anomaly]
readPrec :: ReadPrec Anomaly
$creadPrec :: ReadPrec Anomaly
readList :: ReadS [Anomaly]
$creadList :: ReadS [Anomaly]
readsPrec :: Int -> ReadS Anomaly
$creadsPrec :: Int -> ReadS Anomaly
Prelude.Read, Int -> Anomaly -> ShowS
[Anomaly] -> ShowS
Anomaly -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Anomaly] -> ShowS
$cshowList :: [Anomaly] -> ShowS
show :: Anomaly -> String
$cshow :: Anomaly -> String
showsPrec :: Int -> Anomaly -> ShowS
$cshowsPrec :: Int -> Anomaly -> ShowS
Prelude.Show, forall x. Rep Anomaly x -> Anomaly
forall x. Anomaly -> Rep Anomaly x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Anomaly x -> Anomaly
$cfrom :: forall x. Anomaly -> Rep Anomaly x
Prelude.Generic)

-- |
-- Create a value of 'Anomaly' 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:
--
-- 'anomalyEndDate', 'anomaly_anomalyEndDate' - The last day the anomaly is detected.
--
-- 'anomalyStartDate', 'anomaly_anomalyStartDate' - The first day the anomaly is detected.
--
-- 'dimensionValue', 'anomaly_dimensionValue' - The dimension for the anomaly (for example, an Amazon Web Service in a
-- service monitor).
--
-- 'feedback', 'anomaly_feedback' - The feedback value.
--
-- 'rootCauses', 'anomaly_rootCauses' - The list of identified root causes for the anomaly.
--
-- 'anomalyId', 'anomaly_anomalyId' - The unique identifier for the anomaly.
--
-- 'anomalyScore', 'anomaly_anomalyScore' - The latest and maximum score for the anomaly.
--
-- 'impact', 'anomaly_impact' - The dollar impact for the anomaly.
--
-- 'monitorArn', 'anomaly_monitorArn' - The Amazon Resource Name (ARN) for the cost monitor that generated this
-- anomaly.
newAnomaly ::
  -- | 'anomalyId'
  Prelude.Text ->
  -- | 'anomalyScore'
  AnomalyScore ->
  -- | 'impact'
  Impact ->
  -- | 'monitorArn'
  Prelude.Text ->
  Anomaly
newAnomaly :: Text -> AnomalyScore -> Impact -> Text -> Anomaly
newAnomaly
  Text
pAnomalyId_
  AnomalyScore
pAnomalyScore_
  Impact
pImpact_
  Text
pMonitorArn_ =
    Anomaly'
      { $sel:anomalyEndDate:Anomaly' :: Maybe Text
anomalyEndDate = forall a. Maybe a
Prelude.Nothing,
        $sel:anomalyStartDate:Anomaly' :: Maybe Text
anomalyStartDate = forall a. Maybe a
Prelude.Nothing,
        $sel:dimensionValue:Anomaly' :: Maybe Text
dimensionValue = forall a. Maybe a
Prelude.Nothing,
        $sel:feedback:Anomaly' :: Maybe AnomalyFeedbackType
feedback = forall a. Maybe a
Prelude.Nothing,
        $sel:rootCauses:Anomaly' :: Maybe [RootCause]
rootCauses = forall a. Maybe a
Prelude.Nothing,
        $sel:anomalyId:Anomaly' :: Text
anomalyId = Text
pAnomalyId_,
        $sel:anomalyScore:Anomaly' :: AnomalyScore
anomalyScore = AnomalyScore
pAnomalyScore_,
        $sel:impact:Anomaly' :: Impact
impact = Impact
pImpact_,
        $sel:monitorArn:Anomaly' :: Text
monitorArn = Text
pMonitorArn_
      }

-- | The last day the anomaly is detected.
anomaly_anomalyEndDate :: Lens.Lens' Anomaly (Prelude.Maybe Prelude.Text)
anomaly_anomalyEndDate :: Lens' Anomaly (Maybe Text)
anomaly_anomalyEndDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Maybe Text
anomalyEndDate :: Maybe Text
$sel:anomalyEndDate:Anomaly' :: Anomaly -> Maybe Text
anomalyEndDate} -> Maybe Text
anomalyEndDate) (\s :: Anomaly
s@Anomaly' {} Maybe Text
a -> Anomaly
s {$sel:anomalyEndDate:Anomaly' :: Maybe Text
anomalyEndDate = Maybe Text
a} :: Anomaly)

-- | The first day the anomaly is detected.
anomaly_anomalyStartDate :: Lens.Lens' Anomaly (Prelude.Maybe Prelude.Text)
anomaly_anomalyStartDate :: Lens' Anomaly (Maybe Text)
anomaly_anomalyStartDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Maybe Text
anomalyStartDate :: Maybe Text
$sel:anomalyStartDate:Anomaly' :: Anomaly -> Maybe Text
anomalyStartDate} -> Maybe Text
anomalyStartDate) (\s :: Anomaly
s@Anomaly' {} Maybe Text
a -> Anomaly
s {$sel:anomalyStartDate:Anomaly' :: Maybe Text
anomalyStartDate = Maybe Text
a} :: Anomaly)

-- | The dimension for the anomaly (for example, an Amazon Web Service in a
-- service monitor).
anomaly_dimensionValue :: Lens.Lens' Anomaly (Prelude.Maybe Prelude.Text)
anomaly_dimensionValue :: Lens' Anomaly (Maybe Text)
anomaly_dimensionValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Maybe Text
dimensionValue :: Maybe Text
$sel:dimensionValue:Anomaly' :: Anomaly -> Maybe Text
dimensionValue} -> Maybe Text
dimensionValue) (\s :: Anomaly
s@Anomaly' {} Maybe Text
a -> Anomaly
s {$sel:dimensionValue:Anomaly' :: Maybe Text
dimensionValue = Maybe Text
a} :: Anomaly)

-- | The feedback value.
anomaly_feedback :: Lens.Lens' Anomaly (Prelude.Maybe AnomalyFeedbackType)
anomaly_feedback :: Lens' Anomaly (Maybe AnomalyFeedbackType)
anomaly_feedback = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Maybe AnomalyFeedbackType
feedback :: Maybe AnomalyFeedbackType
$sel:feedback:Anomaly' :: Anomaly -> Maybe AnomalyFeedbackType
feedback} -> Maybe AnomalyFeedbackType
feedback) (\s :: Anomaly
s@Anomaly' {} Maybe AnomalyFeedbackType
a -> Anomaly
s {$sel:feedback:Anomaly' :: Maybe AnomalyFeedbackType
feedback = Maybe AnomalyFeedbackType
a} :: Anomaly)

-- | The list of identified root causes for the anomaly.
anomaly_rootCauses :: Lens.Lens' Anomaly (Prelude.Maybe [RootCause])
anomaly_rootCauses :: Lens' Anomaly (Maybe [RootCause])
anomaly_rootCauses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Maybe [RootCause]
rootCauses :: Maybe [RootCause]
$sel:rootCauses:Anomaly' :: Anomaly -> Maybe [RootCause]
rootCauses} -> Maybe [RootCause]
rootCauses) (\s :: Anomaly
s@Anomaly' {} Maybe [RootCause]
a -> Anomaly
s {$sel:rootCauses:Anomaly' :: Maybe [RootCause]
rootCauses = Maybe [RootCause]
a} :: Anomaly) 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 unique identifier for the anomaly.
anomaly_anomalyId :: Lens.Lens' Anomaly Prelude.Text
anomaly_anomalyId :: Lens' Anomaly Text
anomaly_anomalyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Text
anomalyId :: Text
$sel:anomalyId:Anomaly' :: Anomaly -> Text
anomalyId} -> Text
anomalyId) (\s :: Anomaly
s@Anomaly' {} Text
a -> Anomaly
s {$sel:anomalyId:Anomaly' :: Text
anomalyId = Text
a} :: Anomaly)

-- | The latest and maximum score for the anomaly.
anomaly_anomalyScore :: Lens.Lens' Anomaly AnomalyScore
anomaly_anomalyScore :: Lens' Anomaly AnomalyScore
anomaly_anomalyScore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {AnomalyScore
anomalyScore :: AnomalyScore
$sel:anomalyScore:Anomaly' :: Anomaly -> AnomalyScore
anomalyScore} -> AnomalyScore
anomalyScore) (\s :: Anomaly
s@Anomaly' {} AnomalyScore
a -> Anomaly
s {$sel:anomalyScore:Anomaly' :: AnomalyScore
anomalyScore = AnomalyScore
a} :: Anomaly)

-- | The dollar impact for the anomaly.
anomaly_impact :: Lens.Lens' Anomaly Impact
anomaly_impact :: Lens' Anomaly Impact
anomaly_impact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Impact
impact :: Impact
$sel:impact:Anomaly' :: Anomaly -> Impact
impact} -> Impact
impact) (\s :: Anomaly
s@Anomaly' {} Impact
a -> Anomaly
s {$sel:impact:Anomaly' :: Impact
impact = Impact
a} :: Anomaly)

-- | The Amazon Resource Name (ARN) for the cost monitor that generated this
-- anomaly.
anomaly_monitorArn :: Lens.Lens' Anomaly Prelude.Text
anomaly_monitorArn :: Lens' Anomaly Text
anomaly_monitorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Anomaly' {Text
monitorArn :: Text
$sel:monitorArn:Anomaly' :: Anomaly -> Text
monitorArn} -> Text
monitorArn) (\s :: Anomaly
s@Anomaly' {} Text
a -> Anomaly
s {$sel:monitorArn:Anomaly' :: Text
monitorArn = Text
a} :: Anomaly)

instance Data.FromJSON Anomaly where
  parseJSON :: Value -> Parser Anomaly
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Anomaly"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe AnomalyFeedbackType
-> Maybe [RootCause]
-> Text
-> AnomalyScore
-> Impact
-> Text
-> Anomaly
Anomaly'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AnomalyEndDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AnomalyStartDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DimensionValue")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Feedback")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RootCauses" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"AnomalyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"AnomalyScore")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Impact")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"MonitorArn")
      )

instance Prelude.Hashable Anomaly where
  hashWithSalt :: Int -> Anomaly -> Int
hashWithSalt Int
_salt Anomaly' {Maybe [RootCause]
Maybe Text
Maybe AnomalyFeedbackType
Text
AnomalyScore
Impact
monitorArn :: Text
impact :: Impact
anomalyScore :: AnomalyScore
anomalyId :: Text
rootCauses :: Maybe [RootCause]
feedback :: Maybe AnomalyFeedbackType
dimensionValue :: Maybe Text
anomalyStartDate :: Maybe Text
anomalyEndDate :: Maybe Text
$sel:monitorArn:Anomaly' :: Anomaly -> Text
$sel:impact:Anomaly' :: Anomaly -> Impact
$sel:anomalyScore:Anomaly' :: Anomaly -> AnomalyScore
$sel:anomalyId:Anomaly' :: Anomaly -> Text
$sel:rootCauses:Anomaly' :: Anomaly -> Maybe [RootCause]
$sel:feedback:Anomaly' :: Anomaly -> Maybe AnomalyFeedbackType
$sel:dimensionValue:Anomaly' :: Anomaly -> Maybe Text
$sel:anomalyStartDate:Anomaly' :: Anomaly -> Maybe Text
$sel:anomalyEndDate:Anomaly' :: Anomaly -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
anomalyEndDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
anomalyStartDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dimensionValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AnomalyFeedbackType
feedback
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RootCause]
rootCauses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
anomalyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AnomalyScore
anomalyScore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Impact
impact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
monitorArn

instance Prelude.NFData Anomaly where
  rnf :: Anomaly -> ()
rnf Anomaly' {Maybe [RootCause]
Maybe Text
Maybe AnomalyFeedbackType
Text
AnomalyScore
Impact
monitorArn :: Text
impact :: Impact
anomalyScore :: AnomalyScore
anomalyId :: Text
rootCauses :: Maybe [RootCause]
feedback :: Maybe AnomalyFeedbackType
dimensionValue :: Maybe Text
anomalyStartDate :: Maybe Text
anomalyEndDate :: Maybe Text
$sel:monitorArn:Anomaly' :: Anomaly -> Text
$sel:impact:Anomaly' :: Anomaly -> Impact
$sel:anomalyScore:Anomaly' :: Anomaly -> AnomalyScore
$sel:anomalyId:Anomaly' :: Anomaly -> Text
$sel:rootCauses:Anomaly' :: Anomaly -> Maybe [RootCause]
$sel:feedback:Anomaly' :: Anomaly -> Maybe AnomalyFeedbackType
$sel:dimensionValue:Anomaly' :: Anomaly -> Maybe Text
$sel:anomalyStartDate:Anomaly' :: Anomaly -> Maybe Text
$sel:anomalyEndDate:Anomaly' :: Anomaly -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
anomalyEndDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
anomalyStartDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dimensionValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AnomalyFeedbackType
feedback
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RootCause]
rootCauses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
anomalyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AnomalyScore
anomalyScore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Impact
impact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
monitorArn