Merge pull request IntersectMBO#5403 from input-output-hk/jutaro/benchmark-new

Optimize new tracing

Author: jutaro

bench/locli/src/Cardano/Unlog/LogObject.hs

@@ -31,7 +31,6 @@ where
 import           Cardano.Prelude hiding (Text, show)
 import           Prelude (id, show, unzip3)
 
-import           Control.Monad (fail)
 import qualified Data.Aeson as AE
 import qualified Data.Aeson.Key as Aeson
 import qualified Data.Aeson.KeyMap as KeyMap
@@ -480,7 +479,7 @@ instance FromJSON LogObject where
        case (kind, wrapped, unwrapped) of
          (Nothing, Just _, Just x) -> (,) <$> pure x <*> (fromText <$> x .: "kind")
          (Just kind0, _, _) -> pure (v, kind0)
-         _ -> fail $ "Unexpected LogObject .data: " <> show v
+         _ -> pure (v, "")
 
 parsePartialResourceStates :: Value -> Parser (Resources Word64)
 parsePartialResourceStates =

cardano-node/cardano-node.cabal

@@ -38,7 +38,6 @@ common project-config
                         -Wpartial-fields
                         -Wredundant-constraints
                         -Wunused-packages
-
 common maybe-Win32
   if os(windows)
     build-depends:      Win32

cardano-node/src/Cardano/Node/Configuration/Logging.hs

@@ -289,7 +289,7 @@ createLoggingLayer ver nodeConfig' p = do
          >>= maybe (pure ())
                    (traceResourceStats
                       (appendName "node" tr))
-       Conc.threadDelay 1000000 -- TODO:  make configurable
+       Conc.threadDelay 1000000 -- microseconds = 1 sec
 
    traceResourceStats :: Trace IO Text -> ResourceStats -> IO ()
    traceResourceStats tr rs = do

cardano-node/src/Cardano/Node/Handlers/Shutdown.hs

@@ -27,6 +27,7 @@ module Cardano.Node.Handlers.Shutdown
 where
 
 import           Control.Concurrent.Async (race_)
+import           Control.DeepSeq (NFData)
 import           Control.Exception (try)
 import           Control.Exception.Base (throwIO)
 import           Control.Monad (void, when)
@@ -59,6 +60,8 @@ data ShutdownOn
 
 deriving instance FromJSON ShutdownOn
 deriving instance ToJSON ShutdownOn
+deriving instance NFData ShutdownOn
+
 
 parseShutdownOn :: Opt.Parser ShutdownOn
 parseShutdownOn = asum
@@ -90,6 +93,8 @@ data ShutdownTrace
   -- ^ Will terminate upon reaching a ChainDB sync limit
   deriving (Generic, FromJSON, ToJSON)
 
+deriving instance NFData ShutdownTrace
+
 data AndWithOrigin
   = AndWithOriginBlock (BlockNo, WithOrigin BlockNo)
   | AndWithOriginSlot (SlotNo, WithOrigin SlotNo)

cardano-node/src/Cardano/Node/Startup.hs

@@ -3,12 +3,14 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Node.Startup where
 
 import qualified Cardano.Api as Api
+import           Control.DeepSeq (NFData)
 import           Prelude
 
 import           Data.Aeson (FromJSON, ToJSON)
@@ -181,6 +183,8 @@ data NodeInfo = NodeInfo
   , niSystemStartTime :: UTCTime
   } deriving (Eq, Generic, ToJSON, FromJSON, Show)
 
+deriving instance (NFData NodeInfo)
+
 instance MetaTrace NodeInfo where
   namespaceFor NodeInfo {}  =
     Namespace [] ["NodeInfo"]
@@ -265,6 +269,8 @@ data NodeStartupInfo = NodeStartupInfo {
   , suiSlotsPerKESPeriod :: Word64
   } deriving (Eq, Generic, ToJSON, FromJSON, Show)
 
+deriving instance (NFData NodeStartupInfo)
+
 instance MetaTrace NodeStartupInfo where
   namespaceFor NodeStartupInfo {}  =
     Namespace [] ["NodeStartupInfo"]

