77 lines
3.0 KiB
Haskell
77 lines
3.0 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module FlagsSpec (spec) where
|
|
|
|
import Control.Concurrent.Async (mapConcurrently_)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Data.Aeson (decodeFileStrict)
|
|
import Data.Map.Strict (Map)
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Text (Text)
|
|
import qualified Hedgehog.Gen as Gen
|
|
import qualified Hedgehog.Range as Range
|
|
import Katip.Monadic (runNoLoggingT)
|
|
import System.IO.Temp (withTempDirectory)
|
|
import Test.Hspec
|
|
import Test.Hspec.Hedgehog
|
|
|
|
import HomeAssistant.Runtime.Flags
|
|
|
|
spec :: Spec
|
|
spec = describe "Flags" $ do
|
|
describe "loadFlags" $ do
|
|
it "defaults all names to True when the file is missing (opt-out)" $
|
|
withTempDirectory "/tmp" "flags-spec" $ \dir -> do
|
|
flags <- runNoLoggingT (loadFlags dir ["a", "b"])
|
|
m <- allFlags flags
|
|
m `shouldBe` M.fromList [("a" :: Text, True), ("b", True)]
|
|
|
|
it "lets the file override the True default, missing keys stay True" $
|
|
withTempDirectory "/tmp" "flags-spec" $ \dir -> do
|
|
let path = dir <> "/handlers.json"
|
|
writeFile path "{\"b\": false}"
|
|
flags <- runNoLoggingT (loadFlags dir ["a", "b"])
|
|
m <- allFlags flags
|
|
m `shouldBe` M.fromList [("a" :: Text, True), ("b" :: Text, False)]
|
|
|
|
it "treats a corrupt file as empty (all-enabled) without throwing" $
|
|
withTempDirectory "/tmp" "flags-spec" $ \dir -> do
|
|
let path = dir <> "/handlers.json"
|
|
writeFile path "not json at all"
|
|
flags <- runNoLoggingT (loadFlags dir ["a"])
|
|
m <- allFlags flags
|
|
m `shouldBe` M.fromList [("a" :: Text, True)]
|
|
|
|
describe "isEnabled" $ do
|
|
it "returns the stored value" $
|
|
withTempDirectory "/tmp" "flags-spec" $ \dir -> do
|
|
let path = dir <> "/handlers.json"
|
|
writeFile path "{\"a\": false}"
|
|
flags <- runNoLoggingT (loadFlags dir ["a"])
|
|
isEnabled flags "a" `shouldReturn` False
|
|
|
|
it "defaults unknown names to True" $
|
|
withTempDirectory "/tmp" "flags-spec" $ \dir -> do
|
|
flags <- runNoLoggingT (loadFlags dir [])
|
|
isEnabled flags "unknown" `shouldReturn` True
|
|
|
|
describe "setEnabled" $ do
|
|
it "updates the in-memory map and persists to disk" $
|
|
withTempDirectory "/tmp" "flags-spec" $ \dir -> do
|
|
flags <- runNoLoggingT (loadFlags dir ["a"])
|
|
setEnabled flags "a" False
|
|
isEnabled flags "a" `shouldReturn` False
|
|
-- reload from disk to confirm persistence
|
|
flags' <- runNoLoggingT (loadFlags dir ["a"])
|
|
isEnabled flags' "a" `shouldReturn` False
|
|
|
|
it "concurrent writes leave the file consistent with the TVar" $
|
|
hedgehog $ do
|
|
n <- forAll $ Gen.int (Range.linear 1 50)
|
|
liftIO $ withTempDirectory "/tmp" "flags-spec" $ \dir -> do
|
|
flags <- runNoLoggingT (loadFlags dir ["x"])
|
|
mapConcurrently_ (\i -> setEnabled flags "x" (even i)) [1 .. n]
|
|
m <- allFlags flags
|
|
decoded <- decodeFileStrict (dir <> "/handlers.json")
|
|
(decoded :: Maybe (Map Text Bool)) `shouldBe` Just m
|