From 319104641ba52cfd6a1fe57618627327557dd823 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Tue, 15 Sep 2026 22:09:45 +0300 Subject: [PATCH] runtime: start the metrics graph server worker --- src/HomeAssistant/Runtime.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/HomeAssistant/Runtime.hs b/src/HomeAssistant/Runtime.hs index bc99bc4..68f026e 100644 --- a/src/HomeAssistant/Runtime.hs +++ b/src/HomeAssistant/Runtime.hs @@ -36,7 +36,9 @@ import HomeAssistant.Controller.Children (schoolLightController) import Data.Maybe (fromMaybe) import qualified System.Metrics import qualified HomeAssistant.Runtime.Metrics +import qualified HomeAssistant.Runtime.Graphing import System.FilePath (()) +import Text.Read (readMaybe) import HomeAssistant.Controller.Kitchen (kitchenMotionController) step :: (MonadIO m) => FilePath -> UUID -> Auto m a b -> a -> m (b, Auto m a b) @@ -79,6 +81,13 @@ runController rootDir bus (Controller name machine _enabled) = do (_, next) <- step path uuid f msg go path inbound next +lookupPort :: IO Int +lookupPort = do + m <- lookupEnv "HA_METRICS_PORT" + case m of + Nothing -> pure 8124 + Just s -> maybe (fail ("HA_METRICS_PORT is not a number: " <> s)) pure (readMaybe s) + defaultMain :: IO () defaultMain = withSocketsDo $ do severity <- maybe InfoS (const DebugS) <$> lookupEnv "HA_DEBUG" @@ -91,13 +100,16 @@ defaultMain = withSocketsDo $ do rootPath <- fromMaybe "/tmp/" <$> lookupEnv "HA_LIB_DIR" rrdPath <- fromMaybe "hass-controller.rrd" <$> lookupEnv "HA_RRD_PATH" rrdtool <- fromMaybe "rrdtool" <$> lookupEnv "HA_RRDTOOL" + metricsPort <- lookupPort let active = [c | c@(Controller _ _ True) <- controllers] ents = foldMap (\(Controller _ m _) -> entities m) active workers = [ ("reader", readerAction host 8123 token ents bus) , ("writer", writerAction bus) ] ++ [ (name, runController rootPath bus c) | c@(Controller name _ True) <- controllers ] - ++ [("metrics", HomeAssistant.Runtime.Metrics.metricsAction store rrdPath rrdtool)] + ++ [ ("metrics", HomeAssistant.Runtime.Metrics.metricsAction store rrdPath rrdtool) + , ("metrics-http", HomeAssistant.Runtime.Graphing.graphAction rrdPath rrdtool metricsPort) + ] as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers (_, v) <- waitAny as absurd v