{-# 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

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 "parseRange" $ do
    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:trig=hass-controller.rrd:hass_trigger_in:AVERAGE"
          , "CDEF:trig_min=trig,60,*"
          , "DEF:svc=hass-controller.rrd:hass_service_out:AVERAGE"
          , "CDEF:svc_min=svc,60,*"
          , "LINE2:trig_min#0066cc:triggers in/min"
          , "LINE2:svc_min#cc0000:services 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