RRDTool.hs

{-# LANGUAGE OverloadedStrings #-}

{- | Simple API for passing ekg monitoring statistics to a round-robin database
(RRD) using `rrdtool`. -}

module System.Metrics.RRDTool
  ( -- * Basic Types
    IntervalSeconds
  , SourceValue

  -- * Data Sources
  , DataSource(..)
  , DataSourceType(..)
  , gcSources

  -- * Round Robin Archives
  , ConsolidationFunction(..)
  , RoundRobinArchive(..)

  -- * Round Robin Databases
  , RoundRobinDatabase
  , newRRD
  , rrdStore

  -- * Monitoring Thread
  , MonitorThread
  , runMonitor
  , killMonitor
  , nullMonitor
  ) where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Maybe
import Data.Time
import System.Directory
import System.Metrics
import System.Process

import qualified Data.HashMap.Strict as HM

import System.Metrics.RRDTool.Internals

{- | Create a new 'RoundRobinDatabase'. Creates the database file on disk if
not already present.  Metrics must subsequently be registered in the store
associated with the 'RoundRobinDatabase', which can be obtained with
'rrdStore'. Throws an 'IOException' if there was a problem running `rrdtool`.
-}
newRRD
  :: FilePath -- ^ The name of the database file.
  -> IntervalSeconds -- ^ The update interval in seconds.
  -> Maybe FilePath -- ^ A path to the `rrdtool` binary, or 'Nothing' to simply call `rrdtool`.
  -> [RoundRobinArchive] -- ^ Round-robin archives that define how data is stored.
  -> [DataSource] -- ^ Data sources to define in the database.
  -> IO RoundRobinDatabase
newRRD dbPath step maybeToolPath archives sources = do
  store <- newStore

  let rrd = RoundRobinDatabase
        { rrdToolPath = fromMaybe "rrdtool" maybeToolPath
        , rrdFilePath = dbPath
        , rrdArchives = archives
        , rrdSources  = HM.fromList [(dsMetric source, source) | source <- sources]
        , rrdStore    = store
        , rrdStep     = step
        }

  rrdExists <- doesFileExist $ rrdFilePath rrd
  unless rrdExists $ runTool rrd $ createRRDArgs rrd
  return rrd

runTool :: RoundRobinDatabase -> [String] -> IO ()
runTool = callProcess . rrdToolPath

{- | The monitoring thread for a round robin database, which can be created
with 'runMonitor' and killed with 'killMonitor'. -}
data MonitorThread = MonitorThread
  { killMonitor :: IO () -- ^ Kills the monitoring thread.
  }

{- | Run a monitoring thread for the given database, which samples the metrics
and updates the database at the chosen frequency. Failed updates are ignored.
-}
runMonitor :: RoundRobinDatabase -> IO MonitorThread
runMonitor rrd = do
  joinVar <- newEmptyMVar
  monitorThreadId <- mask $ \restore -> forkIO $ monitorThread restore `finally` putMVar joinVar ()
  return MonitorThread
    { killMonitor = killThread monitorThreadId >> takeMVar joinVar
    }
  where
  monitorThread restore = forever $ do
    threadDelay $ rrdStep rrd * 1000000
    void $ forkIO $ restore rrdUpdate

  ignoreIOException :: IOException -> IO ()
  ignoreIOException = const $ return ()

  rrdUpdate = do
    now <- getCurrentTime
    sample <- sampleAll $ rrdStore rrd
    case updateRRDArgs rrd sample now of
      Nothing -> return ()
      Just args -> handle ignoreIOException $ runTool rrd args

{- | A do-nothing MonitorThread, for use if monitoring is disabled. -}
nullMonitor :: MonitorThread
nullMonitor = MonitorThread $ return ()