{-# LANGUAGE UndecidableInstances #-}

-- | Aggregates all tracing messages in a single type.
--
-- This module provides a central point where top-level traced messages are
-- grouped. This is useful for traces consumers that will need to do something
-- specific depending on various tracing messages, eg. monitoring and metrics
-- collection.
module Hydra.Logging.Messages where

import Hydra.Prelude

import Hydra.API.APIServerLog (APIServerLog)
import Hydra.Chain.Direct.Handlers (DirectChainLog)
import Hydra.Network.Authenticate (AuthLog)
import Hydra.Network.Reliability (ReliabilityLog)
import Hydra.Node (HydraNodeLog)
import Hydra.Options (RunOptions)

data HydraLog tx net
  = DirectChain {forall tx net. HydraLog tx net -> DirectChainLog
directChain :: DirectChainLog}
  | APIServer {forall tx net. HydraLog tx net -> APIServerLog
api :: APIServerLog}
  | Network {forall tx net. HydraLog tx net -> net
network :: net}
  | Node {forall tx net. HydraLog tx net -> HydraNodeLog tx
node :: HydraNodeLog tx}
  | NodeOptions {forall tx net. HydraLog tx net -> RunOptions
runOptions :: RunOptions}
  | Authentication {forall tx net. HydraLog tx net -> AuthLog
authentication :: AuthLog}
  | Reliability {forall tx net. HydraLog tx net -> ReliabilityLog
reliability :: ReliabilityLog}
  deriving stock ((forall x. HydraLog tx net -> Rep (HydraLog tx net) x)
-> (forall x. Rep (HydraLog tx net) x -> HydraLog tx net)
-> Generic (HydraLog tx net)
forall x. Rep (HydraLog tx net) x -> HydraLog tx net
forall x. HydraLog tx net -> Rep (HydraLog tx net) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx net x. Rep (HydraLog tx net) x -> HydraLog tx net
forall tx net x. HydraLog tx net -> Rep (HydraLog tx net) x
$cfrom :: forall tx net x. HydraLog tx net -> Rep (HydraLog tx net) x
from :: forall x. HydraLog tx net -> Rep (HydraLog tx net) x
$cto :: forall tx net x. Rep (HydraLog tx net) x -> HydraLog tx net
to :: forall x. Rep (HydraLog tx net) x -> HydraLog tx net
Generic)

deriving stock instance (Eq net, Eq (HydraNodeLog tx)) => Eq (HydraLog tx net)
deriving stock instance (Show net, Show (HydraNodeLog tx)) => Show (HydraLog tx net)
deriving anyclass instance (ToJSON net, ToJSON (HydraNodeLog tx)) => ToJSON (HydraLog tx net)
deriving anyclass instance (FromJSON net, FromJSON (HydraNodeLog tx)) => FromJSON (HydraLog tx net)

instance (Arbitrary net, Arbitrary (HydraNodeLog tx)) => Arbitrary (HydraLog tx net) where
  arbitrary :: Gen (HydraLog tx net)
arbitrary = Gen (HydraLog tx net)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary
  shrink :: HydraLog tx net -> [HydraLog tx net]
shrink = HydraLog tx net -> [HydraLog tx net]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink