{-# 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.XRay.Types.TelemetryRecord
-- 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.XRay.Types.TelemetryRecord 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.XRay.Types.BackendConnectionErrors

-- |
--
-- /See:/ 'newTelemetryRecord' smart constructor.
data TelemetryRecord = TelemetryRecord'
  { TelemetryRecord -> Maybe BackendConnectionErrors
backendConnectionErrors :: Prelude.Maybe BackendConnectionErrors,
    TelemetryRecord -> Maybe Int
segmentsReceivedCount :: Prelude.Maybe Prelude.Int,
    TelemetryRecord -> Maybe Int
segmentsRejectedCount :: Prelude.Maybe Prelude.Int,
    TelemetryRecord -> Maybe Int
segmentsSentCount :: Prelude.Maybe Prelude.Int,
    TelemetryRecord -> Maybe Int
segmentsSpilloverCount :: Prelude.Maybe Prelude.Int,
    TelemetryRecord -> POSIX
timestamp :: Data.POSIX
  }
  deriving (TelemetryRecord -> TelemetryRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TelemetryRecord -> TelemetryRecord -> Bool
$c/= :: TelemetryRecord -> TelemetryRecord -> Bool
== :: TelemetryRecord -> TelemetryRecord -> Bool
$c== :: TelemetryRecord -> TelemetryRecord -> Bool
Prelude.Eq, ReadPrec [TelemetryRecord]
ReadPrec TelemetryRecord
Int -> ReadS TelemetryRecord
ReadS [TelemetryRecord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TelemetryRecord]
$creadListPrec :: ReadPrec [TelemetryRecord]
readPrec :: ReadPrec TelemetryRecord
$creadPrec :: ReadPrec TelemetryRecord
readList :: ReadS [TelemetryRecord]
$creadList :: ReadS [TelemetryRecord]
readsPrec :: Int -> ReadS TelemetryRecord
$creadsPrec :: Int -> ReadS TelemetryRecord
Prelude.Read, Int -> TelemetryRecord -> ShowS
[TelemetryRecord] -> ShowS
TelemetryRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TelemetryRecord] -> ShowS
$cshowList :: [TelemetryRecord] -> ShowS
show :: TelemetryRecord -> String
$cshow :: TelemetryRecord -> String
showsPrec :: Int -> TelemetryRecord -> ShowS
$cshowsPrec :: Int -> TelemetryRecord -> ShowS
Prelude.Show, forall x. Rep TelemetryRecord x -> TelemetryRecord
forall x. TelemetryRecord -> Rep TelemetryRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TelemetryRecord x -> TelemetryRecord
$cfrom :: forall x. TelemetryRecord -> Rep TelemetryRecord x
Prelude.Generic)

-- |
-- Create a value of 'TelemetryRecord' 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:
--
-- 'backendConnectionErrors', 'telemetryRecord_backendConnectionErrors' -
--
-- 'segmentsReceivedCount', 'telemetryRecord_segmentsReceivedCount' -
--
-- 'segmentsRejectedCount', 'telemetryRecord_segmentsRejectedCount' -
--
-- 'segmentsSentCount', 'telemetryRecord_segmentsSentCount' -
--
-- 'segmentsSpilloverCount', 'telemetryRecord_segmentsSpilloverCount' -
--
-- 'timestamp', 'telemetryRecord_timestamp' -
newTelemetryRecord ::
  -- | 'timestamp'
  Prelude.UTCTime ->
  TelemetryRecord
newTelemetryRecord :: UTCTime -> TelemetryRecord
newTelemetryRecord UTCTime
pTimestamp_ =
  TelemetryRecord'
    { $sel:backendConnectionErrors:TelemetryRecord' :: Maybe BackendConnectionErrors
backendConnectionErrors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:segmentsReceivedCount:TelemetryRecord' :: Maybe Int
segmentsReceivedCount = forall a. Maybe a
Prelude.Nothing,
      $sel:segmentsRejectedCount:TelemetryRecord' :: Maybe Int
segmentsRejectedCount = forall a. Maybe a
Prelude.Nothing,
      $sel:segmentsSentCount:TelemetryRecord' :: Maybe Int
segmentsSentCount = forall a. Maybe a
Prelude.Nothing,
      $sel:segmentsSpilloverCount:TelemetryRecord' :: Maybe Int
segmentsSpilloverCount = forall a. Maybe a
Prelude.Nothing,
      $sel:timestamp:TelemetryRecord' :: POSIX
timestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pTimestamp_
    }

