Supervise workers and make auth failures fatal

src/HomeAssistant/Runtime.hs

@@ -14,15 +14,16 @@ module HomeAssistant.Runtime
   ) where
 
 import AFRP (Event (..), Mealy (..))
-import Control.Concurrent.Async (mapConcurrently_)
+import Control.Concurrent.Async (async, waitAny)
 import Control.Concurrent.STM (atomically, dupTChan, readTChan)
 import Data.Aeson (Value)
 import qualified Data.Text as T
 import Data.Time (getCurrentTime)
-import Data.Void (Void)
+import Data.Void (Void, absurd)
 import HomeAssistant.Controller (HASS, HASSEff (..), lightController)
 import HomeAssistant.Runtime.Bus
 import HomeAssistant.Runtime.Connection (readerAction, writerAction)
+import HomeAssistant.Runtime.Supervisor (defaultBackoff, supervised)
 import Network.Socket (withSocketsDo)
 import System.Environment (getEnv)
 
@@ -53,10 +54,13 @@ defaultMain :: IO ()
 defaultMain = withSocketsDo $ do
   token <- getEnv "HA_TOKEN"
   bus <- newBus 0
-  mapConcurrently_ id $
-    [ readerAction "last-resort-redux" 8123 token bus
-    , writerAction bus
-    ] ++ map (runController bus) controllers
+  let workers =
+        [ ("reader", readerAction "last-resort-redux" 8123 token bus)
+        , ("writer", writerAction bus)
+        ] ++ [ (name, runController bus c) | c@(Controller name _) <- controllers ]
+  as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers
+  (_, v) <- waitAny as
+  absurd v
 
 dryRunHassEval :: CallIdGen -> HASSEff a -> IO a
 dryRunHassEval gen = \case