Merge remote-tracking branch 'origin/dev-websockets-node-update' into dev

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
 

bin/gargantext-central-exchange/Main.hs

@@ -17,8 +17,8 @@ import Control.Concurrent (threadDelay)
 import Control.Monad (join, mapM_)
 import Data.ByteString.Char8 qualified as C
 import Data.Text qualified as T
-import Gargantext.Core.AsyncUpdates.CentralExchange (gServer)
-import Gargantext.Core.AsyncUpdates.Constants (ceBind, ceConnect)
+import Gargantext.Core.Notifications.CentralExchange (gServer)
+import Gargantext.Core.Notifications.Constants (ceBind, ceConnect)
 import Gargantext.Prelude
 import Nanomsg
 import Options.Applicative

bin/gargantext-cli/CLI/Invitations.hs

@@ -21,7 +21,7 @@ import Gargantext.API.Errors.Types
 import Gargantext.API.Node () -- instances only
 import Gargantext.API.Node.Share qualified as Share
 import Gargantext.API.Node.Share.Types qualified as Share
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (User(..))

gargantext.cabal

@@ -164,14 +164,6 @@ library
       Gargantext.API.Types
       Gargantext.API.Viz.Types
       Gargantext.Core
-      Gargantext.Core.AsyncUpdates
-      Gargantext.Core.AsyncUpdates.CentralExchange
-      Gargantext.Core.AsyncUpdates.CentralExchange.Types
-      Gargantext.Core.AsyncUpdates.Dispatcher
-      Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions
-      Gargantext.Core.AsyncUpdates.Dispatcher.Types
-      Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket
-      Gargantext.Core.AsyncUpdates.Nanomsg
       Gargantext.Core.Config
       Gargantext.Core.Config.Ini.Ini
       Gargantext.Core.Config.Ini.Mail
@@ -187,6 +179,14 @@ library
       Gargantext.Core.NodeStory
       Gargantext.Core.NodeStory.DB
       Gargantext.Core.NodeStory.Types
+      Gargantext.Core.Notifications
+      Gargantext.Core.Notifications.CentralExchange
+      Gargantext.Core.Notifications.CentralExchange.Types
+      Gargantext.Core.Notifications.Dispatcher
+      Gargantext.Core.Notifications.Dispatcher.Subscriptions
+      Gargantext.Core.Notifications.Dispatcher.Types
+      Gargantext.Core.Notifications.Dispatcher.WebSocket
+      Gargantext.Core.Notifications.Nanomsg
       Gargantext.Core.Text
       Gargantext.Core.Text.Context
       Gargantext.Core.Text.Corpus.API
@@ -797,12 +797,12 @@ test-suite garg-test-tasty
   other-modules:
       CLI.Phylo.Common
       Paths_gargantext
-      Test.Core.AsyncUpdates
       Test.API.Private.Share
       Test.API.Authentication
       Test.API.Routes
       Test.API.Setup
       Test.API.UpdateList
+      Test.Core.Notifications
       Test.Core.Similarity
       Test.Core.Text
       Test.Core.Text.Corpus.Query

src/Gargantext/API/Admin/EnvTypes.hs

@@ -40,10 +40,10 @@ import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Job
 import Gargantext.API.Prelude (GargM, IsGargServer)
-import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
-import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher)
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types (HasDispatcher(..))
+import Gargantext.Core.Notifications.CentralExchange qualified as CE
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
+import Gargantext.Core.Notifications.Dispatcher (Dispatcher)
+import Gargantext.Core.Notifications.Dispatcher.Types (HasDispatcher(..))
 import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..))
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)

src/Gargantext/API/Admin/Settings.hs

@@ -28,8 +28,8 @@ import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
-import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
-import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
+import Gargantext.Core.Notifications.CentralExchange qualified as CE
+import Gargantext.Core.Notifications.Dispatcher qualified as D
 import Gargantext.Core.Config (GargConfig(..), gc_jobs, gc_frontend_config, hasConfig)
 import Gargantext.Core.Config.Types (PortNumber, SettingsFile(..), fc_appPort, jc_js_job_timeout, jc_js_id_timeout, jwtSettings)
 import Gargantext.Core.Config.Utils (readConfig)