telemetryRecord_backendConnectionErrors :: Lens.Lens' TelemetryRecord (Prelude.Maybe BackendConnectionErrors)
telemetryRecord_backendConnectionErrors :: Lens' TelemetryRecord (Maybe BackendConnectionErrors)
telemetryRecord_backendConnectionErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TelemetryRecord' {Maybe BackendConnectionErrors
backendConnectionErrors :: Maybe BackendConnectionErrors
$sel:backendConnectionErrors:TelemetryRecord' :: TelemetryRecord -> Maybe BackendConnectionErrors
backendConnectionErrors} -> Maybe BackendConnectionErrors
backendConnectionErrors) (\s :: TelemetryRecord
s@TelemetryRecord' {} Maybe BackendConnectionErrors
a -> TelemetryRecord
s {$sel:backendConnectionErrors:TelemetryRecord' :: Maybe BackendConnectionErrors
backendConnectionErrors = Maybe BackendConnectionErrors
a} :: TelemetryRecord)

telemetryRecord_segmentsReceivedCount :: Lens.Lens' TelemetryRecord (Prelude.Maybe Prelude.Int)
telemetryRecord_segmentsReceivedCount :: Lens' TelemetryRecord (Maybe Int)
telemetryRecord_segmentsReceivedCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TelemetryRecord' {Maybe Int
segmentsReceivedCount :: Maybe Int
$sel:segmentsReceivedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
segmentsReceivedCount} -> Maybe Int
segmentsReceivedCount) (\s :: TelemetryRecord
s@TelemetryRecord' {} Maybe Int
a -> TelemetryRecord
s {$sel:segmentsReceivedCount:TelemetryRecord' :: Maybe Int
segmentsReceivedCount = Maybe Int
a} :: TelemetryRecord)

telemetryRecord_segmentsRejectedCount :: Lens.Lens' TelemetryRecord (Prelude.Maybe Prelude.Int)
telemetryRecord_segmentsRejectedCount :: Lens' TelemetryRecord (Maybe Int)
telemetryRecord_segmentsRejectedCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TelemetryRecord' {Maybe Int
segmentsRejectedCount :: Maybe Int
$sel:segmentsRejectedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
segmentsRejectedCount} -> Maybe Int
segmentsRejectedCount) (\s :: TelemetryRecord
s@TelemetryRecord' {} Maybe Int
a -> TelemetryRecord
s {$sel:segmentsRejectedCount:TelemetryRecord' :: Maybe Int
segmentsRejectedCount = Maybe Int
a} :: TelemetryRecord)

telemetryRecord_segmentsSentCount :: Lens.Lens' TelemetryRecord (Prelude.Maybe Prelude.Int)
telemetryRecord_segmentsSentCount :: Lens' TelemetryRecord (Maybe Int)
telemetryRecord_segmentsSentCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TelemetryRecord' {Maybe Int
segmentsSentCount :: Maybe Int
$sel:segmentsSentCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
segmentsSentCount} -> Maybe Int
segmentsSentCount) (\s :: TelemetryRecord
s@TelemetryRecord' {} Maybe Int
a -> TelemetryRecord
s {$sel:segmentsSentCount:TelemetryRecord' :: Maybe Int
segmentsSentCount = Maybe Int
a} :: TelemetryRecord)

telemetryRecord_segmentsSpilloverCount :: Lens.Lens' TelemetryRecord (Prelude.Maybe Prelude.Int)
telemetryRecord_segmentsSpilloverCount :: Lens' TelemetryRecord (Maybe Int)
telemetryRecord_segmentsSpilloverCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TelemetryRecord' {Maybe Int
segmentsSpilloverCount :: Maybe Int
$sel:segmentsSpilloverCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
segmentsSpilloverCount} -> Maybe Int
segmentsSpilloverCount) (\s :: TelemetryRecord
s@TelemetryRecord' {} Maybe Int
a -> TelemetryRecord
s {$sel:segmentsSpilloverCount:TelemetryRecord' :: Maybe Int
segmentsSpilloverCount = Maybe Int
a} :: TelemetryRecord)

