Skip to content

Commit

Permalink
CAD-2907 locli: extend block propagation timeline display
Browse files Browse the repository at this point in the history
  • Loading branch information
@deepfire
deepfire committed Jul 20, 2021
1 parent 119b9b0 commit 96c7178
Show file tree
Hide file tree
Showing 2 changed files with 50 additions and 32 deletions.
67 changes: 43 additions & 24 deletions nix/workbench/locli/src/Cardano/Analysis/BlockProp.hs
View file
Expand Up @@ -30,6 +30,7 @@ import Data.Maybe (catMaybes, mapMaybe, isNothing)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Short (toText)
import Data.Tuple (swap)
import Data.Vector (Vector)
import qualified Data.Vector as Vec
Expand Down Expand Up @@ -70,18 +71,18 @@ data BlockPropagation
instance RenderDistributions BlockPropagation where
rdFields =
-- Width LeftPad
[ Field 6 0 "forged" (f!!0) "Forge" $ DDeltaT bpForgerForges
, Field 6 0 "fAdopted" (f!!1) "Adopt" $ DDeltaT bpForgerAdoptions
, Field 6 0 "fAnnounced" (f!!2) "Announ" $ DDeltaT bpForgerAnnouncements
, Field 6 0 "fSendStart" (f!!3) "Sendin" $ DDeltaT bpForgerSends
, Field 4 1 "noticedVal" (p!!0) " Noti" $ DDeltaT (fst . bpPeerNotices)
, Field 4 0 "noticedCoV" (p!!1) "ced " $ DDeltaT (snd . bpPeerNotices)
, Field 4 1 "requestedVal" (p!!2) "Reque" $ DDeltaT (fst . bpPeerRequests)
, Field 4 0 "requestedVal" (p!!3) "sted " $ DDeltaT (snd . bpPeerRequests)
, Field 4 1 "fetchedVal" (p!!4) " Fetc" $ DDeltaT (fst . bpPeerFetches)
, Field 4 0 "fetchedCoV" (p!!5) "hed " $ DDeltaT (snd . bpPeerFetches)
, Field 4 1 "pAdoptedVal" (p!!6) " Adop" $ DDeltaT (fst . bpPeerAdoptions)
, Field 4 0 "pAdoptedCoV" (p!!7) "ted " $ DDeltaT (snd . bpPeerAdoptions)
[ Field 6 0 "forged" (f!!0) "Forge" $ DDeltaT bpForgerForges
, Field 6 0 "fAdopted" (f!!1) "Adopt" $ DDeltaT bpForgerAdoptions
, Field 6 0 "fAnnounced" (f!!2) "Announ" $ DDeltaT bpForgerAnnouncements
, Field 6 0 "fSendStart" (f!!3) "Sendin" $ DDeltaT bpForgerSends
, Field 4 1 "noticedVal" (p!!0) " Noti" $ DDeltaT (fst . bpPeerNotices)
, Field 4 0 "noticedCoV" (p!!1) "ced " $ DDeltaT (snd . bpPeerNotices)
, Field 4 1 "requestedVal" (p!!2) "Reque" $ DDeltaT (fst . bpPeerRequests)
, Field 4 0 "requestedCoV" (p!!3) "sted " $ DDeltaT (snd . bpPeerRequests)
, Field 4 1 "fetchedVal" (p!!4) " Fetc" $ DDeltaT (fst . bpPeerFetches)
, Field 4 0 "fetchedCoV" (p!!5) "hed " $ DDeltaT (snd . bpPeerFetches)
, Field 4 1 "pAdoptedVal" (p!!6) " Adop" $ DDeltaT (fst . bpPeerAdoptions)
, Field 4 0 "pAdoptedCoV" (p!!7) "ted " $ DDeltaT (snd . bpPeerAdoptions)
, Field 4 1 "pAnnouncedVal" (p!!8) "Annou" $ DDeltaT (fst . bpPeerAnnouncements)
, Field 4 0 "pAnnouncedCoV" (p!!9) "nced " $ DDeltaT (snd . bpPeerAnnouncements)
, Field 4 1 "pSendStartVal" (p!!10) " Send" $ DDeltaT (fst . bpPeerSends)
Expand Down Expand Up @@ -373,22 +374,40 @@ data BlockEvents
instance RenderTimeline BlockEvents where
rtFields =
-- Width LeftPad
[ Field 5 0 "block" "block" "no." $ IWord64 (unBlockNo . beBlockNo)
, Field 5 0 "abs.slot" "abs." "slot#" $ IWord64 (unSlotNo . beSlotNo)
, Field 6 0 "hash" "block" "hash" $ IText (shortHash . beBlock)
, Field 6 0 "hashPrev" "prev" "hash" $ IText (shortHash . beBlockPrev)
, Field 5 0 "valid.observ" "valid" "obsrv" $ IInt (length . beValidObservs)
, Field 5 0 "errors" "all" "errs" $ IInt (length . beErrors)
, Field 5 0 "forks" "" "forks" $ IInt (count bpeIsFork . beErrors)
, Field 5 0 "missAdopt" (m!!0) "adopt" $ IInt (count (bpeIsMissing Adopt) . beErrors)
, Field 5 0 "missAnnou" (m!!1) "annou" $ IInt (count (bpeIsMissing Announce) . beErrors)
, Field 5 0 "missSend" (m!!2) "send" $ IInt (count (bpeIsMissing Send) . beErrors)
, Field 5 0 "negAnnou" (n!!0) "annou" $ IInt (count (bpeIsNegative Announce) . beErrors)
, Field 5 0 "negSend" (n!!1) "send" $ IInt (count (bpeIsNegative Send) . beErrors)
[ Field 5 0 "block" "block" "no." $ IWord64 (unBlockNo . beBlockNo)
, Field 5 0 "abs.slot" "abs." "slot#" $ IWord64 (unSlotNo . beSlotNo)
, Field 6 0 "hash" "block" "hash" $ IText (shortHash . beBlock)
, Field 6 0 "hashPrev" "prev" "hash" $ IText (shortHash . beBlockPrev)
, Field 6 0 "forger" "forger" "host" $ IText (toText . unHost . beForger)
, Field 6 0 "forged" (f!!0) "Forge" $ IDeltaT beForged
, Field 6 0 "fAdopted" (f!!1) "Adopt" $ IDeltaT beAdopted
, Field 6 0 "fAnnounced" (f!!2) "Announ" $ IDeltaT beAnnounced
, Field 6 0 "fSendStart" (f!!3) "Sendin" $ IDeltaT beSending
, Field 5 0 "valid.observ" "valid" "obsrv" $ IInt (length . beValidObservs)
, Field 5 0 "noticedVal" (p!!0) "Notic" $ IDeltaT (af boNoticed . beValidObservs)
, Field 5 0 "requestedVal" (p!!1) "Requd" $ IDeltaT (af boRequested . beValidObservs)
, Field 5 0 "fetchedVal" (p!!2) "Fetch" $ IDeltaT (af boFetched . beValidObservs)
, Field 5 0 "pAdoptedVal" (p!!3) "Adopt" $ IDeltaT (af' boAdopted . beValidObservs)
, Field 5 0 "pAnnouncedVal" (p!!4) "Annou" $ IDeltaT (af' boAnnounced . beValidObservs)
, Field 5 0 "pSendStartVal" (p!!5) "Send" $ IDeltaT (af' boSending . beValidObservs)
, Field 5 0 "errors" "all" "errs" $ IInt (length . beErrors)
, Field 5 0 "forks" "" "forks" $ IInt (count bpeIsFork . beErrors)
, Field 5 0 "missAdopt" (m!!0) "adopt" $ IInt (count (bpeIsMissing Adopt) . beErrors)
, Field 5 0 "missAnnou" (m!!1) "annou" $ IInt (count (bpeIsMissing Announce) . beErrors)
, Field 5 0 "missSend" (m!!2) "send" $ IInt (count (bpeIsMissing Send) . beErrors)
, Field 5 0 "negAnnou" (n!!0) "annou" $ IInt (count (bpeIsNegative Announce) . beErrors)
, Field 5 0 "negSend" (n!!1) "send" $ IInt (count (bpeIsNegative Send) . beErrors)
]
where
f = nChunksEachOf 4 7 "Forger event Δt:"
p = nChunksEachOf 6 6 "Peer event Δt:"
m = nChunksEachOf 3 6 "Missing phase"
n = nChunksEachOf 2 6 "Negative phase"
af f = avg . fmap f
af' f = avg . mapMaybe f
avg :: [NominalDiffTime] -> NominalDiffTime
avg [] = 0
avg xs = (/ fromInteger (fromIntegral $ length xs)) $ sum xs
count :: (a -> Bool) -> [a] -> Int
count f = length . filter f
rtCommentary BlockEvents{..} = (" " <>) . T.pack . show <$> beErrors
Expand Down
15 changes: 7 additions & 8 deletions nix/workbench/locli/src/Cardano/Unlog/Render.hs
View file
Expand Up @@ -75,13 +75,11 @@ renderTimeline xs =
entry :: a -> Text
entry v = renderLineDist $
\Field{..} ->
let w = show fWidth
in case fSelect of
IInt (($v)->x) -> T.pack $ printf ('%':(w++"d")) x
IWord64 (($v)->x) -> T.pack $ printf ('%':(w++"d")) x
IFloat (($v)->x) -> T.take fWidth $ T.pack $
printf ('%':'.':(show (fWidth - 2)++"F")) x
IDeltaT (($v)->x) -> T.take fWidth . T.dropWhileEnd (== 's') $ show x
case fSelect of
IInt (($v)->x) -> T.pack $ printf "%*d" fWidth x
IWord64 (($v)->x) -> T.pack $ printf "%*d" fWidth x
IFloat (($v)->x) -> T.pack $ take fWidth $ printf "%*F" (fWidth - 2) x
IDeltaT (($v)->x) -> T.pack $ take fWidth $ printf "%-*s" fWidth $ dropWhileEnd (== 's') $ show x
IText (($v)->x) -> T.take fWidth . T.dropWhileEnd (== 's') $ x

fields :: [IField a]
Expand All @@ -107,6 +105,8 @@ renderDistributions mode x =
case mode of
RenderPretty -> catMaybes [head1, head2] <> pLines <> sizeAvg
RenderCsv -> headCsv : pLines
where headCsv = T.intercalate "," $ fId <$> fields

where
pLines :: [Text]
pLines = fLine <$> [0..(nPercs - 1)]
Expand Down Expand Up @@ -137,7 +137,6 @@ renderDistributions mode x =
else Just (renderLineHead1 (uncurry T.take . ((+1) . fWidth &&& fHead1)))
head2 = if all ((== 0) . T.length . fHead2) fields then Nothing
else Just (renderLineHead2 (uncurry T.take . ((+1) . fWidth &&& fHead2)))
headCsv = T.intercalate "," $ fId <$> fields

sizeAvg :: [Text]
sizeAvg = fmap (T.intercalate " ")
Expand Down

0 comments on commit 96c7178

Please sign in to comment.