{-# 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.TimeStreamWrite.Types.Record
-- 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.TimeStreamWrite.Types.Record 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 Amazonka.TimeStreamWrite.Types.Dimension
import Amazonka.TimeStreamWrite.Types.MeasureValue
import Amazonka.TimeStreamWrite.Types.MeasureValueType
import Amazonka.TimeStreamWrite.Types.TimeUnit

-- | Record represents a time series data point being written into
-- Timestream. Each record contains an array of dimensions. Dimensions
-- represent the meta data attributes of a time series data point such as
-- the instance name or availability zone of an EC2 instance. A record also
-- contains the measure name which is the name of the measure being
-- collected for example the CPU utilization of an EC2 instance. A record
-- also contains the measure value and the value type which is the data
-- type of the measure value. In addition, the record contains the
-- timestamp when the measure was collected that the timestamp unit which
-- represents the granularity of the timestamp.
--
-- Records have a @Version@ field, which is a 64-bit @long@ that you can
-- use for updating data points. Writes of a duplicate record with the same
-- dimension, timestamp, and measure name but different measure value will
-- only succeed if the @Version@ attribute of the record in the write
-- request is higher than that of the existing record. Timestream defaults
-- to a @Version@ of @1@ for records without the @Version@ field.
--
-- /See:/ 'newRecord' smart constructor.
data Record = Record'
  { -- | Contains the list of dimensions for time series data points.
    Record -> Maybe [Dimension]
dimensions :: Prelude.Maybe [Dimension],
    -- | Measure represents the data attribute of the time series. For example,
    -- the CPU utilization of an EC2 instance or the RPM of a wind turbine are
    -- measures.
    Record -> Maybe Text
measureName :: Prelude.Maybe Prelude.Text,
    -- | Contains the measure value for the time series data point.
    Record -> Maybe Text
measureValue :: Prelude.Maybe Prelude.Text,
    -- | Contains the data type of the measure value for the time series data
    -- point. Default type is @DOUBLE@.
    Record -> Maybe MeasureValueType
measureValueType :: Prelude.Maybe MeasureValueType,
    -- | Contains the list of MeasureValue for time series data points.
    --
    -- This is only allowed for type @MULTI@. For scalar values, use
    -- @MeasureValue@ attribute of the Record directly.
    Record -> Maybe [MeasureValue]
measureValues :: Prelude.Maybe [MeasureValue],
    -- | Contains the time at which the measure value for the data point was
    -- collected. The time value plus the unit provides the time elapsed since
    -- the epoch. For example, if the time value is @12345@ and the unit is
    -- @ms@, then @12345 ms@ have elapsed since the epoch.
    Record -> Maybe Text
time :: Prelude.Maybe Prelude.Text,
    -- | The granularity of the timestamp unit. It indicates if the time value is
    -- in seconds, milliseconds, nanoseconds or other supported values. Default
    -- is @MILLISECONDS@.
    Record -> Maybe TimeUnit
timeUnit :: Prelude.Maybe TimeUnit,
    -- | 64-bit attribute used for record updates. Write requests for duplicate
    -- data with a higher version number will update the existing measure value
    -- and version. In cases where the measure value is the same, @Version@
    -- will still be updated . Default value is @1@.
    --
    -- @Version@ must be @1@ or greater, or you will receive a
    -- @ValidationException@ error.
    Record -> Maybe Integer
version :: Prelude.Maybe Prelude.Integer
  }
  deriving (Record -> Record -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Record -> Record -> Bool
$c/= :: Record -> Record -> Bool
== :: Record -> Record -> Bool
$c== :: Record -> Record -> Bool
Prelude.Eq, ReadPrec [Record]
ReadPrec Record
Int -> ReadS Record
ReadS [Record]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Record]
$creadListPrec :: ReadPrec [Record]
readPrec :: ReadPrec Record
$creadPrec :: ReadPrec Record
readList :: ReadS [Record]
$creadList :: ReadS [Record]
readsPrec :: Int -> ReadS Record
$creadsPrec :: Int -> ReadS Record
Prelude.Read, Int -> Record -> ShowS
[Record] -> ShowS
Record -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Record] -> ShowS
$cshowList :: [Record] -> ShowS
show :: Record -> String
$cshow :: Record -> String
showsPrec :: Int -> Record -> ShowS
$cshowsPrec :: Int -> Record -> ShowS
Prelude.Show, forall x. Rep Record x -> Record
forall x. Record -> Rep Record x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Record x -> Record
$cfrom :: forall x. Record -> Rep Record x
Prelude.Generic)

