[tests] first working notification test

README.md

@@ -233,10 +233,14 @@ Or, from "outside":
 $ nix-shell --run "cabal v2-test --test-show-details=streaming"
 ```
 
-If you want to run particular tests, use:
+If you want to run particular tests, use (for Tasty):
 ```shell
 cabal v2-test garg-test-tasty --test-show-details=streaming --test-option=--pattern='/job status update and tracking/
 ```
+or (for Hspec):
+```shell
+cabal v2-test garg-test-hspec --test-show-details=streaming --test-option=--match='/Dispatcher, Central Exchange, WebSockets/'
+```
 
 ### CI
 

src/Gargantext/Core/AsyncUpdates/Dispatcher/Types.hs

@@ -215,4 +215,10 @@ instance ToJSON Notification where
        , "message" .= toJSON message
        ])
     ]
-    
+-- We don't need to decode notifications, this is for tests only
+instance FromJSON Notification where
+  parseJSON = Aeson.withObject "Notification" $ \o -> do
+    n <- o .: "notification"
+    topic <- n .: "topic"
+    message <- n .: "message"
+    pure $ Notification topic message

test/Test/API.hs

 
 module Test.API where
 
+import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
 import Gargantext.Core.Config.Types (NotificationsConfig)
 import Prelude
 import Test.Hspec
@@ -11,8 +12,8 @@ import qualified Test.API.Notifications as Notifications
 import qualified Test.API.Private as Private
 import qualified Test.API.UpdateList as UpdateList
 
-tests :: NotificationsConfig -> Spec
-tests _nc = describe "API" $ do
+tests :: NotificationsConfig -> D.Dispatcher -> Spec
+tests nc dispatcher = describe "API" $ do
   Auth.tests
   Private.tests
   GraphQL.tests
@@ -20,4 +21,4 @@ tests _nc = describe "API" $ do
   UpdateList.tests
   -- | TODO This would work if I managed to get forking dispatcher &
   --   exchange listeners properly
-  -- Notifications.tests nc
+  Notifications.tests nc dispatcher

test/Test/API/Notifications.hs

@@ -17,61 +17,60 @@ module Test.API.Notifications (
   ) where
 
 import Control.Concurrent (forkIO, killThread, threadDelay)
-import Control.Concurrent.STM.TVar qualified as TVar
+import Control.Concurrent.STM.TChan
 import Control.Monad.STM (atomically)
 import Data.Aeson qualified as Aeson
+import Data.Maybe (isJust)
 import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
+import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
 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.API.Setup (withTestDBAndNotifications)  -- , setupEnvironment, createAliceAndBob)
 import Test.Hspec
 import Test.Instances ()
 
 
-tests :: NotificationsConfig -> Spec
-tests nc = sequential $ aroundAll withTestDBAndPort $ do
+tests :: NotificationsConfig -> D.Dispatcher -> Spec
+tests nc dispatcher = sequential $ aroundAll (withTestDBAndNotifications dispatcher) $ do
   describe "Dispatcher, Central Exchange, WebSockets" $ do
     it "simple WS notification works" $ \((_testEnv, port), _) -> do
-      tvar <- TVar.newTVarIO Nothing
+      let topic = DT.UpdateTree 0
+      tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
       -- 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)
+              -- We wait a bit before the server settles
+              threadDelay (100 * millisecond)
+              WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe topic)
               d <- WS.receiveData conn
-              putStrLn ("received: " <> show d)
-              atomically $ TVar.writeTVar tvar (Aeson.decode d)
-            putStrLn "After WS client"
+              let dec = Aeson.decode d :: Maybe DT.Notification
+              atomically $ writeTChan tchan dec
+              -- atomically $ TVar.writeTVar tvar (Aeson.decode d)
+            putStrLn "[WSClient] after"
             
       -- wait a bit to settle
-      putStrLn "settling a bit initially"
-      threadDelay (500 * millisecond)
+      threadDelay (100 * millisecond)
     
-      putStrLn "forking wsConnection"
       wsConnection <- forkIO $ wsConnect
       
       -- wait a bit to connect
-      threadDelay (500 * millisecond)
-      putStrLn "settling a bit for connection"
+      threadDelay (100 * millisecond)
       threadDelay (500 * millisecond)
 
-      let msg = CET.UpdateTreeFirstLevel 0
-      putStrLn "Notifying CE"
-      CE.notify nc msg
+      CE.notify nc $ CET.UpdateTreeFirstLevel 0
 
-      threadDelay (500 * millisecond)
-      putStrLn "Reading tvar with timeout"
-      d <- TVar.readTVarIO tvar
-      putStrLn "Killing wsConnection thread" 
+      -- d <- TVar.readTVarIO tvar
+      md <- atomically $ readTChan tchan
       killThread wsConnection
 
-      putStrLn "Checking d" 
-
-      d `shouldBe` (Just msg)
+      md `shouldSatisfy` isJust
+      let (Just (DT.Notification topic' message')) = md
+      topic' `shouldBe` topic
+      message' `shouldBe` DT.MEmpty
 
 
 millisecond :: Int

test/Test/API/Setup.hs

@@ -15,6 +15,7 @@ import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
+import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
 import Gargantext.Core.Config (_gc_secrets, gc_frontend_config, gc_jobs, hasConfig)
 import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort, jwtSettings)
 import Gargantext.Core.Config.Utils (readConfig)
@@ -84,8 +85,8 @@ newTestEnv testEnv logger port = do
     , _env_jobs      = jobs_env
     , _env_self_url  = self_url_env
     , _env_config    = config_env
-    , _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)"
-    , _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)"
+    , _env_central_exchange = Prelude.error "[Test.API.Setup.Env] central exchange not needed, but forced somewhere (check StrictData)"
+    , _env_dispatcher = Prelude.error "[Test.API.Setup.Env] dispatcher not needed, but forced somewhere (check StrictData)"
     -- , _env_central_exchange = central_exchange
     -- , _env_dispatcher = dispatcher
     , _env_jwt_settings
@@ -124,6 +125,15 @@ withTestDBAndPort action =
     let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
     Warp.testWithApplicationSettings stgs (pure app) $ \port -> action ((testEnv, port), app)
 
+withTestDBAndNotifications :: D.Dispatcher -> (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
+withTestDBAndNotifications dispatcher action = do
+  withTestDB $ \testEnv -> do    
+    app <- withLoggerHoisted Mock $ \ioLogger -> do
+             env <- newTestEnv testEnv ioLogger 8080
+             makeApp $ env { _env_dispatcher = dispatcher }
+    let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
+    Warp.testWithApplicationSettings stgs (pure app) $ \port -> action ((testEnv, port), app)
+
 -- | Starts the backend server /and/ the microservices proxy, the former at
 -- a random port, the latter at a predictable port.
 withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO ()

test/Test/Utils/Jobs.hs

@@ -272,36 +272,37 @@ newTestEnv = do
   k <- genSecret
   let settings = defaultJobSettings 1 k
   myEnv <- newJobEnv settings defaultPrios testTlsManager
+  let fmt_error v = Prelude.error $ "[Test.Utils.Jobs.Env] " <> v <> " not needed, but forced somewhere (check StrictData)"
   let _gc_notifications_config =
-        NotificationsConfig { _nc_central_exchange_bind = Prelude.error "nc_central_exchange_bind not needed, but forced somewhere (check StrictData)"
+        NotificationsConfig { _nc_central_exchange_bind = fmt_error "nc_central_exchange_bind"
                             , _nc_central_exchange_connect = "tcp://localhost:15510"
-                            , _nc_dispatcher_bind = Prelude.error "nc_dispatcher_bind not needed, but forced somewhere (check StrictData)"
-                            , _nc_dispatcher_connect = Prelude.error "nc_dispatcher_connect not needed, but forced somewhere (check StrictData)" }
+                            , _nc_dispatcher_bind = fmt_error "nc_dispatcher_bind"
+                            , _nc_dispatcher_connect = fmt_error "nc_dispatcher_connect" }
   let _env_config =
-        GargConfig { _gc_datafilepath = Prelude.error "gc_datafilepath not needed, but forced somewhere (check StrictData)"
-                   , _gc_frontend_config = Prelude.error "gc_frontend_config not needed, but forced somewhere (check StrictData)"
-                   , _gc_mail_config = Prelude.error "gc_mail_config not needed, but forced somewhere (check StrictData)"
-                   , _gc_database_config = Prelude.error "gc_database_config not needed, but forced somewhere (check StrictData)"
-                   , _gc_nlp_config = Prelude.error "gc_nlp_config not needed, but forced somewhere (check StrictData)"
+        GargConfig { _gc_datafilepath = fmt_error "gc_datafilepath"
+                   , _gc_frontend_config = fmt_error "gc_frontend_config"
+                   , _gc_mail_config = fmt_error "gc_mail_config"
+                   , _gc_database_config = fmt_error "gc_database_config"
+                   , _gc_nlp_config = fmt_error "gc_nlp_config"
                    , _gc_notifications_config
-                   , _gc_frames = Prelude.error "gc_frames not needed, but forced somewhere (check StrictData)"
-                   , _gc_jobs = Prelude.error "gc_jobs not needed, but forced somewhere (check StrictData)"
-                   , _gc_secrets = Prelude.error "gc_secrets not needed, but forced somewhere (check StrictData)"
-                   , _gc_apis = Prelude.error "gc_apis not needed, but forced somewhere (check StrictData)"
-                   , _gc_log_level = Prelude.error "gc_log_level not needed, but forced somewhere (check StrictData)"
+                   , _gc_frames = fmt_error "gc_frames not needed"
+                   , _gc_jobs = fmt_error "gc_jobs not needed"
+                   , _gc_secrets = fmt_error "gc_secrets"
+                   , _gc_apis = fmt_error "gc_apis"
+                   , _gc_log_level = fmt_error "gc_log_level"
                    }
   pure $ Env
-       { _env_logger    = Prelude.error "env_logger not needed, but forced somewhere (check StrictData)"
-       , _env_pool      = Prelude.error "env_pool not needed, but forced somewhere (check StrictData)"
-       , _env_nodeStory = Prelude.error "env_nodeStory not needed, but forced somewhere (check StrictData)"
+       { _env_logger    = fmt_error "env_logger"
+       , _env_pool      = fmt_error "env_pool"
+       , _env_nodeStory = fmt_error "env_nodeStory"
        , _env_manager   = testTlsManager
-       , _env_self_url  = Prelude.error "self_url not needed, but forced somewhere (check StrictData)"
-       , _env_scrapers  = Prelude.error "scrapers not needed, but forced somewhere (check StrictData)"
+       , _env_self_url  = fmt_error "self_url"
+       , _env_scrapers  = fmt_error "scrapers"
        , _env_jobs      = myEnv
        , _env_config
-       , _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)"
-       , _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)"
-       , _env_jwt_settings = Prelude.error "jwt_settings not needed, but forced somewherer (check StrictData)"
+       , _env_central_exchange = fmt_error "central exchange"
+       , _env_dispatcher = fmt_error "dispatcher"
+       , _env_jwt_settings = fmt_error "jwt_settings"
        }
 
 testFetchJobStatus :: IO ()

test/drivers/hspec/Main.hs

@@ -16,8 +16,8 @@ import System.Process
 import Test.Hspec
 import qualified Data.Text as T
 import qualified Test.API                     as API
-import qualified Test.Server.ReverseProxy     as ReverseProxy
 import qualified Test.Database.Operations     as DB
+import qualified Test.Server.ReverseProxy     as ReverseProxy
 
 
 startCoreNLPServer :: IO ProcessHandle
@@ -82,9 +82,9 @@ main = do
   hSetBuffering stdout NoBuffering
   -- TODO Ideally remove start/stop notifications and use
   -- Test/API/Setup to initialize this in env
-  withNotifications $ \(nc, _, _) -> do
+  withNotifications $ \(nc, _ce, dispatcher) -> do
     bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ do
-      API.tests nc
+      API.tests nc dispatcher
       ReverseProxy.tests
       DB.tests
       DB.nodeStoryTests