{-| 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.TChan qualified as TChan 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 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 :: Spec tests = sequential $ aroundAll withTestDBAndPort $ do describe "Dispatcher, Central Exchange, WebSockets" $ do it "simple WS notification works" $ \((_testEnv, port), _) -> do tchan <- TChan.newTChanIO -- 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 atomically $ TChan.writeTChan tchan (Aeson.eitherDecode d) putStrLn "After WS client" -- wait a bit to settle putStrLn "settling a bit initially" threadDelay 1000000 putStrLn "forking wsConnection" wsConnection <- forkIO $ wsConnect -- wait a bit to connect threadDelay 1000000 putStrLn "settling a bit for connection" threadDelay 1000000 let msg = CET.UpdateTreeFirstLevel 0 putStrLn "Notifying CE" CE.notify msg putStrLn "Reading tvar with timeout" d <- Timeout.timeout 1000000 (atomically $ TChan.readTChan tchan) putStrLn "Killing wsConnection thread" killThread wsConnection putStrLn "Checking d" d `shouldBe` (Just $ Right msg)