Squashed commit of the following:

commit 3030272d
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Thu Oct 10 18:31:19 2024 +0200

    [VERSION] +1 to 0.0.7.3.2

commit bd33dd6c
Merge: 1d3417d9 592d966c
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Thu Oct 10 18:10:51 2024 +0200

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

commit 592d966c
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Thu Oct 10 18:06:20 2024 +0200

    [notifications] add missing test/Test/Core/Notifications.hs

commit 1d3417d9
Merge: 163304df a48fe0c8
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Thu Oct 10 17:54:39 2024 +0200

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

commit a48fe0c8
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Thu Oct 10 10:01:10 2024 +0200

    [ws] rename AsyncUpdates to Notifications

    This is bit more clear

commit cd831db4
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Wed Oct 9 16:00:48 2024 +0200

    [tests] first working notification test

commit 81af005d
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Wed Oct 9 11:05:11 2024 +0200

    Squashed commit of the following:

    commit 163304df
    Author: Alexandre Delanoë <devel+git@delanoe.org>
    Date:   Tue Oct 8 18:39:54 2024 +0200

        [FIX] conflict

    commit 82c68074
    Merge: f7b76918 5623161c
    Author: Alexandre Delanoë <devel+git@delanoe.org>
    Date:   Tue Oct 8 18:28:55 2024 +0200

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

    commit f7b76918
    Merge: fe7a92cc 88655f68
    Author: Alexandre Delanoë <devel+git@delanoe.org>
    Date:   Tue Oct 8 18:28:53 2024 +0200

        [FIX] conflicts

    commit fe7a92cc
    Author: Christian Merten <christian@merten.dev>
    Date:   Tue Oct 8 17:19:53 2024 +0200

        fix: no longer update graphs and phylos on corpus update

    commit f775d4a3
    Merge: 76b557ea d2f4b89d
    Author: Alexandre Delanoë <devel+git@delanoe.org>
    Date:   Tue Oct 8 16:27:53 2024 +0200

        Merge remote-tracking branch 'origin/dev-guidelines-update' into dev

    commit 76b557ea
    Merge: 2925d008 50c77ea2
    Author: Alexandre Delanoë <devel+git@delanoe.org>
    Date:   Tue Oct 8 16:27:27 2024 +0200

        Merge remote-tracking branch 'origin/304-dev-pubmed-api-not-in-toml' into dev

    commit d2f4b89d
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 15:37:54 2024 +0200

        DEVELOPER_GUIDELINES: update about git amend

        This is the result of Autumn workshop 2024

    commit 50c77ea2
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 15:15:28 2024 +0200

        [notifications] fix for send

        sendNonblocking threw an error initially. I just do a compromise and
        timeout the normal send (which blocks infinitely sometimes)

    commit 025b80b6
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 14:10:56 2024 +0200

        [docker] fix network: host, fix caddyfile

    commit 2925d008
    Author: Christian Merten <christian@merten.dev>
    Date:   Tue Oct 8 10:34:17 2024 +0200

        fix arbitrary instance

    commit e8fb3db6
    Author: Christian Merten <christian@merten.dev>
    Date:   Tue Oct 8 10:13:40 2024 +0200

        fix: re-add lost instances

    commit b86d2e61
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 10:09:18 2024 +0200

        [toml] remove pubmed api key from config

        It's set up in user settings instead and has been for a long time.

    commit c06de5ef
    Merge: ab710337 a0ec337b
    Author: Christian Merten <christian@merten.dev>
    Date:   Tue Oct 8 09:35:55 2024 +0200

        Merge remote-tracking branch 'gitlab/dev' into cm/update-corpus-button

    commit ab710337
    Author: Christian Merten <christian@merten.dev>
    Date:   Fri Apr 26 22:32:33 2024 +0200

        feat: update corpus endpoint

commit d4a9200e
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Wed Oct 9 11:01:43 2024 +0200

    [ws] notification action on node share

commit 163304df
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Tue Oct 8 18:39:54 2024 +0200

    [FIX] conflict

commit 82c68074
Merge: f7b76918 5623161c
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Tue Oct 8 18:28:55 2024 +0200

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

commit f7b76918
Merge: fe7a92cc 88655f68
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Tue Oct 8 18:28:53 2024 +0200

    [FIX] conflicts

commit 5623161c
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Tue Oct 8 18:18:23 2024 +0200

    [ws] implement node update (rename, move) with notifications to parents

commit 88655f68
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Tue Oct 8 18:05:25 2024 +0200

    Squashed commit of the following:

    commit f775d4a3
    Merge: 76b557ea d2f4b89d
    Author: Alexandre Delanoë <devel+git@delanoe.org>
    Date:   Tue Oct 8 16:27:53 2024 +0200

        Merge remote-tracking branch 'origin/dev-guidelines-update' into dev

    commit 76b557ea
    Merge: 2925d008 50c77ea2
    Author: Alexandre Delanoë <devel+git@delanoe.org>
    Date:   Tue Oct 8 16:27:27 2024 +0200

        Merge remote-tracking branch 'origin/304-dev-pubmed-api-not-in-toml' into dev

    commit d2f4b89d
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 15:37:54 2024 +0200

        DEVELOPER_GUIDELINES: update about git amend

        This is the result of Autumn workshop 2024

    commit 50c77ea2
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 15:15:28 2024 +0200

        [notifications] fix for send

        sendNonblocking threw an error initially. I just do a compromise and
        timeout the normal send (which blocks infinitely sometimes)

    commit 025b80b6
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 14:10:56 2024 +0200

        [docker] fix network: host, fix caddyfile

    commit 2925d008
    Author: Christian Merten <christian@merten.dev>
    Date:   Tue Oct 8 10:34:17 2024 +0200

        fix arbitrary instance

    commit e8fb3db6
    Author: Christian Merten <christian@merten.dev>
    Date:   Tue Oct 8 10:13:40 2024 +0200

        fix: re-add lost instances

    commit b86d2e61
    Author: Przemysław Kaminski <pk@intrepidus.pl>
    Date:   Tue Oct 8 10:09:18 2024 +0200

        [toml] remove pubmed api key from config

        It's set up in user settings instead and has been for a long time.

    commit c06de5ef
    Merge: ab710337 a0ec337b
    Author: Christian Merten <christian@merten.dev>
    Date:   Tue Oct 8 09:35:55 2024 +0200

        Merge remote-tracking branch 'gitlab/dev' into cm/update-corpus-button

    commit ab710337
    Author: Christian Merten <christian@merten.dev>
    Date:   Fri Apr 26 22:32:33 2024 +0200

        feat: update corpus endpoint

