Skip to content

Commit 2d14754

Browse files
v0d1chv0d1ch
committed
Improve labeling and color handling
Signed-off-by: Sasha Bogicevic <[email protected]>
1 parent e20987e commit 2d14754

File tree

1 file changed

+148
-86
lines changed
  • hydra-node/exe/visualize-logs

1 file changed

+148
-86
lines changed

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

Lines changed: 148 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE OverloadedRecordDot #-}
2-
{-# OPTIONS_GHC -Wno-deprecations #-}
32

43
module Main where
54

@@ -12,27 +11,68 @@ import Control.Lens ((^?))
1211
import Control.Monad (foldM)
1312
import Data.Aeson (eitherDecode')
1413
import Data.Aeson.Lens (key, _String)
15-
import Data.ByteString.Lazy.Char8 qualified as C8
1614
import Data.Text.Encoding (encodeUtf8)
1715
import Hydra.Chain (ChainEvent (..))
1816
import Hydra.HeadLogic (Effect (..), Input (..), Outcome (..), StateChanged (..))
1917
import Hydra.Logging (Envelope (..))
2018
import Hydra.Logging.Messages (HydraLog (..))
2119
import Hydra.Node (HydraNodeLog (..))
2220

23-
data InfoLine = InfoLine {header :: Text, line :: Text, color :: Text} deriving (Eq, Show)
21+
data InfoLine = InfoLine {toplabel :: LogType, details :: Text} deriving (Eq, Show)
2422

2523
data Decoded tx
2624
= DecodedHydraLog {t :: UTCTime, n :: Text, info :: InfoLine}
2725
| DropLog
2826
deriving (Eq, Show)
2927

28+
-- | This instance is needed to sort results by timestamp
3029
instance Ord (Decoded tx) where
3130
compare DropLog DropLog = EQ
3231
compare DropLog DecodedHydraLog{} = LT
3332
compare DecodedHydraLog{} DropLog = GT
3433
compare (DecodedHydraLog t1 _ _) (DecodedHydraLog t2 _ _) = compare t1 t2
3534

35+
-- | Log type labels for visualization
36+
data LogType
37+
= NodeOptionsLabel
38+
| ClientSentLabel
39+
| ObservationLabel
40+
| NetworkLabel
41+
| ChainEffectLabel
42+
| ErrorLabel
43+
| LogicLabel Text
44+
| LogicError Text
45+
| Other Text
46+
deriving (Eq, Show)
47+
48+
labelLog :: LogType -> Text
49+
labelLog NodeOptionsLabel = "NODE OPTIONS"
50+
labelLog ClientSentLabel = "CLIENT SENT"
51+
labelLog ObservationLabel = "OBSERVATION"
52+
labelLog NetworkLabel = "NETWORK EFFECT"
53+
labelLog ChainEffectLabel = "POSTING TX"
54+
labelLog ErrorLabel = "ERROR"
55+
labelLog (LogicLabel t) = unlines ["LOGIC", t]
56+
labelLog (LogicError t) = unlines ["LOGIC ERROR", t]
57+
labelLog (Other t) = unlines ["OTHER", t]
58+
59+
colorLog :: LogType -> Text
60+
colorLog = \case
61+
NodeOptionsLabel -> green
62+
ClientSentLabel -> green
63+
ObservationLabel -> blue
64+
NetworkLabel -> magenta
65+
ChainEffectLabel -> blue
66+
ErrorLabel -> red
67+
LogicLabel t -> case t of
68+
"DepositExpired" -> red
69+
"DecommitInvalid" -> red
70+
"IgnoredHeadInitializing" -> red
71+
"TxInvalid" -> red
72+
_ -> cyan
73+
LogicError _ -> red
74+
Other _ -> green
75+
3676
main :: IO ()
3777
main = visualize ["../devnet/alice-logs.txt", "../devnet/bob-logs.txt"]
3878

@@ -42,95 +82,117 @@ visualize paths = do
4282
runConduitRes $
4383
mapM_ sourceFileBS paths
4484
.| linesUnboundedAsciiC
45-
.| mapMC
46-
( \l ->
47-
case l ^? key "message" . _String of
48-
Nothing -> P.error "Failed to find key 'message' which was expected"
49-
Just line ->
50-
let envelope = fromStrict $ encodeUtf8 line
51-
in case decodeAs envelope (undefined :: Envelope (HydraLog Tx)) of
52-
Left e -> P.error $ show e <> line
53-
Right decoded ->
54-
case decoded.message of
55-
NodeOptions opt -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "NODE OPTIONS" (show opt) green)
56-
Node msg ->
57-
case msg of
58-
BeginInput{input} ->
59-
case input of
60-
ClientInput{clientInput} ->
61-
pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "CLIENT SENT" (show clientInput) green)
62-
NetworkInput{} -> pure DropLog
63-
ChainInput{chainEvent} ->
64-
case chainEvent of
65-
Observation{observedTx} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "OBESERVATION" (show observedTx) blue)
66-
Rollback{} -> pure DropLog
67-
Tick{} -> pure DropLog
68-
PostTxError{postTxError} ->
69-
pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "ERROR" (show postTxError) red)
70-
EndInput{} -> pure DropLog
71-
BeginEffect{effect} ->
72-
case effect of
73-
ClientEffect{} -> pure DropLog
74-
NetworkEffect{message} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "NETWORK EFFECT" (show message) magenta)
75-
OnChainEffect{postChainTx} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "POSTING" (show postChainTx) blue)
76-
EndEffect{} -> pure DropLog
77-
LogicOutcome{outcome} ->
78-
case outcome of
79-
Continue{stateChanges} ->
80-
foldM
81-
( \b a -> case a of
82-
HeadInitialized{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "HeadInitialized" "" cyan)
83-
HeadOpened{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "HeadOpened" "" cyan)
84-
CommittedUTxO{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "CommittedUTxO" "" cyan)
85-
HeadAborted{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "HeadAborted" "" red)
86-
SnapshotRequestDecided{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "SnapshotRequestDecided" "" cyan)
87-
SnapshotRequested{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "SnapshotRequested" "" cyan)
88-
PartySignedSnapshot{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "PartySignedSnapshot" "" cyan)
89-
SnapshotConfirmed{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "SnapshotConfirmed" "" cyan)
90-
DepositRecorded{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DepositRecorded" "" cyan)
91-
DepositActivated{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DepositActivated" "" cyan)
92-
DepositExpired{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DepositExpired" "" red)
93-
DepositRecovered{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DepositRecovered" "" cyan)
94-
CommitApproved{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "CommitApproved" "" cyan)
95-
CommitFinalized{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "CommitFinalized" "" cyan)
96-
DecommitRecorded{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DecommitRecorded" "" cyan)
97-
DecommitApproved{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DecommitApproved" "" cyan)
98-
DecommitInvalid{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DecommitInvalid" "" red)
99-
DecommitFinalized{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "DecommitFinalized" "" cyan)
100-
HeadClosed{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "HeadClosed" "" green)
101-
HeadContested{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "HeadContested" "" cyan)
102-
HeadIsReadyToFanout{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "HeadIsReadyToFanout" "" cyan)
103-
HeadFannedOut{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "HeadFannedOut" "" cyan)
104-
IgnoredHeadInitializing{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "IgnoredHeadInitializing" "" red)
105-
TxInvalid{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "TxInvalid" "" red)
106-
_ -> pure b
107-
)
108-
DropLog
109-
stateChanges
110-
Wait{} -> pure DropLog
111-
Error{error = err} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "LOGIC ERROR" (show err) red)
112-
DroppedFromQueue{} -> pure DropLog
113-
LoadingState -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "Loading state..." "" green)
114-
LoadedState{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "Loaded." "" green)
115-
ReplayingState -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "Replaying state..." "" green)
116-
Misconfiguration{} -> pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine "MISCONFIG!" "" red)
117-
_ -> pure DropLog
118-
)
85+
.| mapMC decodeAndProcess
11986
.| filterC (/= DropLog)
12087
.| sinkList
121-
forM_ (sort decodedLines) $ \l ->
122-
render l
12388

124-
decodeAs :: forall a. FromJSON a => C8.ByteString -> a -> Either String a
125-
decodeAs l _ =
126-
case eitherDecode' l :: Either String a of
127-
Left e -> Left e
128-
Right decoded -> pure decoded
89+
forM_ (sort decodedLines) render
90+
91+
decodeAndProcess :: ByteString -> ResourceT IO (Decoded Tx)
92+
decodeAndProcess l =
93+
case l ^? key "message" . _String of
94+
Nothing -> P.error "Failed to find key 'message' which was expected"
95+
Just line ->
96+
let envelope = fromStrict $ encodeUtf8 line
97+
in case eitherDecode' envelope :: Either String (Envelope (HydraLog Tx)) of
98+
Left e -> P.error $ "Decoding failed" <> show e <> "for line: " <> line
99+
Right decoded -> lift $ processLogs decoded
100+
101+
-- | Ideally we would have Data instances for all types so we could get data type String representation
102+
-- instead of providing strings but that would add some compilation time overhead so not worth it.
103+
processLogs :: Envelope (HydraLog Tx) -> IO (Decoded Tx)
104+
processLogs decoded =
105+
case decoded.message of
106+
NodeOptions opt -> logIt NodeOptionsLabel (show opt)
107+
Node msg ->
108+
case msg of
109+
BeginInput{input} ->
110+
case input of
111+
ClientInput{clientInput} -> logIt ClientSentLabel (show clientInput)
112+
NetworkInput{} -> pure DropLog
113+
ChainInput{chainEvent} ->
114+
case chainEvent of
115+
Observation{observedTx} -> logIt ObservationLabel (show observedTx)
116+
Rollback{} -> pure DropLog
117+
Tick{} -> pure DropLog
118+
PostTxError{postTxError} -> logIt ErrorLabel (show postTxError)
119+
EndInput{} -> pure DropLog
120+
BeginEffect{effect} ->
121+
case effect of
122+
ClientEffect{} -> pure DropLog
123+
NetworkEffect{message} -> logIt NetworkLabel (show message)
124+
OnChainEffect{postChainTx} -> logIt ChainEffectLabel (show postChainTx)
125+
EndEffect{} -> pure DropLog
126+
LogicOutcome{outcome} ->
127+
case outcome of
128+
Continue{stateChanges} ->
129+
foldM
130+
( \_ a -> case a of
131+
HeadInitialized{} -> logIt (LogicLabel "HeadInitialized") ""
132+
HeadOpened{} -> logIt (LogicLabel "HeadOpened") ""
133+
CommittedUTxO{} -> logIt (LogicLabel "CommittedUTxO") ""
134+
HeadAborted{} -> logIt (LogicLabel "HeadAborted") ""
135+
SnapshotRequestDecided{} -> logIt (LogicLabel "SnapshotRequestDecided") ""
136+
SnapshotRequested{} -> logIt (LogicLabel "SnapshotRequested") ""
137+
PartySignedSnapshot{} -> logIt (LogicLabel "PartySignedSnapshot") ""
138+
SnapshotConfirmed{} -> logIt (LogicLabel "SnapshotConfirmed") ""
139+
DepositRecorded{} -> logIt (LogicLabel "DepositRecorded") ""
140+
DepositActivated{} -> logIt (LogicLabel "DepositActivated") ""
141+
DepositExpired{} -> logIt (LogicLabel "DepositExpired") ""
142+
DepositRecovered{} -> logIt (LogicLabel "DepositRecovered") ""
143+
CommitApproved{} -> logIt (LogicLabel "CommitApproved") ""
144+
CommitFinalized{} -> logIt (LogicLabel "CommitFinalized") ""
145+
DecommitRecorded{} -> logIt (LogicLabel "DecommitRecorded") ""
146+
DecommitApproved{} -> logIt (LogicLabel "DecommitApproved") ""
147+
DecommitInvalid{} -> logIt (LogicLabel "DecommitInvalid") ""
148+
DecommitFinalized{} -> logIt (LogicLabel "DecommitFinalized") ""
149+
HeadClosed{} -> logIt (LogicLabel "HeadClosed") ""
150+
HeadContested{} -> logIt (LogicLabel "HeadContested") ""
151+
HeadIsReadyToFanout{} -> logIt (LogicLabel "HeadIsReadyToFanout") ""
152+
HeadFannedOut{} -> logIt (LogicLabel "HeadFannedOut") ""
153+
IgnoredHeadInitializing{} -> logIt (LogicLabel "IgnoredHeadInitializing") ""
154+
TxInvalid{} -> logIt (LogicLabel "TxInvalid") ""
155+
NetworkConnected{} -> pure DropLog
156+
NetworkDisconnected{} -> pure DropLog
157+
PeerConnected{} -> pure DropLog
158+
PeerDisconnected{} -> pure DropLog
159+
NetworkVersionMismatch{} -> pure DropLog
160+
NetworkClusterIDMismatch{} -> pure DropLog
161+
TransactionReceived{} -> pure DropLog
162+
TransactionAppliedToLocalUTxO{} -> pure DropLog
163+
ChainRolledBack{} -> pure DropLog
164+
TickObserved{} -> pure DropLog
165+
LocalStateCleared{} -> pure DropLog
166+
Checkpoint{} -> pure DropLog
167+
)
168+
DropLog
169+
stateChanges
170+
Wait{} -> pure DropLog
171+
Error{error = err} -> logIt (LogicError "LOGIC ERROR") (show err)
172+
DroppedFromQueue{} -> pure DropLog
173+
LoadingState -> logIt (Other "Loading state...") ""
174+
LoadedState{} -> logIt (Other "Loaded.") ""
175+
ReplayingState -> logIt (Other "Replaying state...") ""
176+
Misconfiguration{} -> logIt (Other "MISCONFIG!") ""
177+
_ -> pure DropLog
178+
where
179+
logIt :: LogType -> Text -> IO (Decoded Tx)
180+
logIt l s =
181+
pure $ DecodedHydraLog decoded.timestamp decoded.namespace (InfoLine l s)
129182

130183
render :: Decoded tx -> IO ()
131184
render = \case
132-
DecodedHydraLog{t, n, info = InfoLine{header, line, color}} -> do
133-
putTextLn $ color <> unlines ["[" <> show t <> "]", "NAMESPACE:" <> show n, header, line] <> reset
185+
DecodedHydraLog{t, n, info = InfoLine{toplabel, details}} -> do
186+
putTextLn $
187+
unlines
188+
[ "-----------------------------------"
189+
, "[" <> show t <> "]"
190+
, "NAMESPACE:" <> show n
191+
, colorLog toplabel
192+
, labelLog toplabel
193+
, details
194+
, reset
195+
]
134196
DropLog -> putTextLn ""
135197

136198
-- ANSI escape codes for colors

0 commit comments

Comments
 (0)