Skip to content

Commit

Permalink
If GC stats aren't available, just return 0 for all values
Browse files Browse the repository at this point in the history
  • Loading branch information
@tibbe
tibbe committed Sep 18, 2012
1 parent 8884284 commit d1e8628
Showing 1 changed file with 72 additions and 56 deletions.
128 changes: 72 additions & 56 deletions System/Remote/Monitoring.hs
View file
Expand Up @@ -348,60 +348,82 @@ getLabel name server = getRef name (userLabels server)
-- | All the stats exported by the server (i.e. GC stats plus user -- | All the stats exported by the server (i.e. GC stats plus user
-- defined counters). -- defined counters).
data Stats = Stats data Stats = Stats
!(Maybe Stats.GCStats) -- GC statistics !Stats.GCStats -- GC statistics
![(T.Text, Json)] -- Counters ![(T.Text, Json)] -- Counters
![(T.Text, Json)] -- Gauges ![(T.Text, Json)] -- Gauges
![(T.Text, Json)] -- Labels ![(T.Text, Json)] -- Labels
{-# UNPACK #-} !Double -- Milliseconds since epoch {-# UNPACK #-} !Double -- Milliseconds since epoch


emptyGCStats :: Stats.GCStats
emptyGCStats = Stats.GCStats
{ bytesAllocated = 0
, numGcs = 0
, maxBytesUsed = 0
, numByteUsageSamples = 0
, cumulativeBytesUsed = 0
, bytesCopied = 0
, currentBytesUsed = 0
, currentBytesSlop = 0
, maxBytesSlop = 0
, peakMegabytesAllocated = 0
, mutatorCpuSeconds = 0
, mutatorWallSeconds = 0
, gcCpuSeconds = 0
, gcWallSeconds = 0
, cpuSeconds = 0
, wallSeconds = 0
#if MIN_VERSION_base(4,6,0)
, parTotBytesCopied = 0
#else
, parAvgBytesCopied = 0
#endif
, parMaxBytesCopied = 0
}

instance A.ToJSON Stats where instance A.ToJSON Stats where
toJSON (Stats maybeGcStats counters gauges labels t) = A.object $ toJSON (Stats gcStats counters gauges labels t) = A.object $
[ "server_timestamp_millis" .= t [ "server_timestamp_millis" .= t
, "counters" .= Assocs (gcCounters ++ counters) , "counters" .= Assocs (gcCounters ++ counters)
, "gauges" .= Assocs (gcGauges ++ gauges) , "gauges" .= Assocs (gcGauges ++ gauges)
, "labels" .= Assocs (labels) , "labels" .= Assocs (labels)
] ]
where where
(gcCounters, gcGauges) = partitionGcStats maybeGcStats (gcCounters, gcGauges) = partitionGcStats gcStats


-- | 'Stats' encoded as a flattened JSON object. -- | 'Stats' encoded as a flattened JSON object.
newtype Combined = Combined Stats newtype Combined = Combined Stats


instance A.ToJSON Combined where instance A.ToJSON Combined where
toJSON (Combined (Stats maybeGcStats counters gauges labels t)) = toJSON (Combined (Stats (Stats.GCStats {..}) counters gauges labels t)) =
A.object $ A.object $
gcCombined ++ map (uncurry (.=)) counters ++ [ "server_timestamp_millis" .= t
map (uncurry (.=)) gauges ++ , "bytes_allocated" .= bytesAllocated
map (uncurry (.=)) labels , "num_gcs" .= numGcs
where , "max_bytes_used" .= maxBytesUsed
gcCombined = case maybeGcStats of , "num_bytes_usage_samples" .= numByteUsageSamples
Nothing -> [] , "cumulative_bytes_used" .= cumulativeBytesUsed
Just (Stats.GCStats {..}) -> , "bytes_copied" .= bytesCopied
[ "server_timestamp_millis" .= t , "current_bytes_used" .= currentBytesUsed
, "bytes_allocated" .= bytesAllocated , "current_bytes_slop" .= currentBytesSlop
, "num_gcs" .= numGcs , "max_bytes_slop" .= maxBytesSlop
, "max_bytes_used" .= maxBytesUsed , "peak_megabytes_allocated" .= peakMegabytesAllocated
, "num_bytes_usage_samples" .= numByteUsageSamples , "mutator_cpu_seconds" .= mutatorCpuSeconds
, "cumulative_bytes_used" .= cumulativeBytesUsed , "mutator_wall_seconds" .= mutatorWallSeconds
, "bytes_copied" .= bytesCopied , "gc_cpu_seconds" .= gcCpuSeconds
, "current_bytes_used" .= currentBytesUsed , "gc_wall_seconds" .= gcWallSeconds
, "current_bytes_slop" .= currentBytesSlop , "cpu_seconds" .= cpuSeconds
, "max_bytes_slop" .= maxBytesSlop , "wall_seconds" .= wallSeconds
, "peak_megabytes_allocated" .= peakMegabytesAllocated
, "mutator_cpu_seconds" .= mutatorCpuSeconds
, "mutator_wall_seconds" .= mutatorWallSeconds
, "gc_cpu_seconds" .= gcCpuSeconds
, "gc_wall_seconds" .= gcWallSeconds
, "cpu_seconds" .= cpuSeconds
, "wall_seconds" .= wallSeconds
#if MIN_VERSION_base(4,6,0) #if MIN_VERSION_base(4,6,0)
, "par_tot_bytes_copied" .= parTotBytesCopied , "par_tot_bytes_copied" .= parTotBytesCopied
, "par_avg_bytes_copied" .= parTotBytesCopied , "par_avg_bytes_copied" .= parTotBytesCopied
#else #else
, "par_avg_bytes_copied" .= parAvgBytesCopied , "par_avg_bytes_copied" .= parAvgBytesCopied
#endif #endif
, "par_max_bytes_copied" .= parMaxBytesCopied , "par_max_bytes_copied" .= parMaxBytesCopied
] ] ++
map (uncurry (.=)) counters ++
map (uncurry (.=)) gauges ++
map (uncurry (.=)) labels


-- | A list of string keys and JSON-encodable values. Used to render -- | A list of string keys and JSON-encodable values. Used to render
-- a list of key-value pairs as a JSON object. -- a list of key-value pairs as a JSON object.
Expand Down Expand Up @@ -480,15 +502,15 @@ serveMany mapRef = do
writeLBS $ A.encode $ A.toJSON $ Group list time writeLBS $ A.encode $ A.toJSON $ Group list time
{-# INLINABLE serveMany #-} {-# INLINABLE serveMany #-}


maybeGetGcStats :: IO (Maybe Stats.GCStats) getGcStats :: IO Stats.GCStats
maybeGetGcStats = do getGcStats = do
#if MIN_VERSION_base(4,6,0) #if MIN_VERSION_base(4,6,0)
enabled <- Stats.getGCStatsEnabled enabled <- Stats.getGCStatsEnabled
if enabled if enabled
then Just `fmap` Stats.getGCStats then Stats.getGCStats
else return Nothing else return emptyGCStats
#else #else
Just `fmap` Stats.getGCStats Stats.getGCStats
#endif #endif


-- | Serve all counter, gauges and labels, built-in or not, as a -- | Serve all counter, gauges and labels, built-in or not, as a
Expand All @@ -501,26 +523,26 @@ serveAll counters gauges labels = do
-- requests ought to go to the 'serveOne' handler. -- requests ought to go to the 'serveOne' handler.
unless (S.null $ rqPathInfo req) pass unless (S.null $ rqPathInfo req) pass
modifyResponse $ setContentType "application/json" modifyResponse $ setContentType "application/json"
maybeGcStats <- liftIO maybeGetGcStats gcStats <- liftIO getGcStats
counterList <- liftIO $ readAllRefs counters counterList <- liftIO $ readAllRefs counters
gaugeList <- liftIO $ readAllRefs gauges gaugeList <- liftIO $ readAllRefs gauges
labelList <- liftIO $ readAllRefs labels labelList <- liftIO $ readAllRefs labels
time <- liftIO getTimeMillis time <- liftIO getTimeMillis
writeLBS $ A.encode $ A.toJSON $ Stats maybeGcStats counterList gaugeList writeLBS $ A.encode $ A.toJSON $ Stats gcStats counterList gaugeList
labelList time labelList time


-- | Serve all counters and gauges, built-in or not, as a flattened -- | Serve all counters and gauges, built-in or not, as a flattened
-- JSON object. -- JSON object.
serveCombined :: IORef Counters -> IORef Gauges -> IORef Labels -> Snap () serveCombined :: IORef Counters -> IORef Gauges -> IORef Labels -> Snap ()
serveCombined counters gauges labels = do serveCombined counters gauges labels = do
modifyResponse $ setContentType "application/json" modifyResponse $ setContentType "application/json"
maybeGcStats <- liftIO maybeGetGcStats gcStats <- liftIO getGcStats
counterList <- liftIO $ readAllRefs counters counterList <- liftIO $ readAllRefs counters
gaugeList <- liftIO $ readAllRefs gauges gaugeList <- liftIO $ readAllRefs gauges
labelList <- liftIO $ readAllRefs labels labelList <- liftIO $ readAllRefs labels
time <- liftIO getTimeMillis time <- liftIO getTimeMillis
writeLBS $ A.encode $ A.toJSON $ Combined $ writeLBS $ A.encode $ A.toJSON $ Combined $
Stats maybeGcStats counterList gaugeList labelList time Stats gcStats counterList gaugeList labelList time


-- | Serve a single counter, as plain text. -- | Serve a single counter, as plain text.
serveOne :: (Ref r t, Show t) => IORef (M.HashMap T.Text r) -> Snap () serveOne :: (Ref r t, Show t) => IORef (M.HashMap T.Text r) -> Snap ()
Expand All @@ -540,16 +562,12 @@ serveOne refs = do
-- Try built-in (e.g. GC) refs -- Try built-in (e.g. GC) refs
case Map.lookup name builtinCounters of case Map.lookup name builtinCounters of
Just f -> do Just f -> do
maybeGcStats <- liftIO maybeGetGcStats gcStats <- liftIO getGcStats
case maybeGcStats of writeBS $ S8.pack $ f gcStats
Nothing -> notFound Nothing -> do
Just gcStats -> writeBS $ S8.pack $ f gcStats modifyResponse $ setResponseStatus 404 "Not Found"
Nothing -> notFound r <- getResponse
where finishWith r
notFound = do
modifyResponse $ setResponseStatus 404 "Not Found"
r <- getResponse
finishWith r
{-# INLINABLE serveOne #-} {-# INLINABLE serveOne #-}


-- | A list of all built-in (e.g. GC) counters, together with a -- | A list of all built-in (e.g. GC) counters, together with a
Expand Down Expand Up @@ -588,10 +606,8 @@ instance A.ToJSON Json where
toJSON (Json x) = A.toJSON x toJSON (Json x) = A.toJSON x


-- | Partition GC statistics into counters and gauges. -- | Partition GC statistics into counters and gauges.
partitionGcStats :: Maybe Stats.GCStats partitionGcStats :: Stats.GCStats -> ([(T.Text, Json)], [(T.Text, Json)])
-> ([(T.Text, Json)], [(T.Text, Json)]) partitionGcStats (Stats.GCStats {..}) = (counters, gauges)
partitionGcStats Nothing = ([], [])
partitionGcStats (Just (Stats.GCStats {..})) = (counters, gauges)
where where
counters = [ counters = [
("bytes_allocated" , Json bytesAllocated) ("bytes_allocated" , Json bytesAllocated)
Expand Down

0 comments on commit d1e8628

Please sign in to comment.