commit fe7a92cc
Author: Christian Merten <christian@merten.dev>
Date:   Tue Oct 8 17:19:53 2024 +0200

    fix: no longer update graphs and phylos on corpus update

commit f775d4a3
Merge: 76b557ea d2f4b89d
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Tue Oct 8 16:27:53 2024 +0200

    Merge remote-tracking branch 'origin/dev-guidelines-update' into dev

commit 76b557ea
Merge: 2925d008 50c77ea2
Author: Alexandre Delanoë <devel+git@delanoe.org>
Date:   Tue Oct 8 16:27:27 2024 +0200

    Merge remote-tracking branch 'origin/304-dev-pubmed-api-not-in-toml' into dev

commit d2f4b89d
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Tue Oct 8 15:37:54 2024 +0200

    DEVELOPER_GUIDELINES: update about git amend

    This is the result of Autumn workshop 2024

commit 50c77ea2
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Tue Oct 8 15:15:28 2024 +0200

    [notifications] fix for send

    sendNonblocking threw an error initially. I just do a compromise and
    timeout the normal send (which blocks infinitely sometimes)

commit 025b80b6
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Tue Oct 8 14:10:56 2024 +0200

    [docker] fix network: host, fix caddyfile

commit ee0db8c1
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Tue Oct 8 12:39:12 2024 +0200

    [nix] add nanomsg to nix pkgs

    Also, fix ./start to use gargantext-settings.toml

commit 2925d008
Author: Christian Merten <christian@merten.dev>
Date:   Tue Oct 8 10:34:17 2024 +0200

    fix arbitrary instance

commit e8fb3db6
Author: Christian Merten <christian@merten.dev>
Date:   Tue Oct 8 10:13:40 2024 +0200

    fix: re-add lost instances

commit b86d2e61
Author: Przemysław Kaminski <pk@intrepidus.pl>
Date:   Tue Oct 8 10:09:18 2024 +0200

    [toml] remove pubmed api key from config

    It's set up in user settings instead and has been for a long time.

commit c06de5ef
Merge: ab710337 a0ec337b
Author: Christian Merten <christian@merten.dev>
Date:   Tue Oct 8 09:35:55 2024 +0200

    Merge remote-tracking branch 'gitlab/dev' into cm/update-corpus-button

commit ab710337
Author: Christian Merten <christian@merten.dev>
Date:   Fri Apr 26 22:32:33 2024 +0200

    feat: update corpus endpoint
