Triggers instead of full state events

src/HomeAssistant/Runtime/Connection.hs

@@ -18,10 +18,11 @@ import Control.Concurrent.STM
 import Control.Exception (onException)
 import Control.Exception.Annotated (throw)
 import Control.Lens ((^?))
-import Control.Monad (forever)
+import Control.Monad (forever, forM_)
 import Data.Aeson (Value, eitherDecode, encode, object, (.=))
 import Data.Aeson.Lens (key, _String)
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Void (Void)
 import HomeAssistant.Controller (Service (..), Target (..))
@@ -35,11 +36,11 @@ import AFRP (Request(..))
 -- | Connect, authenticate, subscribe, then receive and broadcast forever.
 -- Restarting this action reconnects. All setup sends happen before the
 -- connection is published in the bus, so only the writer sends afterwards.
-readerAction :: String -> Int -> String -> Bus -> IO Void
-readerAction host port token bus =
+readerAction :: String -> Int -> String -> S.Set T.Text -> Bus -> IO Void
+readerAction host port token ents bus =
   WS.runClient host port "/api/websocket" $ \conn -> do
     handshake conn token
-    subscribe bus conn
+    subscribe bus conn ents
     atomically $ writeTVar (busConn bus) (Just conn)
     putStrLn "[reader] connected"
     -- Unpublish on exit so the writer blocks and the backlog survives the outage.
@@ -62,14 +63,19 @@ expectType expected msg =
     Just t | t == expected -> pure ()
     _ -> throw (Fatal $ "expected " <> expected <> ", got: " <> T.pack (show msg))
 
-subscribe :: Bus -> WS.Connection -> IO ()
-subscribe bus conn = do
-  sid <- generateCallId (busGen bus)
-  WS.sendTextData conn $ encode $ object
-    [ "id"         .= sid
-    , "type"       .= ("subscribe_events" :: T.Text)
-    , "event_type" .= ("state_changed" :: T.Text)
-    ]
+subscribe :: Bus -> WS.Connection -> S.Set T.Text -> IO ()
+subscribe bus conn ents =
+  forM_ (S.toList ents) $ \entityId -> do
+    print entityId
+    sid <- generateCallId (busGen bus)
+    WS.sendTextData conn $ encode $ object
+      [ "id"         .= sid
+      , "type"       .= ("subscribe_trigger" :: T.Text)
+      , "trigger"    .= object
+        [ "platform" .= ("state" :: T.Text)
+        , "entity_id" .= entityId
+        ]
+      ]
 
 -- | Undecodable messages are skipped: reconnecting cannot fix a decode
 -- problem, so crashing here would only produce a hot restart loop.