{-| 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 #-} 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 Test.API.Setup (withTestDBAndPort) -- , setupEnvironment, createAliceAndBob) import Test.Hspec import Test.Instances () 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