-- |
-- Create a value of 'Record' 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', 'record_dimensions' - Contains the list of dimensions for time series data points.
--
-- 'measureName', 'record_measureName' - Measure represents the data attribute of the time series. For example,
-- the CPU utilization of an EC2 instance or the RPM of a wind turbine are
-- measures.
--
-- 'measureValue', 'record_measureValue' - Contains the measure value for the time series data point.
--
-- 'measureValueType', 'record_measureValueType' - Contains the data type of the measure value for the time series data
-- point. Default type is @DOUBLE@.
--
-- 'measureValues', 'record_measureValues' - Contains the list of MeasureValue for time series data points.
--
-- This is only allowed for type @MULTI@. For scalar values, use
-- @MeasureValue@ attribute of the Record directly.
--
-- 'time', 'record_time' - Contains the time at which the measure value for the data point was
-- collected. The time value plus the unit provides the time elapsed since
-- the epoch. For example, if the time value is @12345@ and the unit is
-- @ms@, then @12345 ms@ have elapsed since the epoch.
--
-- 'timeUnit', 'record_timeUnit' - The granularity of the timestamp unit. It indicates if the time value is
-- in seconds, milliseconds, nanoseconds or other supported values. Default
-- is @MILLISECONDS@.
--
-- 'version', 'record_version' - 64-bit attribute used for record updates. Write requests for duplicate
-- data with a higher version number will update the existing measure value
-- and version. In cases where the measure value is the same, @Version@
-- will still be updated . Default value is @1@.
--
-- @Version@ must be @1@ or greater, or you will receive a
-- @ValidationException@ error.
newRecord ::
  Record
newRecord :: Record
newRecord =
  Record'
    { $sel:dimensions:Record' :: Maybe [Dimension]
dimensions = forall a. Maybe a
Prelude.Nothing,
      $sel:measureName:Record' :: Maybe Text
measureName = forall a. Maybe a
Prelude.Nothing,
      $sel:measureValue:Record' :: Maybe Text
measureValue = forall a. Maybe a
Prelude.Nothing,
      $sel:measureValueType:Record' :: Maybe MeasureValueType
measureValueType = forall a. Maybe a
Prelude.Nothing,
      $sel:measureValues:Record' :: Maybe [MeasureValue]
measureValues = forall a. Maybe a
Prelude.Nothing,
      $sel:time:Record' :: Maybe Text
time = forall a. Maybe a
Prelude.Nothing,
      $sel:timeUnit:Record' :: Maybe TimeUnit
timeUnit = forall a. Maybe a
Prelude.Nothing,
      $sel:version:Record' :: Maybe Integer
version = forall a. Maybe a
Prelude.Nothing
    }

-- | Contains the list of dimensions for time series data points.
record_dimensions :: Lens.Lens' Record (Prelude.Maybe [Dimension])
record_dimensions :: Lens' Record (Maybe [Dimension])
record_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe [Dimension]
dimensions :: Maybe [Dimension]
$sel:dimensions:Record' :: Record -> Maybe [Dimension]
dimensions} -> Maybe [Dimension]
dimensions) (\s :: Record
s@Record' {} Maybe [Dimension]
a -> Record
s {$sel:dimensions:Record' :: Maybe [Dimension]
dimensions = Maybe [Dimension]
a} :: Record) 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

-- | Measure represents the data attribute of the time series. For example,
-- the CPU utilization of an EC2 instance or the RPM of a wind turbine are
-- measures.
record_measureName :: Lens.Lens' Record (Prelude.Maybe Prelude.Text)
record_measureName :: Lens' Record (Maybe Text)
record_measureName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe Text
measureName :: Maybe Text
$sel:measureName:Record' :: Record -> Maybe Text
measureName} -> Maybe Text
measureName) (\s :: Record
s@Record' {} Maybe Text
a -> Record
s {$sel:measureName:Record' :: Maybe Text
measureName = Maybe Text
a} :: Record)

