{-# 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 for short names" $ sanitizeName ("rts.gc.cpu_ms" :: Text) `shouldBe` "rts_gc_cpu_ms" it "shortens names longer than 19 chars to 15 chars + _ + 3 hex" $ do let result = sanitizeName ("rts.gc.par_balanced_bytes_copied" :: Text) length result `shouldBe` 19 take 15 result `shouldBe` "rts_gc_par_bala" drop 15 result `shouldBe` "_" ++ drop 16 result it "is deterministic (same input -> same output)" $ sanitizeName ("rts.gc.peak_megabytes_allocated" :: Text) `shouldBe` sanitizeName ("rts.gc.peak_megabytes_allocated" :: Text) describe "buildSchema" $ do it "builds sorted DsSpecs from counters and gauges, skipping labels" $ let sample :: HashMap Text M.Value sample = HM.fromList [ ("x.allocated", M.Counter 1000) , ("a.bytes_used", M.Gauge 500) , ("c.label_thing", M.Label "irrelevant") ] in buildSchema sample `shouldBe` [ DsSpec "a.bytes_used" "a_bytes_used" Gauge , DsSpec "x.allocated" "x_allocated" Derive ] it "produces dsName <= 19 chars for long ekg GC metric names" $ let sample :: HashMap Text M.Value sample = HM.fromList [ ("rts.gc.par_balanced_bytes_copied", M.Gauge 1) , ("rts.gc.peak_megabytes_allocated", M.Gauge 2) , ("rts.gc.cumulative_bytes_used", M.Counter 3) ] in map (length . dsName) (buildSchema sample) `shouldSatisfy` all (<= 19) 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 ()