src/Gargantext/API/Node/New.hs

@@ -27,7 +27,7 @@ import Gargantext.API.Errors.Types
 import Gargantext.API.Node.New.Types
 import Gargantext.API.Prelude
 import Gargantext.API.Routes.Named.Node qualified as Named
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CE
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node
 import Gargantext.Database.Admin.Types.Node

src/Gargantext/API/Node/Share.hs

@@ -20,7 +20,7 @@ import Data.Text qualified as Text
 import Gargantext.API.Node.Share.Types
 import Gargantext.API.Prelude
 import Gargantext.API.Routes.Named.Share qualified as Named
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification)
+import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
 import Gargantext.Database.Action.Share (ShareNodeWith(..))

src/Gargantext/API/Prelude.hs

@@ -25,7 +25,7 @@ import Data.Aeson.Types
 import Gargantext.API.Admin.Auth.Types (AuthenticationError)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Errors.Class
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification)
+import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
 import Gargantext.Core.Config (HasConfig)
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)

src/Gargantext/API/Routes/Named.hs

@@ -27,7 +27,7 @@ import Gargantext.API.GraphQL
 import Gargantext.API.Routes.Named.Private
 import Gargantext.API.Routes.Named.Public
 import Gargantext.API.Routes.Types
-import Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket qualified as Dispatcher
+import Gargantext.Core.Notifications.Dispatcher.WebSocket qualified as Dispatcher
 import Servant.API ((:>), (:-), JSON, ReqBody, Post, Get, QueryParam)
 import Servant.API.Description (Summary)
 import Servant.API.NamedRoutes

src/Gargantext/API/Server/Named.hs

@@ -22,7 +22,7 @@ import Gargantext.API.Routes.Named
 import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
 import Gargantext.API.Swagger (swaggerDoc)
 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
-import Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket qualified as Dispatcher
+import Gargantext.Core.Notifications.Dispatcher.WebSocket qualified as Dispatcher
 import Gargantext.Core.Config (gc_frontend_config, hasConfig)
 import Gargantext.Core.Config.Types (fc_url_backend_api)
 import Gargantext.Prelude hiding (Handler, catch)

