Visualise logs (#2176)

fix #2047 

New executable accepts one or more log file paths as the argument and
then parses the logs back to the original types, sorts them on the
timestamp field and displays using different colors for network entries,
observations, messages from Head logic etc.

If we like this then we could go further and use brick to conditionally
show details to reduce the clutter a bit more.

Since this is for internal usage I didn't bother with proper exception
handling.

`cabal run hydra-node:exe:visualize-logs -- log-path-1 log-path-2
log-path-3`
<img width="3391" height="1357" alt="logs"
src="https://github.com/user-attachments/assets/014072b5-1d89-4b0a-a334-ddf29f26292a"
/>

---

<!-- Consider each and tick it off one way or the other -->
* [x] CHANGELOG updated or not needed
* [x] Documentation updated or not needed
* [x] Haddocks updated or not needed
* [x] No new TODOs introduced or explained herafter

Author: v0d1ch

hydra-node/exe/visualize-logs/Main.hs

@@ -0,0 +1,276 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+-- | Parse hydra-node logs format more easy on the eyes. Parser works with regular json logs as well as journalctl format.
+module Main where
+
+import Hydra.Cardano.Api (Tx)
+import Hydra.Prelude hiding (encodeUtf8, takeWhile)
+
+import Conduit
+import Control.Lens ((^?))
+import Control.Monad (foldM)
+import Data.Aeson (eitherDecode')
+import Data.Aeson.Lens (key, _String)
+import Data.Attoparsec.ByteString
+import Data.Attoparsec.ByteString qualified as A
+import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isEndOfLine)
+import Data.Text.Encoding (encodeUtf8)
+import Hydra.Chain (ChainEvent (..))
+import Hydra.HeadLogic (Effect (..), Input (..), Outcome (..), StateChanged (..))
+import Hydra.Logging (Envelope (..))
+import Hydra.Logging.Messages (HydraLog (..))
+import Hydra.Node (HydraNodeLog (..))
+import Options.Applicative hiding (Parser)
+import Options.Applicative qualified as Options
+
+data InfoLine = InfoLine {toplabel :: LogType, details :: Text} deriving (Eq, Show)
+
+data Decoded tx
+  = DecodedHydraLog {t :: UTCTime, n :: Text, infoLine :: InfoLine}
+  | DropLog
+  deriving (Eq, Show)
+
+-- | This instance is needed to sort results by timestamp
+instance Ord (Decoded tx) where
+  compare DropLog DropLog = EQ
+  compare DropLog DecodedHydraLog{} = LT
+  compare DecodedHydraLog{} DropLog = GT
+  compare (DecodedHydraLog t1 _ _) (DecodedHydraLog t2 _ _) = compare t1 t2
+
+-- | Log type labels for visualization
+data LogType
+  = NodeOptionsLabel
+  | ClientSentLabel
+  | ObservationLabel
+  | NetworkLabel
+  | ChainEffectLabel
+  | ErrorLabel
+  | LogicLabel Text
+  | LogicError Text
+  | Other Text
+  deriving (Eq, Show)
+
+labelLog :: LogType -> Text
+labelLog NodeOptionsLabel = "NODE OPTIONS"
+labelLog ClientSentLabel = "CLIENT SENT"
+labelLog ObservationLabel = "OBSERVATION"
+labelLog NetworkLabel = "NETWORK EFFECT"
+labelLog ChainEffectLabel = "POSTING TX"
+labelLog ErrorLabel = "ERROR"
+labelLog (LogicLabel t) = unlines ["LOGIC", t]
+labelLog (LogicError t) = unlines ["LOGIC ERROR", t]
+labelLog (Other t) = unlines ["OTHER", t]
+
+colorLog :: LogType -> Text
+colorLog = \case
+  NodeOptionsLabel -> green
+  ClientSentLabel -> green
+  ObservationLabel -> blue
+  NetworkLabel -> magenta
+  ChainEffectLabel -> blue
+  ErrorLabel -> red
+  LogicLabel t -> case t of
+    "DepositExpired" -> red
+    "DecommitInvalid" -> red
+    "IgnoredHeadInitializing" -> red
+    "TxInvalid" -> red
+    _ -> cyan
+  LogicError _ -> red
+  Other _ -> green
+
+newtype Options = Options
+  { paths :: [FilePath]
+  }
+  deriving (Show)
+
+options :: Options.Parser Options
+options =
+  Options
+    <$> many
+      ( strArgument
+          ( metavar "FILES"
+              <> help "One or more log file paths."
+          )
+      )
+
+opts :: ParserInfo Options
+opts =
+  info
+    (options <**> helper)
+    ( fullDesc
+        <> progDesc "Group logs by the timestamp and display using colors and separators for easy inspection."
+        <> header "Visualize hydra-node logs"
+    )
+
+main :: IO ()
+main = do
+  args <- execParser opts
+  visualize $ paths args
+
+visualize :: [FilePath] -> IO ()
+visualize paths = do
+  decodedLines <-
+    runConduitRes $
+      mapM_ sourceFileBS paths
+        .| linesUnboundedAsciiC
+        .| mapMC decodeAndProcess
+        .| filterC (/= DropLog)
+        .| sinkList
+
+  forM_ (sort decodedLines) render
+
+decodeAndProcess :: ByteString -> ResourceT IO (Decoded Tx)
+decodeAndProcess l =
+  case inCurlyBraces l of
+    Left _ -> lift $ pure DropLog
+    Right incomingLine ->
+      case incomingLine of
+        Nothing -> lift $ pure DropLog
+        Just jsonLine ->
+          case jsonLine ^? key "message" . _String of
+            Nothing -> process jsonLine
+            Just line -> process $ encodeUtf8 line
+ where
+  process :: ByteString -> ResourceT IO (Decoded Tx)
+  process line =
+    case eitherDecode' (fromStrict line) of
+      Left e -> do
+        putTextLn $ red <> "Decoding failed for line: " <> decodeUtf8 l <> "\nError: " <> show e
+        pure DropLog
+      Right decoded -> lift $ processLogs decoded
+
+charToWord8 :: Char -> Word8
+charToWord8 = fromIntegral . ord
+
+textBetweenBraces :: A.Parser ByteString
+textBetweenBraces = do
+  skipWhile (/= charToWord8 '{')
+  _ <- char8 '{'
+  jsonStr <- takeWhile (not . isEndOfLine)
+  pure $ "{" <> jsonStr
+
+lineParser :: A.Parser (Maybe ByteString)
+lineParser = do
+  result <- optional textBetweenBraces
+  skipWhile (not . isEndOfLine)
+  endOfLine <|> endOfInput
+  return result
+
+inCurlyBraces :: ByteString -> Either String (Maybe ByteString)
+inCurlyBraces = parseOnly lineParser
+
+-- | Ideally we would have Data instances for all types so we could get data type string representation
+-- instead of providing strings directly but that would add some compilation time overhead so not worth it.
+processLogs :: Envelope (HydraLog Tx) -> IO (Decoded Tx)
+processLogs decoded =
+  case decoded.message of
+    NodeOptions opt -> logIt NodeOptionsLabel opt
+    Node msg ->
+      case msg of
+        BeginInput{input} ->
+          case input of
+            ClientInput{clientInput} -> logIt ClientSentLabel clientInput
+            NetworkInput{} -> pure DropLog
+            ChainInput{chainEvent} ->
+              case chainEvent of
+                Observation{observedTx} -> logIt ObservationLabel observedTx
+                Rollback{} -> pure DropLog
+                Tick{} -> pure DropLog
+                PostTxError{postTxError} -> logIt ErrorLabel postTxError
+        EndInput{} -> pure DropLog
+        BeginEffect{effect} ->
+          case effect of
+            ClientEffect{} -> pure DropLog
+            NetworkEffect{message} -> logIt NetworkLabel message
+            OnChainEffect{postChainTx} -> logIt ChainEffectLabel postChainTx
+        EndEffect{} -> pure DropLog
+        LogicOutcome{outcome} ->
+          case outcome of
+            Continue{stateChanges} ->
+              foldM
+                ( \_ a -> case a of
+                    details@HeadInitialized{} -> logIt (LogicLabel "HeadInitialized") details
+                    details@HeadOpened{} -> logIt (LogicLabel "HeadOpened") details
+                    details@CommittedUTxO{} -> logIt (LogicLabel "CommittedUTxO") details
+                    details@HeadAborted{} -> logIt (LogicLabel "HeadAborted") details
+                    details@SnapshotRequestDecided{} -> logIt (LogicLabel "SnapshotRequestDecided") details
+                    details@SnapshotRequested{} -> logIt (LogicLabel "SnapshotRequested") details
+                    details@PartySignedSnapshot{} -> logIt (LogicLabel "PartySignedSnapshot") details
+                    details@SnapshotConfirmed{} -> logIt (LogicLabel "SnapshotConfirmed") details
+                    details@DepositRecorded{} -> logIt (LogicLabel "DepositRecorded") details
+                    details@DepositActivated{} -> logIt (LogicLabel "DepositActivated") details
+                    details@DepositExpired{} -> logIt (LogicLabel "DepositExpired") details
+                    details@DepositRecovered{} -> logIt (LogicLabel "DepositRecovered") details
+                    details@CommitApproved{} -> logIt (LogicLabel "CommitApproved") details
+                    details@CommitFinalized{} -> logIt (LogicLabel "CommitFinalized") details
+                    details@DecommitRecorded{} -> logIt (LogicLabel "DecommitRecorded") details
+                    details@DecommitApproved{} -> logIt (LogicLabel "DecommitApproved") details
+                    details@DecommitInvalid{} -> logIt (LogicLabel "DecommitInvalid") details
+                    details@DecommitFinalized{} -> logIt (LogicLabel "DecommitFinalized") details
+                    details@HeadClosed{} -> logIt (LogicLabel "HeadClosed") details
+                    details@HeadContested{} -> logIt (LogicLabel "HeadContested") details
+                    details@HeadIsReadyToFanout{} -> logIt (LogicLabel "HeadIsReadyToFanout") details
+                    details@HeadFannedOut{} -> logIt (LogicLabel "HeadFannedOut") details
+                    details@IgnoredHeadInitializing{} -> logIt (LogicLabel "IgnoredHeadInitializing") details
+                    details@TxInvalid{} -> logIt (LogicLabel "TxInvalid") details
+                    NetworkConnected{} -> pure DropLog
+                    NetworkDisconnected{} -> pure DropLog
+                    PeerConnected{} -> pure DropLog
+                    PeerDisconnected{} -> pure DropLog
+                    NetworkVersionMismatch{} -> pure DropLog
+                    NetworkClusterIDMismatch{} -> pure DropLog
+                    TransactionReceived{} -> pure DropLog
+                    TransactionAppliedToLocalUTxO{} -> pure DropLog
+                    ChainRolledBack{} -> pure DropLog
+                    TickObserved{} -> pure DropLog
+                    LocalStateCleared{} -> pure DropLog
+                    Checkpoint{} -> pure DropLog
+                )
+                DropLog
+                stateChanges
+            Wait{} -> pure DropLog
+            Error{error = err} -> logIt (LogicError "LOGIC ERROR") err
+        DroppedFromQueue{} -> pure DropLog
+        LoadingState -> logIt (Other "Loading state...") ()
+        LoadedState{} -> logIt (Other "Loaded.") ()
+        ReplayingState -> logIt (Other "Replaying state...") ()
+        details@Misconfiguration{} -> logIt (Other "MISCONFIG!") details
+    _ -> pure DropLog
+ where
+  logIt :: Show x => LogType -> x -> IO (Decoded Tx)
+  logIt l s =
+    pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine l (show s))
+
+render :: Decoded tx -> IO ()
+render = \case
+  DecodedHydraLog{t, n, infoLine = InfoLine{toplabel, details}} -> do
+    putTextLn $
+      unlines
+        [ "-----------------------------------"
+        , "[" <> show t <> "]"
+        , "NAMESPACE:" <> show n
+        , colorLog toplabel
+        , labelLog toplabel
+        , details
+        , reset
+        ]
+  DropLog -> putTextLn ""
+
+-- ANSI escape codes for colors
+red :: Text
+red = "\ESC[31m"
+
+green :: Text
+green = "\ESC[32m"
+
+blue :: Text
+blue = "\ESC[34m"
+
+cyan :: Text
+cyan = "\ESC[36m"
+
+magenta :: Text
+magenta = "\ESC[45m"
+
+reset :: Text
+reset = "\ESC[0m"

