Commit e0351853 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'testing' into stable

parents 1dd5a40d 9c2f627d
Pipeline #6879 failed with stages
in 48 minutes and 6 seconds
## Version 0.0.7.3.5
* [FRONT][FIX][[Topbar] Update the navigation bar links in the "Info" dropdown (#710)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/710)
## Version 0.0.7.3.4
* [FRONT][FIX][Sigma settings don't apply sometimes (#708)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/708)
## Version 0.0.7.3.3
* [FRONT][FIX][Display graph parameters in legend (#706)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/706)
* [BACK][FIX][Document Search (#415)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/415)
* [BACK][DOC+Scripts][Improving onboarding
experience](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/360)
## 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)
......
...@@ -254,6 +254,19 @@ Ideally, we could have the following process, divided in 4 phases: ...@@ -254,6 +254,19 @@ Ideally, we could have the following process, divided in 4 phases:
marked with an `approved` label on Gitlab. The old `triage` label should be removed; marked with an `approved` label on Gitlab. The old `triage` label should be removed;
- _Implementation_: Finally, the ticket gets implemented. This concludes the lifecycle. - _Implementation_: Finally, the ticket gets implemented. This concludes the lifecycle.
### Try to amend or squash if you rebase with `dev`
Example here: https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/322
MR here: https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/258
With amending/squashing, gitlab produces:
- for new users on the issue, a large commit set with changes
- for users already following the issue, gitlab produces a "compare
with previous version" like this one:
https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/258#note_9863
## Conclusion ## Conclusion
We have presented a comprehensive overview on the set of best practices we should put in place within We have presented a comprehensive overview on the set of best practices we should put in place within
......
This diff is collapsed.
# The following line is more portable than just /bin/bash:
#!/usr/bin/env bash
# A couple hygienic options
set -e -u
# The following command will run `cabal run gargantext-cli --` followed by the
# options provided by the user, from inside a Nix shell. For instance,
# if the user types
# $ ./bin/cli someCommand "some string argument"
# the following will be run from inside a Nix shell:
# $ cabal run gargantext-cli -- someCommand "some string argument"
# It's a little convoluted because we want to keep spaces that were enclosed in
# quotes or escaped by the user.
nix-shell --run "$(printf "%q " cabal run gargantext-cli -- "$@")"
...@@ -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
......
...@@ -76,8 +76,7 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo = ...@@ -76,8 +76,7 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
, _jc_max_docs_scrapers = _gc_max_docs_scrapers , _jc_max_docs_scrapers = _gc_max_docs_scrapers
, _jc_js_job_timeout = _gc_js_job_timeout , _jc_js_job_timeout = _gc_js_job_timeout
, _jc_js_id_timeout = _gc_js_id_timeout } , _jc_js_id_timeout = _gc_js_id_timeout }
, _gc_apis = CTypes.APIsConfig { _ac_pubmed_api_key = _gc_pubmed_api_key , _gc_apis = CTypes.APIsConfig { _ac_epo_api_url = _gc_epo_api_url
, _ac_epo_api_url = _gc_epo_api_url
, _ac_scrapyd_url } , _ac_scrapyd_url }
, _gc_log_level = LevelDebug , _gc_log_level = LevelDebug
} }
......
...@@ -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(..))
......
# The following line is more portable than just /bin/bash:
#!/usr/bin/env bash
# A couple hygienic options
set -e -u
echo "Launching Gargantext..."
nix-shell --run "cabal run gargantext-server -- --run Prod --toml gargantext-settings.toml"
# http disables automatic https
http://localhost:8108 {
root * /srv/purescript-gargantext/dist
file_server
}
...@@ -3,7 +3,6 @@ version: '3' ...@@ -3,7 +3,6 @@ version: '3'
services: services:
caddy: caddy:
image: caddy:alpine image: caddy:alpine
network: host
ports: ports:
- 8108:8108 - 8108:8108
volumes: volumes:
......
...@@ -59,9 +59,6 @@ data_filepath = FILEPATH_TO_CHANGE ...@@ -59,9 +59,6 @@ data_filepath = FILEPATH_TO_CHANGE
[apis] [apis]
[apis.pubmed]
api_key = ENTER_PUBMED_API_KEY
[apis.epo] [apis.epo]
api_url = EPO_API_URL api_url = EPO_API_URL
......
...@@ -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.5
synopsis: Search, map, share synopsis: Search, map, share
description: Please see README.md description: Please see README.md
category: Data category: Data
...@@ -32,23 +32,24 @@ data-files: ...@@ -32,23 +32,24 @@ data-files:
ekg-assets/bootstrap-1.4.0.min.css ekg-assets/bootstrap-1.4.0.min.css
ekg-assets/chart_line_add.png ekg-assets/chart_line_add.png
ekg-assets/cross.png ekg-assets/cross.png
test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
test-data/ngrams/GarganText_DocsList-nodeId-177.json test-data/ngrams/GarganText_DocsList-nodeId-177.json
test-data/ngrams/GarganText_NgramsTerms-nodeId-177.json test-data/ngrams/GarganText_NgramsTerms-nodeId-177.json
test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
test-data/ngrams/simple.json test-data/ngrams/simple.json
test-data/ngrams/simple.tsv test-data/ngrams/simple.tsv
test-data/phylo/187481.json
test-data/phylo/bpa_phylo_test.json test-data/phylo/bpa_phylo_test.json
test-data/phylo/cleopatre.golden.json test-data/phylo/cleopatre.golden.json
test-data/phylo/nadal.golden.json test-data/phylo/issue-290-small.golden.json
test-data/phylo/nadal_docslist.golden.tsv test-data/phylo/nadal_docslist.golden.tsv
test-data/phylo/nadal.golden.json
test-data/phylo/nadal_ngramslist.golden.tsv test-data/phylo/nadal_ngramslist.golden.tsv
test-data/phylo/issue-290-small.golden.json
test-data/phylo/open_science.json test-data/phylo/open_science.json
test-data/phylo/small-phylo.golden.json test-data/phylo/phylo2dot2json.golden.json
test-data/phylo/small_phylo_docslist.tsv test-data/phylo/small_phylo_docslist.tsv
test-data/phylo/small-phylo.golden.json
test-data/phylo/small_phylo_ngramslist.tsv test-data/phylo/small_phylo_ngramslist.tsv
test-data/phylo/187481.json test-data/search/GarganText_DocsList-soysauce.json
test-data/phylo/phylo2dot2json.golden.json
test-data/stemming/lancaster.txt test-data/stemming/lancaster.txt
test-data/test_config.ini test-data/test_config.ini
test-data/test_config.toml test-data/test_config.toml
...@@ -164,14 +165,6 @@ library ...@@ -164,14 +165,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
...@@ -187,6 +180,14 @@ library ...@@ -187,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
...@@ -723,6 +724,7 @@ common testDependencies ...@@ -723,6 +724,7 @@ common testDependencies
, epo-api-client , epo-api-client
, extra ^>= 1.7.9 , extra ^>= 1.7.9
, fast-logger ^>= 3.2.2 , fast-logger ^>= 3.2.2
, filepath ^>= 1.4.2.2
, fmt , fmt
, gargantext , gargantext
, gargantext-prelude , gargantext-prelude
...@@ -797,12 +799,13 @@ test-suite garg-test-tasty ...@@ -797,12 +799,13 @@ 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.Private.Table
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
...@@ -857,6 +860,7 @@ test-suite garg-test-hspec ...@@ -857,6 +860,7 @@ test-suite garg-test-hspec
Test.API.Notifications Test.API.Notifications
Test.API.Private Test.API.Private
Test.API.Private.Share Test.API.Private.Share
Test.API.Private.Table
Test.API.Routes Test.API.Routes
Test.API.Setup Test.API.Setup
Test.API.UpdateList Test.API.UpdateList
......
...@@ -62,6 +62,7 @@ rec { ...@@ -62,6 +62,7 @@ rec {
pkgs.gmp pkgs.gmp
pkgs.lapack pkgs.lapack
pkgs.libxml2 pkgs.libxml2
pkgs.nanomsg
pkgs.plfit pkgs.plfit
] ++ pkgs.lib.optionals pkgs.stdenv.cc.isClang [ ] ++ pkgs.lib.optionals pkgs.stdenv.cc.isClang [
pkgs.llvmPackages.openmp pkgs.llvmPackages.openmp
......
...@@ -40,10 +40,10 @@ import Gargantext.API.Admin.Orchestrator.Types ...@@ -40,10 +40,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)
......
...@@ -27,7 +27,7 @@ import Gargantext.API.Errors.Types ...@@ -27,7 +27,7 @@ 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.Notifications.CentralExchange.Types qualified as CE
import Gargantext.Database.Action.Flow.Types import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Node import Gargantext.Database.Action.Node
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
......
...@@ -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(..))
......
...@@ -34,8 +34,8 @@ import Gargantext.Database.Action.Flow (reIndexWith) ...@@ -34,8 +34,8 @@ import Gargantext.Database.Action.Flow (reIndexWith)
import Gargantext.Database.Action.Flow.Pairing (pairing) import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore) import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
import Gargantext.Database.Admin.Types.Hyperdata.Phylo ( HyperdataPhylo(HyperdataPhylo) ) import Gargantext.Database.Admin.Types.Hyperdata.Phylo ( HyperdataPhylo(HyperdataPhylo) )
import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(NodeCorpus, NodeAnnuaire) ) import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(NodeCorpus, NodeAnnuaire, NodeTexts, NodeGraph, NodePhylo, NodeList) )
import Gargantext.Database.Query.Table.Node (defaultList, getNode) import Gargantext.Database.Query.Table.Node (defaultList, getNode, getChildrenByType)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_parent_id) import Gargantext.Database.Schema.Node (node_parent_id)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -58,7 +58,8 @@ updateNode :: (HasNodeStory env err m ...@@ -58,7 +58,8 @@ updateNode :: (HasNodeStory env err m
-> UpdateNodeParams -> UpdateNodeParams
-> JobHandle m -> JobHandle m
-> m () -> m ()
updateNode nId (UpdateNodeParamsGraph metric partitionMethod bridgeMethod strength nt1 nt2) jobHandle = do updateNode nId (UpdateNodeParamsGraph
(UpdateNodeConfigGraph metric partitionMethod bridgeMethod strength nt1 nt2)) jobHandle = do
markStarted 2 jobHandle markStarted 2 jobHandle
-- printDebug "Computing graph: " method -- printDebug "Computing graph: " method
...@@ -144,6 +145,24 @@ updateNode tId (UpdateNodeParamsTexts _mode) jobHandle = do ...@@ -144,6 +145,24 @@ updateNode tId (UpdateNodeParamsTexts _mode) jobHandle = do
markComplete jobHandle markComplete jobHandle
updateNode tId
(UpdateNodeParamsCorpus methodGraph methodPhylo methodTexts methodList)
jobHandle = do
markStarted 3 jobHandle
markProgress 1 jobHandle
_ <- getNode tId
childTexts <- getChildrenByType tId NodeTexts
childGraphs <- getChildrenByType tId NodeGraph
childPhylos <- getChildrenByType tId NodePhylo
childNodeLists <- getChildrenByType tId NodeList
mapM_ (\cId -> updateNode cId (UpdateNodeParamsTexts methodTexts) jobHandle) childTexts
mapM_ (\cId -> updateNode cId (UpdateNodeParamsGraph methodGraph) jobHandle) childGraphs
mapM_ (\cId -> updateNode cId (UpdateNodePhylo methodPhylo) jobHandle) childPhylos
mapM_ (\cId -> updateNode cId (UpdateNodeParamsList methodList) jobHandle) childNodeLists
markComplete jobHandle
updateNode _nId _p jobHandle = do updateNode _nId _p jobHandle = do
simuLogs jobHandle 10 simuLogs jobHandle 10
......
...@@ -17,16 +17,15 @@ import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) ) ...@@ -17,16 +17,15 @@ import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
------------------------------------------------------------------------ ------------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method } data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric | UpdateNodeParamsGraph { methodGraph :: !UpdateNodeConfigGraph }
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
| UpdateNodeParamsTexts { methodTexts :: !Granularity } | UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsCorpus { methodGraph :: !UpdateNodeConfigGraph
, methodPhylo :: !PhyloSubConfigAPI
, methodTexts :: !Granularity
, methodList :: !Method }
| UpdateNodeParamsBoard { methodBoard :: !Charts } | UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType | LinkNodeReq { nodeType :: !NodeType
...@@ -47,6 +46,16 @@ data Granularity = NewNgrams | NewTexts | Both ...@@ -47,6 +46,16 @@ data Granularity = NewNgrams | NewTexts | Both
data Charts = Sources | Authors | Institutes | Ngrams | All data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded) deriving (Generic, Eq, Ord, Enum, Bounded)
------------------------------------------------------------------------
data UpdateNodeConfigGraph = UpdateNodeConfigGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
deriving (Generic)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend. -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON UpdateNodeParams where instance FromJSON UpdateNodeParams where
...@@ -59,7 +68,7 @@ instance ToSchema UpdateNodeParams ...@@ -59,7 +68,7 @@ instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where instance Arbitrary UpdateNodeParams where
arbitrary = do arbitrary = do
l <- UpdateNodeParamsList <$> arbitrary l <- UpdateNodeParamsList <$> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary g <- UpdateNodeParamsGraph <$> arbitrary
t <- UpdateNodeParamsTexts <$> arbitrary t <- UpdateNodeParamsTexts <$> arbitrary
b <- UpdateNodeParamsBoard <$> arbitrary b <- UpdateNodeParamsBoard <$> arbitrary
elements [l,g,t,b] elements [l,g,t,b]
...@@ -82,4 +91,18 @@ instance ToSchema Charts ...@@ -82,4 +91,18 @@ instance ToSchema Charts
instance Arbitrary Charts where instance Arbitrary Charts where
arbitrary = elements [ minBound .. maxBound ] arbitrary = elements [ minBound .. maxBound ]
instance FromJSON UpdateNodeConfigGraph
instance ToJSON UpdateNodeConfigGraph
instance ToSchema UpdateNodeConfigGraph
instance Arbitrary UpdateNodeConfigGraph where
arbitrary = do
methodGraphMetric <- arbitrary
methodGraphClustering <- arbitrary
methodGraphBridgeness <- arbitrary
methodGraphEdgesStrength <- arbitrary
methodGraphNodeType1 <- arbitrary
methodGraphNodeType2 <- arbitrary
return $ UpdateNodeConfigGraph methodGraphMetric methodGraphClustering methodGraphBridgeness
methodGraphEdgesStrength methodGraphNodeType1 methodGraphNodeType2
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -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)
......
...@@ -15,7 +15,6 @@ TODO-SECURITY: Critical ...@@ -15,7 +15,6 @@ TODO-SECURITY: Critical
module Gargantext.Core.Config.Types module Gargantext.Core.Config.Types
( APIsConfig(..) ( APIsConfig(..)
, ac_pubmed_api_key
, ac_epo_api_url , ac_epo_api_url
, ac_scrapyd_url , ac_scrapyd_url
, CORSOrigin(..) , CORSOrigin(..)
...@@ -299,13 +298,11 @@ makeLenses ''JobsConfig ...@@ -299,13 +298,11 @@ makeLenses ''JobsConfig
data APIsConfig = data APIsConfig =
APIsConfig { _ac_pubmed_api_key :: !Text APIsConfig { _ac_epo_api_url :: !Text
, _ac_epo_api_url :: !Text
, _ac_scrapyd_url :: !BaseUrl } , _ac_scrapyd_url :: !BaseUrl }
deriving (Generic, Show) deriving (Generic, Show)
instance FromValue APIsConfig where instance FromValue APIsConfig where
fromValue = parseTableFromValue $ do fromValue = parseTableFromValue $ do
_ac_pubmed_api_key <- reqKeyOf "pubmed" $ parseTableFromValue $ reqKey "api_key"
_ac_epo_api_url <- reqKeyOf "epo" $ parseTableFromValue $ reqKey "api_url" _ac_epo_api_url <- reqKeyOf "epo" $ parseTableFromValue $ reqKey "api_url"
scrapyd_url <- reqKeyOf "scrapyd" $ parseTableFromValue $ reqKey "url" scrapyd_url <- reqKeyOf "scrapyd" $ parseTableFromValue $ reqKey "url"
_ac_scrapyd_url <- _ac_scrapyd_url <-
...@@ -316,8 +313,7 @@ instance FromValue APIsConfig where ...@@ -316,8 +313,7 @@ instance FromValue APIsConfig where
instance ToValue APIsConfig where instance ToValue APIsConfig where
toValue = defaultTableToValue toValue = defaultTableToValue
instance ToTable APIsConfig where instance ToTable APIsConfig where
toTable (APIsConfig { .. }) = table [ "pubmed" .= table [ "api_key" .= _ac_pubmed_api_key ] toTable (APIsConfig { .. }) = table [ "epo" .= table [ "api_url" .= _ac_epo_api_url ]
, "epo" .= table [ "api_url" .= _ac_epo_api_url ]
, "scrapyd" .= table [ "url" .= showBaseUrl _ac_scrapyd_url ] , "scrapyd" .= table [ "url" .= showBaseUrl _ac_scrapyd_url ]
] ]
......
{-| {-|
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,11 +25,12 @@ import Data.Aeson qualified as Aeson ...@@ -25,11 +25,12 @@ 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, sendNonblocking, withSocket) import Nanomsg (Pull(..), Push(..), bind, connect, recv, send, withSocket)
import System.Timeout (timeout)
{- {-
...@@ -74,7 +75,8 @@ gServer (NotificationsConfig { .. }) = do ...@@ -74,7 +75,8 @@ gServer (NotificationsConfig { .. }) = do
Just _ujp@(UpdateJobProgress _s) -> do Just _ujp@(UpdateJobProgress _s) -> do
-- logMsg ioLogger DEBUG $ "[central_exchange] " <> show ujp -- logMsg ioLogger DEBUG $ "[central_exchange] " <> show ujp
-- send the same message that we received -- send the same message that we received
void $ sendNonblocking s_dispatcher r -- void $ sendNonblocking s_dispatcher r
void $ timeout 100_000 $ send s_dispatcher r
Just (UpdateTreeFirstLevel node_id) -> do Just (UpdateTreeFirstLevel node_id) -> do
logMsg ioLogger INFO $ "[central_exchange] update tree: " <> show node_id logMsg ioLogger INFO $ "[central_exchange] update tree: " <> show node_id
-- putText $ "[central_exchange] sending that to the dispatcher: " <> show node_id -- putText $ "[central_exchange] sending that to the dispatcher: " <> show node_id
...@@ -92,7 +94,8 @@ gServer (NotificationsConfig { .. }) = do ...@@ -92,7 +94,8 @@ gServer (NotificationsConfig { .. }) = do
-- gargantext-server but maybe it can be a separate -- gargantext-server but maybe it can be a separate
-- process, independent of the server. -- process, independent of the server.
-- send the same message that we received -- send the same message that we received
void $ sendNonblocking s_dispatcher r -- void $ sendNonblocking s_dispatcher r
void $ timeout 100_000 $ send s_dispatcher r
_ -> logMsg ioLogger DEBUG $ "[central_exchange] unknown message" _ -> logMsg ioLogger DEBUG $ "[central_exchange] unknown message"
...@@ -104,4 +107,6 @@ notify (NotificationsConfig { _nc_central_exchange_connect }) ceMessage = do ...@@ -104,4 +107,6 @@ notify (NotificationsConfig { _nc_central_exchange_connect }) ceMessage = do
let str = Aeson.encode ceMessage let str = Aeson.encode ceMessage
withLogger () $ \ioLogger -> withLogger () $ \ioLogger ->
logMsg ioLogger DEBUG $ "[central_exchange] sending: " <> (T.unpack $ TE.decodeUtf8 $ BSL.toStrict str) logMsg ioLogger DEBUG $ "[central_exchange] sending: " <> (T.unpack $ TE.decodeUtf8 $ BSL.toStrict str)
void $ sendNonblocking s $ BSL.toStrict str -- err <- sendNonblocking s $ BSL.toStrict str
-- putText $ "[notify] err: " <> show err
void $ timeout 100_000 $ send s $ BSL.toStrict str
{-| {-|
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
......
...@@ -122,9 +122,14 @@ afterStep1b word = fromMaybe word result ...@@ -122,9 +122,14 @@ afterStep1b word = fromMaybe word result
step1b :: [Char] -> [Char] step1b :: [Char] -> [Char]
step1b = either identity afterStep1b . beforeStep1b step1b = either identity afterStep1b . beforeStep1b
-- Issue #415: According to the Porter stemming rules, we need to replace `y` with `i` only if there
-- are no other vocals at the end.
step1c :: [Char] -> [Char] step1c :: [Char] -> [Char]
step1c word = fromMaybe word result step1c word
where result = replaceEnd containsVowel word "y" "i" | length word > 2 && List.last word == 'y' && isConsonant word (List.length word - 2)
= List.init word <> "i"
| otherwise
= word
step1 :: [Char] -> [Char] step1 :: [Char] -> [Char]
step1 = step1c . step1b . step1a step1 = step1c . step1b . step1a
......
...@@ -27,8 +27,8 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog) ...@@ -27,8 +27,8 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
import Gargantext.API.Admin.Settings ( devSettings, newPool ) import Gargantext.API.Admin.Settings ( devSettings, newPool )
import Gargantext.API.Admin.Types (HasSettings(..), Settings(..)) import Gargantext.API.Admin.Types (HasSettings(..), Settings(..))
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,10 +122,15 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do ...@@ -117,10 +122,15 @@ 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
ret <- insertDB ([NodeNode { _nn_node1_id = nId
, _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 nId
void $ CE.ce_notify $ CE.UpdateTreeFirstLevel n
return ret
else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only" 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,9 +14,11 @@ module Gargantext.Database.Query.Table.Node.Update (Update(..), update) ...@@ -14,9 +14,11 @@ 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.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.Prelude (DBCmd, runPGSQuery) import Gargantext.Database.Query.Table.Node (getParentId)
import Gargantext.Database.Prelude (Cmd, DBCmd, runPGSQuery)
import Gargantext.Prelude import Gargantext.Prelude
-- import Data.ByteString -- import Data.ByteString
...@@ -35,11 +37,25 @@ data Update = Rename NodeId Name ...@@ -35,11 +37,25 @@ data Update = Rename NodeId Name
unOnly :: Only a -> a unOnly :: Only a -> a
unOnly (Only a) = a unOnly (Only a) = a
-- TODO-ACCESS -- | Prefer this, because it notifies parents of the node change
update :: Update -> DBCmd err [Int] update :: Update -> Cmd err [Int]
update (Rename nId name) = map unOnly <$> runPGSQuery "UPDATE nodes SET name=? where id=? returning id" update u@(Rename nId _name) = do
(DT.take 255 name,nId) ret <- update' u
update (Move nId pId) = map unOnly <$> runPGSQuery "UPDATE nodes SET parent_id= ? where id=? returning id" mpId <- getParentId nId
(pId, nId) case mpId of
Nothing -> pure ()
Just pId -> CE.ce_notify $ CE.UpdateTreeFirstLevel pId
return ret
update u@(Move nId pId) = do
mpId <- getParentId nId
ret <- update' u
case mpId of
Nothing -> pure ()
Just pId' -> CE.ce_notify $ CE.UpdateTreeFirstLevel pId'
CE.ce_notify $ CE.UpdateTreeFirstLevel pId
return ret
-- TODO-ACCESS
update' :: Update -> DBCmd err [Int]
update' (Rename nId name) = map unOnly <$> runPGSQuery "UPDATE nodes SET name=? where id=? returning id" (DT.take 255 name, nId)
update' (Move nId pId) = map unOnly <$> runPGSQuery "UPDATE nodes SET parent_id= ? where id=? returning id" (pId, nId)
...@@ -16,7 +16,7 @@ docker compose up -d ...@@ -16,7 +16,7 @@ docker compose up -d
echo "GarganText: docker for postgresql database [OK]" echo "GarganText: docker for postgresql database [OK]"
cd ../../ cd ../../
echo "GarganText: gargantext-server with Nix and Cabal..." echo "GarganText: gargantext-server with Nix and Cabal..."
nix-shell --run "cabal run gargantext-server -- --ini gargantext.ini --run Prod +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE" nix-shell --run "cabal run gargantext-server -- --toml gargantext-settings.toml --run Prod +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE"
echo "GarganText: gargantext-server with Nix and Cabal [OK]" echo "GarganText: gargantext-server with Nix and Cabal [OK]"
echo "GarganText: project stopped." echo "GarganText: project stopped."
{
"documents": [
{
"document": {
"id": 1101563,
"hash_id": null,
"typename": 4,
"user_id": 58,
"parent_id": null,
"name": "THE EFFECT OF ANTIOXIDANTS ON FROZEN GROUND PORK",
"date": "1956-01-01T00:00:00Z",
"hyperdata": {
"abstract": "The relative effectiveness of monosodium glutamate (MSG), soybean flour, and butylated hydroxyanisole (BHA) as antioxidants for ground pork stored raw, and pork cooked prior to freezer storage, was studied. Peroxide determinations were made at intervals through 18 months of storage, and organoleptic judgments at corresponding intervals through 12 months. Peroxide determinations indicated that soybean flour, BHA, and the cooking process alone inhibited fat oxidation, but MSG did not. On palatability tests, soy-treated pork was rated down on flavor. Samples with MSG received the best scores, but showed rapid peroxide development after 12 months when stored raw. None of the samples became rancid during the first 12 months of storage. At 15 and 18 months, peroxide numbers indicated rancidity in the untreated and in the MSG treated pork stored raw.",
"authors": "NEILL, J; PAGE, L",
"bdd": "WOS",
"language_iso2": "EN",
"publication_date": "1956-01-01 00:00:00 UTC",
"publication_day": 1,
"publication_month": 1,
"publication_year": 1956,
"source": "FOOD TECHNOLOGY",
"title": "THE EFFECT OF ANTIOXIDANTS ON FROZEN GROUND PORK"
}
},
"ngrams": {
"ngrams": [],
"hash": ""
},
"hash": ""
},
{
"document": {
"id": 1101539,
"hash_id": null,
"typename": 4,
"user_id": 58,
"parent_id": null,
"name": "INFLUENCE OF DIETARY PROTEIN LEVEL AND AMINO ACID COMPOSITION ON CHICK; PERFORMANCE",
"date": "1965-01-01T00:00:00Z",
"hyperdata": {
"abstract": "Studies were designed to investigate the effects of altering dietary protein levels and/or amino acid composition on chick growth and feed efficiency. Contradictory observations in chick performance were made among a series of diets in which the crude protein content was increased from 18 to 22%. Chick weight and feed efficiency was unaffected as dietary protein was increased by replacing cellulose with monosodium glutamate or L-glutamic acid. Chick performance was improved, however, by supplementation of the deficient essential amino acids. Increasing dietary protein concomitantly with essential amino acid supplementation had no effect on chick weight or feed efficiency. In contrast, significant improvements in chick performance were observed in a series of diets where dietary protein was increased by replacing corn with soybean meal.",
"authors": "ASKELSON, CE; BALLOUN, SL",
"bdd": "WOS",
"doi": "10.3382/ps.0440193",
"language_iso2": "EN",
"publication_date": "1965-01-01 00:00:00 UTC",
"publication_day": 1,
"publication_month": 1,
"publication_year": 1965,
"source": "POULTRY SCIENCE",
"title": "INFLUENCE OF DIETARY PROTEIN LEVEL AND AMINO ACID COMPOSITION ON CHICK; PERFORMANCE"
}
},
"ngrams": {
"ngrams": [],
"hash": ""
},
"hash": ""
},
{
"document": {
"id": 1102103,
"hash_id": null,
"typename": 4,
"user_id": 58,
"parent_id": null,
"name": "DILUENT SENSITIVITY IN THERMALLY STRESSED CELLS OF; PSEUDOMONAS-FLUORESCENS",
"date": "1977-01-01T00:00:00Z",
"hyperdata": {
"abstract": "Thermally injured cells of P. fluorescens cannot produce colonies on Trypticase soy agar (TSA) after dilution with 0.1% peptone. Nutritional exigency could not be used as the criterion for this injury, since varying the composition of the plating medium had little effect on the number of colonies that developed. The injured cells had no requirement for compounds known to leak out during the heat treatment in order to recover. The cells did not exhibit injury if dilution preceded heat treatment on the plating medium, demonstrating that the heat treatment sensitized the cells to the trauma of dilution. Substitution of 0.1% peptone with growth medium as the diluent largely offset the previously observed drop in TSA count. Little difference in survival was observed when monosodium glutamate or the balance of the defined medium was used as the diluent. The diluent effect was ionic rather than osmotic. The presence of cations was important in maintaining the integrity of the injured cell, and divalent cations enhanced this protective effect. The role of these cations at the level of the cell envelope is discussed.",
"authors": "GRAY, RJH; ORDAL, ZJ; WITTER, LD",
"bdd": "WOS",
"doi": "10.1128/AEM.33.5.1074-1078.1977",
"language_iso2": "EN",
"publication_date": "1977-01-01 00:00:00 UTC",
"publication_day": 1,
"publication_month": 1,
"publication_year": 1977,
"source": "APPLIED AND ENVIRONMENTAL MICROBIOLOGY",
"title": "DILUENT SENSITIVITY IN THERMALLY STRESSED CELLS OF; PSEUDOMONAS-FLUORESCENS"
}
},
"ngrams": {
"ngrams": [],
"hash": ""
},
"hash": ""
},
{
"document": {
"id": 1101179,
"hash_id": null,
"typename": 4,
"user_id": 58,
"parent_id": null,
"name": "GROWTH OF BACILLUS-CEREUS IN MEDIA CONTAINING PLANT SEED MATERIALS AND; INGREDIENTS USED IN CHINESE COOKERY",
"date": "1980-01-01T00:00:00Z",
"hyperdata": {
"abstract": "Growth and sporulation of enterotoxigenic strains of B. cereus in media containing 20 different plant seed flours and meals, with and without added infusions of beef, pork, chicken and shrimp, monosodium glutamate (MSG) and soy sauce, were studied. Suspensions (2%; pH 7.1) of seed flours and meals from diverse botanical origins were excellent sources of nutrients for growth. No correlations could be made between composition of seed materials and rate of cell division. Mean generation times of B. cereus cultured in soy, peanut and rice flour media supplemented with animal flesh infusions were significantly faster (P .ltoreq. 0.05) than those of respective controls. Monosodium glutamate (1-2%) and soy sauce (5-10%) stimulated the rate of growth of B. cereus in rice flour medium. Test flours supporting slower growth rates appeared generally to support higher rates of sporulation.",
"authors": "BEUCHAT, LR; MALIN, CFA; CARPENTER, JA",
"bdd": "WOS",
"doi": "10.1111/j.1365-2672.1980.tb01028.x",
"language_iso2": "EN",
"publication_date": "1980-01-01 00:00:00 UTC",
"publication_day": 1,
"publication_month": 1,
"publication_year": 1980,
"source": "JOURNAL OF APPLIED BACTERIOLOGY",
"title": "GROWTH OF BACILLUS-CEREUS IN MEDIA CONTAINING PLANT SEED MATERIALS AND; INGREDIENTS USED IN CHINESE COOKERY"
}
},
"ngrams": {
"ngrams": [],
"hash": ""
},
"hash": ""
}
],
"garg_version": "0.0.7.3.1"
}
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
...@@ -20,7 +20,7 @@ import Prelude qualified ...@@ -20,7 +20,7 @@ import Prelude qualified
import Servant.Auth.Client () import Servant.Auth.Client ()
import Servant.Client import Servant.Client
import Test.API.Routes (auth_api) import Test.API.Routes (auth_api)
import Test.API.Setup (withTestDBAndPort, setupEnvironment) import Test.API.Setup (withTestDBAndPort, setupEnvironment, SpecContext (..))
import Test.Database.Types import Test.Database.Types
import Test.Hspec import Test.Hspec
import Gargantext.API.Routes.Named import Gargantext.API.Routes.Named
...@@ -32,7 +32,7 @@ cannedToken = "eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW1 ...@@ -32,7 +32,7 @@ cannedToken = "eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW1
tests :: Spec tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
describe "Prelude" $ do describe "Prelude" $ do
it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
describe "Authentication" $ do describe "Authentication" $ do
baseUrl <- runIO $ parseBaseUrl "http://localhost" baseUrl <- runIO $ parseBaseUrl "http://localhost"
manager <- runIO $ newManager defaultManagerSettings manager <- runIO $ newManager defaultManagerSettings
...@@ -41,15 +41,15 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -41,15 +41,15 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-- testing scenarios start here -- testing scenarios start here
describe "GET /api/v1.0/version" $ do describe "GET /api/v1.0/version" $ do
let version_api = gargVersionEp . gargAPIVersion . mkBackEndAPI $ genericClient let version_api = gargVersionEp . gargAPIVersion . mkBackEndAPI $ genericClient
it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do it "requires no auth and returns the current version" $ \SpecContext{..} -> do
result <- runClientM version_api (clientEnv port) result <- runClientM version_api (clientEnv _sctx_port)
case result of case result of
Left err -> Prelude.fail (show err) Left err -> Prelude.fail (show err)
Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back
describe "POST /api/v1.0/auth" $ do describe "POST /api/v1.0/auth" $ do
it "requires no auth and authenticates the user 'alice'" $ \((testEnv, port), _) -> do it "requires no auth and authenticates the user 'alice'" $ \(SpecContext testEnv port _app _) -> do
-- Let's create the Alice user. -- Let's create the Alice user.
void $ flip runReaderT testEnv $ runTestMonad $ do void $ flip runReaderT testEnv $ runTestMonad $ do
...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
result `shouldBe` Right expected result `shouldBe` Right expected
it "denies login for user 'alice' if password is invalid" $ \((_testEnv, port), _) -> do it "denies login for user 'alice' if password is invalid" $ \(SpecContext _testEnv port _app _) -> do
let authPayload = AuthRequest "alice" (GargPassword "wrong") let authPayload = AuthRequest "alice" (GargPassword "wrong")
result <- runClientM (auth_api authPayload) (clientEnv port) result <- runClientM (auth_api authPayload) (clientEnv port)
putText $ "result: " <> show result putText $ "result: " <> show result
......
...@@ -15,7 +15,7 @@ import Servant.Auth.Client () ...@@ -15,7 +15,7 @@ import Servant.Auth.Client ()
import Servant.Client import Servant.Client
import Servant.Client.Generic (genericClient) import Servant.Client.Generic (genericClient)
import Test.API.Routes (mkUrl) import Test.API.Routes (mkUrl)
import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
import Test.Hspec import Test.Hspec
import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
import Test.Utils (protected, withValidLogin, protectedNewError) import Test.Utils (protected, withValidLogin, protectedNewError)
...@@ -26,7 +26,7 @@ tests :: Spec ...@@ -26,7 +26,7 @@ tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
describe "Errors API" $ do describe "Errors API" $ do
describe "Prelude" $ do describe "Prelude" $ do
it "setup DB triggers and users" $ \((testEnv, port), _) -> do it "setup DB triggers and users" $ \(SpecContext testEnv port _app _) -> do
setupEnvironment testEnv setupEnvironment testEnv
baseUrl <- parseBaseUrl "http://localhost" baseUrl <- parseBaseUrl "http://localhost"
manager <- newManager defaultManagerSettings manager <- newManager defaultManagerSettings
...@@ -41,7 +41,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -41,7 +41,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "GET /api/v1.0/node" $ do describe "GET /api/v1.0/node" $ do
it "returns the old error by default" $ \((_testEnv, port), app) -> do it "returns the old error by default" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
res <- protected token "GET" (mkUrl port "/node/99") "" res <- protected token "GET" (mkUrl port "/node/99") ""
...@@ -52,7 +52,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -52,7 +52,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
statusCode `shouldBe` 404 statusCode `shouldBe` 404
simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|] simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|]
it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
res <- protectedNewError token "GET" (mkUrl port "/node/99") "" res <- protectedNewError token "GET" (mkUrl port "/node/99") ""
......
...@@ -10,7 +10,7 @@ module Test.API.GraphQL ( ...@@ -10,7 +10,7 @@ module Test.API.GraphQL (
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Prelude import Prelude
import Servant.Auth.Client () import Servant.Auth.Client ()
import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
import Test.Hspec import Test.Hspec
import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
import Test.Hspec.Wai.JSON (json) import Test.Hspec.Wai.JSON (json)
...@@ -21,10 +21,10 @@ tests :: Spec ...@@ -21,10 +21,10 @@ tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
describe "GraphQL" $ do describe "GraphQL" $ do
describe "Prelude" $ do describe "Prelude" $ do
it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
describe "get_user_infos" $ do describe "get_user_infos" $ do
it "allows 'alice' to see her own info" $ \((testEnv, port), app) -> do it "allows 'alice' to see her own info" $ \(SpecContext testEnv port app _) -> do
createAliceAndBob testEnv createAliceAndBob testEnv
withApplication app $ do withApplication app $ do
...@@ -34,7 +34,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -34,7 +34,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
describe "nodes" $ do describe "nodes" $ do
it "returns node_type" $ \((_testEnv, port), app) -> do it "returns node_type" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "{ nodes(node_id: 2) { node_type } }" } |] let query = [r| { "query": "{ nodes(node_id: 2) { node_type } }" } |]
...@@ -42,21 +42,21 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -42,21 +42,21 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
describe "check error format" $ do describe "check error format" $ do
it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |] let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |] let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected
it "returns the old error (though this is deprecated)" $ \((_testEnv, port), app) -> do it "returns the old error (though this is deprecated)" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |] let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |] let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
it "check new errors with 'type'" $ \((_testEnv, port), app) -> do it "check new errors with 'type'" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |] let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |]
......
...@@ -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
......
...@@ -9,26 +9,25 @@ module Test.API.Private ( ...@@ -9,26 +9,25 @@ module Test.API.Private (
import Gargantext.API.Routes.Named.Node import Gargantext.API.Routes.Named.Node
import Gargantext.API.Routes.Named.Private import Gargantext.API.Routes.Named.Private
import Gargantext.Core.Types (Node)
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Core.Types (Node)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
import Gargantext.Prelude hiding (get) import Gargantext.Prelude hiding (get)
import Network.HTTP.Client hiding (Proxy) import Network.HTTP.Client hiding (Proxy)
import Network.Wai
import Servant.Auth.Client () import Servant.Auth.Client ()
import Servant.Client import Servant.Client
import Servant.Client.Generic (genericClient) import Servant.Client.Generic (genericClient)
import Test.API.Private.Share qualified as Share import Test.API.Private.Share qualified as Share
import Test.API.Private.Table qualified as Table
import Test.API.Routes (mkUrl) import Test.API.Routes (mkUrl)
import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
import Test.Database.Types
import Test.Hspec import Test.Hspec
import Test.Hspec.Wai hiding (pendingWith) import Test.Hspec.Wai hiding (pendingWith)
import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
import Test.Hspec.Wai.JSON (json) import Test.Hspec.Wai.JSON (json)
import Test.Utils (protected, shouldRespondWithFragment, withValidLogin) import Test.Utils (protected, shouldRespondWithFragment, withValidLogin)
privateTests :: SpecWith ((TestEnv, Int), Application) privateTests :: SpecWith (SpecContext a)
privateTests = privateTests =
describe "Private API" $ do describe "Private API" $ do
baseUrl <- runIO $ parseBaseUrl "http://localhost" baseUrl <- runIO $ parseBaseUrl "http://localhost"
...@@ -38,7 +37,7 @@ privateTests = ...@@ -38,7 +37,7 @@ privateTests =
describe "GET /api/v1.0/user" $ do describe "GET /api/v1.0/user" $ do
-- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking. -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
it "doesn't allow someone with an invalid token to show the results" $ \((testEnv, port), _) -> do it "doesn't allow someone with an invalid token to show the results" $ \(SpecContext testEnv port _ _) -> do
createAliceAndBob testEnv createAliceAndBob testEnv
...@@ -49,7 +48,7 @@ privateTests = ...@@ -49,7 +48,7 @@ privateTests =
length result `shouldBe` 0 length result `shouldBe` 0
-- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking. -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do it "allows 'alice' to see the results" $ \(SpecContext _testEnv port _app _) -> do
withValidLogin port "alice" (GargPassword "alice") $ \clientEnv _token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv _token -> do
let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM)) let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
...@@ -60,33 +59,33 @@ privateTests = ...@@ -60,33 +59,33 @@ privateTests =
describe "GET /api/v1.0/node" $ do describe "GET /api/v1.0/node" $ do
it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do it "unauthorised users shouldn't see anything" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
get (mkUrl port "/node/1") `shouldRespondWith` 401 get (mkUrl port "/node/1") `shouldRespondWith` 401
it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do it "allows 'alice' to see her own node info" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/node/8") "" protected token "GET" (mkUrl port "/node/8") ""
`shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |] `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403 protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403
describe "GET /api/v1.0/tree" $ do describe "GET /api/v1.0/tree" $ do
it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do it "unauthorised users shouldn't see anything" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
get (mkUrl port "/tree/1") `shouldRespondWith` 401 get (mkUrl port "/tree/1") `shouldRespondWith` 401
it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do it "allows 'alice' to see her own node info" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/tree/8") "" protected token "GET" (mkUrl port "/tree/8") ""
`shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |] `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403 protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403
...@@ -96,7 +95,9 @@ tests :: Spec ...@@ -96,7 +95,9 @@ tests :: Spec
tests = do tests = do
sequential $ aroundAll withTestDBAndPort $ do sequential $ aroundAll withTestDBAndPort $ do
describe "Prelude" $ do describe "Prelude" $ do
it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
privateTests privateTests
describe "Share API" $ do describe "Share API" $ do
Share.tests Share.tests
describe "Table API" $ do
Table.tests
...@@ -43,12 +43,12 @@ shareURL token = ...@@ -43,12 +43,12 @@ shareURL token =
tests :: Spec tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
describe "Prelude" $ do describe "Prelude" $ do
it "setup DB triggers" $ \((testEnv, _), _) -> do it "setup DB triggers" $ \SpecContext{..} -> do
setupEnvironment testEnv setupEnvironment _sctx_env
-- Let's create the Alice user. -- Let's create the Alice user.
createAliceAndBob testEnv createAliceAndBob _sctx_env
it "should fail if no node type is specified" $ \((_testEnv, serverPort), app) -> do it "should fail if no node type is specified" $ \(SpecContext _testEnv serverPort app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) clientEnv url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) clientEnv
...@@ -57,7 +57,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -57,7 +57,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node Type" . T.pack) -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node Type" . T.pack)
_ -> fail "Test did not fail as expected!" _ -> fail "Test did not fail as expected!"
it "should fail if no node ID is specified" $ \((_testEnv, serverPort), app) -> do it "should fail if no node ID is specified" $ \(SpecContext _testEnv serverPort app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) clientEnv url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) clientEnv
...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node ID" . T.pack) -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node ID" . T.pack)
_ -> fail "Test did not fail as expected!" _ -> fail "Test did not fail as expected!"
it "should return a valid URL" $ \((testEnv, serverPort), app) -> do it "should return a valid URL" $ \(SpecContext testEnv serverPort app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
cId <- liftIO $ newCorpusForUser testEnv "alice" cId <- liftIO $ newCorpusForUser testEnv "alice"
...@@ -77,7 +77,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -77,7 +77,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
Right (ShareLink _) Right (ShareLink _)
-> pure () -> pure ()
it "should include the port if needed (like localhost)" $ \((testEnv, serverPort), app) -> do it "should include the port if needed (like localhost)" $ \(SpecContext testEnv serverPort app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
cId <- liftIO $ newCorpusForUser testEnv "alice" cId <- liftIO $ newCorpusForUser testEnv "alice"
......
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Test.API.Private.Table (
tests
) where
import Gargantext.API.HashedResponse
import Gargantext.Core.Text.Corpus.Query
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu
import Gargantext.Prelude
import qualified Gargantext.API.Ngrams.Types as APINgrams
import qualified Gargantext.Database.Query.Facet as Facet
import Servant.Client
import Test.API.Routes
import Test.API.Setup
import Test.API.UpdateList (createDocsList, checkEither)
import Test.Hspec
import Test.Hspec.Wai.Internal (withApplication)
import Test.Utils
tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do
describe "Prelude" $ do
it "setup DB triggers" $ \SpecContext{..} -> do
setupEnvironment _sctx_env
-- Let's create the Alice user.
createAliceAndBob _sctx_env
beforeAllWith createSoySauceCorpus $ do
it "should return sauce in the search (#415)" $ \SpecContext{..} -> do
let corpusId = _sctx_data
withApplication _sctx_app $ do
withValidLogin _sctx_port "alice" (GargPassword "alice") $ \clientEnv token -> do
liftIO $ do
(HashedResponse _ tr1)
<- checkEither $ runClientM (get_table token
corpusId
(Just APINgrams.Docs)
(Just 10)
(Just 0)
(Just Facet.DateDesc)
(Just $ RawQuery "sauce")
Nothing
) clientEnv
length (tr_docs tr1) `shouldBe` 1
it "should return soy in the search (#415)" $ \SpecContext{..} -> do
let corpusId = _sctx_data
withApplication _sctx_app $ do
withValidLogin _sctx_port "alice" (GargPassword "alice") $ \clientEnv token -> do
liftIO $ do
(HashedResponse _ tr1)
<- checkEither $ runClientM (get_table token
corpusId
(Just APINgrams.Docs)
(Just 10)
(Just 0)
(Just Facet.DateDesc)
(Just $ RawQuery "soy")
Nothing
) clientEnv
length (tr_docs tr1) `shouldBe` 3
createSoySauceCorpus :: SpecContext () -> IO (SpecContext CorpusId)
createSoySauceCorpus ctx@SpecContext{..} = do
withApplication _sctx_app $ do
withValidLogin _sctx_port "alice" (GargPassword "alice") $ \clientEnv token -> do
corpusId <- createDocsList "test-data/search/GarganText_DocsList-soysauce.json" _sctx_env _sctx_port clientEnv token
pure $ const corpusId <$> ctx
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Test.API.Setup where module Test.API.Setup (
SpecContext(..)
, withTestDBAndPort
, withTestDBAndNotifications
, withBackendServerAndProxy
, setupEnvironment
, createAliceAndBob
) where
import Control.Concurrent.Async qualified as Async import Control.Concurrent.Async qualified as Async
import Control.Concurrent.MVar import Control.Concurrent.MVar
...@@ -15,6 +22,7 @@ import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..)) ...@@ -15,6 +22,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)
...@@ -50,6 +58,21 @@ import Test.Database.Types ...@@ -50,6 +58,21 @@ import Test.Database.Types
import UnliftIO qualified import UnliftIO qualified
-- | The context that each spec will be carrying along. This type is
-- polymorphic so that each test can embellish it with test-specific data.
-- 'SpecContext' is a functor, so you can use 'fmap' to change the 'a'.
data SpecContext a =
SpecContext {
_sctx_env :: !TestEnv
, _sctx_port :: !Warp.Port
, _sctx_app :: !Application
, _sctx_data :: !a
}
instance Functor SpecContext where
fmap f (SpecContext e p a d) = SpecContext e p a (f d)
newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
newTestEnv testEnv logger port = do newTestEnv testEnv logger port = do
tomlFile@(SettingsFile sf) <- fakeTomlPath tomlFile@(SettingsFile sf) <- fakeTomlPath
...@@ -84,8 +107,8 @@ newTestEnv testEnv logger port = do ...@@ -84,8 +107,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
...@@ -93,7 +116,7 @@ newTestEnv testEnv logger port = do ...@@ -93,7 +116,7 @@ newTestEnv testEnv logger port = do
-- | Run the gargantext server on a random port, picked by Warp, which allows -- | Run the gargantext server on a random port, picked by Warp, which allows
-- for concurrent tests to be executed in parallel, if we need to. -- for concurrent tests to be executed in parallel, if we need to.
withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO () withTestDBAndPort :: (SpecContext () -> IO ()) -> IO ()
withTestDBAndPort action = withTestDBAndPort action =
withTestDB $ \testEnv -> do withTestDB $ \testEnv -> do
-- TODO Despite being cautious here only to start/kill dispatcher -- TODO Despite being cautious here only to start/kill dispatcher
...@@ -122,6 +145,15 @@ withTestDBAndPort action = ...@@ -122,6 +145,15 @@ withTestDBAndPort action =
env <- newTestEnv testEnv ioLogger 8080 env <- newTestEnv testEnv ioLogger 8080
makeApp env makeApp env
let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions } let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
Warp.testWithApplicationSettings stgs (pure app) $ \port -> action (SpecContext 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) 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
......
...@@ -7,12 +7,14 @@ ...@@ -7,12 +7,14 @@
module Test.API.UpdateList ( module Test.API.UpdateList (
tests tests
, newCorpusForUser -- * Useful helpers
, JobPollHandle(..) , JobPollHandle(..)
, newCorpusForUser
, pollUntilFinished , pollUntilFinished
-- * Useful helpers
, updateNode , updateNode
, createDocsList
, checkEither
) where ) where
import Control.Lens (mapped, over) import Control.Lens (mapped, over)
...@@ -57,11 +59,12 @@ import Gargantext.Prelude hiding (get) ...@@ -57,11 +59,12 @@ import Gargantext.Prelude hiding (get)
import Network.Wai.Handler.Warp qualified as Wai import Network.Wai.Handler.Warp qualified as Wai
import Paths_gargantext (getDataFileName) import Paths_gargantext (getDataFileName)
import qualified Prelude import qualified Prelude
import System.FilePath
import Servant import Servant
import Servant.Client import Servant.Client
import Servant.Job.Async import Servant.Job.Async
import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node) import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node)
import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
import Test.Database.Types import Test.Database.Types
import Test.Hspec import Test.Hspec
import Test.Hspec.Wai.Internal (withApplication, WaiSession) import Test.Hspec.Wai.Internal (withApplication, WaiSession)
...@@ -114,13 +117,13 @@ uploadJSONList port token cId pathToNgrams = do ...@@ -114,13 +117,13 @@ uploadJSONList port token cId pathToNgrams = do
tests :: Spec tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
describe "UpdateList API" $ do describe "UpdateList API" $ do
it "setup DB triggers and users" $ \((testEnv, _), _) -> do it "setup DB triggers and users" $ \(SpecContext testEnv _port _app _) -> do
setupEnvironment testEnv setupEnvironment testEnv
createAliceAndBob testEnv createAliceAndBob testEnv
describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
it "allows uploading a JSON ngrams file" $ \((testEnv, port), app) -> do it "allows uploading a JSON ngrams file" $ \(SpecContext testEnv port app _) -> do
cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
...@@ -142,7 +145,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -142,7 +145,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
] ]
} |] } |]
it "does not create duplicates when uploading JSON (#313)" $ \((testEnv, port), app) -> do it "does not create duplicates when uploading JSON (#313)" $ \(SpecContext testEnv port app _) -> do
cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
...@@ -206,7 +209,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -206,7 +209,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "POST /api/v1.0/lists/:id/csv/add/form/async (CSV)" $ do describe "POST /api/v1.0/lists/:id/csv/add/form/async (CSV)" $ do
it "parses CSV via ngramsListFromCSVData" $ \((_testEnv, _port), _app) -> do it "parses CSV via ngramsListFromCSVData" $ \(SpecContext _testEnv _port _app _) -> do
simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv") simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv")
ngramsListFromTSVData simpleNgrams `shouldBe` ngramsListFromTSVData simpleNgrams `shouldBe`
Right (Map.fromList [ (NgramsTerms, Versioned 0 $ Map.fromList [ Right (Map.fromList [ (NgramsTerms, Versioned 0 $ Map.fromList [
...@@ -214,7 +217,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -214,7 +217,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
, (NgramsTerm "brazorf", NgramsRepoElement 1 StopTerm Nothing Nothing (MSet mempty)) , (NgramsTerm "brazorf", NgramsRepoElement 1 StopTerm Nothing Nothing (MSet mempty))
])]) ])])
it "allows uploading a CSV ngrams file" $ \((testEnv, port), app) -> do it "allows uploading a CSV ngrams file" $ \(SpecContext testEnv port app _) -> do
cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
...@@ -257,12 +260,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -257,12 +260,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "POST /api/v1.0/corpus/:id/add/form/async (JSON)" $ do describe "POST /api/v1.0/corpus/:id/add/form/async (JSON)" $ do
it "allows uploading a JSON docs file" $ \((testEnv, port), app) -> it "allows uploading a JSON docs file" $ \(SpecContext testEnv port app _) ->
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
void $ createFortranDocsList testEnv port clientEnv token void $ createFortranDocsList testEnv port clientEnv token
it "doesn't use trashed documents for score calculation (#385)" $ \((testEnv, port), app) -> do it "doesn't use trashed documents for score calculation (#385)" $ \(SpecContext testEnv port app _) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
corpusId <- createFortranDocsList testEnv port clientEnv token corpusId <- createFortranDocsList testEnv port clientEnv token
...@@ -336,21 +339,28 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -336,21 +339,28 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
) clientEnv ) clientEnv
length (_ne_occurrences fortran_ngram') `shouldBe` 1 length (_ne_occurrences fortran_ngram') `shouldBe` 1
createDocsList :: FilePath
-> TestEnv
createFortranDocsList :: TestEnv -> Int -> ClientEnv -> Token -> WaiSession () CorpusId -> Int
createFortranDocsList testEnv port clientEnv token = do -> ClientEnv
-> Token
-> WaiSession () CorpusId
createDocsList testDataPath testEnv port clientEnv token = do
folderId <- liftIO $ newPrivateFolderForUser testEnv "alice" folderId <- liftIO $ newPrivateFolderForUser testEnv "alice"
([corpusId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build folderId)) [aesonQQ|{"pn_typename":"NodeCorpus","pn_name":"TestCorpus"}|] ([corpusId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build folderId)) [aesonQQ|{"pn_typename":"NodeCorpus","pn_name":"TestCorpus"}|]
-- Import the docsList with only two documents, both containing a \"fortran\" term. -- Import the docsList with only two documents, both containing a \"fortran\" term.
simpleDocs <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/GarganText_DocsList-nodeId-177.json") simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath)
let newWithForm = mkNewWithForm simpleDocs "GarganText_DocsList-nodeId-177.json" let newWithForm = mkNewWithForm simpleDocs (T.pack $ takeBaseName testDataPath)
(j :: JobPollHandle) <- checkEither $ fmap toJobPollHandle <$> liftIO (runClientM (add_file_async token corpusId newWithForm) clientEnv) (j :: JobPollHandle) <- checkEither $ fmap toJobPollHandle <$> liftIO (runClientM (add_file_async token corpusId newWithForm) clientEnv)
let mkPollUrl jh = "/corpus/" <> fromString (show $ _NodeId corpusId) <> "/add/form/async/" +|_jph_id jh|+ "/poll?limit=1" let mkPollUrl jh = "/corpus/" <> fromString (show $ _NodeId corpusId) <> "/add/form/async/" +|_jph_id jh|+ "/poll?limit=1"
j' <- pollUntilFinished token port mkPollUrl j j' <- pollUntilFinished token port mkPollUrl j
liftIO (_jph_status j' `shouldBe` "IsFinished") liftIO (_jph_status j' `shouldBe` "IsFinished")
pure corpusId pure corpusId
createFortranDocsList :: TestEnv -> Int -> ClientEnv -> Token -> WaiSession () CorpusId
createFortranDocsList testEnv port =
createDocsList "test-data/ngrams/GarganText_DocsList-nodeId-177.json" testEnv port
updateNode :: Int -> ClientEnv -> Token -> NodeId -> WaiSession () () updateNode :: Int -> ClientEnv -> Token -> NodeId -> WaiSession () ()
updateNode port clientEnv token nodeId = do updateNode port clientEnv token nodeId = do
let params = UpdateNodeParamsTexts Both let params = UpdateNodeParamsTexts Both
......
{-| {-|
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 ]
...@@ -135,6 +135,8 @@ stemmingTest :: TestEnv -> Assertion ...@@ -135,6 +135,8 @@ stemmingTest :: TestEnv -> Assertion
stemmingTest _env = do stemmingTest _env = do
stem EN GargPorterAlgorithm "Ajeje" `shouldBe` "Ajeje" stem EN GargPorterAlgorithm "Ajeje" `shouldBe` "Ajeje"
stem EN GargPorterAlgorithm "PyPlasm:" `shouldBe` "PyPlasm:" stem EN GargPorterAlgorithm "PyPlasm:" `shouldBe` "PyPlasm:"
stem EN GargPorterAlgorithm "soy" `shouldBe` "soy"
stem EN GargPorterAlgorithm "cry" `shouldBe` "cri"
-- This test outlines the main differences between Porter and Lancaster. -- This test outlines the main differences between Porter and Lancaster.
stem EN GargPorterAlgorithm "dancer" `shouldBe` "dancer" stem EN GargPorterAlgorithm "dancer" `shouldBe` "dancer"
stem EN LancasterAlgorithm "dancer" `shouldBe` "dant" stem EN LancasterAlgorithm "dancer" `shouldBe` "dant"
......
...@@ -26,8 +26,8 @@ import Gargantext.API.Errors.Types qualified as Errors ...@@ -26,8 +26,8 @@ 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.Types (RenameNode(..), WithQuery(..)) import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DET 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.Main (ListType(CandidateTerm, StopTerm, MapTerm)) import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
......
...@@ -272,36 +272,37 @@ newTestEnv = do ...@@ -272,36 +272,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
......
...@@ -26,7 +26,7 @@ import qualified Test.Parsers.Date as PD ...@@ -26,7 +26,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
...@@ -40,7 +40,7 @@ main = do ...@@ -40,7 +40,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
...@@ -58,5 +58,5 @@ main = do ...@@ -58,5 +58,5 @@ main = do
, Phylo.tests , Phylo.tests
, testGroup "Stemming" [ Lancaster.tests ] , testGroup "Stemming" [ Lancaster.tests ]
, 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