cardano-node/src/Cardano/Node/Tracing.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PackageImports #-}
+
+
 module Cardano.Node.Tracing
   ( Tracers (..)
   , ConsensusStartupException (..)
@@ -9,7 +12,7 @@ module Cardano.Node.Tracing
 import           Prelude (IO)
 
 import           Codec.CBOR.Read (DeserialiseFailure)
-import           "contra-tracer" Control.Tracer (Tracer)
+import           "contra-tracer" Control.Tracer (Tracer (..))
 
 import qualified Ouroboros.Consensus.Network.NodeToClient as NodeToClient
 import qualified Ouroboros.Consensus.Network.NodeToNode as NodeToNode
@@ -21,7 +24,7 @@ import           Ouroboros.Network.NodeToClient (LocalAddress, NodeToClientVersi
 import           Ouroboros.Network.NodeToNode (NodeToNodeVersion, RemoteAddress)
 
 import           Cardano.Node.Handlers.Shutdown (ShutdownTrace)
-import           Cardano.Node.Startup (NodeInfo, NodeStartupInfo, StartupTrace)
+import           Cardano.Node.Startup (NodeInfo, NodeStartupInfo, StartupTrace (..))
 
 import           Cardano.Logging.Resources
 import           Cardano.Node.Tracing.StateRep (NodeState)
@@ -31,25 +34,25 @@ import           Cardano.Node.Tracing.Tracers.Peer (PeerT)
 
 data Tracers peer localPeer blk p2p = Tracers
   { -- | Trace the ChainDB
-    chainDBTracer         :: Tracer IO (ChainDB.TraceEvent blk)
+    chainDBTracer         :: !(Tracer IO (ChainDB.TraceEvent blk))
     -- | Consensus-specific tracers.
-  , consensusTracers      :: Consensus.Tracers IO peer localPeer blk
+  , consensusTracers      :: !(Consensus.Tracers IO peer localPeer blk)
     -- | Tracers for the node-to-node protocols.
-  , nodeToNodeTracers     :: NodeToNode.Tracers IO peer blk DeserialiseFailure
+  , nodeToNodeTracers     :: !(NodeToNode.Tracers IO peer blk DeserialiseFailure)
     --, serialisedBlockTracer :: NodeToNode.SerialisedTracer IO peer blk (SerialisedBlockTrace)
     -- | Tracers for the node-to-client protocols
-  , nodeToClientTracers   :: NodeToClient.Tracers IO localPeer blk DeserialiseFailure
+  , nodeToClientTracers   :: !(NodeToClient.Tracers IO localPeer blk DeserialiseFailure)
     -- | Diffusion tracers
-  , diffusionTracers      :: Diffusion.Tracers RemoteAddress NodeToNodeVersion
+  , diffusionTracers      :: !(Diffusion.Tracers RemoteAddress NodeToNodeVersion
                                                LocalAddress  NodeToClientVersion
-                                              IO
-  , diffusionTracersExtra :: Diffusion.ExtraTracers p2p
-
-  , startupTracer         :: Tracer IO (StartupTrace blk)
-  , shutdownTracer        :: Tracer IO ShutdownTrace
-  , nodeInfoTracer        :: Tracer IO NodeInfo
-  , nodeStartupInfoTracer :: Tracer IO NodeStartupInfo
-  , nodeStateTracer       :: Tracer IO NodeState
-  , resourcesTracer       :: Tracer IO ResourceStats
-  , peersTracer           :: Tracer IO [PeerT blk]
+                                              IO)
+  , diffusionTracersExtra :: !(Diffusion.ExtraTracers p2p)
+
+  , startupTracer         :: !(Tracer IO (StartupTrace blk))
+  , shutdownTracer        :: !(Tracer IO ShutdownTrace)
+  , nodeInfoTracer        :: !(Tracer IO NodeInfo)
+  , nodeStartupInfoTracer :: !(Tracer IO NodeStartupInfo)
+  , nodeStateTracer       :: !(Tracer IO NodeState)
+  , resourcesTracer       :: !(Tracer IO ResourceStats)
+  , peersTracer           :: !(Tracer IO [PeerT blk])
   }

cardano-node/src/Cardano/Node/Tracing/DefaultTraceConfig.hs

@@ -12,7 +12,7 @@ defaultCardanoConfig :: TraceConfig
 defaultCardanoConfig = emptyTraceConfig {
   tcOptions = Map.fromList
     [([],
-         [ ConfSeverity (SeverityF Nothing) -- Means Silence
+         [ ConfSeverity (SeverityF (Just Notice)) -- Means Silence
          , ConfDetail DNormal
          , ConfBackend  [Stdout MachineFormat
                         , EKGBackend

cardano-node/src/Cardano/Node/Tracing/Peers.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
@@ -6,6 +7,7 @@ module Cardano.Node.Tracing.Peers
   , traceNodePeers
   ) where
 
+import           Control.DeepSeq (NFData)
 import           Data.Aeson (FromJSON, ToJSON)
 import           Data.Text (Text)
 import           GHC.Generics (Generic)
@@ -21,10 +23,12 @@ type PeerInfoPP = Text -- The result of 'ppPeer' function.
 newtype NodePeers = NodePeers [PeerInfoPP]
 
 deriving instance Generic NodePeers
+deriving instance NFData NodePeers
 
 instance ToJSON NodePeers
 instance FromJSON NodePeers
 
+
 instance MetaTrace NodePeers where
   namespaceFor NodePeers {}  =
     Namespace [] ["NodePeers"]

cardano-node/src/Cardano/Node/Tracing/StateRep.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -22,6 +23,7 @@ import           Cardano.Api (textShow)
 
 import           Cardano.Logging
 
+import           Control.DeepSeq (NFData)
 import           Data.Aeson
 import           Data.Text (Text)
 import           Data.Time.Clock
@@ -41,9 +43,17 @@ import qualified Cardano.Node.Startup as Startup
 import           Cardano.Slotting.Slot (EpochNo, SlotNo (..), WithOrigin)
 import           Cardano.Tracing.OrphanInstances.Network ()
 
-instance FromJSON ChunkNo
+deriving instance FromJSON ChunkNo
 
-instance ToJSON ChunkNo
+deriving instance ToJSON ChunkNo
+
+deriving instance NFData ChunkNo
+
+deriving instance Generic NPV.NodeToNodeVersion
+deriving instance NFData NPV.NodeToNodeVersion
+
+deriving instance Generic NPV.NodeToClientVersion
+deriving instance NFData NPV.NodeToClientVersion
 
 data OpeningDbs
   = StartedOpeningImmutableDB
@@ -54,23 +64,31 @@ data OpeningDbs
   | OpenedLgrDB
   deriving (Generic, FromJSON, ToJSON)
 
+deriving instance (NFData OpeningDbs)
+
 data Replays
   = ReplayFromGenesis  (WithOrigin SlotNo)
   | ReplayFromSnapshot SlotNo (WithOrigin SlotNo) (WithOrigin SlotNo)
   | ReplayedBlock      SlotNo (WithOrigin SlotNo) (WithOrigin SlotNo)
   deriving (Generic, FromJSON, ToJSON)
 
+deriving instance (NFData Replays)
+
 data InitChainSelection
   = InitChainStartedSelection
   | InitChainSelected
   deriving (Generic, FromJSON, ToJSON)
 
+deriving instance (NFData InitChainSelection)
+
 type SyncPercentage = Double
 
 data AddedToCurrentChain
   = AddedToCurrentChain !EpochNo !SlotNo !SyncPercentage
   deriving (Generic, FromJSON, ToJSON)
 
+deriving instance (NFData AddedToCurrentChain)
+
 data StartupState
   = StartupSocketConfigError Text
   | StartupDBValidation
@@ -81,6 +99,8 @@ data StartupState
   | WarningDevelopmentNodeToClientVersions [NPV.NodeToClientVersion]
   deriving (Generic, FromJSON, ToJSON)
 
+deriving instance (NFData StartupState)
+
 -- | The representation of the current state of node.
 --   All node states prior to tracing system going online are effectively invisible.
 data NodeState
@@ -94,22 +114,24 @@ data NodeState
   | NodeShutdown ShutdownTrace
   deriving (Generic, FromJSON, ToJSON)
 
+deriving instance (NFData NodeState)
+
 instance LogFormatting NodeState where
   forMachine _ = \case
     NodeOpeningDbs x -> mconcat
-      ["openingDb" .= toJSON x]
+      [ "kind" .= String "NodeOpeningDbs",         "openingDb" .= toJSON x]
     NodeReplays x -> mconcat
-      ["replays"   .= toJSON x]
+      [ "kind" .= String "NodeReplays",            "replays"   .= toJSON x]
     NodeInitChainSelection x -> mconcat
-      ["chainSel"  .= toJSON x]
+      [ "kind" .= String "NodeInitChainSelection", "chainSel"  .= toJSON x]
     NodeKernelOnline -> mconcat
-      []
+      [ "kind" .= String "NodeInitChainSelection"]
     NodeAddBlock x -> mconcat
-      ["addBlock"  .= toJSON x]
+      [ "kind" .= String "NodeAddBlock",           "addBlock"  .= toJSON x]
     NodeStartup x -> mconcat
-      ["startup"   .= toJSON x]
+      [ "kind" .= String "NodeStartup",            "startup"   .= toJSON x]
     NodeShutdown x -> mconcat
-      ["shutdown"  .= toJSON x]
+      [ "kind" .= String "NodeShutdown",           "shutdown"  .= toJSON x]
     _ -> mempty
 
 instance MetaTrace NodeState where