diff --git a/src/HomeAssistant/Runtime/Graphing.hs b/src/HomeAssistant/Runtime/Graphing.hs index ca8cbea..e535cae 100644 --- a/src/HomeAssistant/Runtime/Graphing.hs +++ b/src/HomeAssistant/Runtime/Graphing.hs @@ -59,36 +59,124 @@ parseRange t = lookup t [(T.pack (rangeSuffix r), r) | r <- [minBound .. maxBoun rangeStart :: Range -> String rangeStart r = "end-" ++ rangeSuffix r -data Series = Series - { serDs :: String - , serAlias :: String - , serColor :: String - , serLabel :: String +data CF = Average | Minimum | Maximum | Last + deriving (Eq, Show) + +data Source = Source + { srcDs :: String + , srcCF :: CF } deriving (Eq, Show) +data Transform + = Identity + | Multiply Double + deriving (Eq, Show) + +data Series = Series + { serSource :: Source + , serTransform :: Transform + , serAlias :: String + , serColor :: String + , serLabel :: String + } + deriving (Eq, Show) + +data Plot + = Line Int Series + | Area Series + deriving (Eq, Show) + data GraphSpec = GraphSpec - { gsName :: Text - , gsTitle :: String - , gsSeries :: [Series] + { gsName :: Text + , gsTitle :: String + , gsPlots :: [Plot] } deriving (Eq, Show) +average :: String -> Source +average ds = Source ds Average + +maximumCF :: String -> Source +maximumCF ds = Source ds Maximum + +line :: String -> String -> Source -> Plot +line alias color source = + Line 2 Series + { serSource = source + , serTransform = Identity + , serAlias = alias + , serColor = color + , serLabel = alias + } + +area :: String -> String -> Source -> Plot +area alias color source = + Area Series + { serSource = source + , serTransform = Identity + , serAlias = alias + , serColor = color + , serLabel = alias + } + +ratelimitGraph :: GraphSpec +ratelimitGraph = + GraphSpec + { gsName = "ratelimit" + , gsTitle = "Rate limiting" + , gsPlots = + [ Line 2 Series + { serSource = Source "ratelimit_retry" Average + , serTransform = Multiply 60 + , serAlias = "retry" + , serColor = "#0066cc" + , serLabel = "Requests retried/min" + } + , Line 2 Series + { serSource = Source "ratelimit_exhausted" Average + , serTransform = Multiply 60 + , serAlias = "exhaust" + , serColor = "#cc0000" + , serLabel = "Requests exhausted/min" + } + ] + } + +trafficGraph :: GraphSpec +trafficGraph = + GraphSpec + { gsName = "traffic" + , gsTitle = "Traffic" + , gsPlots = + [ Line 2 Series + { serSource = Source "hass_trigger_in" Average + , serTransform = Multiply 60 + , serAlias = "in" + , serColor = "#0066cc" + , serLabel = "Triggers in/min" + } + , Line 2 Series + { serSource = Source "hass_service_out" Average + , serTransform = Multiply 60 + , serAlias = "out" + , serColor = "#cc0000" + , serLabel = "Service calls out/min" + } + ] + } + +memoryGraph :: GraphSpec +memoryGraph = + GraphSpec + "memory" + "Memory use" + [ area "live" "#99ccff" (average "rts_gc_current__a7a") + , line "peak" "#cc0000" (maximumCF "rts_gc_current__a7a") + ] + graphs :: [GraphSpec] -graphs = - [ GraphSpec - "traffic" - "Hass triggers in / services out" - [ Series "hass_trigger_in" "trig" "#0066cc" "triggers in/min" - , Series "hass_service_out" "svc" "#cc0000" "services out/min" - ] - , GraphSpec - "ratelimit" - "Rate limiting" - [ Series "ratelimit_retry" "retry" "#0066cc" "Requests retried in/min" - , Series "ratelimit_exhausted" "exhaust" "#cc0000" "Requests exhausted out/min" - ] - ] +graphs = [memoryGraph, ratelimitGraph, trafficGraph] lookupGraph :: [GraphSpec] -> Text -> Maybe GraphSpec lookupGraph specs name = case [g | g <- specs, gsName g == name] of @@ -98,6 +186,48 @@ lookupGraph specs name = case [g | g <- specs, gsName g == name] of parseNameParam :: [GraphSpec] -> Text -> Maybe GraphSpec parseNameParam specs t = T.stripSuffix ".png" t >>= lookupGraph specs +cfName :: CF -> String +cfName = \case + Average -> "AVERAGE" + Minimum -> "MIN" + Maximum -> "MAX" + Last -> "LAST" + +defArgs :: FilePath -> Series -> [String] +defArgs rrdPath series = + [ "DEF:" ++ rawF ++ "=" ++ rrdPath ++ ":" + ++ srcDs source ++ ":" ++ cfName (srcCF source) + ] + ++ transformArgs + where + source = serSource series + alias = serAlias series + rawF = alias ++ "_raw" + + transformArgs = case serTransform series of + Identity -> + [ "CDEF:" ++ alias ++ "=" ++ rawF ] + + Multiply factor -> + [ "CDEF:" ++ alias ++ "=" ++ rawF + ++ "," ++ show factor ++ ",*" + ] + +plotArg :: Plot -> String +plotArg = \case + Line width series -> + "LINE" ++ show width ++ ":" ++ serAlias series + ++ serColor series ++ ":" ++ serLabel series + + Area series -> + "AREA:" ++ serAlias series + ++ serColor series ++ ":" ++ serLabel series + +plotSeries :: Plot -> Series +plotSeries = \case + Line _ series -> series + Area series -> series + buildGraphArgs :: FilePath -> GraphSpec -> Range -> [String] buildGraphArgs rrdPath spec range = [ "graph" @@ -108,15 +238,9 @@ buildGraphArgs rrdPath spec range = , "--height", "250" , "--imgformat", "PNG" ] - ++ concatMap defArgs (gsSeries spec) - ++ map line (gsSeries spec) - where - defArgs (Series ds alias _ _) = - [ "DEF:" ++ alias ++ "=" ++ rrdPath ++ ":" ++ ds ++ ":AVERAGE" - , "CDEF:" ++ alias ++ "_min=" ++ alias ++ ",60,*" - ] - line (Series _ alias color label) = - "LINE2:" ++ alias ++ "_min" ++ color ++ ":" ++ label + ++ concatMap (defArgs rrdPath . plotSeries) (gsPlots spec) + ++ map plotArg (gsPlots spec) + readProcessBytes :: FilePath -> [String] -> IO (ExitCode, BS.ByteString, String) readProcessBytes cmd args = diff --git a/src/HomeAssistant/Runtime/Supervisor.hs b/src/HomeAssistant/Runtime/Supervisor.hs index b9b3db3..13184a5 100644 --- a/src/HomeAssistant/Runtime/Supervisor.hs +++ b/src/HomeAssistant/Runtime/Supervisor.hs @@ -16,7 +16,7 @@ import Data.Void (Void) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Catch (MonadCatch, MonadMask) import Katip (KatipContext, logFM, ls) -import Control.Retry (RetryStatus(..), recovering, limitRetries, fullJitterBackoff) +import Control.Retry (RetryStatus(..), recovering, fullJitterBackoff, capDelay) import Control.Monad (when) import Katip.Core (Severity(..)) @@ -49,4 +49,4 @@ supervised name action = checkpoint (Annotation name) $ do [ \_retryStatus -> Handler $ \(_ :: Fatal) -> pure False , \_retryStatus -> Handler $ \(_ :: SomeException) -> pure True ] - retryPolicy = fullJitterBackoff 50000 <> limitRetries 5 + retryPolicy = capDelay (15 * 1_000_000) (fullJitterBackoff 50_000)