{-# 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.MwAA.Types.MetricDatum
-- 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.MwAA.Types.MetricDatum where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MwAA.Types.Dimension
import Amazonka.MwAA.Types.StatisticSet
import Amazonka.MwAA.Types.Unit
import qualified Amazonka.Prelude as Prelude

-- | __Internal only__. Collects Apache Airflow metrics. To learn more about
-- the metrics published to Amazon CloudWatch, see
-- <https://docs.aws.amazon.com/mwaa/latest/userguide/cw-metrics.html Amazon MWAA performance metrics in Amazon CloudWatch>.
--
-- /See:/ 'newMetricDatum' smart constructor.
data MetricDatum = MetricDatum'
  { -- | __Internal only__. The dimensions associated with the metric.
    MetricDatum -> Maybe [Dimension]
dimensions :: Prelude.Maybe [Dimension],
    -- | __Internal only__. The statistical values for the metric.
    MetricDatum -> Maybe StatisticSet
statisticValues :: Prelude.Maybe StatisticSet,
    -- | __Internal only__. The unit used to store the metric.
    MetricDatum -> Maybe Unit
unit :: Prelude.Maybe Unit,
    -- | __Internal only__. The value for the metric.
    MetricDatum -> Maybe Double
value :: Prelude.Maybe Prelude.Double,
    -- | __Internal only__. The name of the metric.
    MetricDatum -> Text
metricName :: Prelude.Text,
    -- | __Internal only__. The time the metric data was received.
    MetricDatum -> POSIX
timestamp :: Data.POSIX
  }
  deriving (MetricDatum -> MetricDatum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricDatum -> MetricDatum -> Bool
$c/= :: MetricDatum -> MetricDatum -> Bool
== :: MetricDatum -> MetricDatum -> Bool
$c== :: MetricDatum -> MetricDatum -> Bool
Prelude.Eq, ReadPrec [MetricDatum]
ReadPrec MetricDatum
Int -> ReadS MetricDatum
ReadS [MetricDatum]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MetricDatum]
$creadListPrec :: ReadPrec [MetricDatum]
readPrec :: ReadPrec MetricDatum
$creadPrec :: ReadPrec MetricDatum
readList :: ReadS [MetricDatum]
$creadList :: ReadS [MetricDatum]
readsPrec :: Int -> ReadS MetricDatum
$creadsPrec :: Int -> ReadS MetricDatum
Prelude.Read, Int -> MetricDatum -> ShowS
[MetricDatum] -> ShowS
MetricDatum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetricDatum] -> ShowS
$cshowList :: [MetricDatum] -> ShowS
show :: MetricDatum -> String
$cshow :: MetricDatum -> String
showsPrec :: Int -> MetricDatum -> ShowS
$cshowsPrec :: Int -> MetricDatum -> ShowS
Prelude.Show, forall x. Rep MetricDatum x -> MetricDatum
forall x. MetricDatum -> Rep MetricDatum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetricDatum x -> MetricDatum
$cfrom :: forall x. MetricDatum -> Rep MetricDatum x
Prelude.Generic)

-- |
-- Create a value of 'MetricDatum' 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:
--
-- 'dimensions', 'metricDatum_dimensions' - __Internal only__. The dimensions associated with the metric.
--
-- 'statisticValues', 'metricDatum_statisticValues' - __Internal only__. The statistical values for the metric.
--
-- 'unit', 'metricDatum_unit' - __Internal only__. The unit used to store the metric.
--
-- 'value', 'metricDatum_value' - __Internal only__. The value for the metric.
--
-- 'metricName', 'metricDatum_metricName' - __Internal only__. The name of the metric.
--
-- 'timestamp', 'metricDatum_timestamp' - __Internal only__. The time the metric data was received.
newMetricDatum ::
  -- | 'metricName'
  Prelude.Text ->
  -- | 'timestamp'
  Prelude.UTCTime ->
  MetricDatum
newMetricDatum :: Text -> UTCTime -> MetricDatum
newMetricDatum Text
pMetricName_ UTCTime
pTimestamp_ =
  MetricDatum'
    { $sel:dimensions:MetricDatum' :: Maybe [Dimension]
dimensions = forall a. Maybe a
Prelude.Nothing,
      $sel:statisticValues:MetricDatum' :: Maybe StatisticSet
statisticValues = forall a. Maybe a
Prelude.Nothing,
      $sel:unit:MetricDatum' :: Maybe Unit
unit = forall a. Maybe a
Prelude.Nothing,
      $sel:value:MetricDatum' :: Maybe Double
value = forall a. Maybe a
Prelude.Nothing,
      $sel:metricName:MetricDatum' :: Text
metricName = Text
pMetricName_,
      $sel:timestamp:MetricDatum' :: POSIX
timestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pTimestamp_
    }

-- | __Internal only__. The dimensions associated with the metric.
metricDatum_dimensions :: Lens.Lens' MetricDatum (Prelude.Maybe [Dimension])
metricDatum_dimensions :: Lens' MetricDatum (Maybe [Dimension])
metricDatum_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe [Dimension]
dimensions :: Maybe [Dimension]
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
dimensions} -> Maybe [Dimension]
dimensions) (\s :: MetricDatum
s@MetricDatum' {} Maybe [Dimension]
a -> MetricDatum
s {$sel:dimensions:MetricDatum' :: Maybe [Dimension]
dimensions = Maybe [Dimension]
a} :: MetricDatum) 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