hydra-node/hydra-node.cabal

@@ -247,6 +247,25 @@ executable hydra-node
 
   ghc-options:    -threaded -rtsopts -with-rtsopts=-N4
 
+executable visualize-logs
+  import:         project-config
+  hs-source-dirs: exe/visualize-logs
+  main-is:        Main.hs
+  build-depends:
+    , aeson
+    , attoparsec
+    , base
+    , conduit
+    , hydra-cardano-api
+    , hydra-node
+    , hydra-prelude
+    , lens
+    , lens-aeson
+    , optparse-applicative
+    , text
+
+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N4
+
 benchmark tx-cost
   import:         project-config
   hs-source-dirs: bench/tx-cost

hydra-node/src/Hydra/API/APIServerLog.hs

@@ -1,8 +1,9 @@
 module Hydra.API.APIServerLog where
 
-import Hydra.Prelude
+import Hydra.Prelude hiding (encodeUtf8)
 
 import Data.Aeson qualified as Aeson
+import Data.Text.Encoding (encodeUtf8)
 import Hydra.Network (PortNumber)
 
 data APIServerLog
@@ -18,7 +19,7 @@ data APIServerLog
       }
   | APITransactionSubmitted {submittedTxId :: String}
   deriving stock (Eq, Show, Generic)
