metrics: register inbound-trigger and outbound-service counters

src/HomeAssistant/Runtime/Metrics.hs

@@ -10,6 +10,8 @@ module HomeAssistant.Runtime.Metrics
   , buildUpdateArgs
   , parseInfoDs
   , schemaMatches
+  , AppMetrics (..)
+  , registerAppMetrics
   , ensureRrd
   , sampleAndUpdate
   , metricsAction
@@ -28,7 +30,8 @@ import Data.Void (Void)
 import Numeric (showHex)
 import qualified Data.Text as T
 import qualified Data.HashMap.Strict as HM
-import qualified System.Metrics as M (Value (..), Sample, Store, sampleAll)
+import qualified System.Metrics as M (Value (..), Sample, Store, createCounter, sampleAll)
+import System.Metrics.Counter (Counter)
 import System.Directory (doesFileExist, renameFile)
 import System.Exit (ExitCode (..))
 import System.Process (callProcess, readProcessWithExitCode)
@@ -67,6 +70,17 @@ buildSchema sample =
     , Just dt <- [dsTypeOf val]
     ]
 
+data AppMetrics = AppMetrics
+  { amTriggersIn  :: Counter
+  , amServicesOut :: Counter
+  }
+
+registerAppMetrics :: M.Store -> IO AppMetrics
+registerAppMetrics store =
+  AppMetrics
+    <$> M.createCounter "hass.trigger.in" store
+    <*> M.createCounter "hass.service.out" store
+
 buildCreateArgs :: FilePath -> Int -> [(String, DsType)] -> [String]
 buildCreateArgs path step specs =
   ["create", path, "--step", show step]

test/MetricsSpec.hs

@@ -21,6 +21,8 @@ import HomeAssistant.Runtime.Metrics
   , metricsAction
   , parseInfoDs
   , schemaMatches
+  , AppMetrics (..)
+  , registerAppMetrics
   )
 import qualified System.Metrics as M (Value (..))
 import Test.Hspec
@@ -164,6 +166,15 @@ spec = do
       schemaMatches [ds "a" Derive] [("a", Gauge)]
         `shouldBe` False
 
+  describe "registerAppMetrics" $ do
+    it "registers both counters with the store" $ do
+      store <- Metrics.newStore
+      m <- registerAppMetrics store
+      Counter.inc (amTriggersIn 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)
+
   describe "end-to-end (rrdtool-gated)" $ do
     it "creates an rrd, samples, and updates it" $ do
       mRrdtool <- findExecutable "rrdtool"