From 4a471f44612d75a6bd221763c816fb7823b04fb9 Mon Sep 17 00:00:00 2001 From: Denis Shevchenko Date: Mon, 8 Aug 2022 13:38:52 +0400 Subject: [PATCH] cardano-tracer: more strictness. --- .../src/Cardano/Tracer/Handlers/Logs/Rotator.hs | 5 +++-- .../Tracer/Handlers/RTView/State/Displayed.hs | 4 ++-- .../Tracer/Handlers/RTView/State/TraceObjects.hs | 13 +++++++------ .../Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs | 3 ++- .../Tracer/Handlers/RTView/Update/Historical.hs | 2 +- .../Cardano/Tracer/Handlers/RTView/Update/KES.hs | 3 ++- .../Tracer/Handlers/RTView/Update/Resources.hs | 12 ++++++------ .../Cardano/Tracer/Handlers/RTView/Update/Utils.hs | 2 +- cardano-tracer/src/Cardano/Tracer/Utils.hs | 8 ++++---- 9 files changed, 28 insertions(+), 24 deletions(-) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs index 82c251fe29d..2356172ee29 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-} @@ -109,7 +110,7 @@ checkIfCurrentLogIsFull currentLogLock pathToCurrentLog format maxSizeInBytes = where logIsFull = do size <- getFileSize pathToCurrentLog - return $ fromIntegral size >= maxSizeInBytes + return $! fromIntegral size >= maxSizeInBytes -- | If there are too old log files - they will be removed. -- Please note that some number of log files can be kept in any case. @@ -129,7 +130,7 @@ checkIfThereAreOldLogs fromOldestToNewest maxAgeInHours keepFilesNum = do checkOldLogs (oldestLog:otherLogs) now' = case getTimeStampFromLog oldestLog of Just ts -> do - let oldestLogAge = toSeconds $ now' `diffUTCTime` ts + let !oldestLogAge = toSeconds $ now' `diffUTCTime` ts when (oldestLogAge >= maxAgeInSecs) $ do removeFile oldestLog checkOldLogs otherLogs now' diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Displayed.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Displayed.hs index aa36c701de4..f2a11052133 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Displayed.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Displayed.hs @@ -110,12 +110,12 @@ updateDisplayedElements displayedElements connected = atomically $ deleteDisconnected = go where go [] els = els - go (anId:ids) els = go ids $ M.delete anId els + go (anId:ids) els = go ids $! M.delete anId els addNewlyConnected = go where go [] els = els - go (anId:ids) els = go ids $ M.insert anId M.empty els + go (anId:ids) els = go ids $! M.insert anId M.empty els -- | If the user reloaded the web-page, after DOM re-rendering, we have to restore -- displayed state of all elements that they have _before_ page's reload. diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/TraceObjects.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/TraceObjects.hs index df1ee1f3ed1..c2fc6775ff4 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/TraceObjects.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/TraceObjects.hs @@ -36,12 +36,13 @@ initSavedTraceObjects = newTVarIO M.empty saveTraceObjects :: SavedTraceObjects -> NodeId -> [TraceObject] -> IO () saveTraceObjects savedTraceObjects nodeId traceObjects = - unless (null itemsToSave) $ atomically $ modifyTVar' savedTraceObjects $ \savedTO -> - case M.lookup nodeId savedTO of - Nothing -> - M.insert nodeId (M.fromList itemsToSave) savedTO - Just savedTOForThisNode -> - M.adjust (const $ savedTOForThisNode `updateSavedBy` itemsToSave) nodeId savedTO + unless (null itemsToSave) $ + atomically $ modifyTVar' savedTraceObjects $ \savedTO -> + case M.lookup nodeId savedTO of + Nothing -> + M.insert nodeId (M.fromList itemsToSave) savedTO + Just savedTOForThisNode -> + M.adjust (const $! savedTOForThisNode `updateSavedBy` itemsToSave) nodeId savedTO where itemsToSave = mapMaybe getTOValue traceObjects diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs index a7e34937259..0b791cd5fcf 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -624,4 +625,4 @@ doMakeChartTimer addPoints tracerEnv history datasetIndices dataName chartId = d addPoints tracerEnv history datasetIndices dataName chartId return uiUpdateTimer where - defaultUpdatePeriodInMs = 15 * 1000 + defaultUpdatePeriodInMs = 15_000 diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs index 927beca8339..100374aa00a 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs @@ -198,7 +198,7 @@ getAllHistoryFromBackup tracerEnv@TracerEnv{teConnectedNodes} dataName = do Right rawPoints -> case CSV.decode CSV.NoHeader rawPoints of Left _ -> return [] -- Maybe file was broken... - Right (pointsV :: V.Vector HistoricalPoint) -> return $ V.toList pointsV + Right (pointsV :: V.Vector HistoricalPoint) -> return $! V.toList pointsV getLastHistoryFromBackupsAll :: TracerEnv diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs index 9efd16420f3..95a77c4fc18 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -51,6 +52,6 @@ updateKESInfo tracerEnv settings displayed = Right (remainingKesPeriods :: Int, _) -> do let secondsUntilRenew = remainingKesPeriods * esKESPeriodLength * esSlotLengthInS daysUntilRenew :: Double - daysUntilRenew = fromIntegral secondsUntilRenew / 3600 / 24 + !daysUntilRenew = fromIntegral secondsUntilRenew / 3600 / 24 setDisplayedValue nodeId displayed (anId <> "__node-days-until-op-cert-renew") $ pack $ printf "%.1f" daysUntilRenew diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs index 909485c3e92..57e9365392b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs @@ -52,8 +52,8 @@ updateResourcesHistory nodeId (ResHistory rHistory) lastResources metricName met let tns = utc2ns now tDiffInSec = max 0.1 $ fromIntegral (tns - cpuLastNS resourcesForNode) / 1000_000_000 :: Double ticksDiff = cpuTicks - cpuLastTicks resourcesForNode - !cpuV = fromIntegral ticksDiff / fromIntegral (100 :: Int) / tDiffInSec - newCPUPct = if cpuV < 0 then 0.0 else cpuV * 100.0 + cpuV = fromIntegral ticksDiff / fromIntegral (100 :: Int) / tDiffInSec + !newCPUPct = if cpuV < 0 then 0.0 else cpuV * 100.0 addHistoricalData rHistory nodeId now CPUData $ ValueD newCPUPct updateLastResources lastResources nodeId $ \current -> current { cpuLastTicks = cpuTicks @@ -93,8 +93,8 @@ updateResourcesHistory nodeId (ResHistory rHistory) lastResources metricName met let tns = utc2ns now tDiffInSec = max 0.1 $ fromIntegral (tns - cpuGCLastNS resourcesForNode) / 1000_000_000 :: Double ticksDiff = cpuTimeGCInCentiS - cpuGCLastTicks resourcesForNode - !cpuV = fromIntegral ticksDiff / fromIntegral (100 :: Int) / tDiffInSec - newCPUPct = if cpuV < 0 then 0.0 else cpuV * 100.0 + cpuV = fromIntegral ticksDiff / fromIntegral (100 :: Int) / tDiffInSec + !newCPUPct = if cpuV < 0 then 0.0 else cpuV * 100.0 addHistoricalData rHistory nodeId now CPUTimeGCData $ ValueD newCPUPct updateLastResources lastResources nodeId $ \current -> current { cpuGCLastTicks = cpuTimeGCInCentiS @@ -114,8 +114,8 @@ updateResourcesHistory nodeId (ResHistory rHistory) lastResources metricName met let tns = utc2ns now tDiffInSec = max 0.1 $ fromIntegral (tns - cpuAppLastNS resourcesForNode) / 1000_000_000 :: Double ticksDiff = cpuTimeAppInCentiS - cpuAppLastTicks resourcesForNode - !cpuV = fromIntegral ticksDiff / fromIntegral (100 :: Int) / tDiffInSec - newCPUPct = if cpuV < 0 then 0.0 else cpuV * 100.0 + cpuV = fromIntegral ticksDiff / fromIntegral (100 :: Int) / tDiffInSec + !newCPUPct = if cpuV < 0 then 0.0 else cpuV * 100.0 addHistoricalData rHistory nodeId now CPUTimeAppData $ ValueD newCPUPct updateLastResources lastResources nodeId $ \current -> current { cpuAppLastTicks = cpuTimeAppInCentiS diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Utils.hs index 08fb44dd181..0ecf7baadf2 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Utils.hs @@ -56,7 +56,7 @@ utc2s utc = fromInteger . round $ utcTimeToPOSIXSeconds utc -- | Converts a timestamp to nanoseconds since Unix epoch. utc2ns :: UTCTime -> Word64 -utc2ns utc = fromInteger . round $ 1000_000_000 * utcTimeToPOSIXSeconds utc +utc2ns utc = fromInteger . round $! 1000_000_000 * utcTimeToPOSIXSeconds utc s2utc :: Word64 -> UTCTime s2utc posixTime = posixSecondsToUTCTime $ fromIntegral posixTime diff --git a/cardano-tracer/src/Cardano/Tracer/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Utils.hs index 3aa21036442..724515d97df 100644 --- a/cardano-tracer/src/Cardano/Tracer/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Utils.hs @@ -111,7 +111,7 @@ connIdToNodeId ConnectionId{remoteAddress} = NodeId preparedAddress where -- We have to remove "wrong" symbols from 'NodeId', -- to make it appropriate for the name of the subdirectory. - preparedAddress = + !preparedAddress = T.pack . dropPrefix "-" . dropSuffix "-" @@ -173,9 +173,9 @@ askNodeId -> IO (Maybe NodeId) askNodeId TracerEnv{teConnectedNodesNames} nodeName = do nodesNames <- readTVarIO teConnectedNodesNames - return $ if nodeName `BM.memberR` nodesNames - then Just $ nodesNames !> nodeName - else Nothing + return $! if nodeName `BM.memberR` nodesNames + then Just $ nodesNames !> nodeName + else Nothing -- | Stop the protocols. As a result, 'MsgDone' will be sent and interaction -- between acceptor's part and forwarder's part will be finished.