-  deriving anyclass (ToJSON)
+  deriving anyclass (ToJSON, FromJSON)
 
 -- | New type wrapper to define JSON instances.
 newtype PathInfo = PathInfo ByteString
@@ -28,6 +29,10 @@ instance ToJSON PathInfo where
   toJSON (PathInfo bytes) =
     Aeson.String $ decodeUtf8 bytes
 
+instance FromJSON PathInfo where
+  parseJSON = Aeson.withText "PathInfo" $ \t ->
+    pure $ PathInfo $ encodeUtf8 t
+
 -- | New type wrapper to define JSON instances.
 --
 -- NOTE: We are not using http-types 'StdMethod' as we do not want to be
@@ -38,3 +43,7 @@ newtype Method = Method ByteString
 instance ToJSON Method where
   toJSON (Method bytes) =
     Aeson.String $ decodeUtf8 bytes
+
+instance FromJSON Method where
+  parseJSON = Aeson.withText "Method" $ \t ->
+    pure $ Method $ encodeUtf8 t

hydra-node/src/Hydra/Chain.hs

@@ -163,6 +163,7 @@ data OnChainTx tx
 deriving stock instance IsTx tx => Eq (OnChainTx tx)
 deriving stock instance IsTx tx => Show (OnChainTx tx)
 deriving anyclass instance IsTx tx => ToJSON (OnChainTx tx)
