metrics: detect rrd schema mismatch and recreate with backup

test/MetricsSpec.hs

@@ -5,7 +5,9 @@ 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
 import HomeAssistant.Runtime.Metrics
   ( DsType (..)
   , DsSpec (..)
@@ -17,11 +19,14 @@ import HomeAssistant.Runtime.Metrics
   , ensureRrd
   , sampleAndUpdate
   , metricsAction
+  , parseInfoDs
+  , schemaMatches
   )
 import qualified System.Metrics as M (Value (..))
 import Test.Hspec
 import Control.Exception (try, SomeException)
-import System.Directory (findExecutable, getTemporaryDirectory, removeFile)
+import Control.Monad (forM_)
+import System.Directory (findExecutable, getTemporaryDirectory, listDirectory, removeFile)
 import System.Exit (ExitCode (ExitSuccess))
 import System.Process (readProcessWithExitCode)
 import qualified System.Metrics as Metrics
@@ -126,6 +131,39 @@ spec = do
           , "N:U"
           ]
 
+  describe "parseInfoDs" $ do
+    it "extracts DS names and types from rrdtool info output" $
+      let info = unlines
+            [ "filename = \"test.rrd\""
+            , "step = 10"
+            , "ds[foo].index = 0"
+            , "ds[foo].type = \"DERIVE\""
+            , "ds[bar].type = \"GAUGE\""
+            , "rra[0].cf = \"AVERAGE\""
+            ]
+      in parseInfoDs info `shouldBe` [("foo", Derive), ("bar", Gauge)]
+
+    it "ignores lines that are not ds type declarations" $
+      parseInfoDs "step = 10\nrra[0].cf = \"AVERAGE\"\n" `shouldBe` []
+
+  describe "schemaMatches" $ do
+    let ds name ty = DsSpec (T.pack name) name ty
+    it "is true for identical schemas regardless of order" $
+      schemaMatches [ds "b" Gauge, ds "a" Derive] [("a", Derive), ("b", Gauge)]
+        `shouldBe` True
+
+    it "is false when the derived schema has an added DS" $
+      schemaMatches [ds "a" Derive, ds "b" Gauge] [("a", Derive)]
+        `shouldBe` False
+
+    it "is false when the derived schema has a removed DS" $
+      schemaMatches [ds "a" Derive] [("a", Derive), ("b", Gauge)]
+        `shouldBe` False
+
+    it "is false when a DS type changed" $
+      schemaMatches [ds "a" Derive] [("a", Gauge)]
+        `shouldBe` False
+
   describe "end-to-end (rrdtool-gated)" $ do
     it "creates an rrd, samples, and updates it" $ do
       mRrdtool <- findExecutable "rrdtool"
@@ -148,3 +186,29 @@ spec = do
           length out `shouldSatisfy` (> 0)
           _ <- try (removeFile rrdPath) :: IO (Either SomeException ())
           return ()
+
+    it "backs up and recreates the rrd when the schema changes" $ do
+      mRrdtool <- findExecutable "rrdtool"
+      case mRrdtool of
+        Nothing -> pendingWith "rrdtool not on PATH"
+        Just rrdtool -> do
+          tmp <- getTemporaryDirectory
+          let rrdPath = tmp ++ "/hass-controller-schema-change-test.rrd"
+              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 ()