cardano-tracer: more strictness.

IntersectMBO · Aug 8, 2022 · 4a471f4 · 4a471f4
1 parent 2448873
commit 4a471f4
Show file tree

Hide file tree

Showing 9 changed files with 28 additions and 24 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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.