+deriving anyclass instance IsTx tx => FromJSON (OnChainTx tx)
 
 instance ArbitraryIsTx tx => Arbitrary (OnChainTx tx) where
   arbitrary = genericArbitrary
@@ -316,6 +317,7 @@ data ChainEvent tx
 deriving stock instance (IsTx tx, IsChainState tx) => Eq (ChainEvent tx)
 deriving stock instance (IsTx tx, IsChainState tx) => Show (ChainEvent tx)
 deriving anyclass instance (IsTx tx, IsChainState tx) => ToJSON (ChainEvent tx)
+deriving anyclass instance (IsTx tx, IsChainState tx) => FromJSON (ChainEvent tx)
 
 instance (ArbitraryIsTx tx, IsChainState tx) => Arbitrary (ChainEvent tx) where
   arbitrary = genericArbitrary

hydra-node/src/Hydra/Chain/Direct/Handlers.hs

@@ -507,4 +507,4 @@ data CardanoChainLog
   | RolledBackward {point :: ChainPoint}
   | Wallet TinyWalletLog
   deriving stock (Eq, Show, Generic)
-  deriving anyclass (ToJSON)
+  deriving anyclass (ToJSON, FromJSON)

hydra-node/src/Hydra/Chain/Direct/Wallet.hs

@@ -452,3 +452,4 @@ data TinyWalletLog
   deriving stock (Eq, Generic, Show)
 
 deriving anyclass instance ToJSON TinyWalletLog
+deriving anyclass instance FromJSON TinyWalletLog

hydra-node/src/Hydra/HeadLogic/Error.hs

@@ -49,6 +49,14 @@ deriving anyclass instance
   ) =>
   ToJSON (LogicError tx)
 
+deriving anyclass instance
+  ( FromJSON (HeadState tx)
+  , FromJSON (Input tx)
+  , FromJSON (RequirementFailure tx)
+  , FromJSON (SideLoadRequirementFailure tx)
+  ) =>
+  FromJSON (LogicError tx)
+
 data RequirementFailure tx
   = ReqSnNumberInvalid {requestedSn :: SnapshotNumber, lastSeenSn :: SnapshotNumber}
   | ReqSvNumberInvalid {requestedSv :: SnapshotVersion, lastSeenSv :: SnapshotVersion}
@@ -66,6 +74,7 @@ data RequirementFailure tx
 deriving stock instance Eq (TxIdType tx) => Eq (RequirementFailure tx)
 deriving stock instance Show (TxIdType tx) => Show (RequirementFailure tx)
 deriving anyclass instance ToJSON (TxIdType tx) => ToJSON (RequirementFailure tx)
+deriving anyclass instance FromJSON (TxIdType tx) => FromJSON (RequirementFailure tx)
 
 data SideLoadRequirementFailure tx
   = SideLoadInitialSnapshotMismatch
@@ -79,3 +88,4 @@ data SideLoadRequirementFailure tx
 deriving stock instance Eq (UTxOType tx) => Eq (SideLoadRequirementFailure tx)
 deriving stock instance Show (UTxOType tx) => Show (SideLoadRequirementFailure tx)
 deriving anyclass instance ToJSON (UTxOType tx) => ToJSON (SideLoadRequirementFailure tx)
+deriving anyclass instance FromJSON (UTxOType tx) => FromJSON (SideLoadRequirementFailure tx)