More graphs

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 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
-  { serDs    :: String
+  { 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]
+  , 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 =

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)