home-assistant-controller/test/MetricsSpec.hs

{-# 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 ()