132 lines
4.1 KiB
Haskell
132 lines
4.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module MetricsSpec (spec) where
|
|
|
|
import Data.HashMap.Strict (HashMap)
|
|
import qualified Data.HashMap.Strict as HM
|
|
import Data.Int (Int64)
|
|
import Data.Text (Text)
|
|
import HomeAssistant.Runtime.Metrics
|
|
( DsType (..)
|
|
, DsSpec (..)
|
|
, dsTypeOf
|
|
, sanitizeName
|
|
, 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
|
|
describe "dsTypeOf" $ do
|
|
it "maps Counter to Derive" $
|
|
dsTypeOf (M.Counter 1000) `shouldBe` Just Derive
|
|
|
|
it "maps Gauge to Gauge" $
|
|
dsTypeOf (M.Gauge 500) `shouldBe` Just Gauge
|
|
|
|
it "maps Label to Nothing" $
|
|
dsTypeOf (M.Label "hello") `shouldBe` Nothing
|
|
|
|
describe "sanitizeName" $ do
|
|
it "replaces dots with underscores" $
|
|
sanitizeName ("rts.gc.bytes_allocated" :: Text) `shouldBe` "rts_gc_bytes_allocated"
|
|
|
|
describe "buildSchema" $ do
|
|
it "builds sorted DsSpecs from counters and gauges, skipping labels" $
|
|
let sample :: HashMap Text M.Value
|
|
sample = HM.fromList
|
|
[ ("rts.gc.bytes_allocated", M.Counter 1000)
|
|
, ("rts.gc.max_bytes_used", M.Gauge 500)
|
|
, ("rts.gc.label_thing", M.Label "irrelevant")
|
|
]
|
|
in buildSchema sample `shouldBe`
|
|
[ DsSpec "rts.gc.bytes_allocated" "rts_gc_bytes_allocated" Derive
|
|
, DsSpec "rts.gc.max_bytes_used" "rts_gc_max_bytes_used" Gauge
|
|
]
|
|
|
|
describe "buildCreateArgs" $ do
|
|
it "builds create argv with mixed DERIVE and GAUGE DSes and RRAs" $
|
|
buildCreateArgs "test.rrd" 10
|
|
[ ("ds1", Derive)
|
|
, ("ds2", Gauge)
|
|
]
|
|
`shouldBe`
|
|
[ "create"
|
|
, "test.rrd"
|
|
, "--step"
|
|
, "10"
|
|
, "DS:ds1:DERIVE:20:0:U"
|
|
, "DS:ds2:GAUGE:20:0:U"
|
|
, "RRA:AVERAGE:0.5:1:6000"
|
|
, "RRA:MAX:0.5:1:6000"
|
|
, "RRA:AVERAGE:0.5:360:1680"
|
|
, "RRA:MAX:0.5:360:1680"
|
|
]
|
|
|
|
describe "buildUpdateArgs" $ do
|
|
it "builds update argv with numeric values" $
|
|
buildUpdateArgs "test.rrd" ["ds1", "ds2"] [Just 100, Just 200]
|
|
`shouldBe`
|
|
[ "update"
|
|
, "test.rrd"
|
|
, "--template"
|
|
, "ds1:ds2"
|
|
, "N:100:200"
|
|
]
|
|
|
|
it "renders Nothing as U (unknown)" $
|
|
buildUpdateArgs "test.rrd" ["ds1", "ds2"] [Just 100, Nothing]
|
|
`shouldBe`
|
|
[ "update"
|
|
, "test.rrd"
|
|
, "--template"
|
|
, "ds1:ds2"
|
|
, "N:100:U"
|
|
]
|
|
|
|
it "renders all-Nothing as all-U" $
|
|
buildUpdateArgs "test.rrd" ["ds1"] [Nothing]
|
|
`shouldBe`
|
|
[ "update"
|
|
, "test.rrd"
|
|
, "--template"
|
|
, "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 ()
|