145 lines
4.8 KiB
Haskell
145 lines
4.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module GraphingSpec (spec) where
|
|
|
|
import Control.Exception (SomeException, finally, try)
|
|
import qualified Data.ByteString as BS
|
|
import HomeAssistant.Runtime.Graphing
|
|
( GraphSpec (..)
|
|
, Range (..)
|
|
, buildGraphArgs
|
|
, graphs
|
|
, lookupGraph
|
|
, parseNameParam
|
|
, parseRange
|
|
, rangeStart
|
|
, readProcessBytes
|
|
)
|
|
import qualified HomeAssistant.Runtime.Metrics as Metrics
|
|
import System.Directory (findExecutable, getTemporaryDirectory, removeFile)
|
|
import System.Exit (ExitCode (..))
|
|
import System.Process (readProcessWithExitCode)
|
|
import Test.Hspec
|
|
import Servant.API (FromHttpApiData(..), ToHttpApiData (..))
|
|
import HomeAssistant.Runtime.Graphing (Graph(..))
|
|
|
|
traffic :: GraphSpec
|
|
traffic = case lookupGraph graphs Traffic of
|
|
Just s -> s
|
|
Nothing -> error "traffic graph is missing from the table"
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
describe "Graph HttpApiData" $ do
|
|
-- There's an enumerable amount of graphs, we can just enumerate through them all
|
|
it "satisfies roundtrip property" $ do
|
|
let modes = [minBound..maxBound]
|
|
let got = map (parseQueryParam . toQueryParam @Graph) modes
|
|
let wanted = map Right modes
|
|
got `shouldBe` wanted
|
|
describe "parseRange" $ do
|
|
-- Fully enumerable
|
|
it "the http-api-data satisfies roundtrip property" $ do
|
|
let rs = [minBound..maxBound]
|
|
let got = map (parseQueryParam . toQueryParam @Range) rs
|
|
let wanted = map Right rs
|
|
got `shouldBe` wanted
|
|
it "accepts every suffix in the closed set" $
|
|
map parseRange ["10m", "1h", "24h", "7d", "30d"]
|
|
`shouldBe` [ Just TenMinutes
|
|
, Just OneHour
|
|
, Just OneDay
|
|
, Just OneWeek
|
|
, Just OneMonth
|
|
]
|
|
|
|
it "rejects everything outside the closed set" $
|
|
map parseRange
|
|
[ ""
|
|
, "1h "
|
|
, " 1h"
|
|
, "1h; rm -rf /"
|
|
, "end-1h"
|
|
, "../../etc/passwd"
|
|
, "1y"
|
|
, "30m"
|
|
, "1H"
|
|
]
|
|
`shouldBe` replicate 9 Nothing
|
|
|
|
describe "rangeStart" $ do
|
|
it "renders rrdtool end- relative starts" $
|
|
map rangeStart [TenMinutes, OneHour, OneDay, OneWeek, OneMonth]
|
|
`shouldBe` ["end-10m", "end-1h", "end-24h", "end-7d", "end-30d"]
|
|
|
|
describe "parseNameParam" $ do
|
|
it "resolves the traffic graph only with a .png suffix" $ do
|
|
fmap gsName (parseNameParam graphs "traffic.png") `shouldBe` Just "traffic"
|
|
parseNameParam graphs "traffic" `shouldBe` Nothing
|
|
|
|
it "rejects unknown, malformed, and traversing names" $
|
|
map (parseNameParam graphs)
|
|
[ "unknown.png"
|
|
, "../traffic.png"
|
|
, "traffic.png.png"
|
|
, ""
|
|
, "nope"
|
|
]
|
|
`shouldBe` replicate 5 Nothing
|
|
|
|
describe "buildGraphArgs" $ do
|
|
it "builds the traffic argv for a range" $
|
|
buildGraphArgs "hass-controller.rrd" traffic OneHour
|
|
`shouldBe`
|
|
[ "graph"
|
|
, "-"
|
|
, "--start", "end-1h"
|
|
, "--title", "Hass triggers in / services out"
|
|
, "--width", "800"
|
|
, "--height", "250"
|
|
, "--imgformat", "PNG"
|
|
, "DEF:in_raw=hass-controller.rrd:hass_trigger_in:AVERAGE"
|
|
, "CDEF:in=in_raw,60.0,*"
|
|
, "DEF:out_raw=hass-controller.rrd:hass_service_out:AVERAGE"
|
|
, "CDEF:out=out_raw,60.0,*"
|
|
, "LINE2:in#0066cc:Triggers in/min"
|
|
, "LINE2:out#cc0000:Service calls out/min"
|
|
]
|
|
|
|
describe "end-to-end (rrdtool-gated)" $ do
|
|
it "renders a PNG for the traffic graph" $ do
|
|
mRrdtool <- findExecutable "rrdtool"
|
|
case mRrdtool of
|
|
Nothing -> pendingWith "rrdtool not on PATH"
|
|
Just rrdtool -> do
|
|
tmp <- getTemporaryDirectory
|
|
let rrdPath = tmp ++ "/hass-controller-graph-test.rrd"
|
|
cleanup = try (removeFile rrdPath) :: IO (Either SomeException ())
|
|
schema =
|
|
[ ("hass_trigger_in", Metrics.Derive)
|
|
, ("hass_service_out", Metrics.Derive)
|
|
]
|
|
pngMagic = BS.pack [0x89, 0x50, 0x4E, 0x47, 0x0D, 0x0A, 0x1A, 0x0A]
|
|
_ <- cleanup
|
|
( do
|
|
(createCode, _, _) <-
|
|
readProcessWithExitCode rrdtool (Metrics.buildCreateArgs rrdPath 10 schema) ""
|
|
createCode `shouldBe` ExitSuccess
|
|
(updateCode, _, _) <-
|
|
readProcessWithExitCode
|
|
rrdtool
|
|
(Metrics.buildUpdateArgs
|
|
rrdPath
|
|
["hass_trigger_in", "hass_service_out"]
|
|
[Just 5, Just 3])
|
|
""
|
|
updateCode `shouldBe` ExitSuccess
|
|
(code, out, _) <- readProcessBytes rrdtool (buildGraphArgs rrdPath traffic OneHour)
|
|
code `shouldBe` ExitSuccess
|
|
out `shouldSatisfy` BS.isPrefixOf pngMagic
|
|
)
|
|
`finally` cleanup
|
|
|
|
|
|
|