telemetryRecord_timestamp :: Lens.Lens' TelemetryRecord Prelude.UTCTime
telemetryRecord_timestamp :: Lens' TelemetryRecord UTCTime
telemetryRecord_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TelemetryRecord' {POSIX
timestamp :: POSIX
$sel:timestamp:TelemetryRecord' :: TelemetryRecord -> POSIX
timestamp} -> POSIX
timestamp) (\s :: TelemetryRecord
s@TelemetryRecord' {} POSIX
a -> TelemetryRecord
s {$sel:timestamp:TelemetryRecord' :: POSIX
timestamp = POSIX
a} :: TelemetryRecord) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.Hashable TelemetryRecord where
  hashWithSalt :: Int -> TelemetryRecord -> Int
hashWithSalt Int
_salt TelemetryRecord' {Maybe Int
Maybe BackendConnectionErrors
POSIX
timestamp :: POSIX
segmentsSpilloverCount :: Maybe Int
segmentsSentCount :: Maybe Int
segmentsRejectedCount :: Maybe Int
segmentsReceivedCount :: Maybe Int
backendConnectionErrors :: Maybe BackendConnectionErrors
$sel:timestamp:TelemetryRecord' :: TelemetryRecord -> POSIX
$sel:segmentsSpilloverCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsSentCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsRejectedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsReceivedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:backendConnectionErrors:TelemetryRecord' :: TelemetryRecord -> Maybe BackendConnectionErrors
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BackendConnectionErrors
backendConnectionErrors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
segmentsReceivedCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
segmentsRejectedCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
segmentsSentCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
segmentsSpilloverCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
timestamp

instance Prelude.NFData TelemetryRecord where
  rnf :: TelemetryRecord -> ()
rnf TelemetryRecord' {Maybe Int
Maybe BackendConnectionErrors
POSIX
timestamp :: POSIX
segmentsSpilloverCount :: Maybe Int
segmentsSentCount :: Maybe Int
segmentsRejectedCount :: Maybe Int
segmentsReceivedCount :: Maybe Int
backendConnectionErrors :: Maybe BackendConnectionErrors
$sel:timestamp:TelemetryRecord' :: TelemetryRecord -> POSIX
$sel:segmentsSpilloverCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsSentCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsRejectedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsReceivedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:backendConnectionErrors:TelemetryRecord' :: TelemetryRecord -> Maybe BackendConnectionErrors
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BackendConnectionErrors
backendConnectionErrors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
segmentsReceivedCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
segmentsRejectedCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
segmentsSentCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
segmentsSpilloverCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
timestamp

instance Data.ToJSON TelemetryRecord where
  toJSON :: TelemetryRecord -> Value
toJSON TelemetryRecord' {Maybe Int
Maybe BackendConnectionErrors
POSIX
timestamp :: POSIX
segmentsSpilloverCount :: Maybe Int
segmentsSentCount :: Maybe Int
segmentsRejectedCount :: Maybe Int
segmentsReceivedCount :: Maybe Int
backendConnectionErrors :: Maybe BackendConnectionErrors
$sel:timestamp:TelemetryRecord' :: TelemetryRecord -> POSIX
$sel:segmentsSpilloverCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsSentCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsRejectedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:segmentsReceivedCount:TelemetryRecord' :: TelemetryRecord -> Maybe Int
$sel:backendConnectionErrors:TelemetryRecord' :: TelemetryRecord -> Maybe BackendConnectionErrors
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BackendConnectionErrors" 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 BackendConnectionErrors
backendConnectionErrors,
            (Key
"SegmentsReceivedCount" 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 Int
segmentsReceivedCount,
            (Key
"SegmentsRejectedCount" 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 Int
segmentsRejectedCount,
            (Key
"SegmentsSentCount" 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 Int
segmentsSentCount,
            (Key
"SegmentsSpilloverCount" 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 Int
segmentsSpilloverCount,
            forall a. a -> Maybe a
Prelude.Just (Key
"Timestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
timestamp)
          ]
      )