runtime: increment trigger/service counters on the bus

test/BusSpec.hs

@@ -10,16 +10,19 @@ import Control.Concurrent.STM
   , writeTChan
   )
 import Data.Aeson (Value (..))
+import qualified Data.HashMap.Strict as HM
 import Data.Time (UTCTime (..), utc)
 import Data.UUID (nil)
 import HomeAssistant.Controller (HASSEff (..), Service (..), Target(..))
 import HomeAssistant.Runtime.Bus
+import HomeAssistant.Runtime.Metrics (registerAppMetrics)
 import Katip (Namespace (Namespace), runKatipContextT, Severity (..))
+import qualified System.Metrics as Metrics
 import Test.Hspec
 
 spec :: Spec
 spec = describe "Bus" $ do
-  it "broadcasts inbound messages to every dup'd channel in order" $ withBus InfoS $ \bus -> do
+  it "broadcasts inbound messages to every dup'd channel in order" $ withTestBus $ \bus -> do
     p1 <- atomically $ dupTChan (busInbound bus)
     p2 <- atomically $ dupTChan (busInbound bus)
     atomically $ writeTChan (busInbound bus) (Event (Number 1))
@@ -29,7 +32,7 @@ spec = describe "Bus" $ do
     r1 `shouldBe` (Event (Number 1), Event (Number 2))
     r2 `shouldBe` (Event (Number 1), Event (Number 2))
 
-  it "channelHassEval writes CallService to the outbound channel" $ withBus InfoS $ \bus -> do
+  it "channelHassEval writes CallService to the outbound channel" $ withTestBus $ \bus -> do
     let req = Request (UTCTime (toEnum 0) 0) utc nil
         svc = Service "light" "turn_on" Nothing [EntityId "light.bedroom_masse"]
     runKatipContextT (busLogEnv bus) () (Namespace ["test"]) $
@@ -43,3 +46,21 @@ spec = describe "Bus" $ do
     a <- generateCallId gen
     b <- generateCallId gen
     (a, b) `shouldBe` (1, 2)
+
+  describe "recordInbound / recordOutbound" $ do
+    it "increments the trigger and service counters" $ do
+      store <- Metrics.newStore
+      m <- registerAppMetrics store
+      withBus InfoS m $ \bus -> do
+        recordInbound bus
+        recordInbound bus
+        recordOutbound bus
+        sample <- Metrics.sampleAll store
+        HM.lookup "hass.trigger.in" sample `shouldBe` Just (Metrics.Counter 2)
+        HM.lookup "hass.service.out" sample `shouldBe` Just (Metrics.Counter 1)
+
+withTestBus :: (Bus -> IO a) -> IO a
+withTestBus action = do
+  store <- Metrics.newStore
+  m <- registerAppMetrics store
+  withBus InfoS m action