Make flag-decision tests fail fast and assert the outbound metric

test/BusSpec.hs

@@ -21,6 +21,7 @@ import HomeAssistant.Runtime.Metrics (registerAppMetrics)
 import Katip (Namespace (Namespace), runKatipContextT, Severity (..))
 import qualified System.Metrics as Metrics
 import System.IO.Temp (withTempDirectory)
+import System.Timeout (timeout)
 import Test.Hspec
 
 spec :: Spec
@@ -50,9 +51,10 @@ spec = describe "Bus" $ do
           svc = Service "light" "turn_on" Nothing [EntityId "light.test"]
       runKatipContextT (busLogEnv bus) () (Namespace ["test"]) $
         channelHassEval bus (CallService req svc)
-      (_, svc') <- atomically $ readTChan (busOutbound bus)
-      svc' `shouldBe` svc
-
+      result <- timeout 1000000 $ atomically $ readTChan (busOutbound bus)
+      case result of
+        Nothing -> expectationFailure "expected a write to the outbound channel"
+        Just (_, svc') -> svc' `shouldBe` svc
 
   it "generates unique sequential call ids" $ do
     gen <- mkCallIdGen 0

test/ConnectionSpec.hs

@@ -3,9 +3,8 @@
 module ConnectionSpec (spec) where
 
 import AFRP (Request(..))
-import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (object, (.=))
-import Data.Foldable (forM_)
+import qualified Data.HashMap.Strict as HM
 import Data.Maybe (fromJust)
 import Data.Text (Text)
 import Data.Time (UTCTime (..), utc)
@@ -19,6 +18,7 @@ import HomeAssistant.Runtime.Connection (dispatchService, encodeService, isTrigg
 import Katip (Namespace (Namespace), Severity (InfoS), runKatipContextT)
 import System.IO.Temp (withTempDirectory)
 import qualified System.Metrics as Metrics
+import System.Timeout (timeout)
 import Test.Hspec
 
 spec :: Spec
@@ -63,10 +63,12 @@ spec = do
         flags <- loadFlags dir ["test"]
         setEnabled flags "test" False
         withBus InfoS m flags $ \bus -> do
-          runKatipContextT (busLogEnv bus) () (Namespace ["connection"]) $
-            dispatchService limiter bus (req 1) (lightOn [EntityId "light.test"])
-          generateCallId (busGen bus) `shouldReturn` 1
-
+          timeout 1000000 (do
+            runKatipContextT (busLogEnv bus) () (Namespace ["connection"]) $
+              dispatchService limiter bus (req 1) (lightOn [EntityId "light.test"])
+            generateCallId (busGen bus)) `shouldReturn` Just 1
+          sample <- Metrics.sampleAll store
+          HM.lookup "hass.service.out" sample `shouldBe` Just (Metrics.Counter 0)
 
 req :: Int -> Request
 req n = Request (UTCTime (toEnum 0) (fromIntegral (0 :: Int))) utc