From 50fdf8c70e983e676da0f86a2319601b2ccaa236 Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Sun, 26 May 2024 13:26:59 -0400 Subject: [PATCH 1/2] log: make cut logging more descriptive Now we get a diff when the cut db has a new cut! See example: current cut is now psY73l diff: 13 @ M-plFQ (height 4810061) -> 13 @ OhqXKd (height 4810062) Change-Id: If906446190bb2cf7cb6d88c4933a82711462f462 --- changes/2024-05-30T145052-0400.txt | 1 + src/Chainweb/BlockHash.hs | 4 ++++ src/Chainweb/BlockHeader.hs | 13 +++++++++++ src/Chainweb/Cut.hs | 23 +++++++++++++++++++ src/Chainweb/CutDB.hs | 37 +++++++++++++++++++----------- 5 files changed, 65 insertions(+), 13 deletions(-) create mode 100644 changes/2024-05-30T145052-0400.txt diff --git a/changes/2024-05-30T145052-0400.txt b/changes/2024-05-30T145052-0400.txt new file mode 100644 index 0000000000..63861cbe23 --- /dev/null +++ b/changes/2024-05-30T145052-0400.txt @@ -0,0 +1 @@ +Cut pipeline logging is more descriptive diff --git a/src/Chainweb/BlockHash.hs b/src/Chainweb/BlockHash.hs index 9bb019fee7..6c49da4ac8 100644 --- a/src/Chainweb/BlockHash.hs +++ b/src/Chainweb/BlockHash.hs @@ -39,6 +39,7 @@ module Chainweb.BlockHash , decodeBlockHash , nullBlockHash , blockHashToText +, blockHashToTextShort , blockHashFromText -- * Block Hash Record @@ -154,6 +155,9 @@ blockHashToText :: BlockHash_ a -> T.Text blockHashToText = encodeB64UrlNoPaddingText . runPutS . encodeBlockHash {-# INLINE blockHashToText #-} +blockHashToTextShort :: BlockHash_ a -> T.Text +blockHashToTextShort = T.take 6 . blockHashToText + blockHashFromText :: MerkleHashAlgorithm a => MonadThrow m diff --git a/src/Chainweb/BlockHeader.hs b/src/Chainweb/BlockHeader.hs index f8539dc594..ccf7da04c8 100644 --- a/src/Chainweb/BlockHeader.hs +++ b/src/Chainweb/BlockHeader.hs @@ -89,6 +89,7 @@ module Chainweb.BlockHeader , decodeBlockHeaderWithoutHash , decodeBlockHeaderChecked , decodeBlockHeaderCheckedChainId +, blockHeaderShortDescription , ObjectEncoded(..) , timeBetween @@ -386,6 +387,18 @@ instance IsCasValue BlockHeader where type BlockHeaderCas tbl = Cas tbl BlockHeader +-- | Used for quickly identifying "which block" this is. +-- Example output: +-- "0 @ bSQgL5 (height 4810062)" +blockHeaderShortDescription :: BlockHeader -> T.Text +blockHeaderShortDescription bh = + T.unwords + [ toText (_chainId bh) + , "@" + , blockHashToTextShort (_blockHash bh) + , "(height " <> sshow (getBlockHeight $ _blockHeight bh) <> ")" + ] + makeLenses ''BlockHeader -- | During the first epoch after genesis there are 10 extra difficulty diff --git a/src/Chainweb/Cut.hs b/src/Chainweb/Cut.hs index 1d0aed3362..de3cdde527 100644 --- a/src/Chainweb/Cut.hs +++ b/src/Chainweb/Cut.hs @@ -38,6 +38,8 @@ -- module Chainweb.Cut ( Cut +, cutToTextShort +, cutDiffToTextShort , _cutMap , cutMap , _cutHeight @@ -106,9 +108,11 @@ import Data.Functor.Of import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import qualified Data.Heap as H +import qualified Data.List as List import Data.Maybe (catMaybes, fromMaybe) import Data.Monoid import Data.Ord +import Data.Text (Text) import qualified Data.Text as T import Data.These @@ -898,3 +902,22 @@ forkDepth wdb a b = do maxDepth l u = maximum $ (\(_, x, y) -> _blockHeight y - _blockHeight x) <$> zipCuts l u + +cutToTextShort :: Cut -> [Text] +cutToTextShort c = + [ blockHeaderShortDescription bh + | (_, bh) <- List.sortOn fst $ HM.toList (_cutHeaders c) + ] + +cutDiffToTextShort :: Cut -> Cut -> [Text] +cutDiffToTextShort c c' = + [ T.unwords + [ maybe "No block" blockHeaderShortDescription bh + , "->" + , maybe "No block" blockHeaderShortDescription bh' + ] + | cid <- List.sort $ HM.keys $ HM.union (_cutHeaders c) (_cutHeaders c') + , let bh = HM.lookup cid (_cutHeaders c) + , let bh' = HM.lookup cid (_cutHeaders c') + , bh /= bh' + ] diff --git a/src/Chainweb/CutDB.hs b/src/Chainweb/CutDB.hs index ca2cee9fde..54b0fdba21 100644 --- a/src/Chainweb/CutDB.hs +++ b/src/Chainweb/CutDB.hs @@ -433,7 +433,8 @@ startCutDb config logfun headerStore payloadStore cutHashesStore = mask_ $ do (Just $ over _1 succ $ casKey $ cutToCutHashes Nothing initialCut, Nothing) cutVar <- newTVarIO initialCut c <- readTVarIO cutVar - logg Info $ "got initial cut: " <> sshow c + logg Info $ T.unlines $ + "got initial cut:" : [" " <> block | block <- cutToTextShort c] queue <- newEmptyPQueue cutAsync <- asyncWithUnmask $ \u -> u $ processor queue cutVar logg Info "CutDB started" @@ -554,16 +555,16 @@ processCuts processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = do rng <- Prob.createSystemRandom queueToStream - & S.chain (\c -> loggc Debug c "start processing") + & S.chain (\c -> loggCutId Debug c "start processing") & S.filterM (fmap not . isVeryOld) & S.filterM (fmap not . farAhead) & S.filterM (fmap not . isOld) & S.filterM (fmap not . isCurrent) - & S.chain (\c -> loggc Debug c "fetch all prerequesites") + & S.chain (\c -> loggCutId Info c "fetch all prerequesites") & S.mapM (cutHashesToBlockHeaderMap conf logFun headerStore payloadStore) & S.chain (either - (\(T2 hsid c) -> loggc Warn hsid $ "failed to get prerequesites for some blocks. Missing: " <> encodeToText c) - (\c -> loggc Info c "got all prerequesites") + (\(T2 hsid c) -> loggCutId Warn hsid $ "failed to get prerequesites for some blocks. Missing: " <> encodeToText c) + (\_ -> return ()) ) & S.concat -- ignore left values for now @@ -577,14 +578,24 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d $ joinIntoHeavier_ hdrStore (_cutMap curCut) newCut unless (_cutDbParamsReadOnly conf) $ do maybePrune rng (cutAvgBlockHeight v curCut) - loggc Info newCut "writing cut" + loggCutId Debug newCut "writing cut" casInsert cutHashesStore (cutToCutHashes Nothing resultCut) atomically $ writeTVar cutVar resultCut - loggc Info resultCut "published cut" + let cutDiff = cutDiffToTextShort curCut resultCut + let currentCutIdMsg = T.unwords + [ "current cut is now" + , cutIdToTextShort (_cutId resultCut) <> "," + , "diff:" + ] + let catOverflowing x xs = + if length xs == 1 + then T.unwords (x : xs) + else T.intercalate "\n" (x : (map (" " <>) xs)) + logFun @T.Text Info $ catOverflowing currentCutIdMsg cutDiff ) where - loggc :: HasCutId c => LogLevel -> c -> T.Text -> IO () - loggc l c msg = logFun @T.Text l $ "cut " <> cutIdToTextShort (_cutId c) <> ": " <> msg + loggCutId :: HasCutId c => LogLevel -> c -> T.Text -> IO () + loggCutId l c msg = logFun @T.Text l $ "cut " <> cutIdToTextShort (_cutId c) <> ": " <> msg v = _chainwebVersion headerStore @@ -615,7 +626,7 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d curMax <- maxChainHeight <$> readTVarIO cutVar let newMax = _cutHashesMaxHeight x let r = newMax >= curMax + farAheadThreshold - when r $ loggc Debug x + when r $ loggCutId Debug x $ "skip far ahead cut. Current maximum block height: " <> sshow curMax <> ", got: " <> sshow newMax -- log at debug level because this is a common case during catchup @@ -635,7 +646,7 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d let diam = diameter $ chainGraphAt headerStore curMin newMin = _cutHashesMinHeight x let r = newMin + 2 * (1 + int diam) <= curMin - when r $ loggc Debug x "skip very old cut" + when r $ loggCutId Debug x "skip very old cut" -- log at debug level because this is a common case during catchup return r @@ -644,13 +655,13 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d isOld x = do curHashes <- cutToCutHashes Nothing <$> readTVarIO cutVar let r = all (>= (0 :: Int)) $ (HM.unionWith (-) `on` (fmap (int . _bhwhHeight) . _cutHashes)) curHashes x - when r $ loggc Debug x "skip old cut" + when r $ loggCutId Debug x "skip old cut" return r isCurrent x = do curHashes <- cutToCutHashes Nothing <$> readTVarIO cutVar let r = _cutHashes curHashes == _cutHashes x - when r $ loggc Debug x "skip current cut" + when r $ loggCutId Debug x "skip current cut" return r -- | Stream of most recent cuts. This stream does not generally include the full From aae2d80b46def799ccc6adba537039d7bd383c9b Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Sat, 25 May 2024 12:11:06 -0400 Subject: [PATCH 2/2] log: clearer log for when cuts time out Change-Id: I74cdcc930cdd2fe0a08d05c27b7467f5176da03b --- src/Chainweb/CutDB.hs | 46 +++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/src/Chainweb/CutDB.hs b/src/Chainweb/CutDB.hs index 54b0fdba21..b0d4fc00dd 100644 --- a/src/Chainweb/CutDB.hs +++ b/src/Chainweb/CutDB.hs @@ -17,6 +17,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TupleSections #-} -- | -- Module: Chainweb.CutDB @@ -555,19 +556,16 @@ processCuts processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = do rng <- Prob.createSystemRandom queueToStream - & S.chain (\c -> loggCutId Debug c "start processing") + & S.chain (\c -> loggCutId logFun Debug c "start processing") & S.filterM (fmap not . isVeryOld) & S.filterM (fmap not . farAhead) & S.filterM (fmap not . isOld) & S.filterM (fmap not . isCurrent) - & S.chain (\c -> loggCutId Info c "fetch all prerequesites") + + & S.chain (\c -> loggCutId logFun Info c "fetching all prerequisites") & S.mapM (cutHashesToBlockHeaderMap conf logFun headerStore payloadStore) - & S.chain (either - (\(T2 hsid c) -> loggCutId Warn hsid $ "failed to get prerequesites for some blocks. Missing: " <> encodeToText c) - (\_ -> return ()) - ) - & S.concat - -- ignore left values for now + & S.catMaybes + -- ignore unsuccessful values for now -- using S.scanM would be slightly more efficient (one pointer dereference) -- by keeping the value of cutVar in memory. We use the S.mapM variant with @@ -578,7 +576,7 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d $ joinIntoHeavier_ hdrStore (_cutMap curCut) newCut unless (_cutDbParamsReadOnly conf) $ do maybePrune rng (cutAvgBlockHeight v curCut) - loggCutId Debug newCut "writing cut" + loggCutId logFun Debug newCut "writing cut" casInsert cutHashesStore (cutToCutHashes Nothing resultCut) atomically $ writeTVar cutVar resultCut let cutDiff = cutDiffToTextShort curCut resultCut @@ -594,8 +592,6 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d logFun @T.Text Info $ catOverflowing currentCutIdMsg cutDiff ) where - loggCutId :: HasCutId c => LogLevel -> c -> T.Text -> IO () - loggCutId l c msg = logFun @T.Text l $ "cut " <> cutIdToTextShort (_cutId c) <> ": " <> msg v = _chainwebVersion headerStore @@ -626,7 +622,7 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d curMax <- maxChainHeight <$> readTVarIO cutVar let newMax = _cutHashesMaxHeight x let r = newMax >= curMax + farAheadThreshold - when r $ loggCutId Debug x + when r $ loggCutId logFun Debug x $ "skip far ahead cut. Current maximum block height: " <> sshow curMax <> ", got: " <> sshow newMax -- log at debug level because this is a common case during catchup @@ -646,7 +642,7 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d let diam = diameter $ chainGraphAt headerStore curMin newMin = _cutHashesMinHeight x let r = newMin + 2 * (1 + int diam) <= curMin - when r $ loggCutId Debug x "skip very old cut" + when r $ loggCutId logFun Debug x "skip very old cut" -- log at debug level because this is a common case during catchup return r @@ -655,13 +651,13 @@ processCuts conf logFun headerStore payloadStore cutHashesStore queue cutVar = d isOld x = do curHashes <- cutToCutHashes Nothing <$> readTVarIO cutVar let r = all (>= (0 :: Int)) $ (HM.unionWith (-) `on` (fmap (int . _bhwhHeight) . _cutHashes)) curHashes x - when r $ loggCutId Debug x "skip old cut" + when r $ loggCutId logFun Debug x "skip old cut" return r isCurrent x = do curHashes <- cutToCutHashes Nothing <$> readTVarIO cutVar let r = _cutHashes curHashes == _cutHashes x - when r $ loggCutId Debug x "skip current cut" + when r $ loggCutId logFun Debug x "skip current cut" return r -- | Stream of most recent cuts. This stream does not generally include the full @@ -765,7 +761,7 @@ cutHashesToBlockHeaderMap -> WebBlockHeaderStore -> WebBlockPayloadStore tbl -> CutHashes - -> IO (Either (T2 CutId (HM.HashMap ChainId BlockHash)) (HM.HashMap ChainId BlockHeader)) + -> IO (Maybe (HM.HashMap ChainId BlockHeader)) -- ^ The 'Left' value holds missing hashes, the 'Right' value holds -- a 'Cut'. cutHashesToBlockHeaderMap conf logfun headerStore payloadStore hs = @@ -779,9 +775,13 @@ cutHashesToBlockHeaderMap conf logfun headerStore payloadStore hs = $ "Timeout while processing cut " <> cutIdToTextShort hsid <> " at height " <> sshow (_cutHashesHeight hs) - <> cutOriginText - return $! Left $! T2 hsid mempty - Just x -> return $! x + <> " from origin " <> cutOriginText + return Nothing + Just (Left missing) -> do + loggCutId logfun Warn hs $ "Failed to get prerequisites for some blocks. Missing: " <> encodeToText missing + return Nothing + Just (Right headers) -> do + return (Just headers) where hsid = _cutId hs go = @@ -803,12 +803,12 @@ cutHashesToBlockHeaderMap conf logfun headerStore payloadStore hs = & S.fold_ (\x (cid, h) -> HM.insert cid h x) mempty id & S.fold (\x (cid, h) -> HM.insert cid h x) mempty id if null missing - then return (Right headers) + then return $! Right headers else do when (isJust $ _cutHashesLocalPayload hs) $ logfun @Text Error "error validating locally mined cut; the mining loop will stall until unstuck by another mining node" - return $! Left $! T2 hsid missing + return $! Left missing origin = _cutOrigin hs priority = Priority (- int (_cutHashesHeight hs)) @@ -894,3 +894,7 @@ getQueueStats db = QueueStats <*> (int <$> TM.size (_webBlockHeaderStoreMemo $ view cutDbWebBlockHeaderStore db)) <*> pQueueSize (_webBlockPayloadStoreQueue $ view cutDbPayloadStore db) <*> (int <$> TM.size (_webBlockPayloadStoreMemo $ view cutDbPayloadStore db)) + +-- Logging +loggCutId :: HasCutId c => LogFunction -> LogLevel -> c -> T.Text -> IO () +loggCutId logFun l c msg = logFun @T.Text l $ "cut " <> cutIdToTextShort (_cutId c) <> ": " <> msg