{-# LANGUAGE CPP, OverloadedStrings #-} -- | 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.) -- The former can be used by a human to get an overview of what the -- program is doing and the latter can be used by automated monitoring -- tools. -- -- Typical usage is to start the monitoring server at program startup -- -- > main = do -- > forkServer "localhost" 8000 -- > ... -- -- and then periodically check the stats using a web browser or a -- command line tool (e.g. curl) -- -- > $ curl -H "Accept: application/json" http://localhost:8000/ module System.Remote.Monitoring ( -- * Required configuration -- $configuration -- * Security considerations -- $security -- * REST API -- $api -- * The monitoring server Server , serverThreadId , serverMetricStore , forkServer , forkServerWith -- * Defining metrics -- $userdefined , getCounter , getGauge , getLabel , getDistribution ) where import Control.Concurrent (ThreadId, myThreadId, throwTo) import Control.Exception (AsyncException(ThreadKilled), fromException) import qualified Data.ByteString as S import Data.Int (Int64) import qualified Data.Text as T import Data.Time.Clock.POSIX (getPOSIXTime) import Prelude hiding (read) import qualified System.Metrics as Metrics import qualified System.Metrics.Counter as Counter import qualified System.Metrics.Distribution as Distribution import qualified System.Metrics.Gauge as Gauge import qualified System.Metrics.Label as Label import System.Remote.Snap import Network.Socket (withSocketsDo) #if __GLASGOW_HASKELL__ >= 706 import Control.Concurrent (forkFinally) #else import Control.Concurrent (forkIO) import Control.Exception (SomeException, mask, try) #endif -- $configuration -- -- To make full use out of this module you must first enable GC -- statistics collection in the run-time system. To enable GC -- statistics collection, either run your program with -- -- > +RTS -T -- -- or compile it with -- -- > -with-rtsopts=-T -- -- The runtime overhead of @-T@ is very small so it's safe to always -- leave it enabled. -- $security -- Be aware that if the server started by 'forkServer' is not bound to -- \"localhost\" (or equivalent) anyone on the network can access the -- monitoring server. Either make sure the network is secure or bind -- the server to \"localhost\". -- $api -- To use the machine-readable REST API, send an HTTP GET request to -- the host and port passed to 'forkServer'. -- -- The API is versioned to allow for API evolution. This document is -- for version 1. To ensure you're using this version, append @?v=1@ -- to your resource URLs. Omitting the version number will give you -- the latest version of the API. -- -- The following resources (i.e. URLs) are available: -- -- [\/] JSON object containing all metrics. Metrics are stored as -- nested objects, with one new object layer per \".\" in the metric -- name (see example below.) Content types: \"text\/html\" (default), -- \"application\/json\" -- -- [\/\<namespace\>/\<metric\>] JSON object for a single metric. The -- metric name is created by converting all \"\/\" to \".\". Example: -- \"\/foo\/bar\" corresponds to the metric \"foo.bar\". Content -- types: \"application\/json\" -- -- Each metric is returned as an object containing a @type@ field. Available types -- are: -- -- * \"c\" - 'Counter.Counter' -- -- * \"g\" - 'Gauge.Gauge' -- -- * \"l\" - 'Label.Label' -- -- * \"d\" - 'Distribution.Distribution' -- -- In addition to the @type@ field, there are metric specific fields: -- -- * Counters, gauges, and labels: the @val@ field contains the -- actual value (i.e. an integer or a string). -- -- * Distributions: the @mean@, @variance@, @count@, @sum@, @min@, -- and @max@ fields contain their statistical equivalents. -- -- Example of a response containing the metrics \"myapp.visitors\" and -- \"myapp.args\": -- -- > { -- > "myapp": { -- > "visitors": { -- > "val": 10, -- > "type": "c" -- > }, -- > "args": { -- > "val": "--a-flag", -- > "type": "l" -- > } -- > } -- > } -- $userdefined -- The monitoring server can store and serve integer-valued counters -- and gauges, string-valued labels, and statistical distributions. 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.) A label is a -- free-form string value (e.g. exporting the command line arguments -- or host name.) A distribution is a statistic summary of events -- (e.g. processing time per request.) Each metric is associated with -- a name, which is used when it is displayed in the UI or returned in -- a JSON object. -- -- Metrics share the same namespace so it's not possible to create -- e.g. a counter and a gauge with the same. Attempting to do so will -- result in an 'error'. -- -- 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: -- -- > main = do -- > handle <- forkServer "localhost" 8000 -- > counter <- getCounter "iterations" handle -- > let loop n = do -- > inc counter -- > loop -- > loop -- -- To create a gauge, use 'getGauge' instead of 'getCounter' and then -- call e.g. 'System.Remote.Gauge.set'. Similar for the other metric -- types. -- -- It's also possible to register metrics directly using the -- @System.Metrics@ module in the ekg-core package. This gives you a -- bit more control over how metric values are retrieved. ------------------------------------------------------------------------ -- * The monitoring server -- | A handle that can be used to control the monitoring server. -- Created by 'forkServer'. data Server = Server { -- | The thread ID of the server. You can kill the server by -- killing this thread (i.e. by throwing it an asynchronous -- exception.) Server -> ThreadId serverThreadId :: {-# UNPACK #-} !ThreadId -- | The metric store associated with the server. If you want to -- add metric to the default store created by 'forkServer' you -- need to use this function to retrieve it. , Server -> Store serverMetricStore :: {-# UNPACK #-} !Metrics.Store } -- | Like 'forkServerWith', but creates a default metric store with -- some predefined metrics. The predefined metrics are those given in -- 'System.Metrics.registerGcMetrics'. forkServer :: S.ByteString -- ^ Host to listen on (e.g. \"localhost\") -> Int -- ^ Port to listen on (e.g. 8000) -> IO Server forkServer :: ByteString -> Int -> IO Server forkServer ByteString host Int port = do Store store <- IO Store Metrics.newStore Store -> IO () Metrics.registerGcMetrics Store store Store -> ByteString -> Int -> IO Server forkServerWith Store store ByteString host Int port -- | Start an HTTP server in a new thread. The server replies to GET -- requests to the given host and port. The host argument can be -- 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\". -- -- Registers the following counter, used by the UI: -- -- [@ekg.server_time_ms@] The server time when the sample was taken, -- in milliseconds. -- -- Note that this function, unlike 'forkServer', doesn't register any -- other predefined metrics. This allows other libraries to create and -- provide a metric store for use with this library. If the metric -- store isn't created by you and the creator doesn't register the -- metrics registered by 'forkServer', you might want to register them -- yourself. forkServerWith :: Metrics.Store -- ^ Metric store -> S.ByteString -- ^ Host to listen on (e.g. \"localhost\") -> Int -- ^ Port to listen on (e.g. 8000) -> IO Server forkServerWith :: Store -> ByteString -> Int -> IO Server forkServerWith Store store ByteString host Int port = do Text -> IO Int64 -> Store -> IO () Metrics.registerCounter Text "ekg.server_timestamp_ms" IO Int64 getTimeMs Store store ThreadId me <- IO ThreadId myThreadId ThreadId tid <- IO ThreadId -> IO ThreadId forall a. IO a -> IO a withSocketsDo (IO ThreadId -> IO ThreadId) -> IO ThreadId -> IO ThreadId forall a b. (a -> b) -> a -> b $ IO () -> (Either SomeException () -> IO ()) -> IO ThreadId forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId forkFinally (Store -> ByteString -> Int -> IO () startServer Store store ByteString host Int port) ((Either SomeException () -> IO ()) -> IO ThreadId) -> (Either SomeException () -> IO ()) -> IO ThreadId forall a b. (a -> b) -> a -> b $ \ Either SomeException () r -> case Either SomeException () r of Right () _ -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () Left SomeException e -> case SomeException -> Maybe AsyncException forall e. Exception e => SomeException -> Maybe e fromException SomeException e of Just AsyncException ThreadKilled -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () Maybe AsyncException _ -> ThreadId -> SomeException -> IO () forall e. Exception e => ThreadId -> e -> IO () throwTo ThreadId me SomeException e Server -> IO Server forall (m :: * -> *) a. Monad m => a -> m a return (Server -> IO Server) -> Server -> IO Server forall a b. (a -> b) -> a -> b $! ThreadId -> Store -> Server Server ThreadId tid Store store where getTimeMs :: IO Int64 getTimeMs :: IO Int64 getTimeMs = (POSIXTime -> Int64 forall a b. (RealFrac a, Integral b) => a -> b round (POSIXTime -> Int64) -> (POSIXTime -> POSIXTime) -> POSIXTime -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (POSIXTime -> POSIXTime -> POSIXTime forall a. Num a => a -> a -> a * POSIXTime 1000)) (POSIXTime -> Int64) -> IO POSIXTime -> IO Int64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b `fmap` IO POSIXTime getPOSIXTime ------------------------------------------------------------------------ -- * Defining metrics -- | Return a new, zero-initialized counter associated with the given -- name and server. Multiple calls to 'getCounter' with the same -- arguments will result in an 'error'. getCounter :: T.Text -- ^ Counter name -> Server -- ^ Server that will serve the counter -> IO Counter.Counter getCounter :: Text -> Server -> IO Counter getCounter Text name Server server = Text -> Store -> IO Counter Metrics.createCounter Text name (Server -> Store serverMetricStore Server server) -- | Return a new, zero-initialized gauge associated with the given -- name and server. Multiple calls to 'getGauge' with the same -- arguments will result in an 'error'. getGauge :: T.Text -- ^ Gauge name -> Server -- ^ Server that will serve the gauge -> IO Gauge.Gauge getGauge :: Text -> Server -> IO Gauge getGauge Text name Server server = Text -> Store -> IO Gauge Metrics.createGauge Text name (Server -> Store serverMetricStore Server server) -- | Return a new, empty label associated with the given name and -- server. Multiple calls to 'getLabel' with the same arguments will -- result in an 'error'. getLabel :: T.Text -- ^ Label name -> Server -- ^ Server that will serve the label -> IO Label.Label getLabel :: Text -> Server -> IO Label getLabel Text name Server server = Text -> Store -> IO Label Metrics.createLabel Text name (Server -> Store serverMetricStore Server server) -- | Return a new distribution associated with the given name and -- server. Multiple calls to 'getDistribution' with the same arguments -- will result in an 'error'. getDistribution :: T.Text -- ^ Distribution name -> Server -- ^ Server that will serve the distribution -> IO Distribution.Distribution getDistribution :: Text -> Server -> IO Distribution getDistribution Text name Server server = Text -> Store -> IO Distribution Metrics.createDistribution Text name (Server -> Store serverMetricStore Server server) ------------------------------------------------------------------------ -- Backwards compatibility shims #if __GLASGOW_HASKELL__ < 706 forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId forkFinally action and_then = mask $ \restore -> forkIO $ try (restore action) >>= and_then #endif