Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

cardano-tracer: more strictness. #4283

Merged
merged 1 commit into from
Aug 8, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
Expand Down Expand Up @@ -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.
Expand All @@ -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'
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

Expand Down Expand Up @@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions cardano-tracer/src/Cardano/Tracer/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 "-"
Expand Down Expand Up @@ -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.
Expand Down