diff --git a/src/HomeAssistant/Runtime/Metrics.hs b/src/HomeAssistant/Runtime/Metrics.hs index 8c3dc7a..c5d411e 100644 --- a/src/HomeAssistant/Runtime/Metrics.hs +++ b/src/HomeAssistant/Runtime/Metrics.hs @@ -8,15 +8,23 @@ module HomeAssistant.Runtime.Metrics , buildSchema , buildCreateArgs , buildUpdateArgs + , ensureRrd + , sampleAndUpdate + , metricsAction ) where +import Control.Concurrent (threadDelay) +import Control.Monad (forever, unless) import Data.Int (Int64) import Data.List (intercalate, sortBy) import Data.Ord (comparing) import Data.Text (Text) +import Data.Void (Void) import qualified Data.Text as T import qualified Data.HashMap.Strict as HM -import qualified System.Metrics as M (Value (..), Sample) +import qualified System.Metrics as M (Value (..), Sample, Store, sampleAll) +import System.Directory (doesFileExist) +import System.Process (callProcess) data DsType = Derive | Gauge deriving (Eq, Show) @@ -70,3 +78,32 @@ buildUpdateArgs path names values = where renderValue Nothing = "U" renderValue (Just n) = show n + +lookupValue :: M.Sample -> Text -> Maybe Int64 +lookupValue sample name = case HM.lookup name sample of + Just (M.Counter n) -> Just n + Just (M.Gauge n) -> Just n + _ -> Nothing + +ensureRrd :: FilePath -> FilePath -> [DsSpec] -> IO () +ensureRrd rrdtool rrdPath schema = do + exists <- doesFileExist rrdPath + unless exists $ + callProcess rrdtool (buildCreateArgs rrdPath 10 (map toPair schema)) + where + toPair s = (dsName s, dsType s) + +sampleAndUpdate :: M.Store -> FilePath -> FilePath -> [DsSpec] -> IO () +sampleAndUpdate store rrdtool rrdPath schema = do + sample <- M.sampleAll store + let names = map dsName schema + values = map (lookupValue sample . dsEkgName) schema + callProcess rrdtool (buildUpdateArgs rrdPath names values) + +metricsAction :: M.Store -> FilePath -> FilePath -> IO Void +metricsAction store rrdPath rrdtool = do + schema <- buildSchema <$> M.sampleAll store + ensureRrd rrdtool rrdPath schema + forever $ do + sampleAndUpdate store rrdtool rrdPath schema + threadDelay 10000000 diff --git a/test/MetricsSpec.hs b/test/MetricsSpec.hs index 7346540..91cb934 100644 --- a/test/MetricsSpec.hs +++ b/test/MetricsSpec.hs @@ -14,9 +14,19 @@ import HomeAssistant.Runtime.Metrics , buildSchema , buildCreateArgs , buildUpdateArgs + , ensureRrd + , sampleAndUpdate + , metricsAction ) import qualified System.Metrics as M (Value (..)) import Test.Hspec +import Control.Exception (try, SomeException) +import System.Directory (findExecutable, getTemporaryDirectory, removeFile) +import System.Exit (ExitCode (ExitSuccess)) +import System.Process (readProcessWithExitCode) +import qualified System.Metrics as Metrics +import qualified System.Metrics.Counter as Counter +import qualified System.Metrics.Gauge as Gauge spec :: Spec spec = do @@ -96,3 +106,26 @@ spec = do , "ds1" , "N:U" ] + + describe "end-to-end (rrdtool-gated)" $ do + it "creates an rrd, samples, and updates it" $ do + mRrdtool <- findExecutable "rrdtool" + case mRrdtool of + Nothing -> pendingWith "rrdtool not on PATH" + Just rrdtool -> do + store <- Metrics.newStore + c <- Metrics.createCounter "test.counter" store + g <- Metrics.createGauge "test.gauge" store + Counter.inc c + Gauge.set g 42 + tmp <- getTemporaryDirectory + let rrdPath = tmp ++ "/hass-controller-metrics-test.rrd" + _ <- try (removeFile rrdPath) :: IO (Either SomeException ()) + schema <- buildSchema <$> Metrics.sampleAll store + ensureRrd rrdtool rrdPath schema + sampleAndUpdate store rrdtool rrdPath schema + (rc, out, _) <- readProcessWithExitCode rrdtool ["fetch", rrdPath, "AVERAGE"] "" + rc `shouldBe` ExitSuccess + length out `shouldSatisfy` (> 0) + _ <- try (removeFile rrdPath) :: IO (Either SomeException ()) + return ()