{-|
Module      : Test.API.Notifications
Description : Tests for the notification mechanism (central exchange, dispatcher, websockets)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# OPTIONS_GHC -Wno-orphans  #-}

{-# LANGUAGE QuasiQuotes #-}
    
module Test.API.Notifications (
    tests
  ) where

import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Concurrent.STM.TVar qualified as TVar
import Control.Monad.STM (atomically)
import Data.Aeson qualified as Aeson
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT
import Gargantext.Core.Config.Types (NotificationsConfig(..))
import Network.WebSockets.Client qualified as WS
import Network.WebSockets.Connection qualified as WS
import Prelude
import System.Timeout qualified as Timeout
import Test.API.Setup (withTestDBAndPort)  -- , setupEnvironment, createAliceAndBob)
import Test.Hspec
import Test.Instances ()
import Text.RawString.QQ (r)


tests :: NotificationsConfig -> Spec
tests nc = sequential $ aroundAll withTestDBAndPort $ do
  describe "Dispatcher, Central Exchange, WebSockets" $ do
    it "simple WS notification works" $ \((_testEnv, port), _) -> do
      tvar <- TVar.newTVarIO Nothing
      -- setup a websocket connection
      let wsConnect = do
            putStrLn $ "Creating WS client (port " <> show port <> ")"
            WS.runClient "127.0.0.1" port "/ws" $ \conn -> do
              WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe $ DT.UpdateTree 0)
              d <- WS.receiveData conn
              putStrLn ("received: " <> show d)
              atomically $ TVar.writeTVar tvar (Aeson.decode d)
            putStrLn "After WS client"
            
      -- wait a bit to settle
      putStrLn "settling a bit initially"
      threadDelay (500 * millisecond)
    
      putStrLn "forking wsConnection"
      wsConnection <- forkIO $ wsConnect
      
      -- wait a bit to connect
      threadDelay (500 * millisecond)
      putStrLn "settling a bit for connection"
      threadDelay (500 * millisecond)

      let msg = CET.UpdateTreeFirstLevel 0
      putStrLn "Notifying CE"
      CE.notify nc msg

      threadDelay (500 * millisecond)
      putStrLn "Reading tvar with timeout"
      d <- TVar.readTVarIO tvar
      putStrLn "Killing wsConnection thread" 
      killThread wsConnection

      putStrLn "Checking d" 

      d `shouldBe` (Just msg)


millisecond :: Int
millisecond = 1000