parent 8d5fd6e9
Pipeline #6839 failed with stages
in 18 minutes and 16 seconds
## Version 0.0.7.3.2
* [FRONT][FIX][[Node Graph] Legend tab improvements (#689)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/689)
* [FRONT][FEAT][Notification / websocket issues (#704)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/704)
* Refreshing the pinned tree
## Version 0.0.7.3.1 ## Version 0.0.7.3.1
* [FRONT][FIX][Cannot build the project on latest `dev` (#701)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/701) * [FRONT][FIX][Cannot build the project on latest `dev` (#701)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/701)
......
...@@ -233,10 +233,14 @@ Or, from "outside": ...@@ -233,10 +233,14 @@ Or, from "outside":
$ nix-shell --run "cabal v2-test --test-show-details=streaming" $ 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 ```shell
cabal v2-test garg-test-tasty --test-show-details=streaming --test-option=--pattern='/job status update and tracking/ 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 ### CI
......
...@@ -17,8 +17,8 @@ import Control.Concurrent (threadDelay) ...@@ -17,8 +17,8 @@ import Control.Concurrent (threadDelay)
import Control.Monad (join, mapM_) import Control.Monad (join, mapM_)
import Data.ByteString.Char8 qualified as C import Data.ByteString.Char8 qualified as C
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.Core.AsyncUpdates.CentralExchange (gServer) import Gargantext.Core.Notifications.CentralExchange (gServer)
import Gargantext.Core.AsyncUpdates.Constants (ceBind, ceConnect) import Gargantext.Core.Notifications.Constants (ceBind, ceConnect)
import Gargantext.Prelude import Gargantext.Prelude
import Nanomsg import Nanomsg
import Options.Applicative import Options.Applicative
......
...@@ -21,7 +21,7 @@ import Gargantext.API.Errors.Types ...@@ -21,7 +21,7 @@ import Gargantext.API.Errors.Types
import Gargantext.API.Node () -- instances only import Gargantext.API.Node () -- instances only
import Gargantext.API.Node.Share qualified as Share import Gargantext.API.Node.Share qualified as Share
import Gargantext.API.Node.Share.Types 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.NLP (HasNLPServer)
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
......
...@@ -5,7 +5,7 @@ cabal-version: 3.4 ...@@ -5,7 +5,7 @@ cabal-version: 3.4
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
name: gargantext name: gargantext
version: 0.0.7.3.1 version: 0.0.7.3.2
synopsis: Search, map, share synopsis: Search, map, share
description: Please see README.md description: Please see README.md
category: Data category: Data
...@@ -164,14 +164,6 @@ library ...@@ -164,14 +164,6 @@ library
Gargantext.API.Types Gargantext.API.Types
Gargantext.API.Viz.Types Gargantext.API.Viz.Types
Gargantext.Core 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
Gargantext.Core.Config.Ini.Ini Gargantext.Core.Config.Ini.Ini
Gargantext.Core.Config.Ini.Mail Gargantext.Core.Config.Ini.Mail
...@@ -188,6 +180,14 @@ library ...@@ -188,6 +180,14 @@ library
Gargantext.Core.NodeStory Gargantext.Core.NodeStory
Gargantext.Core.NodeStory.DB Gargantext.Core.NodeStory.DB
Gargantext.Core.NodeStory.Types 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
Gargantext.Core.Text.Context Gargantext.Core.Text.Context
Gargantext.Core.Text.Corpus.API Gargantext.Core.Text.Corpus.API
...@@ -808,12 +808,12 @@ test-suite garg-test-tasty ...@@ -808,12 +808,12 @@ test-suite garg-test-tasty
other-modules: other-modules:
CLI.Phylo.Common CLI.Phylo.Common
Paths_gargantext Paths_gargantext
Test.Core.AsyncUpdates
Test.API.Private.Share Test.API.Private.Share
Test.API.Authentication Test.API.Authentication
Test.API.Routes Test.API.Routes
Test.API.Setup Test.API.Setup
Test.API.UpdateList Test.API.UpdateList
Test.Core.Notifications
Test.Core.Similarity Test.Core.Similarity
Test.Core.Text Test.Core.Text
Test.Core.Text.Corpus.Query Test.Core.Text.Corpus.Query
......
...@@ -44,10 +44,10 @@ import Gargantext.API.Admin.Orchestrator.Types ...@@ -44,10 +44,10 @@ import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Job import Gargantext.API.Job
import Gargantext.API.Prelude (GargM, IsGargServer) import Gargantext.API.Prelude (GargM, IsGargServer)
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher) import Gargantext.Core.Notifications.Dispatcher (Dispatcher)
import Gargantext.Core.AsyncUpdates.Dispatcher.Types (HasDispatcher(..)) import Gargantext.Core.Notifications.Dispatcher.Types (HasDispatcher(..))
import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..)) import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..))
import Gargantext.Core.Mail.Types (HasMail, mailSettings) import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap) import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
......
...@@ -28,8 +28,8 @@ import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo) ...@@ -28,8 +28,8 @@ import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
import Gargantext.API.Admin.EnvTypes import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D import Gargantext.Core.Notifications.Dispatcher qualified as D
import Gargantext.Core.Config (GargConfig(..), gc_jobs, gc_frontend_config, hasConfig) 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.Types (PortNumber, SettingsFile(..), fc_appPort, jc_js_job_timeout, jc_js_id_timeout, jwtSettings)
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
......
...@@ -12,10 +12,8 @@ Async new node feature ...@@ -12,10 +12,8 @@ Async new node feature
-} -}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE IncoherentInstances #-}
module Gargantext.API.Node.New module Gargantext.API.Node.New
where where
...@@ -27,8 +25,8 @@ import Gargantext.API.Errors.Types ...@@ -27,8 +25,8 @@ import Gargantext.API.Errors.Types
import Gargantext.API.Node.New.Types import Gargantext.API.Node.New.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Node qualified as Named import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CE
import Gargantext.Core.Mail.Types (HasMail) import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Worker.Jobs qualified as Jobs import Gargantext.Core.Worker.Jobs qualified as Jobs
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
......
...@@ -20,7 +20,7 @@ import Data.Text qualified as Text ...@@ -20,7 +20,7 @@ import Data.Text qualified as Text
import Gargantext.API.Node.Share.Types import Gargantext.API.Node.Share.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Share qualified as Named 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.NLP (HasNLPServer)
import Gargantext.Core.Types.Individu (User(..), arbitraryUsername) import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
import Gargantext.Database.Action.Share (ShareNodeWith(..)) import Gargantext.Database.Action.Share (ShareNodeWith(..))
......
...@@ -25,7 +25,7 @@ import Data.Aeson.Types ...@@ -25,7 +25,7 @@ import Data.Aeson.Types
import Gargantext.API.Admin.Auth.Types (AuthenticationError) import Gargantext.API.Admin.Auth.Types (AuthenticationError)
import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Errors.Class 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.Config (HasConfig)
import Gargantext.Core.Mail.Types (HasMail) import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Core.NLP (HasNLPServer)
......
...@@ -27,7 +27,7 @@ import Gargantext.API.GraphQL ...@@ -27,7 +27,7 @@ import Gargantext.API.GraphQL
import Gargantext.API.Routes.Named.Private import Gargantext.API.Routes.Named.Private
import Gargantext.API.Routes.Named.Public import Gargantext.API.Routes.Named.Public
import Gargantext.API.Routes.Types 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 ((:>), (:-), JSON, ReqBody, Post, Get, QueryParam)
import Servant.API.Description (Summary) import Servant.API.Description (Summary)
import Servant.API.NamedRoutes import Servant.API.NamedRoutes
......
...@@ -22,7 +22,7 @@ import Gargantext.API.Routes.Named ...@@ -22,7 +22,7 @@ import Gargantext.API.Routes.Named
import Gargantext.API.Server.Named.Public (serverPublicGargAPI) import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
import Gargantext.API.Swagger (swaggerDoc) import Gargantext.API.Swagger (swaggerDoc)
import Gargantext.API.ThrowAll (serverPrivateGargAPI) 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 (gc_frontend_config, hasConfig)
import Gargantext.Core.Config.Types (fc_url_backend_api) import Gargantext.Core.Config.Types (fc_url_backend_api)
import Gargantext.Prelude hiding (Handler, catch) import Gargantext.Prelude hiding (Handler, catch)
......
{-| {-|
Module : Gargantext.Core.AsyncUpdates Module : Gargantext.Core.Notifications
Description : Asynchronous updates to the frontend Description : Asynchronous updates to the frontend
Copyright : (c) CNRS, 2024-Present Copyright : (c) CNRS, 2024-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -10,7 +10,7 @@ Portability : POSIX ...@@ -10,7 +10,7 @@ Portability : POSIX
{-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME(cgenie) undefined remains in code {-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME(cgenie) undefined remains in code
module Gargantext.Core.AsyncUpdates module Gargantext.Core.Notifications
where where
import Gargantext.Core.Types (NodeId, UserId) import Gargantext.Core.Types (NodeId, UserId)
......
{-| {-|
Module : Gargantext.Core.AsyncUpdates.CentralExchange Module : Gargantext.Core.Notifications.CentralExchange
Description : Central exchange (asynchronous notifications) Description : Central exchange (asynchronous notifications)
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -14,7 +14,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918 ...@@ -14,7 +14,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
-} -}
module Gargantext.Core.AsyncUpdates.CentralExchange ( module Gargantext.Core.Notifications.CentralExchange (
gServer gServer
, notify , notify
) where ) where
...@@ -25,8 +25,8 @@ import Data.Aeson qualified as Aeson ...@@ -25,8 +25,8 @@ import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as BSL import Data.ByteString.Lazy qualified as BSL
import Data.Text qualified as T import Data.Text qualified as T
import Data.Text.Encoding qualified as TE import Data.Text.Encoding qualified as TE
import Gargantext.Core.AsyncUpdates.CentralExchange.Types
import Gargantext.Core.Config.Types (NotificationsConfig(..)) import Gargantext.Core.Config.Types (NotificationsConfig(..))
import Gargantext.Core.Notifications.CentralExchange.Types
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging (LogLevel(..), withLogger, logMsg) import Gargantext.System.Logging (LogLevel(..), withLogger, logMsg)
import Nanomsg (Pull(..), Push(..), bind, connect, recv, send, withSocket) import Nanomsg (Pull(..), Push(..), bind, connect, recv, send, withSocket)
......
{-| {-|
Module : Gargantext.Core.AsyncUpdates.CentralExchange.Types Module : Gargantext.Core.Notifications.CentralExchange.Types
Description : Types for asynchronous notifications (central exchange) Description : Types for asynchronous notifications (central exchange)
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -13,7 +13,7 @@ Docs: ...@@ -13,7 +13,7 @@ Docs:
https://dev.sub.gargantext.org/#/share/Notes/187918 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 Codec.Binary.UTF8.String qualified as CBUTF8
import Data.Aeson ((.:), (.=), object, withObject) import Data.Aeson ((.:), (.=), object, withObject)
......
{-| {-|
Module : Gargantext.Core.AsyncUpdates.Dispatcher Module : Gargantext.Core.Notifications.Dispatcher
Description : Dispatcher (handles websocket connections, accepts message from central exchange) Description : Dispatcher (handles websocket connections, accepts message from central exchange)
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918 ...@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.Core.AsyncUpdates.Dispatcher ( module Gargantext.Core.Notifications.Dispatcher (
Dispatcher -- opaque Dispatcher -- opaque
, newDispatcher , newDispatcher
, terminateDispatcher , terminateDispatcher
...@@ -32,9 +32,9 @@ import Data.Aeson qualified as Aeson ...@@ -32,9 +32,9 @@ import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as BSL import Data.ByteString.Lazy qualified as BSL
import Data.Text qualified as T import Data.Text qualified as T
import DeferredFolds.UnfoldlM qualified as UnfoldlM 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.Config.Types (NotificationsConfig(..))
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CETypes
import Gargantext.Core.Notifications.Dispatcher.Types
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging (LogLevel(DEBUG), withLogger, logMsg) import Gargantext.System.Logging (LogLevel(DEBUG), withLogger, logMsg)
import Nanomsg (Pull(..), bind, recv, withSocket) import Nanomsg (Pull(..), bind, recv, withSocket)
......
{-| {-|
Module : Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions Module : Gargantext.Core.Notifications.Dispatcher.Subscriptions
Description : Dispatcher (manage websocket subscriptions) Description : Dispatcher (manage websocket subscriptions)
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -15,10 +15,10 @@ https://dev.sub.gargantext.org/#/share/Notes/187918 ...@@ -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 DeferredFolds.UnfoldlM qualified as UnfoldlM
import Gargantext.Core.AsyncUpdates.Dispatcher.Types import Gargantext.Core.Notifications.Dispatcher.Types
import Gargantext.Prelude import Gargantext.Prelude
import StmContainers.Set as SSet import StmContainers.Set as SSet
......
{-| {-|
Module : Gargantext.Core.AsyncUpdates.Dispatcher.Types Module : Gargantext.Core.Notifications.Dispatcher.Types
Description : Dispatcher (handles websocket connections, accepts message from central exchange) Description : Dispatcher (handles websocket connections, accepts message from central exchange)
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918 ...@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-imports #-} {-# 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 Codec.Binary.UTF8.String qualified as CBUTF8
import Control.Concurrent.Async qualified as Async import Control.Concurrent.Async qualified as Async
...@@ -32,7 +32,7 @@ import Data.UUID.V4 as UUID ...@@ -32,7 +32,7 @@ import Data.UUID.V4 as UUID
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id)) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
import Gargantext.API.Admin.Orchestrator.Types (JobLog) import Gargantext.API.Admin.Orchestrator.Types (JobLog)
import Gargantext.API.Prelude (IsGargServer) 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.Core.Types (NodeId, UserId)
import Gargantext.Prelude import Gargantext.Prelude
import GHC.Conc (TVar, newTVarIO, readTVar, writeTVar) import GHC.Conc (TVar, newTVarIO, readTVar, writeTVar)
...@@ -215,4 +215,10 @@ instance ToJSON Notification where ...@@ -215,4 +215,10 @@ instance ToJSON Notification where
, "message" .= toJSON message , "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
{-| {-|
Module : Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket Module : Gargantext.Core.Notifications.Dispatcher.WebSocket
Description : Dispatcher websocket server Description : Dispatcher websocket server
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918 ...@@ -16,7 +16,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918
{-# LANGUAGE TypeOperators #-} {-# 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.Concurrent.Async qualified as Async
import Control.Lens (view) import Control.Lens (view)
...@@ -24,9 +24,9 @@ import Data.Aeson qualified as Aeson ...@@ -24,9 +24,9 @@ import Data.Aeson qualified as Aeson
import Data.UUID.V4 as UUID import Data.UUID.V4 as UUID
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id)) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
import Gargantext.API.Prelude (IsGargServer) import Gargantext.API.Prelude (IsGargServer)
import Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions import Gargantext.Core.Notifications.Dispatcher.Subscriptions
import Gargantext.Core.AsyncUpdates.Dispatcher.Types import Gargantext.Core.Notifications.Dispatcher.Types
import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher, dispatcherSubscriptions) import Gargantext.Core.Notifications.Dispatcher (Dispatcher, dispatcherSubscriptions)
import Gargantext.Core.Config (HasJWTSettings(jwtSettings)) import Gargantext.Core.Config (HasJWTSettings(jwtSettings))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging (LogLevel(DEBUG), logMsg, withLogger) import Gargantext.System.Logging (LogLevel(DEBUG), logMsg, withLogger)
......
{-| {-|
Module : Gargantext.Core.AsyncUpdates.Nanomsg Module : Gargantext.Core.Notifications.Nanomsg
Description : Nanomsg utils Description : Nanomsg utils
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -14,7 +14,7 @@ https://dev.sub.gargantext.org/#/share/Notes/187918 ...@@ -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 Gargantext.Prelude
import Nanomsg import Nanomsg
......
...@@ -26,8 +26,8 @@ import Gargantext.API.Admin.EnvTypes (ConcreteJobHandle, GargJob, Mode(Dev), mod ...@@ -26,8 +26,8 @@ import Gargantext.API.Admin.EnvTypes (ConcreteJobHandle, GargJob, Mode(Dev), mod
import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog) import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
import Gargantext.API.Admin.Settings ( newPool ) import Gargantext.API.Admin.Settings ( newPool )
import Gargantext.API.Prelude (GargM) import Gargantext.API.Prelude (GargM)
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.Config (GargConfig(..), HasConfig(..)) import Gargantext.Core.Config (GargConfig(..), HasConfig(..))
import Gargantext.Core.Config.Mail qualified as Mail import Gargantext.Core.Config.Mail qualified as Mail
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
......
...@@ -20,7 +20,7 @@ module Gargantext.Database.Action.Delete ...@@ -20,7 +20,7 @@ module Gargantext.Database.Action.Delete
import Control.Lens (view) import Control.Lens (view)
import Data.Text (unpack) import Data.Text (unpack)
import Gargantext.Core (HasDBid(..)) 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.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Share (delFolderTeam) import Gargantext.Database.Action.Share (delFolderTeam)
import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Action.User (getUserId)
......
...@@ -65,7 +65,7 @@ import Data.Text qualified as T ...@@ -65,7 +65,7 @@ import Data.Text qualified as T
import EPO.API.Client.Types qualified as EPO import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Ngrams.Tools (getTermsWith) import Gargantext.API.Ngrams.Tools (getTermsWith)
import Gargantext.Core (Lang(..), NLPServerConfig, withDefaultLanguage) 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 (GargConfig(..), hasConfig)
import Gargantext.Core.Config.Types (APIsConfig(..)) import Gargantext.Core.Config.Types (APIsConfig(..))
import Gargantext.Core.Ext.IMTUser (readFile_Annuaire) import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
......
...@@ -18,6 +18,7 @@ module Gargantext.Database.Action.Share ...@@ -18,6 +18,7 @@ module Gargantext.Database.Action.Share
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens (view) import Control.Lens (view)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database import Gargantext.Database
import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Action.User (getUserId)
...@@ -104,10 +105,14 @@ shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do ...@@ -104,10 +105,14 @@ shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
then errorWith "[G.D.A.S.shareNodeWith] Can share to others only" then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
else do else do
folderSharedId <- getFolderId u NodeFolderShared folderSharedId <- getFolderId u NodeFolderShared
insertDB ([NodeNode { _nn_node1_id = folderSharedId ret <- insertDB ([NodeNode { _nn_node1_id = folderSharedId
, _nn_node2_id = n , _nn_node2_id = n
, _nn_score = Nothing , _nn_score = Nothing
, _nn_category = Nothing }]:: [NodeNode]) , _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 shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
nodeToCheck <- getNode n nodeToCheck <- getNode n
...@@ -117,11 +122,16 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do ...@@ -117,11 +122,16 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
else do else do
folderToCheck <- getNode nId folderToCheck <- getNode nId
if hasNodeType folderToCheck NodeFolderPublic if hasNodeType folderToCheck NodeFolderPublic
then insertDB ([NodeNode { _nn_node1_id = nId then do
, _nn_node2_id = n ret <- insertDB ([NodeNode { _nn_node1_id = nId
, _nn_score = Nothing , _nn_node2_id = n
, _nn_category = Nothing }] :: [NodeNode]) , _nn_score = Nothing
else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only" , _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" shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"
......
...@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple qualified as PGS ...@@ -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.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
import Database.PostgreSQL.Simple.Internal (Field) import Database.PostgreSQL.Simple.Internal (Field)
import Database.PostgreSQL.Simple.Types (Query(..)) 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.Config (HasConfig(..))
import Gargantext.Core.Mail.Types (HasMail) import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Core.NLP (HasNLPServer)
......
...@@ -14,7 +14,7 @@ module Gargantext.Database.Query.Table.Node.Update (Update(..), update) ...@@ -14,7 +14,7 @@ module Gargantext.Database.Query.Table.Node.Update (Update(..), update)
import Data.Text qualified as DT import Data.Text qualified as DT
import Database.PostgreSQL.Simple ( Only(Only) ) 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.Core.Types (Name)
import Gargantext.Database.Admin.Types.Node (NodeId, ParentId) import Gargantext.Database.Admin.Types.Node (NodeId, ParentId)
import Gargantext.Database.Query.Table.Node (getParentId) import Gargantext.Database.Query.Table.Node (getParentId)
......
module Test.API where module Test.API where
import Gargantext.Core.Notifications.Dispatcher qualified as D
import Gargantext.Core.Config.Types (NotificationsConfig) import Gargantext.Core.Config.Types (NotificationsConfig)
import Prelude import Prelude
import Test.Hspec import Test.Hspec
...@@ -11,8 +12,8 @@ import qualified Test.API.Notifications as Notifications ...@@ -11,8 +12,8 @@ import qualified Test.API.Notifications as Notifications
import qualified Test.API.Private as Private import qualified Test.API.Private as Private
import qualified Test.API.UpdateList as UpdateList import qualified Test.API.UpdateList as UpdateList
tests :: NotificationsConfig -> Spec tests :: NotificationsConfig -> D.Dispatcher -> Spec
tests _nc = describe "API" $ do tests nc dispatcher = describe "API" $ do
Auth.tests Auth.tests
Private.tests Private.tests
GraphQL.tests GraphQL.tests
...@@ -20,4 +21,4 @@ tests _nc = describe "API" $ do ...@@ -20,4 +21,4 @@ tests _nc = describe "API" $ do
UpdateList.tests UpdateList.tests
-- | TODO This would work if I managed to get forking dispatcher & -- | TODO This would work if I managed to get forking dispatcher &
-- exchange listeners properly -- exchange listeners properly
-- Notifications.tests nc Notifications.tests nc dispatcher
...@@ -17,61 +17,60 @@ module Test.API.Notifications ( ...@@ -17,61 +17,60 @@ module Test.API.Notifications (
) where ) where
import Control.Concurrent (forkIO, killThread, threadDelay) 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 Control.Monad.STM (atomically)
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE import Data.Maybe (isJust)
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT 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 Gargantext.Core.Config.Types (NotificationsConfig(..))
import Network.WebSockets.Client qualified as WS import Network.WebSockets.Client qualified as WS
import Network.WebSockets.Connection qualified as WS import Network.WebSockets.Connection qualified as WS
import Prelude import Prelude
import Test.API.Setup (withTestDBAndPort) -- , setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndNotifications) -- , setupEnvironment, createAliceAndBob)
import Test.Hspec import Test.Hspec
import Test.Instances () import Test.Instances ()
tests :: NotificationsConfig -> Spec tests :: NotificationsConfig -> D.Dispatcher -> Spec
tests nc = sequential $ aroundAll withTestDBAndPort $ do tests nc dispatcher = sequential $ aroundAll (withTestDBAndNotifications dispatcher) $ do
describe "Dispatcher, Central Exchange, WebSockets" $ do describe "Dispatcher, Central Exchange, WebSockets" $ do
it "simple WS notification works" $ \((_testEnv, port), _) -> 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 -- setup a websocket connection
let wsConnect = do let wsConnect = do
putStrLn $ "Creating WS client (port " <> show port <> ")"
WS.runClient "127.0.0.1" port "/ws" $ \conn -> do 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 d <- WS.receiveData conn
putStrLn ("received: " <> show d) let dec = Aeson.decode d :: Maybe DT.Notification
atomically $ TVar.writeTVar tvar (Aeson.decode d) atomically $ writeTChan tchan dec
putStrLn "After WS client" -- atomically $ TVar.writeTVar tvar (Aeson.decode d)
putStrLn "[WSClient] after"
-- wait a bit to settle -- wait a bit to settle
putStrLn "settling a bit initially" threadDelay (100 * millisecond)
threadDelay (500 * millisecond)
putStrLn "forking wsConnection"
wsConnection <- forkIO $ wsConnect wsConnection <- forkIO $ wsConnect
-- wait a bit to connect -- wait a bit to connect
threadDelay (500 * millisecond) threadDelay (100 * millisecond)
putStrLn "settling a bit for connection"
threadDelay (500 * millisecond) threadDelay (500 * millisecond)
let msg = CET.UpdateTreeFirstLevel 0 CE.notify nc $ CET.UpdateTreeFirstLevel 0
putStrLn "Notifying CE"
CE.notify nc msg
threadDelay (500 * millisecond) -- d <- TVar.readTVarIO tvar
putStrLn "Reading tvar with timeout" md <- atomically $ readTChan tchan
d <- TVar.readTVarIO tvar
putStrLn "Killing wsConnection thread"
killThread wsConnection killThread wsConnection
putStrLn "Checking d" md `shouldSatisfy` isJust
let (Just (DT.Notification topic' message')) = md
d `shouldBe` (Just msg) topic' `shouldBe` topic
message' `shouldBe` DT.MEmpty
millisecond :: Int millisecond :: Int
......
...@@ -15,6 +15,7 @@ import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..)) ...@@ -15,6 +15,7 @@ import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
import Gargantext.API.Admin.Settings import Gargantext.API.Admin.Settings
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Prelude 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 (_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.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort, jwtSettings)
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
...@@ -84,8 +85,8 @@ newTestEnv testEnv logger port = do ...@@ -84,8 +85,8 @@ newTestEnv testEnv logger port = do
, _env_jobs = jobs_env , _env_jobs = jobs_env
, _env_self_url = self_url_env , _env_self_url = self_url_env
, _env_config = config_env , _env_config = config_env
, _env_central_exchange = Prelude.error "central exchange 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 "dispatcher 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_central_exchange = central_exchange
-- , _env_dispatcher = dispatcher -- , _env_dispatcher = dispatcher
, _env_jwt_settings , _env_jwt_settings
...@@ -124,6 +125,15 @@ withTestDBAndPort action = ...@@ -124,6 +125,15 @@ withTestDBAndPort action =
let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions } let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
Warp.testWithApplicationSettings stgs (pure app) $ \port -> action ((testEnv, port), app) 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 -- | Starts the backend server /and/ the microservices proxy, the former at
-- a random port, the latter at a predictable port. -- a random port, the latter at a predictable port.
withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO () withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO ()
......
{-| {-|
Module : Core.AsyncUpdates Module : Core.Notifications
Description : Description :
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -9,14 +9,14 @@ Portability : POSIX ...@@ -9,14 +9,14 @@ Portability : POSIX
-} -}
module Test.Core.AsyncUpdates module Test.Core.Notifications
( test ( test
, qcTests ) , qcTests )
where where
import Data.Aeson qualified as A import Data.Aeson qualified as A
import Gargantext.Core.AsyncUpdates.CentralExchange.Types import Gargantext.Core.Notifications.CentralExchange.Types
import Gargantext.Core.AsyncUpdates.Dispatcher.Types import Gargantext.Core.Notifications.Dispatcher.Types
import Gargantext.Prelude import Gargantext.Prelude
import Test.Hspec import Test.Hspec
import Test.Instances () import Test.Instances ()
......
{-|
Module : Core.Notifications
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Test.Core.Notifications
( test
, qcTests )
where
import Data.Aeson qualified as A
import Gargantext.Core.Notifications.CentralExchange.Types
import Gargantext.Core.Notifications.Dispatcher.Types
import Gargantext.Prelude
import Test.Hspec
import Test.Instances ()
import Test.Tasty
import Test.Tasty.QuickCheck qualified as QC
test :: Spec
test = do
describe "check if json serialization of CEMessage works" $ do
it "UpdateTreeFirstLevel serialization" $ do
let ce = UpdateTreeFirstLevel 15
A.decode (A.encode ce) `shouldBe` (Just ce)
qcTests :: TestTree
qcTests =
testGroup "Notifications QuickCheck tests" $ do
[ QC.testProperty "CEMessage aeson encoding" $ \m -> A.decode (A.encode (m :: CEMessage)) == Just m
, QC.testProperty "Topic aeson encoding" $ \t -> A.decode (A.encode (t :: Topic)) == Just t
, QC.testProperty "Message aeson encoding" $ \m -> A.decode (A.encode (m :: Message)) == Just m
, QC.testProperty "WSRequest aeson encoding" $ \ws -> A.decode (A.encode (ws :: WSRequest)) == Just ws ]
...@@ -27,10 +27,10 @@ import Gargantext.API.Admin.EnvTypes as EnvTypes ...@@ -27,10 +27,10 @@ import Gargantext.API.Admin.EnvTypes as EnvTypes
import Gargantext.API.Errors.Types qualified as Errors import Gargantext.API.Errors.Types qualified as Errors
import Gargantext.API.Ngrams.Types qualified as Ngrams import Gargantext.API.Ngrams.Types qualified as Ngrams
import Gargantext.API.Node.Corpus.New (ApiInfo(..)) import Gargantext.API.Node.Corpus.New (ApiInfo(..))
import Gargantext.API.Node.Corpus.New qualified as New
import Gargantext.API.Node.Types (NewWithForm(..), RenameNode(..), WithQuery(..)) import Gargantext.API.Node.Types (NewWithForm(..), RenameNode(..), WithQuery(..))
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
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.NodeStory.Types qualified as NS
import Gargantext.Core.Text.Ngrams (NgramsType(..)) import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Types.Individu qualified as Individu import Gargantext.Core.Types.Individu qualified as Individu
......
...@@ -276,36 +276,37 @@ newTestEnv = do ...@@ -276,36 +276,37 @@ newTestEnv = do
k <- genSecret k <- genSecret
let settings = defaultJobSettings 1 k let settings = defaultJobSettings 1 k
myEnv <- newJobEnv settings defaultPrios testTlsManager 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 = 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_central_exchange_connect = "tcp://localhost:15510"
, _nc_dispatcher_bind = Prelude.error "nc_dispatcher_bind not needed, but forced somewhere (check StrictData)" , _nc_dispatcher_bind = fmt_error "nc_dispatcher_bind"
, _nc_dispatcher_connect = Prelude.error "nc_dispatcher_connect not needed, but forced somewhere (check StrictData)" } , _nc_dispatcher_connect = fmt_error "nc_dispatcher_connect" }
let _env_config = let _env_config =
GargConfig { _gc_datafilepath = Prelude.error "gc_datafilepath not needed, but forced somewhere (check StrictData)" GargConfig { _gc_datafilepath = fmt_error "gc_datafilepath"
, _gc_frontend_config = Prelude.error "gc_frontend_config not needed, but forced somewhere (check StrictData)" , _gc_frontend_config = fmt_error "gc_frontend_config"
, _gc_mail_config = Prelude.error "gc_mail_config not needed, but forced somewhere (check StrictData)" , _gc_mail_config = fmt_error "gc_mail_config"
, _gc_database_config = Prelude.error "gc_database_config not needed, but forced somewhere (check StrictData)" , _gc_database_config = fmt_error "gc_database_config"
, _gc_nlp_config = Prelude.error "gc_nlp_config not needed, but forced somewhere (check StrictData)" , _gc_nlp_config = fmt_error "gc_nlp_config"
, _gc_notifications_config , _gc_notifications_config
, _gc_frames = Prelude.error "gc_frames not needed, but forced somewhere (check StrictData)" , _gc_frames = fmt_error "gc_frames not needed"
, _gc_jobs = Prelude.error "gc_jobs not needed, but forced somewhere (check StrictData)" , _gc_jobs = fmt_error "gc_jobs not needed"
, _gc_secrets = Prelude.error "gc_secrets not needed, but forced somewhere (check StrictData)" , _gc_secrets = fmt_error "gc_secrets"
, _gc_apis = Prelude.error "gc_apis not needed, but forced somewhere (check StrictData)" , _gc_apis = fmt_error "gc_apis"
, _gc_log_level = Prelude.error "gc_log_level not needed, but forced somewhere (check StrictData)" , _gc_log_level = fmt_error "gc_log_level"
} }
pure $ Env pure $ Env
{ _env_logger = Prelude.error "env_logger not needed, but forced somewhere (check StrictData)" { _env_logger = fmt_error "env_logger"
, _env_pool = Prelude.error "env_pool not needed, but forced somewhere (check StrictData)" , _env_pool = fmt_error "env_pool"
, _env_nodeStory = Prelude.error "env_nodeStory not needed, but forced somewhere (check StrictData)" , _env_nodeStory = fmt_error "env_nodeStory"
, _env_manager = testTlsManager , _env_manager = testTlsManager
, _env_self_url = Prelude.error "self_url not needed, but forced somewhere (check StrictData)" , _env_self_url = fmt_error "self_url"
, _env_scrapers = Prelude.error "scrapers not needed, but forced somewhere (check StrictData)" , _env_scrapers = fmt_error "scrapers"
, _env_jobs = myEnv , _env_jobs = myEnv
, _env_config , _env_config
, _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)" , _env_central_exchange = fmt_error "central exchange"
, _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)" , _env_dispatcher = fmt_error "dispatcher"
, _env_jwt_settings = Prelude.error "jwt_settings not needed, but forced somewherer (check StrictData)" , _env_jwt_settings = fmt_error "jwt_settings"
} }
testFetchJobStatus :: IO () testFetchJobStatus :: IO ()
......
...@@ -6,9 +6,9 @@ import Gargantext.Prelude hiding (isInfixOf) ...@@ -6,9 +6,9 @@ import Gargantext.Prelude hiding (isInfixOf)
import Control.Monad import Control.Monad
import Data.Text (isInfixOf) import Data.Text (isInfixOf)
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D import Gargantext.Core.Notifications.Dispatcher qualified as D
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
import Gargantext.Core.Config.Types (NotificationsConfig(..)) import Gargantext.Core.Config.Types (NotificationsConfig(..))
import Shelly hiding (FilePath) import Shelly hiding (FilePath)
import System.IO import System.IO
...@@ -16,8 +16,8 @@ import System.Process ...@@ -16,8 +16,8 @@ import System.Process
import Test.Hspec import Test.Hspec
import qualified Data.Text as T import qualified Data.Text as T
import qualified Test.API as API import qualified Test.API as API
import qualified Test.Server.ReverseProxy as ReverseProxy
import qualified Test.Database.Operations as DB import qualified Test.Database.Operations as DB
import qualified Test.Server.ReverseProxy as ReverseProxy
startCoreNLPServer :: IO ProcessHandle startCoreNLPServer :: IO ProcessHandle
...@@ -82,9 +82,9 @@ main = do ...@@ -82,9 +82,9 @@ main = do
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
-- TODO Ideally remove start/stop notifications and use -- TODO Ideally remove start/stop notifications and use
-- Test/API/Setup to initialize this in env -- Test/API/Setup to initialize this in env
withNotifications $ \(nc, _, _) -> do withNotifications $ \(nc, _ce, dispatcher) -> do
bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ do bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ do
API.tests nc API.tests nc dispatcher
ReverseProxy.tests ReverseProxy.tests
DB.tests DB.tests
DB.nodeStoryTests DB.nodeStoryTests
......
...@@ -27,7 +27,7 @@ import qualified Test.Parsers.Date as PD ...@@ -27,7 +27,7 @@ import qualified Test.Parsers.Date as PD
import qualified Test.Utils.Crypto as Crypto import qualified Test.Utils.Crypto as Crypto
import qualified Test.Utils.Jobs as Jobs import qualified Test.Utils.Jobs as Jobs
import qualified Test.Core.Similarity as Similarity 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
import Test.Tasty.Hspec import Test.Tasty.Hspec
...@@ -41,7 +41,7 @@ main = do ...@@ -41,7 +41,7 @@ main = do
nlpSpec <- testSpec "NLP" NLP.test nlpSpec <- testSpec "NLP" NLP.test
jobsSpec <- testSpec "Jobs" Jobs.test jobsSpec <- testSpec "Jobs" Jobs.test
similaritySpec <- testSpec "Similarity" Similarity.test similaritySpec <- testSpec "Similarity" Similarity.test
asyncUpdatesSpec <- testSpec "AsyncUpdates" AsyncUpdates.test asyncUpdatesSpec <- testSpec "Notifications" Notifications.test
defaultMain $ testGroup "Gargantext" defaultMain $ testGroup "Gargantext"
[ utilSpec [ utilSpec
...@@ -61,5 +61,5 @@ main = do ...@@ -61,5 +61,5 @@ main = do
, Worker.tests , Worker.tests
, Jobs.qcTests , Jobs.qcTests
, asyncUpdatesSpec , asyncUpdatesSpec
, AsyncUpdates.qcTests , Notifications.qcTests
] ]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment