{-# 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.Edge
-- 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.Edge 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.Alias
import Amazonka.XRay.Types.EdgeStatistics
import Amazonka.XRay.Types.HistogramEntry

-- | Information about a connection between two services. An edge can be a
-- synchronous connection, such as typical call between client and service,
-- or an asynchronous link, such as a Lambda function which retrieves an
-- event from an SNS queue.
--
-- /See:/ 'newEdge' smart constructor.
data Edge = Edge'
  { -- | Aliases for the edge.
    Edge -> Maybe [Alias]
aliases :: Prelude.Maybe [Alias],
    -- | Describes an asynchronous connection, with a value of @link@.
    Edge -> Maybe Text
edgeType :: Prelude.Maybe Prelude.Text,
    -- | The end time of the last segment on the edge.
    Edge -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | A histogram that maps the spread of event age when received by
    -- consumers. Age is calculated each time an event is received. Only
    -- populated when /EdgeType/ is @link@.
    Edge -> Maybe [HistogramEntry]
receivedEventAgeHistogram :: Prelude.Maybe [HistogramEntry],
    -- | Identifier of the edge. Unique within a service map.
    Edge -> Maybe Int
referenceId :: Prelude.Maybe Prelude.Int,
    -- | A histogram that maps the spread of client response times on an edge.
    -- Only populated for synchronous edges.
    Edge -> Maybe [HistogramEntry]
responseTimeHistogram :: Prelude.Maybe [HistogramEntry],
    -- | The start time of the first segment on the edge.
    Edge -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX,
    -- | Response statistics for segments on the edge.
    Edge -> Maybe EdgeStatistics
summaryStatistics :: Prelude.Maybe EdgeStatistics
  }
  deriving (Edge -> Edge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c== :: Edge -> Edge -> Bool
Prelude.Eq, ReadPrec [Edge]
ReadPrec Edge
Int -> ReadS Edge
ReadS [Edge]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Edge]
$creadListPrec :: ReadPrec [Edge]
readPrec :: ReadPrec Edge
$creadPrec :: ReadPrec Edge
readList :: ReadS [Edge]
$creadList :: ReadS [Edge]
readsPrec :: Int -> ReadS Edge
$creadsPrec :: Int -> ReadS Edge
Prelude.Read, Int -> Edge -> ShowS
[Edge] -> ShowS
Edge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edge] -> ShowS
$cshowList :: [Edge] -> ShowS
show :: Edge -> String
$cshow :: Edge -> String
showsPrec :: Int -> Edge -> ShowS
$cshowsPrec :: Int -> Edge -> ShowS
Prelude.Show, forall x. Rep Edge x -> Edge
forall x. Edge -> Rep Edge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Edge x -> Edge
$cfrom :: forall x. Edge -> Rep Edge x
Prelude.Generic)

-- |
-- Create a value of 'Edge' 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:
--
-- 'aliases', 'edge_aliases' - Aliases for the edge.
--
-- 'edgeType', 'edge_edgeType' - Describes an asynchronous connection, with a value of @link@.
--
-- 'endTime', 'edge_endTime' - The end time of the last segment on the edge.
--
-- 'receivedEventAgeHistogram', 'edge_receivedEventAgeHistogram' - A histogram that maps the spread of event age when received by
-- consumers. Age is calculated each time an event is received. Only
-- populated when /EdgeType/ is @link@.
--
-- 'referenceId', 'edge_referenceId' - Identifier of the edge. Unique within a service map.
--
-- 'responseTimeHistogram', 'edge_responseTimeHistogram' - A histogram that maps the spread of client response times on an edge.
-- Only populated for synchronous edges.
--
-- 'startTime', 'edge_startTime' - The start time of the first segment on the edge.
--
-- 'summaryStatistics', 'edge_summaryStatistics' - Response statistics for segments on the edge.
newEdge ::
  Edge
newEdge :: Edge
newEdge =
  Edge'
    { $sel:aliases:Edge' :: Maybe [Alias]
aliases = forall a. Maybe a
Prelude.Nothing,
      $sel:edgeType:Edge' :: Maybe Text
edgeType = forall a. Maybe a
Prelude.Nothing,
      $sel:endTime:Edge' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:receivedEventAgeHistogram:Edge' :: Maybe [HistogramEntry]
receivedEventAgeHistogram = forall a. Maybe a
Prelude.Nothing,
      $sel:referenceId:Edge' :: Maybe Int
referenceId = forall a. Maybe a
Prelude.Nothing,
      $sel:responseTimeHistogram:Edge' :: Maybe [HistogramEntry]
responseTimeHistogram = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:Edge' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:summaryStatistics:Edge' :: Maybe EdgeStatistics
summaryStatistics = forall a. Maybe a
Prelude.Nothing
    }

-- | Aliases for the edge.
edge_aliases :: Lens.Lens' Edge (Prelude.Maybe [Alias])
edge_aliases :: Lens' Edge (Maybe [Alias])
edge_aliases = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe [Alias]
aliases :: Maybe [Alias]
$sel:aliases:Edge' :: Edge -> Maybe [Alias]
aliases} -> Maybe [Alias]
aliases) (\s :: Edge
s@Edge' {} Maybe [Alias]
a -> Edge
s {$sel:aliases:Edge' :: Maybe [Alias]
aliases = Maybe [Alias]
a} :: Edge) 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

-- | Describes an asynchronous connection, with a value of @link@.
edge_edgeType :: Lens.Lens' Edge (Prelude.Maybe Prelude.Text)
edge_edgeType :: Lens' Edge (Maybe Text)
edge_edgeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe Text
edgeType :: Maybe Text
$sel:edgeType:Edge' :: Edge -> Maybe Text
edgeType} -> Maybe Text
edgeType) (\s :: Edge
s@Edge' {} Maybe Text
a -> Edge
s {$sel:edgeType:Edge' :: Maybe Text
edgeType = Maybe Text
a} :: Edge)

-- | The end time of the last segment on the edge.
edge_endTime :: Lens.Lens' Edge (Prelude.Maybe Prelude.UTCTime)
edge_endTime :: Lens' Edge (Maybe UTCTime)
edge_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:Edge' :: Edge -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: Edge
s@Edge' {} Maybe POSIX
a -> Edge
s {$sel:endTime:Edge' :: Maybe POSIX
endTime = Maybe POSIX
a} :: Edge) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A histogram that maps the spread of event age when received by
-- consumers. Age is calculated each time an event is received. Only
-- populated when /EdgeType/ is @link@.
edge_receivedEventAgeHistogram :: Lens.Lens' Edge (Prelude.Maybe [HistogramEntry])
edge_receivedEventAgeHistogram :: Lens' Edge (Maybe [HistogramEntry])
edge_receivedEventAgeHistogram = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe [HistogramEntry]
receivedEventAgeHistogram :: Maybe [HistogramEntry]
$sel:receivedEventAgeHistogram:Edge' :: Edge -> Maybe [HistogramEntry]
receivedEventAgeHistogram} -> Maybe [HistogramEntry]
receivedEventAgeHistogram) (\s :: Edge
s@Edge' {} Maybe [HistogramEntry]
a -> Edge
s {$sel:receivedEventAgeHistogram:Edge' :: Maybe [HistogramEntry]
receivedEventAgeHistogram = Maybe [HistogramEntry]
a} :: Edge) 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

-- | Identifier of the edge. Unique within a service map.
edge_referenceId :: Lens.Lens' Edge (Prelude.Maybe Prelude.Int)
edge_referenceId :: Lens' Edge (Maybe Int)
edge_referenceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe Int
referenceId :: Maybe Int
$sel:referenceId:Edge' :: Edge -> Maybe Int
referenceId} -> Maybe Int
referenceId) (\s :: Edge
s@Edge' {} Maybe Int
a -> Edge
s {$sel:referenceId:Edge' :: Maybe Int
referenceId = Maybe Int
a} :: Edge)

-- | A histogram that maps the spread of client response times on an edge.
-- Only populated for synchronous edges.
edge_responseTimeHistogram :: Lens.Lens' Edge (Prelude.Maybe [HistogramEntry])
edge_responseTimeHistogram :: Lens' Edge (Maybe [HistogramEntry])
edge_responseTimeHistogram = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe [HistogramEntry]
responseTimeHistogram :: Maybe [HistogramEntry]
$sel:responseTimeHistogram:Edge' :: Edge -> Maybe [HistogramEntry]
responseTimeHistogram} -> Maybe [HistogramEntry]
responseTimeHistogram) (\s :: Edge
s@Edge' {} Maybe [HistogramEntry]
a -> Edge
s {$sel:responseTimeHistogram:Edge' :: Maybe [HistogramEntry]
responseTimeHistogram = Maybe [HistogramEntry]
a} :: Edge) 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 start time of the first segment on the edge.
edge_startTime :: Lens.Lens' Edge (Prelude.Maybe Prelude.UTCTime)
edge_startTime :: Lens' Edge (Maybe UTCTime)
edge_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:Edge' :: Edge -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: Edge
s@Edge' {} Maybe POSIX
a -> Edge
s {$sel:startTime:Edge' :: Maybe POSIX
startTime = Maybe POSIX
a} :: Edge) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Response statistics for segments on the edge.
edge_summaryStatistics :: Lens.Lens' Edge (Prelude.Maybe EdgeStatistics)
edge_summaryStatistics :: Lens' Edge (Maybe EdgeStatistics)
edge_summaryStatistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Edge' {Maybe EdgeStatistics
summaryStatistics :: Maybe EdgeStatistics
$sel:summaryStatistics:Edge' :: Edge -> Maybe EdgeStatistics
summaryStatistics} -> Maybe EdgeStatistics
summaryStatistics) (\s :: Edge
s@Edge' {} Maybe EdgeStatistics
a -> Edge
s {$sel:summaryStatistics:Edge' :: Maybe EdgeStatistics
summaryStatistics = Maybe EdgeStatistics
a} :: Edge)

instance Data.FromJSON Edge where
  parseJSON :: Value -> Parser Edge
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Edge"
      ( \Object
x ->
          Maybe [Alias]
-> Maybe Text
-> Maybe POSIX
-> Maybe [HistogramEntry]
-> Maybe Int
-> Maybe [HistogramEntry]
-> Maybe POSIX
-> Maybe EdgeStatistics
-> Edge
Edge'
            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
"Aliases" 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 (Maybe a)
Data..:? Key
"EdgeType")
            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
"EndTime")
            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
"ReceivedEventAgeHistogram"
                            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 (Maybe a)
Data..:? Key
"ReferenceId")
            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
"ResponseTimeHistogram"
                            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 (Maybe a)
Data..:? Key
"StartTime")
            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
"SummaryStatistics")
      )

instance Prelude.Hashable Edge where
  hashWithSalt :: Int -> Edge -> Int
hashWithSalt Int
_salt Edge' {Maybe Int
Maybe [Alias]
Maybe [HistogramEntry]
Maybe Text
Maybe POSIX
Maybe EdgeStatistics
summaryStatistics :: Maybe EdgeStatistics
startTime :: Maybe POSIX
responseTimeHistogram :: Maybe [HistogramEntry]
referenceId :: Maybe Int
receivedEventAgeHistogram :: Maybe [HistogramEntry]
endTime :: Maybe POSIX
edgeType :: Maybe Text
aliases :: Maybe [Alias]
$sel:summaryStatistics:Edge' :: Edge -> Maybe EdgeStatistics
$sel:startTime:Edge' :: Edge -> Maybe POSIX
$sel:responseTimeHistogram:Edge' :: Edge -> Maybe [HistogramEntry]
$sel:referenceId:Edge' :: Edge -> Maybe Int
$sel:receivedEventAgeHistogram:Edge' :: Edge -> Maybe [HistogramEntry]
$sel:endTime:Edge' :: Edge -> Maybe POSIX
$sel:edgeType:Edge' :: Edge -> Maybe Text
$sel:aliases:Edge' :: Edge -> Maybe [Alias]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Alias]
aliases
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
edgeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [HistogramEntry]
receivedEventAgeHistogram
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
referenceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [HistogramEntry]
responseTimeHistogram
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EdgeStatistics
summaryStatistics

instance Prelude.NFData Edge where
  rnf :: Edge -> ()
rnf Edge' {Maybe Int
Maybe [Alias]
Maybe [HistogramEntry]
Maybe Text
Maybe POSIX
Maybe EdgeStatistics
summaryStatistics :: Maybe EdgeStatistics
startTime :: Maybe POSIX
responseTimeHistogram :: Maybe [HistogramEntry]
referenceId :: Maybe Int
receivedEventAgeHistogram :: Maybe [HistogramEntry]
endTime :: Maybe POSIX
edgeType :: Maybe Text
aliases :: Maybe [Alias]
$sel:summaryStatistics:Edge' :: Edge -> Maybe EdgeStatistics
$sel:startTime:Edge' :: Edge -> Maybe POSIX
$sel:responseTimeHistogram:Edge' :: Edge -> Maybe [HistogramEntry]
$sel:referenceId:Edge' :: Edge -> Maybe Int
$sel:receivedEventAgeHistogram:Edge' :: Edge -> Maybe [HistogramEntry]
$sel:endTime:Edge' :: Edge -> Maybe POSIX
$sel:edgeType:Edge' :: Edge -> Maybe Text
$sel:aliases:Edge' :: Edge -> Maybe [Alias]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Alias]
aliases
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
edgeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [HistogramEntry]
receivedEventAgeHistogram
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
referenceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [HistogramEntry]
responseTimeHistogram
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EdgeStatistics
summaryStatistics