runtime: count only trigger event frames and harden metrics tests

test/ConnectionSpec.hs

@@ -9,7 +9,7 @@ import Data.Text (Text)
 import Data.Time (UTCTime (..), utc)
 import Data.UUID (fromString)
 import HomeAssistant.Controller (Service (..), Target(..))
-import HomeAssistant.Runtime.Connection (encodeService, dedupeBatch)
+import HomeAssistant.Runtime.Connection (encodeService, dedupeBatch, isTriggerEvent)
 import Test.Hspec
 
 spec :: Spec
@@ -36,6 +36,14 @@ spec = do
           , "service_data" .= object ["brightness" .= (200 :: Int)]
           ]
 
+  describe "isTriggerEvent" $ do
+    it "is true for event frames" $
+      isTriggerEvent (object ["type" .= ("event" :: Text)]) `shouldBe` True
+    it "is false for result frames" $
+      isTriggerEvent (object ["type" .= ("result" :: Text)]) `shouldBe` False
+    it "is false when there is no type" $
+      isTriggerEvent (object ["id" .= (1 :: Int)]) `shouldBe` False
+
   describe "dedupeBatch" $ do
     it "collapses identical calls to one" $
       let batch = [ (req 1, lightOn [AreaId "x"])

test/MetricsSpec.hs

@@ -4,7 +4,6 @@ module MetricsSpec (spec) where
 
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
-import Data.Int (Int64)
 import Data.List (isPrefixOf)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -18,7 +17,6 @@ import HomeAssistant.Runtime.Metrics
   , buildUpdateArgs
   , ensureRrd
   , sampleAndUpdate
-  , metricsAction
   , parseInfoDs
   , schemaMatches
   , AppMetrics (..)
@@ -26,7 +24,7 @@ import HomeAssistant.Runtime.Metrics
   )
 import qualified System.Metrics as M (Value (..))
 import Test.Hspec
-import Control.Exception (try, SomeException)
+import Control.Exception (try, SomeException, finally)
 import Control.Monad (forM_)
 import System.Directory (findExecutable, getTemporaryDirectory, listDirectory, removeFile)
 import System.Exit (ExitCode (ExitSuccess))
@@ -171,9 +169,10 @@ spec = do
       store <- Metrics.newStore
       m <- registerAppMetrics store
       Counter.inc (amTriggersIn m)
+      Counter.inc (amServicesOut m)
       sample <- Metrics.sampleAll store
       HM.lookup "hass.trigger.in" sample `shouldBe` Just (M.Counter 1)
-      HM.lookup "hass.service.out" sample `shouldBe` Just (M.Counter 0)
+      HM.lookup "hass.service.out" sample `shouldBe` Just (M.Counter 1)
 
   describe "end-to-end (rrdtool-gated)" $ do
     it "creates an rrd, samples, and updates it" $ do
@@ -208,18 +207,20 @@ spec = do
               bakPrefix = "hass-controller-schema-change-test.rrd.bak-"
               base = [ DsSpec "a" "a" Derive, DsSpec "b" "b" Gauge ]
               expanded = base ++ [ DsSpec "c" "c" Derive ]
-          _ <- try (removeFile rrdPath) :: IO (Either SomeException ())
-          ensureRrd rrdtool rrdPath base
-          ensureRrd rrdtool rrdPath base
-          noBackups <- filter (isPrefixOf bakPrefix) <$> listDirectory tmp
-          noBackups `shouldBe` []
-          ensureRrd rrdtool rrdPath expanded
-          backups <- filter (isPrefixOf bakPrefix) <$> listDirectory tmp
-          length backups `shouldBe` 1
-          (rc, out, _) <- readProcessWithExitCode rrdtool ["info", rrdPath] ""
-          rc `shouldBe` ExitSuccess
-          out `shouldContain` "ds[c].type"
-          _ <- try (removeFile rrdPath) :: IO (Either SomeException ())
-          forM_ backups $ \f -> do
-            _ <- try (removeFile (tmp ++ "/" ++ f)) :: IO (Either SomeException ())
-            pure ()
+              clean = do
+                stale <- filter (isPrefixOf bakPrefix) <$> listDirectory tmp
+                forM_ (rrdPath : map (\f -> tmp ++ "/" ++ f) stale) $ \f ->
+                  try (removeFile f) :: IO (Either SomeException ())
+          clean
+          ( do
+              ensureRrd rrdtool rrdPath base
+              ensureRrd rrdtool rrdPath base
+              noBackups <- filter (isPrefixOf bakPrefix) <$> listDirectory tmp
+              noBackups `shouldBe` []
+              ensureRrd rrdtool rrdPath expanded
+              backups <- filter (isPrefixOf bakPrefix) <$> listDirectory tmp
+              length backups `shouldBe` 1
+              (rc, out, _) <- readProcessWithExitCode rrdtool ["info", rrdPath] ""
+              rc `shouldBe` ExitSuccess
+              out `shouldContain` "ds[c].type"
+            ) `finally` clean

test/RuntimeSpec.hs

@@ -11,7 +11,7 @@ spec = pure ()
 --
 -- spec :: Spec
 -- spec = describe "runController" $ do
---   it "feeds inbound events through the machine and forwards service calls" $ withBus InfoS $ \bus -> do
+--   it "feeds inbound events through the machine and forwards service calls" $ withBus severity appMetrics $ \bus -> do
 --     _ <- async (runController bus (Controller "test" lightController True))
 --     putStrLn "Before the delay"
 --     threadDelay 100000 -- let the controller dup its inbound channel