-- | Contains the measure value for the time series data point.
record_measureValue :: Lens.Lens' Record (Prelude.Maybe Prelude.Text)
record_measureValue :: Lens' Record (Maybe Text)
record_measureValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe Text
measureValue :: Maybe Text
$sel:measureValue:Record' :: Record -> Maybe Text
measureValue} -> Maybe Text
measureValue) (\s :: Record
s@Record' {} Maybe Text
a -> Record
s {$sel:measureValue:Record' :: Maybe Text
measureValue = Maybe Text
a} :: Record)

-- | Contains the data type of the measure value for the time series data
-- point. Default type is @DOUBLE@.
record_measureValueType :: Lens.Lens' Record (Prelude.Maybe MeasureValueType)
record_measureValueType :: Lens' Record (Maybe MeasureValueType)
record_measureValueType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe MeasureValueType
measureValueType :: Maybe MeasureValueType
$sel:measureValueType:Record' :: Record -> Maybe MeasureValueType
measureValueType} -> Maybe MeasureValueType
measureValueType) (\s :: Record
s@Record' {} Maybe MeasureValueType
a -> Record
s {$sel:measureValueType:Record' :: Maybe MeasureValueType
measureValueType = Maybe MeasureValueType
a} :: Record)

-- | Contains the list of MeasureValue for time series data points.
--
-- This is only allowed for type @MULTI@. For scalar values, use
-- @MeasureValue@ attribute of the Record directly.
record_measureValues :: Lens.Lens' Record (Prelude.Maybe [MeasureValue])
record_measureValues :: Lens' Record (Maybe [MeasureValue])
record_measureValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe [MeasureValue]
measureValues :: Maybe [MeasureValue]
$sel:measureValues:Record' :: Record -> Maybe [MeasureValue]
measureValues} -> Maybe [MeasureValue]
measureValues) (\s :: Record
s@Record' {} Maybe [MeasureValue]
a -> Record
s {$sel:measureValues:Record' :: Maybe [MeasureValue]
measureValues = Maybe [MeasureValue]
a} :: Record) 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

-- | Contains the time at which the measure value for the data point was
-- collected. The time value plus the unit provides the time elapsed since
-- the epoch. For example, if the time value is @12345@ and the unit is
-- @ms@, then @12345 ms@ have elapsed since the epoch.
record_time :: Lens.Lens' Record (Prelude.Maybe Prelude.Text)
record_time :: Lens' Record (Maybe Text)
record_time = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe Text
time :: Maybe Text
$sel:time:Record' :: Record -> Maybe Text
time} -> Maybe Text
time) (\s :: Record
s@Record' {} Maybe Text
a -> Record
s {$sel:time:Record' :: Maybe Text
time = Maybe Text
a} :: Record)

-- | The granularity of the timestamp unit. It indicates if the time value is
-- in seconds, milliseconds, nanoseconds or other supported values. Default
-- is @MILLISECONDS@.
record_timeUnit :: Lens.Lens' Record (Prelude.Maybe TimeUnit)
record_timeUnit :: Lens' Record (Maybe TimeUnit)
record_timeUnit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe TimeUnit
timeUnit :: Maybe TimeUnit
$sel:timeUnit:Record' :: Record -> Maybe TimeUnit
timeUnit} -> Maybe TimeUnit
timeUnit) (\s :: Record
s@Record' {} Maybe TimeUnit
a -> Record
s {$sel:timeUnit:Record' :: Maybe TimeUnit
timeUnit = Maybe TimeUnit
a} :: Record)

-- | 64-bit attribute used for record updates. Write requests for duplicate
-- data with a higher version number will update the existing measure value
-- and version. In cases where the measure value is the same, @Version@
-- will still be updated . Default value is @1@.
--
-- @Version@ must be @1@ or greater, or you will receive a
-- @ValidationException@ error.
record_version :: Lens.Lens' Record (Prelude.Maybe Prelude.Integer)
record_version :: Lens' Record (Maybe Integer)
record_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Record' {Maybe Integer
version :: Maybe Integer
$sel:version:Record' :: Record -> Maybe Integer
version} -> Maybe Integer
version) (\s :: Record
s@Record' {} Maybe Integer
a -> Record
s {$sel:version:Record' :: Maybe Integer
version = Maybe Integer
a} :: Record)

