diff --git a/System/Remote/Counter.hs b/System/Remote/Counter.hs --- a/System/Remote/Counter.hs +++ b/System/Remote/Counter.hs @@ -1,14 +1,13 @@ {-# LANGUAGE BangPatterns #-} -- | This module defines a type for mutable, integer-valued counters. --- All operations on counters are thread-safe. +-- Counters are non-negative, monotonically increasing values and can +-- be used to track e.g. the number of requests served since program +-- start. All operations on counters are thread-safe. module System.Remote.Counter ( Counter , inc - , dec , add - , subtract - , set ) where import Data.IORef (atomicModifyIORef) @@ -22,24 +21,8 @@ !_ <- atomicModifyIORef ref $ \ n -> let n' = n + 1 in (n', n') return () --- | Decrease the counter by one. -dec :: Counter -> IO () -dec (C ref) = do - !_ <- atomicModifyIORef ref $ \ n -> let n' = n - 1 in (n', n') - return () - -- | Increase the counter by the given amount. add :: Counter -> Int -> IO () add (C ref) i = do !_ <- atomicModifyIORef ref $ \ n -> let n' = n + i in (n', n') return () - --- | Decrease the counter by the given amount. -subtract :: Counter -> Int -> IO () -subtract (C ref) i = do - !_ <- atomicModifyIORef ref $ \ n -> let n' = n - i in (n', n') - return () - --- | Set the counter to the given value. -set :: Counter -> Int -> IO () -set (C ref) !i = atomicModifyIORef ref $ \ _ -> (i, ()) diff --git a/System/Remote/Gauge.hs b/System/Remote/Gauge.hs new file mode 100644 --- /dev/null +++ b/System/Remote/Gauge.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE BangPatterns #-} +-- | This module defines a type for mutable, integer-valued gauges. +-- Gauges are variable values and can be used to track e.g. the +-- current number of concurrent connections. All operations on gauges +-- are thread-safe. +module System.Remote.Gauge + ( + Gauge + , inc + , dec + , add + , subtract + , set + , modify + ) where + +import Data.IORef (atomicModifyIORef) +import Prelude hiding (subtract) + +import System.Remote.Gauge.Internal + +-- | Increase the gauge by one. +inc :: Gauge -> IO () +inc (C ref) = do + !_ <- atomicModifyIORef ref $ \ n -> let n' = n + 1 in (n', n') + return () + +-- | Decrease the gauge by one. +dec :: Gauge -> IO () +dec (C ref) = do + !_ <- atomicModifyIORef ref $ \ n -> let n' = n - 1 in (n', n') + return () + +-- | Increase the gauge by the given amount. +add :: Gauge -> Int -> IO () +add (C ref) i = do + !_ <- atomicModifyIORef ref $ \ n -> let n' = n + i in (n', n') + return () + +-- | Decrease the gauge by the given amount. +subtract :: Gauge -> Int -> IO () +subtract (C ref) i = do + !_ <- atomicModifyIORef ref $ \ n -> let n' = n - i in (n', n') + return () + +-- | Set the gauge to the given value. +set :: Gauge -> Int -> IO () +set (C ref) !i = atomicModifyIORef ref $ \ _ -> (i, ()) + +-- | Set the gauge to the result of applying the given function to the +-- value. +modify :: (Int -> Int) -> Gauge -> IO () +modify f (C ref) = do + !_ <- atomicModifyIORef ref $ \ i -> let i' = f i in (i', i') + return () diff --git a/System/Remote/Gauge/Internal.hs b/System/Remote/Gauge/Internal.hs new file mode 100644 --- /dev/null +++ b/System/Remote/Gauge/Internal.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_HADDOCK not-home #-} +module System.Remote.Gauge.Internal + ( + Gauge(..) + , new + , read + ) where + +import Data.IORef (IORef, newIORef, readIORef) +import Prelude hiding (read) + +-- | A mutable, integer-valued gauge. +newtype Gauge = C { unC :: IORef Int } + +-- | Create a new, zero initialized, gauge. +new :: IO Gauge +new = C `fmap` newIORef 0 + +read :: Gauge -> IO Int +read = readIORef . unC diff --git a/System/Remote/Monitoring.hs b/System/Remote/Monitoring.hs --- a/System/Remote/Monitoring.hs +++ b/System/Remote/Monitoring.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE ExistentialQuantification, OverloadedStrings, RecordWildCards #-} -- | This module provides remote monitoring of a running process over -- HTTP. It can be used to run an HTTP server that provides both a -- web-based user interface and a machine-readable API (e.g. JSON). @@ -29,9 +29,10 @@ , serverThreadId , forkServer - -- * User-defined counters - -- $counters + -- * User-defined counters and gauges + -- $userdefined , getCounter + , getGauge ) where import Control.Applicative ((<$>), (<|>)) @@ -51,9 +52,11 @@ import Data.Maybe (listToMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word8) import qualified GHC.Stats as Stats import Paths_ekg (getDataDir) +import Prelude hiding (read) import Snap.Core (MonadSnap, Request, Snap, finishWith, getHeaders, getRequest, getResponse, method, Method(GET), modifyResponse, pass, route, rqParams, rqPathInfo, setContentType, setResponseStatus, @@ -65,6 +68,8 @@ import System.Remote.Counter (Counter) import qualified System.Remote.Counter.Internal as Counter +import System.Remote.Gauge (Gauge) +import qualified System.Remote.Gauge.Internal as Gauge -- $configuration -- @@ -82,20 +87,45 @@ -- leave it enabled. -- $api --- To use the machine-readable REST API, send an GET request to the --- host and port passed to 'forkServer' and set the Accept header to --- \"application\/json\". +-- To use the machine-readable REST API, send an HTTP GET request to +-- the host and port passed to 'forkServer'. The following resources +-- (i.e. URLs) are available: -- --- The server returns a JSON object with one attribute per --- user-defined counter (created using 'getCounter'). In addition, --- the object includes the following attributes: +-- [\/] JSON object containing all counters and gauges. Counters and +-- gauges are stored as nested objects under the @counters@ and +-- @gauges@ attributes, respectively. Content types: \"text\/html\" +-- (default), \"application\/json\" -- +-- [\/combined] Flattened JSON object containing all counters and +-- gauges. Content types: \"application\/json\" +-- +-- [\/counters] JSON object containing all counters. Content types: +-- \"application\/json\" +-- +-- [\/counters/\] Value of a single counter, as a +-- string. The name should be UTF-8 encoded. Content types: +-- \"text\/plain\" +-- +-- [\/gauges] JSON object containing all gauges. Content types: +-- \"application\/json\" +-- +-- [\/gauges/\] Value of a single gauge, as a string. +-- The name should be UTF-8 encoded. Content types: \"text\/plain\" +-- +-- Counters and gauges are stored as attributes of the returned JSON +-- objects, one attribute per counter or gauge. In addition to +-- user-defined counters and gauges, the below built-in counters and +-- gauges are also returned. Furthermore, the top-level JSON object +-- of any resource contains the @server_timestamp_millis@ attribute, +-- which indicates the server time, in milliseconds, when the sample +-- was taken. +-- +-- Built-in counters: +-- -- [@bytes_allocated@] Total number of bytes allocated -- -- [@num_gcs@] Number of garbage collections performed -- --- [@max_bytes_used@] Maximum number of live bytes seen so far --- -- [@num_bytes_usage_samples@] Number of byte usage samples taken -- -- [@cumulative_bytes_used@] Sum of all byte usage samples, can be @@ -105,14 +135,6 @@ -- -- [@bytes_copied@] Number of bytes copied during GC -- --- [@current_bytes_used@] Current number of live bytes --- --- [@current_bytes_slop@] Current number of bytes lost to slop --- --- [@max_bytes_slop@] Maximum number of bytes lost to slop at any one time so far --- --- [@peak_megabytes_allocated@] Maximum number of megabytes allocated --- -- [@mutator_cpu_seconds@] CPU time spent running mutator threads. -- This does not include any profiling overhead or initialization. -- @@ -127,6 +149,18 @@ -- -- [@wall_seconds@] Total wall clock time elapsed since start -- +-- Built-in gauges: +-- +-- [@max_bytes_used@] Maximum number of live bytes seen so far +-- +-- [@current_bytes_used@] Current number of live bytes +-- +-- [@current_bytes_slop@] Current number of bytes lost to slop +-- +-- [@max_bytes_slop@] Maximum number of bytes lost to slop at any one time so far +-- +-- [@peak_megabytes_allocated@] Maximum number of megabytes allocated +-- -- [@par_avg_bytes_copied@] Number of bytes copied during GC, minus -- space held by mutable lists held by the capabilities. Can be used -- with 'parMaxBytesCopied' to determine how well parallel GC utilized @@ -137,16 +171,6 @@ -- 'parAvgBytesCopied' divided by 'parMaxBytesCopied' approaches 1 for -- a maximally sequential run and approaches the number of threads -- (set by the RTS flag @-N@) for a maximally parallel run. --- --- It's possible to retrieve individual counters by --- --- * appending the counter name to the URL (e.g. \"/my_counter\"), and --- --- * setting the Accept header to \"text\/plain\". --- --- The reason that single counters cannot be returned as JSON is that --- JSON doesn't allow for certain values (e.g. integers) to occur at --- the top-level. ------------------------------------------------------------------------ -- * The monitoring server @@ -154,11 +178,15 @@ -- Map of user-defined counters. type Counters = M.HashMap T.Text Counter +-- Map of user-defined gauges. +type Gauges = M.HashMap T.Text Gauge + -- | A handle that can be used to control the monitoring server. -- Created by 'forkServer'. data Server = Server { threadId :: {-# UNPACK #-} !ThreadId , userCounters :: !(IORef Counters) + , userGauges :: !(IORef Gauges) } -- | The thread ID of the server. You can kill the server by killing @@ -171,15 +199,17 @@ -- either a numeric network address (dotted quad for IPv4, -- colon-separated hex for IPv6) or a hostname (e.g. \"localhost\"). -- The client can control the Content-Type used in responses by --- setting the Accept header. At the moment two content types are --- available: \"application\/json\" and \"text\/html\". +-- setting the Accept header. At the moment three content types are +-- available: \"application\/json\", \"text\/html\", and +-- \"text\/plain\". forkServer :: S.ByteString -- ^ Host to listen on (e.g. \"localhost\") -> Int -- ^ Port to listen on (e.g. 8000) -> IO Server forkServer host port = do counters <- newIORef M.empty - tid <- forkIO $ httpServe conf (monitor counters) - return $! Server tid counters + gauges <- newIORef M.empty + tid <- forkIO $ httpServe conf (monitor counters gauges) + return $! Server tid counters gauges where conf = Config.setVerbose False $ Config.setErrorLog Config.ConfigNoLog $ Config.setAccessLog Config.ConfigNoLog $ @@ -188,17 +218,25 @@ Config.defaultConfig ------------------------------------------------------------------------ --- * User-defined counters +-- * User-defined counters and gauges --- $counters +-- $userdefined -- The monitoring server can store and serve user-defined, --- integer-valued counters. Each counter is associated with a name, --- which is used when the counter is displayed in the UI or returned --- in a JSON object. +-- integer-valued counters and gauges. A counter is a monotonically +-- increasing value (e.g. TCP connections established since program +-- start). A gauge is a variable value (e.g. the current number of +-- concurrent connections.) Each counter or gauge is associated with +-- a name, which is used when the counter or gauge is displayed in the +-- UI or returned in a JSON object. -- +-- Even though it's technically possible to have a counter and a gauge +-- with the same name, associated with the same server, it's not +-- recommended as it might make it harder for clients to distinguish +-- the two. +-- -- To create and use a counter, simply call 'getCounter' to create it --- and then call e.g. 'Counter.inc' or 'Counter.add' to modify its --- value. Example: +-- and then call e.g. 'System.Remote.Counter.inc' or +-- 'System.Remote.Counter.add' to modify its value. Example: -- -- > main = do -- > handle <- forkServer "localhost" 8000 @@ -207,7 +245,40 @@ -- > inc counter -- > loop -- > loop +-- +-- To create a guage, use 'getGauge' instead of 'getCounter' and then +-- call e.g. 'System.Remote.Gauge.set' or +-- 'System.Remote.Gauge.modify'. +class Ref r where + new :: IO r + read :: r -> IO Int + +instance Ref Counter where + new = Counter.new + read = Counter.read + +instance Ref Gauge where + new = Gauge.new + read = Gauge.read + +-- | Lookup a 'Ref' by name in the given map. If no 'Ref' exists +-- under the given name, create a new one, insert it into the map and +-- return it. +getRef :: Ref r + => T.Text -- ^ 'Ref' name + -> IORef (M.HashMap T.Text r) -- ^ Server that will serve the 'Ref' + -> IO r +getRef name mapRef = do + empty <- new + ref <- atomicModifyIORef mapRef $ \ m -> + case M.lookup name m of + Nothing -> let m' = M.insert name empty m + in (m', empty) + Just ref -> (m, ref) + return ref +{-# INLINABLE getRef #-} + -- | Return the counter associated with the given name and server. -- Multiple calls to 'getCounter' with the same arguments will return -- the same counter. The first time 'getCounter' is called for a @@ -216,25 +287,45 @@ getCounter :: T.Text -- ^ Counter name -> Server -- ^ Server that will serve the counter -> IO Counter -getCounter name server = do - emptyCounter <- Counter.new - counter <- atomicModifyIORef (userCounters server) $ \ m -> - case M.lookup name m of - Nothing -> let m' = M.insert name emptyCounter m - in (m', emptyCounter) - Just counter -> (m, counter) - return counter +getCounter name server = getRef name (userCounters server) +-- | Return the gauge associated with the given name and server. +-- Multiple calls to 'getGauge' with the same arguments will return +-- the same gauge. The first time 'getGauge' is called for a given +-- name and server, a new, zero-initialized gauge will be returned. +getGauge :: T.Text -- ^ Gauge name + -> Server -- ^ Server that will serve the gauge + -> IO Gauge +getGauge name server = getRef name (userGauges server) + ------------------------------------------------------------------------ -- * JSON serialization --- 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). -data Stats = Stats !Stats.GCStats ![(T.Text, Int)] +data Stats = Stats + !Stats.GCStats -- GC statistics + ![(T.Text, Json)] -- Counters + ![(T.Text, Json)] -- Gauges + {-# UNPACK #-} !Double -- Milliseconds since epoch instance A.ToJSON Stats where - toJSON (Stats (Stats.GCStats {..}) cs) = A.object $ - [ "bytes_allocated" .= bytesAllocated + toJSON (Stats gcStats@(Stats.GCStats {..}) counters gauges t) = A.object $ + [ "server_timestamp_millis" .= t + , "counters" .= Assocs (gcCounters ++ counters) + , "gauges" .= Assocs (gcGauges ++ gauges) + ] + where + (gcCounters, gcGauges) = partitionGcStats gcStats + +-- | 'Stats' encoded as a flattened JSON object. +newtype Combined = Combined Stats + +instance A.ToJSON Combined where + toJSON (Combined (Stats (Stats.GCStats {..}) counters gauges t)) = + A.object $ + [ "server_timestamp_millis" .= t + , "bytes_allocated" .= bytesAllocated , "num_gcs" .= numGcs , "max_bytes_used" .= maxBytesUsed , "num_bytes_usage_samples" .= numByteUsageSamples @@ -252,18 +343,45 @@ , "wall_seconds" .= wallSeconds , "par_avg_bytes_copied" .= parAvgBytesCopied , "par_max_bytes_copied" .= parMaxBytesCopied - ] ++ map (\ (k, v) -> k .= v) cs + ] ++ map (uncurry (.=)) counters ++ + map (uncurry (.=)) gauges +-- | A list of string keys and JSON-encodable values. Used to render +-- a list of key-value pairs as a JSON object. +newtype Assocs = Assocs [(T.Text, Json)] + +instance A.ToJSON Assocs where + toJSON (Assocs xs) = A.object $ map (uncurry (.=)) xs + +-- | A group of either counters or gauges. +data Group = Group + ![(T.Text, Json)] + {-# UNPACK #-} !Double -- Milliseconds since epoch + +instance A.ToJSON Group where + toJSON (Group xs t) = + A.object $ ("server_timestamp_millis" .= t) : map (uncurry (.=)) xs + ------------------------------------------------------------------------ -- * HTTP request handler -- | A handler that can be installed into an existing Snap application. -monitor :: IORef Counters -> Snap () -monitor counters = do +monitor :: IORef Counters -> IORef Gauges -> Snap () +monitor counters gauges = do dataDir <- liftIO getDataDir route [ - ("/", method GET (format "application/json" (serveAll counters))) - , ("/:counter", method GET (format "text/plain" (serveOne counters))) + ("", method GET (format "application/json" + (serveAll counters gauges))) + , ("combined", method GET (format "application/json" + (serveCombined counters gauges))) + , ("counters", method GET (format "application/json" + (serveMany counters))) + , ("counters/:name", method GET (format "text/plain" + (serveOne counters))) + , ("gauges", method GET (format "application/json" + (serveMany gauges))) + , ("gauges/:name", method GET (format "text/plain" + (serveOne gauges))) ] <|> serveDirectory (dataDir "assets") @@ -281,9 +399,29 @@ Just hdr | hdr == fmt -> action _ -> pass --- | Serve all counters, as a JSON object. -serveAll :: IORef Counters -> Snap () -serveAll counters = do +-- | Get a snapshot of all values. Note that we're not guaranteed to +-- see a consistent snapshot of the whole map. +readAllRefs :: Ref r => IORef (M.HashMap T.Text r) -> IO [(T.Text, Json)] +readAllRefs mapRef = do + m <- readIORef mapRef + forM (M.toList m) $ \ (name, ref) -> do + val <- read ref + return (name, Json val) +{-# INLINABLE readAllRefs #-} + +-- | Serve a collection of counters or gauges, as a JSON object. +serveMany :: Ref r => IORef (M.HashMap T.Text r) -> Snap () +serveMany mapRef = do + list <- liftIO $ readAllRefs mapRef + modifyResponse $ setContentType "application/json" + time <- liftIO getTimeMillis + writeLBS $ A.encode $ A.toJSON $ Group list time +{-# INLINABLE serveMany #-} + +-- | Serve all counter and gauges, built-in or not, as a nested JSON +-- object. +serveAll :: IORef Counters -> IORef Gauges -> Snap () +serveAll counters gauges = do req <- getRequest -- Workaround: Snap still matches requests to /foo to this handler -- if the Accept header is "application/json", even though such @@ -291,35 +429,39 @@ unless (S.null $ rqPathInfo req) pass modifyResponse $ setContentType "application/json" gcStats <- liftIO Stats.getGCStats - counterList <- liftIO readAllCounters - writeLBS $ A.encode $ A.toJSON $ Stats gcStats counterList - where - -- Get a snapshot of all counter values. Note that we're not - -- guaranteed to see a consistent snapshot if we consider more - -- than one counter at once. - readAllCounters :: IO [(T.Text, Int)] - readAllCounters = do - m <- readIORef counters - forM (M.toList m) $ \ (name, ref) -> do - val <- Counter.read ref - return (name, val) + counterList <- liftIO $ readAllRefs counters + gaugeList <- liftIO $ readAllRefs gauges + time <- liftIO getTimeMillis + writeLBS $ A.encode $ A.toJSON $ Stats gcStats counterList gaugeList time +-- | Serve all counters and gauges, built-in or not, as a flattened +-- JSON object. +serveCombined :: IORef Counters -> IORef Gauges -> Snap () +serveCombined counters gauges = do + modifyResponse $ setContentType "application/json" + gcStats <- liftIO Stats.getGCStats + counterList <- liftIO $ readAllRefs counters + gaugeList <- liftIO $ readAllRefs gauges + time <- liftIO getTimeMillis + writeLBS $ A.encode $ A.toJSON $ Combined $ + Stats gcStats counterList gaugeList time + -- | Serve a single counter, as plain text. -serveOne :: IORef Counters -> Snap () -serveOne counters = do +serveOne :: Ref r => IORef (M.HashMap T.Text r) -> Snap () +serveOne refs = do modifyResponse $ setContentType "text/plain" - m <- liftIO $ readIORef counters + m <- liftIO $ readIORef refs req <- getRequest let mname = T.decodeUtf8 <$> join - (listToMaybe <$> Map.lookup "counter" (rqParams req)) + (listToMaybe <$> Map.lookup "name" (rqParams req)) case mname of Nothing -> pass Just name -> case M.lookup name m of Just counter -> do - val <- liftIO $ Counter.read counter + val <- liftIO $ read counter writeBS $ S8.pack $ show val Nothing -> - -- Try built-in (e.g. GC) counters + -- Try built-in (e.g. GC) refs case Map.lookup name builtinCounters of Just f -> do gcStats <- liftIO Stats.getGCStats @@ -328,6 +470,7 @@ modifyResponse $ setResponseStatus 404 "Not Found" r <- getResponse finishWith r +{-# INLINABLE serveOne #-} -- | A list of all built-in (e.g. GC) counters, together with a -- pretty-printing function for each. @@ -353,6 +496,40 @@ , ("par_max_bytes_copied" , show . Stats.parMaxBytesCopied) ] +-- Existential wrapper used for OO-style polymorphism. +data Json = forall a. A.ToJSON a => Json a + +instance A.ToJSON Json where + toJSON (Json x) = A.toJSON x + +-- | Partition GC statistics into counters and gauges. +partitionGcStats :: Stats.GCStats + -> ([(T.Text, Json)], [(T.Text, Json)]) +partitionGcStats (Stats.GCStats {..}) = (counters, gauges) + where + counters = [ + ("bytes_allocated" , Json bytesAllocated) + , ("num_gcs" , Json numGcs) + , ("num_bytes_usage_samples" , Json numByteUsageSamples) + , ("cumulative_bytes_used" , Json cumulativeBytesUsed) + , ("bytes_copied" , Json bytesCopied) + , ("mutator_cpu_seconds" , Json mutatorCpuSeconds) + , ("mutator_wall_seconds" , Json mutatorWallSeconds) + , ("gc_cpu_seconds" , Json gcCpuSeconds) + , ("gc_wall_seconds" , Json gcWallSeconds) + , ("cpu_seconds" , Json cpuSeconds) + , ("wall_seconds" , Json wallSeconds) + ] + gauges = [ + ("max_bytes_used" , Json maxBytesUsed) + , ("current_bytes_used" , Json currentBytesUsed) + , ("current_bytes_slop" , Json currentBytesSlop) + , ("max_bytes_slop" , Json maxBytesSlop) + , ("peak_megabytes_allocated" , Json peakMegabytesAllocated) + , ("par_avg_bytes_copied" , Json parAvgBytesCopied) + , ("par_max_bytes_copied" , Json parMaxBytesCopied) + ] + ------------------------------------------------------------------------ -- Utilities for working with accept headers @@ -378,3 +555,10 @@ breakDiscard w s = let (x, y) = S.break (== w) s in (x, S.drop 1 y) + +------------------------------------------------------------------------ +-- Utilities for working with timestamps + +-- | Return the number of milliseconds since epoch. +getTimeMillis :: IO Double +getTimeMillis = (realToFrac . (* 1000)) `fmap` getPOSIXTime diff --git a/assets/cross-16-ns.png b/assets/cross-16-ns.png new file mode 100644 Binary files /dev/null and b/assets/cross-16-ns.png differ diff --git a/assets/dialog_close.png b/assets/dialog_close.png new file mode 100644 Binary files /dev/null and b/assets/dialog_close.png differ diff --git a/assets/graph-icon.png b/assets/graph-icon.png new file mode 100644 Binary files /dev/null and b/assets/graph-icon.png differ diff --git a/assets/index.html b/assets/index.html --- a/assets/index.html +++ b/assets/index.html @@ -8,7 +8,7 @@ - ekg-0.2.0.0 + ekg-0.3.0.0
@@ -24,27 +24,44 @@ |
- ekg-0.2.0.0 + ekg-0.3.0.0
-
-

Current residency

-
+ -

Allocation rate

-
+
+ +
+

Current residency

+
+
+ +
+

Allocation rate

+
+
-

Productivity

-
+
+

Productivity

+
+
-

GC Stats

+

GC and memory statistics

+ + + + + + - + @@ -76,6 +93,24 @@

Counters

StatisticValue
Maximum residencyMaximum residency 0
+ + + + + + + + +
NameValue
+ +

Gauges

+ + + + + + +
NameValue
diff --git a/assets/monitor.css b/assets/monitor.css --- a/assets/monitor.css +++ b/assets/monitor.css @@ -47,6 +47,22 @@ } /** + * Message box + * + * Taken from: http://woork.blogspot.com/2008/03/css-message-box-collection.html + */ + +.icon-alert { + border: solid 1px #CB2026; + background: #F6CBCA url(cross-16-ns.png) 8px 6px no-repeat; + color: #D0282A; + padding: 4px 0; + text-align: center; + font-weight: bold; + margin-bottom: 10px; +} + +/** * Plots */ @@ -56,10 +72,20 @@ margin-bottom: 1.5em; } +.close-button { + float: right; + cursor: pointer; +} + /** * Table */ .value { text-align: right; +} + +.graph-button { + cursor: pointer; + vertical-align: middle; } diff --git a/assets/monitor.js b/assets/monitor.js --- a/assets/monitor.js +++ b/assets/monitor.js @@ -1,33 +1,52 @@ -$(function () { +$(document).ready(function () { + "use strict"; + // Number formatters - function formatSuffix(val, prec) { - if (val == null) - return "N/A" + function commaify(n) + { + var nStr = n.toString(); + var x = nStr.split('.'); + var x1 = x[0]; + var x2 = x.length > 1 ? '.' + x[1] : ''; + var rgx = /(\d+)(\d{3})/; + while (rgx.test(x1)) { + x1 = x1.replace(rgx, '$1' + ',' + '$2'); + } + return x1 + x2; + } - var prec = prec || 1; - if (val >= 1000000000) + function formatSuffix(val, opt_prec) { + if (val === null) { + return "N/A"; + } + + var prec = opt_prec || 1; + if (val >= 1000000000) { return (val / 1000000000).toFixed(prec) + " GB"; - else if (val >= 1000000) + } else if (val >= 1000000) { return (val / 1000000).toFixed(prec) + " MB"; - else if (val >= 1000) + } else if (val >= 1000) { return (val / 1000).toFixed(prec) + " kB"; - else + } else { return val.toFixed(prec) + " B"; + } } function formatRate(val, prec) { - if (val == null) - return "N/A" + if (val === null) { + return "N/A"; + } return formatSuffix(val, prec) + "/s"; } - function formatPercent(val, prec) { - if (val == null) - return "N/A" + function formatPercent(val, opt_prec) { + if (val === null) { + return "N/A"; + } - var prec = prec || 1; - return val.toFixed(prec) + " %" + var prec = opt_prec || 1; + return val.toFixed(prec) + " %"; } // Set up polling interval control @@ -38,7 +57,7 @@ // Allow the UI to be paused var paused = false; - $('#pause-ui').click(function() { + $('#pause-ui').click(function () { if (paused) { $(this).text("Pause UI"); paused = false; @@ -53,6 +72,18 @@ return formatSuffix(val, axis.tickDecimals); } + function suffixFormatterGeneric(val, axis) { + if (val >= 1000000000) { + return (val / 1000000000).toFixed(axis.tickDecimals) + " G"; + } else if (val >= 1000000) { + return (val / 1000000).toFixed(axis.tickDecimals) + " M"; + } else if (val >= 1000) { + return (val / 1000).toFixed(axis.tickDecimals) + " k"; + } else { + return val.toFixed(axis.tickDecimals); + } + } + function rateFormatter(val, axis) { return formatRate(val, axis.tickDecimals); } @@ -63,19 +94,38 @@ // Fetch data periodically and notify interested parties. var listeners = []; - var fetchData = function() { + + function subscribe(fn) { + listeners.push(fn); + } + + function unsubscribe(fn) { + listeners = listeners.filter(function (el) { + if (el !== fn) { + return el; + } + }); + } + + function fetchData() { function onDataReceived(stats) { - var now = new Date().getTime(); - for(var i = 0; i < listeners.length; i++) - listeners[i](stats, now); + $("#message-box").hide(); + for (var i = 0; i < listeners.length; i++) { + listeners[i](stats, stats.server_timestamp_millis); + } } - + + function onError() { + $("#message-box").show(); + } + $.ajax({ dataType: 'json', success: onDataReceived, + error: onError, cache: false }); - + setTimeout(fetchData, updateInterval); }; fetchData(); @@ -88,26 +138,28 @@ var options = $.extend(true, {}, defaultOptions, opts) var data = new Array(series.length); var maxPoints = 60; - for(var i = 0; i < series.length; i++) + for(var i = 0; i < series.length; i++) { data[i] = []; + } var plot = $.plot(elem, [], options); var prev_stats, prev_time; function onDataReceived(stats, time) { for(var i = 0; i < series.length; i++) { - if (data[i].length >= maxPoints) + if (data[i].length >= maxPoints) { data[i] = data[i].slice(1); - + } + data[i].push([time, series[i].fn(stats, time, prev_stats, prev_time)]); } - + // zip lengends with data - res = [] + var res = [] for(var i = 0; i < series.length; i++) res.push({ label: series[i].label, data: data[i] }); - + if (!paused) { plot.setData(res); plot.setupGrid(); @@ -116,8 +168,9 @@ prev_stats = stats; prev_time = time; } - - listeners.push(onDataReceived); + + subscribe(onDataReceived); + return onDataReceived; } function addCounter(elem, fn, formatter) { @@ -128,69 +181,122 @@ prev_stats = stats; prev_time = time; } - - listeners.push(onDataReceived); + + subscribe(onDataReceived); } - function addDynamicCounters() { + function addDynamicPlot(key, button, graph_fn, label_fn) { + function getStats(stats, time, prev_stats, prev_time) { + return graph_fn(key, stats, time, prev_stats, prev_time); + } + + $("#plots:last").append( + '
' + + '

' + key + + '

'); + var plot = $("#plots > .plot-container:last > div"); + var observer = addPlot(plot, + [{ label: label_fn(key), fn: getStats }], + { yaxis: { tickFormatter: suffixFormatterGeneric } }); + + var plotContainer = $("#" + key + "-plot"); + var closeButton = plotContainer.find("img"); + closeButton.hide(); + closeButton.click(function () { + plotContainer.remove(); + button.show(); + unsubscribe(observer); + }); + + plotContainer.hover( + function () { + closeButton.show(); + }, + function () { + closeButton.hide(); + } + ); + } + + function addDynamicCounters(table, group_fn, graph_fn, label_fn) { var counters = {}; function onDataReceived(stats, time) { - $.each(stats, function(key, value) { + $.each(group_fn(stats), function (key, value) { var elem; if (key in counters) { elem = counters[key]; } else { // Add UI element - $("#counter-table > tbody:last").append( - '' + key + 'N/A'); - elem = $("#counter-table > tbody > tr > td:last"); + table.find("tbody:last").append( + '' + key + + ' Add graph' + + 'N/A'); + elem = table.find("tbody > tr > td:last"); counters[key] = elem; + + var button = table.find("tbody > tr:last > td:first > img"); + button.click(function () { + addDynamicPlot(key, button, graph_fn, label_fn); + $(this).hide(); + }); } if (!paused) - elem.text(value); + elem.text(commaify(value)); }); } - listeners.push(onDataReceived); + subscribe(onDataReceived); } - $(document).ready(function() { + function initAll() { // Metrics - var current_bytes_used = function(stats) { return stats.current_bytes_used }; - var max_bytes_used = function(stats) { return stats.max_bytes_used }; - var max_bytes_slop = function(stats) { return stats.max_bytes_slop }; - var current_bytes_slop = function(stats) { return stats.current_bytes_slop }; - var productivity_wall_percent = function(stats, time, prev_stats, prev_time) { + var current_bytes_used = function (stats) { + return stats.gauges.current_bytes_used; + }; + var max_bytes_used = function (stats) { + return stats.gauges.max_bytes_used; + }; + var max_bytes_slop = function (stats) { + return stats.gauges.max_bytes_slop; + }; + var current_bytes_slop = function (stats) { + return stats.gauges.current_bytes_slop; + }; + var productivity_wall_percent = function (stats, time, prev_stats, prev_time) { if (prev_stats == undefined) return null; - var mutator_seconds = stats.mutator_wall_seconds - - prev_stats.mutator_wall_seconds; - var gc_seconds = stats.gc_wall_seconds - prev_stats.gc_wall_seconds; + var mutator_seconds = stats.counters.mutator_wall_seconds - + prev_stats.counters.mutator_wall_seconds; + var gc_seconds = stats.counters.gc_wall_seconds - + prev_stats.counters.gc_wall_seconds; return 100 * mutator_seconds / (mutator_seconds + gc_seconds); } - var productivity_cpu_percent = function(stats, time, prev_stats, prev_time) { + var productivity_cpu_percent = function (stats, time, prev_stats, prev_time) { if (prev_stats == undefined) return null; - var mutator_seconds = stats.mutator_cpu_seconds - - prev_stats.mutator_cpu_seconds; - var gc_seconds = stats.gc_cpu_seconds - prev_stats.gc_cpu_seconds; + var mutator_seconds = stats.counters.mutator_cpu_seconds - + prev_stats.counters.mutator_cpu_seconds; + var gc_seconds = stats.counters.gc_cpu_seconds - + prev_stats.counters.gc_cpu_seconds; return 100 * mutator_seconds / (mutator_seconds + gc_seconds); } - var allocation_rate = function(stats, time, prev_stats, prev_time) { + var allocation_rate = function (stats, time, prev_stats, prev_time) { if (prev_stats == undefined) return null; - return 1000 * (stats.bytes_allocated - prev_stats.bytes_allocated) / + return 1000 * (stats.counters.bytes_allocated - + prev_stats.counters.bytes_allocated) / (time - prev_time); } // Plots - addPlot($("#current-bytes-used-plot"), + addPlot($("#current-bytes-used-plot > div"), [{ label: "residency", fn: current_bytes_used }], { yaxis: { tickFormatter: suffixFormatter } }); - addPlot($("#allocation-rate-plot"), + addPlot($("#allocation-rate-plot > div"), [{ label: "rate", fn: allocation_rate }], { yaxis: { tickFormatter: rateFormatter } }); - addPlot($("#productivity-plot"), + addPlot($("#productivity-plot > div"), [{ label: "wall clock time", fn: productivity_wall_percent }, { label: "cpu time", fn: productivity_cpu_percent }], { yaxis: { tickDecimals: 1, tickFormatter: percentFormatter } }); @@ -204,6 +310,25 @@ addCounter($("#productivity-cpu"), productivity_cpu_percent, formatPercent) addCounter($("#allocation-rate"), allocation_rate, formatRate) - addDynamicCounters(); - }); + addDynamicCounters($("#counter-table"), function (stats) { + return stats.counters; + }, function (key, stats, time, prev_stats, prev_time) { + if (prev_stats == undefined) + return null; + return 1000 * (stats.counters[key] - prev_stats.counters[key]) / + (time - prev_time); + }, function (label) { + return label + "/s"; + }); + + addDynamicCounters($("#gauge-table"), function (stats) { + return stats.gauges; + }, function (key, stats, time) { + return stats.gauges[key]; + }, function (label) { + return label; + }); + } + + initAll(); }); diff --git a/ekg.cabal b/ekg.cabal --- a/ekg.cabal +++ b/ekg.cabal @@ -1,5 +1,5 @@ name: ekg -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Remote monitoring of processes description: This library lets you remotely monitor a running process over HTTP. @@ -16,14 +16,17 @@ data-files: assets/index.html assets/monitor.js assets/monitor.css assets/jquery.flot.min.js assets/blueprint/screen.css assets/blueprint/print.css assets/blueprint/ie.css - examples/Basic.hs + assets/dialog_close.png assets/graph-icon.png + assets/cross-16-ns.png library exposed-modules: System.Remote.Counter + System.Remote.Gauge System.Remote.Monitoring other-modules: Paths_ekg System.Remote.Counter.Internal + System.Remote.Gauge.Internal build-depends: aeson < 0.6, base >= 4.5 && < 5, @@ -33,6 +36,7 @@ snap-core < 0.8, snap-server < 0.8, text < 0.12, + time < 1.5, transformers < 0.3, unordered-containers < 0.2 ghc-options: -Wall diff --git a/examples/Basic.hs b/examples/Basic.hs deleted file mode 100644 --- a/examples/Basic.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | Example program that continously computes the mean of a list of --- numbers. -module Main where - -import Control.Concurrent -import Control.Exception -import qualified System.Remote.Counter as Counter -import System.Remote.Monitoring - -mean :: Fractional a => [a] -> a -mean xs = sum xs / fromIntegral (length xs) - -main :: IO () -main = do - handle <- forkServer "localhost" 8000 - counter <- getCounter "iterations" handle - let loop n = do - evaluate $ mean [1..n] - threadDelay 2000 - Counter.inc counter - loop n - loop 1000000