src/Gargantext/Core/AsyncUpdates.hs → src/Gargantext/Core/Notifications.hs

 {-|
-Module      : Gargantext.Core.AsyncUpdates
+Module      : Gargantext.Core.Notifications
 Description : Asynchronous updates to the frontend
 Copyright   : (c) CNRS, 2024-Present
 License     : AGPL + CECILL v3
@@ -10,7 +10,7 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME(cgenie) undefined remains in code
 
-module Gargantext.Core.AsyncUpdates
+module Gargantext.Core.Notifications
 where
 
 import Gargantext.Core.Types (NodeId, UserId)

src/Gargantext/Core/AsyncUpdates/CentralExchange.hs → src/Gargantext/Core/Notifications/CentralExchange.hs

 {-|
-Module      : Gargantext.Core.AsyncUpdates.CentralExchange
+Module      : Gargantext.Core.Notifications.CentralExchange
 Description : Central exchange (asynchronous notifications)
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -14,7 +14,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
     
 -}
 
-module Gargantext.Core.AsyncUpdates.CentralExchange (
+module Gargantext.Core.Notifications.CentralExchange (
     gServer
   , notify
   ) where
@@ -25,8 +25,8 @@ import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as BSL
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types
 import Gargantext.Core.Config.Types (NotificationsConfig(..))
+import Gargantext.Core.Notifications.CentralExchange.Types
 import Gargantext.Prelude
 import Gargantext.System.Logging (LogLevel(..), withLogger, logMsg)
 import Nanomsg (Pull(..), Push(..), bind, connect, recv, send, withSocket)

src/Gargantext/Core/AsyncUpdates/CentralExchange/Types.hs → src/Gargantext/Core/Notifications/CentralExchange/Types.hs

 {-|
-Module      : Gargantext.Core.AsyncUpdates.CentralExchange.Types
+Module      : Gargantext.Core.Notifications.CentralExchange.Types
 Description : Types for asynchronous notifications (central exchange)
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -13,7 +13,7 @@ Docs:
 https://dev.sub.gargantext.org/#/share/Notes/187918    
 -}
 
-module Gargantext.Core.AsyncUpdates.CentralExchange.Types where
+module Gargantext.Core.Notifications.CentralExchange.Types where
 
 import Codec.Binary.UTF8.String qualified as CBUTF8
 import Data.Aeson ((.:), (.=), object, withObject)

src/Gargantext/Core/AsyncUpdates/Dispatcher.hs → src/Gargantext/Core/Notifications/Dispatcher.hs

 {-|
-Module      : Gargantext.Core.AsyncUpdates.Dispatcher
+Module      : Gargantext.Core.Notifications.Dispatcher
 Description : Dispatcher (handles websocket connections, accepts message from central exchange)
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
 
 {-# LANGUAGE TypeOperators #-}
     
-module Gargantext.Core.AsyncUpdates.Dispatcher (
+module Gargantext.Core.Notifications.Dispatcher (
     Dispatcher -- opaque
   , newDispatcher
   , terminateDispatcher
@@ -32,9 +32,9 @@ import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as BSL
 import Data.Text qualified as T
 import DeferredFolds.UnfoldlM qualified as UnfoldlM
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CETypes
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types
 import Gargantext.Core.Config.Types (NotificationsConfig(..))
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CETypes
+import Gargantext.Core.Notifications.Dispatcher.Types
 import Gargantext.Prelude
 import Gargantext.System.Logging (LogLevel(DEBUG), withLogger, logMsg)
 import Nanomsg (Pull(..), bind, recv, withSocket)

src/Gargantext/Core/AsyncUpdates/Dispatcher/Subscriptions.hs → src/Gargantext/Core/Notifications/Dispatcher/Subscriptions.hs

 {-|
-Module      : Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions
+Module      : Gargantext.Core.Notifications.Dispatcher.Subscriptions
 Description : Dispatcher (manage websocket subscriptions)
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -15,10 +15,10 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
 -}
 
     
-module Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions where
+module Gargantext.Core.Notifications.Dispatcher.Subscriptions where
 
 import DeferredFolds.UnfoldlM qualified as UnfoldlM
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types
+import Gargantext.Core.Notifications.Dispatcher.Types
 import Gargantext.Prelude
 import StmContainers.Set as SSet
 

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

 {-|
-Module      : Gargantext.Core.AsyncUpdates.Dispatcher.Types
+Module      : Gargantext.Core.Notifications.Dispatcher.Types
 Description : Dispatcher (handles websocket connections, accepts message from central exchange)
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
 
 {-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-imports #-}
     
-module Gargantext.Core.AsyncUpdates.Dispatcher.Types where
+module Gargantext.Core.Notifications.Dispatcher.Types where
 
 import Codec.Binary.UTF8.String qualified as CBUTF8
 import Control.Concurrent.Async qualified as Async
@@ -32,7 +32,7 @@ import Data.UUID.V4 as UUID
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (IsGargServer)
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CETypes
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CETypes
 import Gargantext.Core.Types (NodeId, UserId)
 import Gargantext.Prelude
 import GHC.Conc (TVar, newTVarIO, readTVar, writeTVar)
@@ -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

src/Gargantext/Core/AsyncUpdates/Dispatcher/WebSocket.hs → src/Gargantext/Core/Notifications/Dispatcher/WebSocket.hs

 {-|
-Module      : Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket
+Module      : Gargantext.Core.Notifications.Dispatcher.WebSocket
 Description : Dispatcher websocket server
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
 
 {-# LANGUAGE TypeOperators #-}
     
-module Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket where
+module Gargantext.Core.Notifications.Dispatcher.WebSocket where
 
 import Control.Concurrent.Async qualified as Async
 import Control.Lens (view)
@@ -24,9 +24,9 @@ import Data.Aeson qualified as Aeson
 import Data.UUID.V4 as UUID
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
 import Gargantext.API.Prelude (IsGargServer)
-import Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types
-import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher, dispatcherSubscriptions)
+import Gargantext.Core.Notifications.Dispatcher.Subscriptions
+import Gargantext.Core.Notifications.Dispatcher.Types
+import Gargantext.Core.Notifications.Dispatcher (Dispatcher, dispatcherSubscriptions)
 import Gargantext.Core.Config (HasJWTSettings(jwtSettings))
 import Gargantext.Prelude
 import Gargantext.System.Logging (LogLevel(DEBUG), logMsg, withLogger)

src/Gargantext/Core/AsyncUpdates/Nanomsg.hs → src/Gargantext/Core/Notifications/Nanomsg.hs

 {-|
-Module      : Gargantext.Core.AsyncUpdates.Nanomsg
+Module      : Gargantext.Core.Notifications.Nanomsg
 Description : Nanomsg utils
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -14,7 +14,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
     
 -}
 
-module Gargantext.Core.AsyncUpdates.Nanomsg where
+module Gargantext.Core.Notifications.Nanomsg where
 
 import Gargantext.Prelude
 import Nanomsg

src/Gargantext/Core/Worker/Env.hs

@@ -27,8 +27,8 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
 import Gargantext.API.Admin.Settings ( devSettings, newPool )
 import Gargantext.API.Admin.Types (HasSettings(..), Settings(..))
 import Gargantext.API.Prelude (GargM)
-import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
+import Gargantext.Core.Notifications.CentralExchange qualified as CE
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Config (GargConfig(..), HasConfig(..))
 import Gargantext.Core.Config.Mail qualified as Mail
 import Gargantext.Core.Config.Utils (readConfig)

src/Gargantext/Database/Action/Delete.hs

@@ -20,7 +20,7 @@ module Gargantext.Database.Action.Delete
 import Control.Lens (view)
 import Data.Text (unpack)
 import Gargantext.Core (HasDBid(..))
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types (ce_notify, CEMessage(..))
+import Gargantext.Core.Notifications.CentralExchange.Types (ce_notify, CEMessage(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Share (delFolderTeam)
 import Gargantext.Database.Action.User (getUserId)

src/Gargantext/Database/Action/Flow.hs

@@ -65,7 +65,7 @@ import Data.Text qualified as T
 import EPO.API.Client.Types qualified as EPO
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.Core (Lang(..), NLPServerConfig, withDefaultLanguage)
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification(ce_notify), CEMessage(..))
+import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification(ce_notify), CEMessage(..))
 import Gargantext.Core.Config (GargConfig(..), hasConfig)
 import Gargantext.Core.Config.Types (APIsConfig(..))
 import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)

src/Gargantext/Database/Action/Share.hs

@@ -18,6 +18,7 @@ module Gargantext.Database.Action.Share
 
 import Control.Arrow (returnA)
 import Control.Lens (view)
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database
 import Gargantext.Database.Action.User (getUserId)
@@ -104,10 +105,14 @@ shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
         then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
         else do
           folderSharedId  <- getFolderId u NodeFolderShared
-          insertDB ([NodeNode { _nn_node1_id = folderSharedId
+          ret <- insertDB ([NodeNode { _nn_node1_id = folderSharedId
                                      , _nn_node2_id = n
                                      , _nn_score = Nothing
                                      , _nn_category = Nothing }]:: [NodeNode])
+          void $ CE.ce_notify $ CE.UpdateTreeFirstLevel folderSharedId
+          void $ CE.ce_notify $ CE.UpdateTreeFirstLevel n
+
+          return ret
 
 shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
   nodeToCheck <- getNode n
@@ -117,10 +122,15 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
     else do
       folderToCheck <- getNode nId
       if hasNodeType folderToCheck NodeFolderPublic
-         then insertDB ([NodeNode { _nn_node1_id = nId
+        then do
+          ret <- insertDB ([NodeNode { _nn_node1_id = nId
                                      , _nn_node2_id = n
                                      , _nn_score = Nothing
                                      , _nn_category = Nothing }] :: [NodeNode])
+          void $ CE.ce_notify $ CE.UpdateTreeFirstLevel nId
+          void $ CE.ce_notify $ CE.UpdateTreeFirstLevel n
+
+          return ret
         else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"
 
 shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"

src/Gargantext/Database/Prelude.hs

@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple qualified as PGS
 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Database.PostgreSQL.Simple.Types (Query(..))
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Config (HasConfig(..))
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)

src/Gargantext/Database/Query/Table/Node/Update.hs

@@ -14,7 +14,7 @@ module Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 
 import Data.Text qualified as DT
 import Database.PostgreSQL.Simple ( Only(Only) )
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CE
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Node (NodeId, ParentId)
 import Gargantext.Database.Query.Table.Node (getParentId)

test/Test/API.hs

 
 module Test.API where
 
+import Gargantext.Core.Notifications.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 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 Data.Maybe (isJust)
+import Gargantext.Core.Notifications.CentralExchange qualified as CE
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
+import Gargantext.Core.Notifications.Dispatcher qualified as D
+import Gargantext.Core.Notifications.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.Notifications.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/Core/AsyncUpdates.hs

 {-|
-Module      : Core.AsyncUpdates
+Module      : Core.Notifications
 Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -9,14 +9,14 @@ Portability : POSIX
 
 -}
 
-module Test.Core.AsyncUpdates
+module Test.Core.Notifications
   ( test
   , qcTests )
 where
 
 import Data.Aeson qualified as A
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types
+import Gargantext.Core.Notifications.CentralExchange.Types
+import Gargantext.Core.Notifications.Dispatcher.Types
 import Gargantext.Prelude
 import Test.Hspec
 import Test.Instances ()

test/Test/Instances.hs

@@ -26,8 +26,8 @@ import Gargantext.API.Errors.Types qualified as Errors
 import Gargantext.API.Ngrams.Types qualified as Ngrams
 import Gargantext.API.Node.Corpus.New (ApiInfo(..))
 import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
-import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DET
+import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
+import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET
 import Gargantext.Core.NodeStory.Types qualified as NS
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))

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

@@ -6,9 +6,9 @@ import Gargantext.Prelude hiding (isInfixOf)
 
 import Control.Monad
 import Data.Text (isInfixOf)
-import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
-import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
-import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT
+import Gargantext.Core.Notifications.CentralExchange qualified as CE
+import Gargantext.Core.Notifications.Dispatcher qualified as D
+import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
 import Gargantext.Core.Config.Types (NotificationsConfig(..))
 import Shelly hiding (FilePath)
 import System.IO
@@ -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

test/drivers/tasty/Main.hs

@@ -26,7 +26,7 @@ import qualified Test.Parsers.Date               as PD
 import qualified Test.Utils.Crypto               as Crypto
 import qualified Test.Utils.Jobs                 as Jobs
 import qualified Test.Core.Similarity            as Similarity
-import qualified Test.Core.AsyncUpdates          as AsyncUpdates
+import qualified Test.Core.Notifications          as Notifications
 
 import Test.Tasty
 import Test.Tasty.Hspec
@@ -40,7 +40,7 @@ main = do
   nlpSpec          <- testSpec "NLP" NLP.test
   jobsSpec         <- testSpec "Jobs" Jobs.test
   similaritySpec   <- testSpec "Similarity" Similarity.test
-  asyncUpdatesSpec <- testSpec "AsyncUpdates" AsyncUpdates.test
+  asyncUpdatesSpec <- testSpec "Notifications" Notifications.test
 
   defaultMain $ testGroup "Gargantext"
     [ utilSpec
@@ -58,5 +58,5 @@ main = do
     , Phylo.tests
     , testGroup "Stemming" [ Lancaster.tests ]
     , asyncUpdatesSpec
-    , AsyncUpdates.qcTests
+    , Notifications.qcTests
     ]