Add dedupeBatch: collapse outbound calls per target

This commit is contained in:
2026-08-25 19:33:44 +03:00
parent 6bb96833e1
commit 3f5aa4735c
4 changed files with 85 additions and 23 deletions
+68 -21
View File
@@ -2,31 +2,78 @@
module ConnectionSpec (spec) where
import AFRP (Request(..))
import Data.Aeson (object, (.=))
import Data.Maybe (fromJust)
import Data.Text (Text)
import Data.Time (UTCTime (..), utc)
import Data.UUID (UUID, fromString)
import HomeAssistant.Controller (Service (..), Target(..))
import HomeAssistant.Runtime.Connection (encodeService)
import HomeAssistant.Runtime.Connection (encodeService, dedupeBatch)
import Test.Hspec
spec :: Spec
spec = 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)]
]
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)]
]
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 "dedupeBatch" $ do
it "collapses identical calls to one" $
let batch = [ (req 1, lightOn [AreaId "x"])
, (req 2, lightOn [AreaId "x"])
, (req 3, lightOn [AreaId "x"])
]
in dedupeBatch batch `shouldBe` [(req 3, lightOn [AreaId "x"])]
it "keeps same-target different-service calls separate" $
let batch = [ (req 1, lightOn [AreaId "x"])
, (req 2, lightOff [AreaId "x"])
]
result = dedupeBatch batch
in length result `shouldBe` 2
it "newest call wins for the same key" $
let batch = [ (req 1, lightOn [AreaId "x"])
, (req 2, lightOn [AreaId "x"])
, (req 3, lightOn [AreaId "x"])
]
in map requestTraceId (map fst (dedupeBatch batch)) `shouldBe`
[fromJust (fromString "00000000-0000-0000-0000-000000000003")]
it "treats target lists in different order as the same key" $
let batch = [ (req 1, lightOn [EntityId "a", EntityId "b"])
, (req 2, lightOn [EntityId "b", EntityId "a"])
]
in length (dedupeBatch batch) `shouldBe` 1
req :: Int -> Request
req n = Request (UTCTime (toEnum 0) (fromIntegral (0 :: Int))) utc
(fromJust (fromString uuid))
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