{-# LANGUAGE OverloadedStrings #-}

module BusSpec (spec) where

import AFRP (Request (..), Event (..))
import Control.Concurrent.STM
  ( atomically
  , dupTChan
  , isEmptyTChan
  , readTChan
  , writeTChan
  )
import Data.Aeson (Value (..))
import qualified Data.HashMap.Strict as HM
import Data.Time (UTCTime (..), utc)
import Data.UUID (nil)
import HomeAssistant.Controller (HASSEff (..), Service (..), Target(..))
import HomeAssistant.Runtime.Bus
import HomeAssistant.Runtime.Flags (loadFlags, setEnabled)
import HomeAssistant.Runtime.Metrics (registerAppMetrics)
import Control.Monad.IO.Class (liftIO)
import Katip (Namespace (Namespace), runKatipContextT)
import Katip.Monadic (runNoLoggingT)
import Support (withTestLogEnv)
import qualified System.Metrics as Metrics
import System.IO.Temp (withTempDirectory)
import System.Timeout (timeout)
import Test.Hspec

spec :: Spec
spec = describe "Bus" $ do
  it "broadcasts inbound messages to every dup'd channel in order" $ withTestBus $ \bus -> do
    p1 <- atomically $ dupTChan (busInbound bus)
    p2 <- atomically $ dupTChan (busInbound bus)
    atomically $ writeTChan (busInbound bus) (Event (Number 1))
    atomically $ writeTChan (busInbound bus) (Event (Number 2))
    r1 <- atomically $ (,) <$> readTChan p1 <*> readTChan p1
    r2 <- atomically $ (,) <$> readTChan p2 <*> readTChan p2
    r1 `shouldBe` (Event (Number 1), Event (Number 2))
    r2 `shouldBe` (Event (Number 1), Event (Number 2))

  it "channelHassEval writes CallService to the outbound channel" $ withTestBus $ \bus -> do
    let req = Request (UTCTime (toEnum 0) 0) utc nil "test"
        svc = Service "light" "turn_on" Nothing [EntityId "light.bedroom_masse"]
    runKatipContextT (busLogEnv bus) () (Namespace ["test"]) $
      channelHassEval bus (CallService req svc)
    (_, svc') <- atomically $ readTChan (busOutbound bus)
    svc' `shouldBe` svc

  it "channelHassEval writes CallService to the outbound channel even when the handler is disabled" $
    withTestFlagsBus $ \bus -> do
      setEnabled (busFlags bus) "test-handler" False
      let req = Request (UTCTime (toEnum 0) 0) utc nil "test-handler"
          svc = Service "light" "turn_on" Nothing [EntityId "light.test"]
      runKatipContextT (busLogEnv bus) () (Namespace ["test"]) $
        channelHassEval bus (CallService req svc)
      result <- timeout 1000000 $ atomically $ readTChan (busOutbound bus)
      case result of
        Nothing -> expectationFailure "expected a write to the outbound channel"
        Just (_, svc') -> svc' `shouldBe` svc

  it "generates unique sequential call ids" $ do
    gen <- mkCallIdGen 0
    a <- generateCallId gen
    b <- generateCallId gen
    (a, b) `shouldBe` (1, 2)

  describe "recordInbound / recordOutbound" $ do
    it "increments the trigger and service counters" $ do
      store <- Metrics.newStore
      m <- registerAppMetrics store
      withTempDirectory "/tmp" "bus-spec" $ \dir -> do
        flags <- runNoLoggingT (loadFlags dir [])
        withTestLogEnv $ \le -> withBus le m flags $ \bus -> do
          recordInbound bus
          recordInbound bus
          recordOutbound bus
          sample <- Metrics.sampleAll store
          HM.lookup "hass.trigger.in" sample `shouldBe` Just (Metrics.Counter 2)
          HM.lookup "hass.service.out" sample `shouldBe` Just (Metrics.Counter 1)

withTestBus :: (Bus -> IO a) -> IO a
withTestBus action = do
  store <- Metrics.newStore
  m <- registerAppMetrics store
  withTestLogEnv $ \le ->
    withTempDirectory "/tmp" "bus-spec" $ \dir -> do
      flags <- runNoLoggingT (loadFlags dir [])
      withBus le m flags action

withTestFlagsBus :: (Bus -> IO a) -> IO a
withTestFlagsBus action = do
  store <- Metrics.newStore
  m <- registerAppMetrics store
  withTestLogEnv $ \le ->
    withTempDirectory "/tmp" "bus-spec" $ \dir -> do
      flags <- runNoLoggingT (loadFlags dir ["test-handler"])
      withBus le m flags action