83 lines
3.3 KiB
Haskell
83 lines
3.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module ConnectionSpec (spec) where
|
|
|
|
import AFRP (Request(..))
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Data.Aeson (object, (.=))
|
|
import Data.Foldable (forM_)
|
|
import Data.Maybe (fromJust)
|
|
import Data.Text (Text)
|
|
import Data.Time (UTCTime (..), utc)
|
|
import Data.UUID (fromString)
|
|
import HomeAssistant.Controller (Service (..), Target(..))
|
|
import HomeAssistant.Runtime.Bus
|
|
import HomeAssistant.Runtime.Flags (loadFlags, setEnabled)
|
|
import HomeAssistant.Runtime.Metrics (registerAppMetrics)
|
|
import HomeAssistant.Runtime.RateLimit (registerRateLimitMetrics, slidingWindowLimiter)
|
|
import HomeAssistant.Runtime.Connection (dispatchService, encodeService, isTriggerEvent)
|
|
import Katip (Namespace (Namespace), Severity (InfoS), runKatipContextT)
|
|
import System.IO.Temp (withTempDirectory)
|
|
import qualified System.Metrics as Metrics
|
|
import Test.Hspec
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
describe "encodeService" $ do
|
|
it "encodes a call_service message" $
|
|
encodeService 7 (Service "light" "turn_on" Nothing [EntityId "light.bedroom_masse"])
|
|
`shouldBe` object
|
|
[ "id" .= (7 :: Int)
|
|
, "type" .= ("call_service" :: Text)
|
|
, "domain" .= ("light" :: Text)
|
|
, "service" .= ("turn_on" :: Text)
|
|
, "target" .= object ["entity_id" .= ("light.bedroom_masse" :: Text)]
|
|
]
|
|
|
|
it "includes service_data when present" $
|
|
encodeService 8 (Service "light" "turn_on" (Just (object ["brightness" .= (200 :: Int)])) [EntityId "light.bedroom_masse"])
|
|
`shouldBe` object
|
|
[ "id" .= (8 :: Int)
|
|
, "type" .= ("call_service" :: Text)
|
|
, "domain" .= ("light" :: Text)
|
|
, "service" .= ("turn_on" :: Text)
|
|
, "target" .= object ["entity_id" .= ("light.bedroom_masse" :: Text)]
|
|
, "service_data" .= object ["brightness" .= (200 :: Int)]
|
|
]
|
|
|
|
describe "isTriggerEvent" $ do
|
|
it "is true for event frames" $
|
|
isTriggerEvent (object ["type" .= ("event" :: Text)]) `shouldBe` True
|
|
it "is false for result frames" $
|
|
isTriggerEvent (object ["type" .= ("result" :: Text)]) `shouldBe` False
|
|
it "is false when there is no type" $
|
|
isTriggerEvent (object ["id" .= (1 :: Int)]) `shouldBe` False
|
|
|
|
describe "dispatchService" $ do
|
|
it "skips disabled handlers without consuming a call id" $ do
|
|
store <- Metrics.newStore
|
|
m <- registerAppMetrics store
|
|
rlMetrics <- registerRateLimitMetrics store
|
|
limiter <- slidingWindowLimiter rlMetrics 10 20
|
|
withTempDirectory "/tmp" "connection-spec" $ \dir -> 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
|
|
|
|
|
|
req :: Int -> Request
|
|
req n = Request (UTCTime (toEnum 0) (fromIntegral (0 :: Int))) utc
|
|
(fromJust (fromString uuid)) "test"
|
|
where
|
|
pad i = replicate (12 - length (show i)) '0' <> show i
|
|
uuid = "00000000-0000-0000-0000-" <> pad n
|
|
|
|
lightOn :: [Target] -> Service
|
|
lightOn targets = Service "light" "turn_on" Nothing targets
|
|
|
|
lightOff :: [Target] -> Service
|
|
lightOff targets = Service "light" "turn_off" Nothing targets
|