-- | __Internal only__. The statistical values for the metric.
metricDatum_statisticValues :: Lens.Lens' MetricDatum (Prelude.Maybe StatisticSet)
metricDatum_statisticValues :: Lens' MetricDatum (Maybe StatisticSet)
metricDatum_statisticValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe StatisticSet
statisticValues :: Maybe StatisticSet
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
statisticValues} -> Maybe StatisticSet
statisticValues) (\s :: MetricDatum
s@MetricDatum' {} Maybe StatisticSet
a -> MetricDatum
s {$sel:statisticValues:MetricDatum' :: Maybe StatisticSet
statisticValues = Maybe StatisticSet
a} :: MetricDatum)

-- | __Internal only__. The unit used to store the metric.
metricDatum_unit :: Lens.Lens' MetricDatum (Prelude.Maybe Unit)
metricDatum_unit :: Lens' MetricDatum (Maybe Unit)
metricDatum_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe Unit
unit :: Maybe Unit
$sel:unit:MetricDatum' :: MetricDatum -> Maybe Unit
unit} -> Maybe Unit
unit) (\s :: MetricDatum
s@MetricDatum' {} Maybe Unit
a -> MetricDatum
s {$sel:unit:MetricDatum' :: Maybe Unit
unit = Maybe Unit
a} :: MetricDatum)

-- | __Internal only__. The value for the metric.
metricDatum_value :: Lens.Lens' MetricDatum (Prelude.Maybe Prelude.Double)
metricDatum_value :: Lens' MetricDatum (Maybe Double)
metricDatum_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe Double
value :: Maybe Double
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
value} -> Maybe Double
value) (\s :: MetricDatum
s@MetricDatum' {} Maybe Double
a -> MetricDatum
s {$sel:value:MetricDatum' :: Maybe Double
value = Maybe Double
a} :: MetricDatum)

-- | __Internal only__. The name of the metric.
metricDatum_metricName :: Lens.Lens' MetricDatum Prelude.Text
metricDatum_metricName :: Lens' MetricDatum Text
metricDatum_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Text
metricName :: Text
$sel:metricName:MetricDatum' :: MetricDatum -> Text
metricName} -> Text
metricName) (\s :: MetricDatum
s@MetricDatum' {} Text
a -> MetricDatum
s {$sel:metricName:MetricDatum' :: Text
metricName = Text
a} :: MetricDatum)

-- | __Internal only__. The time the metric data was received.
metricDatum_timestamp :: Lens.Lens' MetricDatum Prelude.UTCTime
metricDatum_timestamp :: Lens' MetricDatum UTCTime
metricDatum_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {POSIX
timestamp :: POSIX
$sel:timestamp:MetricDatum' :: MetricDatum -> POSIX
timestamp} -> POSIX
timestamp) (\s :: MetricDatum
s@MetricDatum' {} POSIX
a -> MetricDatum
s {$sel:timestamp:MetricDatum' :: POSIX
timestamp = POSIX
a} :: MetricDatum) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.Hashable MetricDatum where
  hashWithSalt :: Int -> MetricDatum -> Int
hashWithSalt Int
_salt MetricDatum' {Maybe Double
Maybe [Dimension]
Maybe StatisticSet
Maybe Unit
Text
POSIX
timestamp :: POSIX
metricName :: Text
value :: Maybe Double
unit :: Maybe Unit
statisticValues :: Maybe StatisticSet
dimensions :: Maybe [Dimension]
$sel:timestamp:MetricDatum' :: MetricDatum -> POSIX
$sel:metricName:MetricDatum' :: MetricDatum -> Text
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
$sel:unit:MetricDatum' :: MetricDatum -> Maybe Unit
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Dimension]
dimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StatisticSet
statisticValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Unit
unit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
value
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
timestamp

instance Prelude.NFData MetricDatum where
  rnf :: MetricDatum -> ()
rnf MetricDatum' {Maybe Double
Maybe [Dimension]
Maybe StatisticSet
Maybe Unit
Text
POSIX
timestamp :: POSIX
metricName :: Text
value :: Maybe Double
unit :: Maybe Unit
statisticValues :: Maybe StatisticSet
dimensions :: Maybe [Dimension]
$sel:timestamp:MetricDatum' :: MetricDatum -> POSIX
$sel:metricName:MetricDatum' :: MetricDatum -> Text
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
$sel:unit:MetricDatum' :: MetricDatum -> Maybe Unit
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Dimension]
dimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StatisticSet
statisticValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Unit
unit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
value
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
timestamp

instance Data.ToJSON MetricDatum where
  toJSON :: MetricDatum -> Value
toJSON MetricDatum' {Maybe Double
Maybe [Dimension]
Maybe StatisticSet
Maybe Unit
Text
POSIX
timestamp :: POSIX
metricName :: Text
value :: Maybe Double
unit :: Maybe Unit
statisticValues :: Maybe StatisticSet
dimensions :: Maybe [Dimension]
$sel:timestamp:MetricDatum' :: MetricDatum -> POSIX
$sel:metricName:MetricDatum' :: MetricDatum -> Text
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
$sel:unit:MetricDatum' :: MetricDatum -> Maybe Unit
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Dimensions" 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 [Dimension]
dimensions,
            (Key
"StatisticValues" 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 StatisticSet
statisticValues,
            (Key
"Unit" 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 Unit
unit,
            (Key
"Value" 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
value,
            forall a. a -> Maybe a
Prelude.Just (Key
"MetricName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
metricName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Timestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
timestamp)
          ]
      )