instance Prelude.Hashable Record where
  hashWithSalt :: Int -> Record -> Int
hashWithSalt Int
_salt Record' {Maybe Integer
Maybe [Dimension]
Maybe [MeasureValue]
Maybe Text
Maybe MeasureValueType
Maybe TimeUnit
version :: Maybe Integer
timeUnit :: Maybe TimeUnit
time :: Maybe Text
measureValues :: Maybe [MeasureValue]
measureValueType :: Maybe MeasureValueType
measureValue :: Maybe Text
measureName :: Maybe Text
dimensions :: Maybe [Dimension]
$sel:version:Record' :: Record -> Maybe Integer
$sel:timeUnit:Record' :: Record -> Maybe TimeUnit
$sel:time:Record' :: Record -> Maybe Text
$sel:measureValues:Record' :: Record -> Maybe [MeasureValue]
$sel:measureValueType:Record' :: Record -> Maybe MeasureValueType
$sel:measureValue:Record' :: Record -> Maybe Text
$sel:measureName:Record' :: Record -> Maybe Text
$sel:dimensions:Record' :: Record -> 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 Text
measureName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
measureValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MeasureValueType
measureValueType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MeasureValue]
measureValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
time
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeUnit
timeUnit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
version

instance Prelude.NFData Record where
  rnf :: Record -> ()
rnf Record' {Maybe Integer
Maybe [Dimension]
Maybe [MeasureValue]
Maybe Text
Maybe MeasureValueType
Maybe TimeUnit
version :: Maybe Integer
timeUnit :: Maybe TimeUnit
time :: Maybe Text
measureValues :: Maybe [MeasureValue]
measureValueType :: Maybe MeasureValueType
measureValue :: Maybe Text
measureName :: Maybe Text
dimensions :: Maybe [Dimension]
$sel:version:Record' :: Record -> Maybe Integer
$sel:timeUnit:Record' :: Record -> Maybe TimeUnit
$sel:time:Record' :: Record -> Maybe Text
$sel:measureValues:Record' :: Record -> Maybe [MeasureValue]
$sel:measureValueType:Record' :: Record -> Maybe MeasureValueType
$sel:measureValue:Record' :: Record -> Maybe Text
$sel:measureName:Record' :: Record -> Maybe Text
$sel:dimensions:Record' :: Record -> 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 Text
measureName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
measureValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MeasureValueType
measureValueType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MeasureValue]
measureValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
time
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeUnit
timeUnit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
version

instance Data.ToJSON Record where
  toJSON :: Record -> Value
toJSON Record' {Maybe Integer
Maybe [Dimension]
Maybe [MeasureValue]
Maybe Text
Maybe MeasureValueType
Maybe TimeUnit
version :: Maybe Integer
timeUnit :: Maybe TimeUnit
time :: Maybe Text
measureValues :: Maybe [MeasureValue]
measureValueType :: Maybe MeasureValueType
measureValue :: Maybe Text
measureName :: Maybe Text
dimensions :: Maybe [Dimension]
$sel:version:Record' :: Record -> Maybe Integer
$sel:timeUnit:Record' :: Record -> Maybe TimeUnit
$sel:time:Record' :: Record -> Maybe Text
$sel:measureValues:Record' :: Record -> Maybe [MeasureValue]
$sel:measureValueType:Record' :: Record -> Maybe MeasureValueType
$sel:measureValue:Record' :: Record -> Maybe Text
$sel:measureName:Record' :: Record -> Maybe Text
$sel:dimensions:Record' :: Record -> 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
"MeasureName" 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
measureName,
            (Key
"MeasureValue" 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
measureValue,
            (Key
"MeasureValueType" 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 MeasureValueType
measureValueType,
            (Key
"MeasureValues" 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 [MeasureValue]
measureValues,
            (Key
"Time" 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
time,
            (Key
"TimeUnit" 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 TimeUnit
timeUnit,
            (Key
"Version" 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 Integer
version
          ]
      )