Merge branch 'dev' into 362-dev-sqlite

.gitlab-ci.yml

 # Optimising CI speed by using tips from https://blog.nimbleways.com/let-s-make-faster-gitlab-ci-cd-pipelines/
-#image: adinapoli/gargantext:v3.4
-image: cgenie/gargantext:9.4.8
+#image: cgenie/gargantext:9.4.8
+image: adinapoli/gargantext:v3.5
 
 variables:
   STACK_ROOT: "${CI_PROJECT_DIR}/.stack-root"
   STACK_OPTS: "--system-ghc"
-  CABAL_STORE_DIR: "${CI_PROJECT_DIR}/.cabal"
+  STORE_DIR: "${CI_PROJECT_DIR}/.cabal"
+  CABAL_DIR: "${CI_PROJECT_DIR}/.cabal"
   CORENLP: "4.5.4"
   FF_USE_FASTZIP: "true"
   ARTIFACT_COMPRESSION_LEVEL: "fast"
   CACHE_COMPRESSION_LEVEL: "fast"
+  XDG_CACHE_HOME: "/builds/gargantext/.cache"
 
 stages:
   - cabal
@@ -26,6 +28,8 @@ stack:
       - .stack-work/
   script:
     - echo "Building the project from '$CI_PROJECT_DIR'"
+    - git config --global --add safe.directory $XDG_CACHE_HOME/nix/tarball-cache
+    - git config --global --add safe.directory '*'
     - nix-shell --run "stack build --no-terminal --fast --dry-run"
   allow_failure: false
 
@@ -38,7 +42,9 @@ cabal:
       - .cabal/
     policy: pull-push
   script:
-    - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build all --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'"
+    - git config --global --add safe.directory $XDG_CACHE_HOME/nix/tarball-cache
+    - git config --global --add safe.directory '*'
+    - nix-shell --run "./bin/update-project-dependencies $STORE_DIR && cabal --store-dir=$STORE_DIR v2-build all --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'"
   allow_failure: false
 
 bench:
@@ -51,66 +57,55 @@ bench:
       - .cabal/
     policy: pull-push
   script:
-    - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-bench --flags +no-phylo-debug-logs --ghc-options='-O2 -fclear-plugins'"
+    - nix-shell --run "./bin/update-project-dependencies $STORE_DIR && cabal --store-dir=$STORE_DIR v2-bench --flags +no-phylo-debug-logs --ghc-options='-O2 -fclear-plugins'"
   allow_failure: true
 
 test:
   stage: test
+  # The tests needs to run as the 'test' user, because they leverage the
+  # initdb utility from postgres that cannot be run by 'root'.
+  before_script:
+    - echo "Creating test user..."
+    - mkdir -p /home/test
+    - mkdir -p /root/.config
+    - useradd -U test
+    - chown -R test:test dist-newstyle/
+    - chown -R test:test /root/
+    - chown -R test:test $STORE_DIR
+    - chown -R test:test ${CABAL_DIR}
+    - mkdir -p "$XDG_CACHE_HOME/nix"
+    - chown -R test:test "$XDG_CACHE_HOME/nix"
+
   cache:
     key: cabal.project
     paths:
       - dist-newstyle/
       - .cabal/
     policy: pull-push
-  # The tests needs to run as the 'test' user, because they leverage the
-  # initdb utility from postgres that cannot be run by 'root'.
   script:
     - |
-      mkdir -p /home/test
-      mkdir -p /root/.config
-      useradd -U test
-      chown -R test:test dist-newstyle/
-      chown -R test:test /root/
-      chown -R test:test $CABAL_STORE_DIR
+      git config --global --add safe.directory $XDG_CACHE_HOME/nix/tarball-cache
+      git config --global --add safe.directory '*'
+      export TEST_TMPDIR="${CI_PROJECT_DIR}/tmp"
+      mkdir -p "$TEST_TMPDIR"
       export CABAL=$(nix-shell --run "which cabal")
+      echo "Found cabal at ${CABAL}"
       export TEST_NIX_PATH=$(nix-shell --run "echo -n \$PATH")
-      echo $CABAL
-      echo $TEST_NIX_PATH
-      git config --global --add safe.directory '*'
-      nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR"
+      echo "Found test nix path at ${TEST_NIX_PATH}"
+      nix-shell --run "./bin/update-project-dependencies $STORE_DIR"
       mkdir -p /root/.cache/cabal/logs
       chown -R test:test /root/.cache/cabal/logs/
       chown -R test:test /root/.cache/cabal/packages/hackage.haskell.org/
+      chown -R test:test "$TEST_TMPDIR"
 
       mkdir -p /builds/gargantext/haskell-gargantext/devops/coreNLP/stanford-corenlp-current
       cp -R /root/devops/coreNLP/stanford-corenlp-${CORENLP}/* /builds/gargantext/haskell-gargantext/devops/coreNLP/stanford-corenlp-current/
 
-      nix-shell --run "chown -R test:test /root/.config/ && su -m test -c \"export PATH=$PATH:$TEST_NIX_PATH && cd /builds/gargantext/haskell-gargantext; $CABAL --store-dir=$CABAL_STORE_DIR v2-test --test-show-details=streaming --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'\""
+      nix-shell --run "chown -R test:test /root/.config/ && su -m test -c \"export PATH=$PATH:$TEST_NIX_PATH && export TMPDIR=$TEST_TMPDIR && cd /builds/gargantext/haskell-gargantext; $CABAL --store-dir=$STORE_DIR v2-test --test-show-details=streaming --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'\""
+
       chown -R root:root dist-newstyle/
       chown -R root:root /root/
-      chown -R root:root $CABAL_STORE_DIR
+      chown -R root:root $STORE_DIR
       chown -R root:root /root/.cache/cabal/logs/
       chown -R root:root /root/.cache/cabal/packages/hackage.haskell.org/
       chown -Rh root:root /builds/gargantext/haskell-gargantext/devops/coreNLP/stanford-corenlp-current
-
-#docs:
-#  stage: docs
-#  cache:
-#    key: stack.yaml
-#    paths:
-#      - .stack-root/
-#      - .stack-work/
-#    policy: pull
-#  script:
-#    - nix-shell --run "stack build --no-terminal --haddock --no-haddock-deps --fast --dry-run"
-#    - cp -R "$(stack path --local-install-root)"/doc ./output
-#  # FIXME(adinapoli) Currently Gitlab 11.x doesn't support the 'rules' keyword.
-#  # rules:
-#  # - if: '$CI_MERGE_REQUEST_IID' # Run job on Merge Requests
-#  only:
-#    - merge_requests
-#  artifacts:
-#    paths:
-#      - ./output
-#    expire_in: 1 week
-#  allow_failure: true

CHANGELOG.md

+## Version 0.0.7.4.5
+
+* [BACK][FIX][Error when uploading a specific TSV file (#433)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/433)
+
+## Version 0.0.7.4.4
+
+* [BACK][FIX][Order 1 advanced distance (#445)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/445)
+* [FRONT][FIX][Frontend for bridgeness method choice (#730)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/730)
+* [FRONT][FIX][Unify CSS files to a single syntax format (#712)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/712)
+* [FRONT][FIX][Upgrade sigma.js (#705)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/705)
+* [FRONT][FIX][Subcorpus frontend (#718)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/718)
+* [FRONT][FIX][[Corpus upload] Fix an error on form select "NoList" option (#729)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/729)
+* [FRONT][FIX][Basic feature flag hook (#721)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/721)
+
+## Version 0.0.7.4.3
+
+* [BACK][UPGRADE][Remove obsolete GHC option (#388)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/388)
+* [BACK][REFACT][Error in corpus upload / construction are not reflected in the overall JobStatus (#390)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/390)
+* [BACK][FIX][Write test(s) for "ngrams scores do not account for trashed documents" (#391)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/391)
+
 ## Version 0.0.7.4.2
 
 * [BACK][FIX][Let users create a Subcorpus (#384)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/384)

bin/gargantext-cli/CLI/Import.hs

@@ -75,6 +75,7 @@ import_p = fmap CCMD_import $ ImportArgs
   <*> ( option str ( long "user") )
   <*> ( option str ( long "name") )
   <*> settings_p
+  -- <*> (fmap Limit ( option auto ( long "limit" <> metavar "INT" <> help "The limit for the query") ))
   <*> ( option str ( long "corpus-path" <> help "Path to corpus file") )
 
 function_p :: String -> Either String ImportFunction

bin/gargantext-cli/CLI/Ini.hs

@@ -19,17 +19,17 @@ Import a corpus binary.
 module CLI.Ini where
 
 import CLI.Types
-import Control.Monad.Logger (LogLevel(LevelDebug))
-import Data.Text qualified as T
-import Data.Text.IO qualified as T (writeFile)
 import Database.PostgreSQL.Simple qualified as PGS
-import Gargantext.Core.Config qualified as Config
+import Data.Text.IO qualified as T (writeFile)
+import Data.Text qualified as T
 import Gargantext.Core.Config.Ini.Ini qualified as Ini
 import Gargantext.Core.Config.Ini.Mail qualified as IniMail
 import Gargantext.Core.Config.Ini.NLP qualified as IniNLP
+import Gargantext.Core.Config qualified as Config
 import Gargantext.Core.Config.Types qualified as CTypes
 import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..))
 import Gargantext.Prelude
+import Gargantext.System.Logging (LogLevel(..))
 import Options.Applicative
 import Servant.Client.Core (parseBaseUrl)
 import Toml qualified
@@ -87,7 +87,10 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
                                                   , _wsDefaultVisibilityTimeout = 1
                                                   , _wsDefaultDelay = 0
                                                   , _wsDatabase = connInfo { PGS.connectDatabase = "pgmq"} }
-                    , _gc_log_level = LevelDebug
+                    , _gc_logging = Config.LogConfig {
+                        _lc_log_level = INFO
+                      , _lc_log_file = Nothing
+                      }
                     }
   where
     _ac_scrapyd_url =

bin/gargantext-cli/CLI/Server.hs

@@ -12,31 +12,39 @@ Portability : POSIX
 
 module CLI.Server where
 
-import Data.Version (showVersion)
 import CLI.Parsers (settings_p)
 import CLI.Types
 import CLI.Worker (runAllWorkers)
-import GHC.IO.Encoding (setLocaleEncoding, utf8)
-import Gargantext.API (startGargantext)
+import Control.Monad.IO.Class
+import Data.Version (showVersion)
 import Gargantext.API.Admin.EnvTypes (Mode(..))
+import Gargantext.API (startGargantext)
+import Gargantext.Core.Config
 import Gargantext.Core.Config.Types (_SettingsFile)
+import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Prelude
-import Gargantext.System.Logging (withLogger, logMsg, LogLevel(..), Logger)
+import Gargantext.System.Logging
+import GHC.IO.Encoding (setLocaleEncoding, utf8)
 import Options.Applicative
 import Paths_gargantext qualified as PG -- cabal magic build module
 
-
+withServerCLILogger :: ServerArgs
+                    -> (Logger IO -> IO a)
+                    -> IO a
+withServerCLILogger ServerArgs{..} f = do
+  cfg  <- liftIO $ readConfig server_toml
+  withLogger (cfg ^. gc_logging) $ \logger -> f logger
 
 serverCLI :: CLIServer -> IO ()
-serverCLI (CLIS_start serverArgs) = withLogger () $ \ioLogger ->
+serverCLI (CLIS_start serverArgs) = withServerCLILogger serverArgs $ \ioLogger ->
   startServerCLI ioLogger serverArgs
 
-serverCLI (CLIS_startAll serverArgs@(ServerArgs { .. })) = withLogger () $ \ioLogger -> do
+serverCLI (CLIS_startAll serverArgs@(ServerArgs { .. })) = withServerCLILogger serverArgs $ \ioLogger -> do
   withAsync (startServerCLI ioLogger serverArgs) $ \aServer -> do
     runAllWorkers ioLogger server_toml
     wait aServer
 
-serverCLI (CLIS_version) = withLogger () $ \ioLogger -> do
+serverCLI (CLIS_version) = withLogger (LogConfig Nothing DEBUG) $ \ioLogger -> do
     -- Sets the locale to avoid encoding issues like in #284.
   setLocaleEncoding utf8
   logMsg ioLogger INFO $ "Version: " <> showVersion PG.version
@@ -58,13 +66,13 @@ serverParser = hsubparser (
 
 start_p :: Parser CLIServer
 start_p = fmap CLIS_start $ ServerArgs
-  <$> mode_p 
+  <$> mode_p
   <*> port_p
   <*> settings_p
 
 start_all_p :: Parser CLIServer
 start_all_p = fmap CLIS_startAll $ ServerArgs
-  <$> mode_p 
+  <$> mode_p
   <*> port_p
   <*> settings_p
 
@@ -81,7 +89,7 @@ port_p = option auto ( long "port"
                     <> showDefault
                     <> value 8008
                     <> help "Port" )
-  
+
 version_p :: Parser CLIServer
 version_p = pure CLIS_version
 

bin/gargantext-cli/CLI/Worker.hs

@@ -19,7 +19,7 @@ import CLI.Parsers
 import Control.Concurrent.Async (forConcurrently_)
 import Data.List qualified as List (cycle, concat, take)
 import Data.Text qualified as T
-import Gargantext.Core.Config (hasConfig, gc_worker)
+import Gargantext.Core.Config (hasConfig, gc_worker, gc_logging)
 import Gargantext.Core.Config.Types (SettingsFile(..))
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Config.Worker (WorkerDefinition(..), WorkerSettings(..), findDefinitionByName)
@@ -67,8 +67,9 @@ workerCLI (CLIW_run (WorkerArgs { .. })) = do
           withPGMQWorkerCtrlC env wd $ \a _state -> do
             -- _ <- runReaderT (sendJob Ping) env
             wait a
-workerCLI (CLIW_runAll (WorkerAllArgs { .. })) = withLogger () $ \ioLogger -> do
-  runAllWorkers ioLogger worker_toml
+workerCLI (CLIW_runAll (WorkerAllArgs { .. })) = withWorkerEnv worker_toml $ \env -> do
+  let log_cfg = env ^. hasConfig . gc_logging
+  withLogger log_cfg $ \ioLogger -> runAllWorkers ioLogger worker_toml
 workerCLI (CLIW_stats (WorkerStatsArgs { .. })) = do
   putStrLn ("worker toml: " <> _SettingsFile ws_toml)
 

bin/install-cabal2stack

@@ -19,7 +19,7 @@ then
     CURDIR=$PWD
     git clone https://github.com/iconnect/cabal2stack.git cabal2stack-installer
     cd cabal2stack-installer
-    cabal --store-dir=$STORE_DIR v2-install --index-state="${INDEX_STATE}" --overwrite-policy=always
+    cabal --store-dir=$STORE_DIR v2-install --allow-newer --index-state="${INDEX_STATE}" --overwrite-policy=always
     cd $CURDIR
     rm -rf cabal2stack-installer
 fi

bin/scripts/server

@@ -7,4 +7,6 @@ LOGFILE=$FOLDER"/"$FILE
 
 mkdir -p $FOLDER
 
-nix-shell --run "~/.cabal/bin/gargantext-server --toml gargantext-settings.toml --run Prod +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE"
+#nix-shell --run "~/.cabal/bin/gargantext-server --toml gargantext-settings.toml --run Prod +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE"
+
+nix-shell --run "cabal  v2-run  gargantext server -- start-all -m Dev -p 8008 -c gargantext-settings.toml" #> $LOGFILE 2>&1 & tail -F $LOGFILE"

bin/setup-ci-environment

@@ -4,4 +4,4 @@ set -euxo pipefail
 
 DEFAULT_STORE=$HOME/.cabal
 STORE_DIR="${1:-$DEFAULT_STORE}"
-INDEX_STATE="2023-12-10T10:34:46Z"
+INDEX_STATE="2025-02-17T10:13:39Z"

bin/update-project-dependencies

@@ -18,12 +18,12 @@ fi
 # with the `sha256sum` result calculated on the `cabal.project` and
 # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
 # cache can kick in.
-expected_cabal_project_hash="43ef700760f469f504cc78ccb7ca0fce80aba265a1bcac26e0db250b4b8562b6"  
-expected_cabal_project_freeze_hash="bf98c4373747e16acdba3e143ad67c978b53587918ee68b313237434dc21d56d" 
+expected_cabal_project_hash="37352ca36ca5e69d9945da11439be4c3909297b338242855fa588dffdf1ba02b" 
+expected_cabal_project_freeze_hash="cd52143d3a9d285360b59c6371d3e258552c1bc115bd612024db3de1f7593ff7" 
 
 
 cabal --store-dir=$STORE_DIR v2-build --dry-run
-cabal2stack --system-ghc --allow-newer --resolver lts-21.25 --resolver-file devops/stack/lts-21.25.yaml -o stack.yaml
+cabal2stack --system-ghc --allow-newer --resolver lts-22.43 --resolver-file devops/stack/lts-22.43.yaml -o stack.yaml
 
 # Run 'sed' to remove the constraint for 'gargantext', as it doesn't make sense and
 # for the test we need to run this with a different flag.

cabal.project

 -- Generated by stack2cabal
 
 -- index-state: 2023-12-10T10:34:46Z
-index-state: 2024-09-12T03:02:26Z
+index-state: 2025-02-17T10:13:39Z
 
-with-compiler: ghc-9.4.8
+with-compiler: ghc-9.6.6
 optimization: 2
 benchmarks: False
+tests: True
 
 packages:
     ./
@@ -26,11 +27,6 @@ source-repository-package
     location: https://gitlab.iscpif.fr/gargantext/opaleye-textsearch.git
     tag: 04b5c9044fef44393b66bffa258ca0b0f59c1087
 
-source-repository-package
-    type: git
-    location: https://github.com/alpmestan/accelerate-arithmetic.git
-    tag: a110807651036ca2228a76507ee35bbf7aedf87a
-
 source-repository-package
     type: git
     location: https://github.com/alpmestan/hmatrix.git
@@ -43,11 +39,6 @@ source-repository-package
     tag: bc6ca8058077b0b5702ea4b88bd4189cfcad267a
     subdir: sparse-linear
 
-source-repository-package
-    type: git
-    location: https://github.com/chessai/eigen.git
-    tag: 1790fdf9138970dde0dbabf8b270698145a4a88c
-
 source-repository-package
     type: git
     location: https://github.com/delanoe/data-time-segment.git
@@ -58,11 +49,6 @@ source-repository-package
     location: https://github.com/delanoe/patches-map
     tag: 76cae88f367976ff091e661ee69a5c3126b94694
 
-source-repository-package
-    type: git
-    location: https://gitlab.iscpif.fr/amestanogullari/accelerate-utility.git
-    tag: a3875fe652d3bb5acb522674c22c6c814c1b4ad0
-
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
@@ -101,12 +87,14 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/gargantext-graph.git
-    tag: 588e104fe7593210956610cab0041fd16584a4ce
+    tag: a08ceed71b297a811f90cb86c3c61dc0b153036b
+    subdir: gargantext-graph-core
 
+-- Support for GHC 9.6.x
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
-    tag: bb15d828d5ef36eeaa84cccb00598b585048c88e
+    tag: 214b31a2db46de5a2cac24231a3c07a1c4c3fab9
 
 source-repository-package
     type: git
@@ -128,10 +116,11 @@ source-repository-package
     location: https://gitlab.iscpif.fr/gargantext/iso639.git
     tag: eab929d106833ded8011a0d6705135e3fc506a9c
 
+-- GHC 9.6.6 support
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/patches-class.git
-    tag: 3668d28607867a88b2dfc62158139b3cfd629ddb
+    tag: a591716220cfcabffa24eb29cbaa2517023642af
 
 source-repository-package
     type: git
@@ -177,23 +166,21 @@ source-repository-package
     location: https://gitlab.iscpif.fr/gargantext/haskell-throttle
     tag: 02f5ed9ee2d6cce45161addf945b88bc6adf9059
 
-        
 allow-newer: MissingH:base
-           , accelerate-arithmetic:accelerate
-           , accelerate-utility:accelerate
-           , base:*
-           , crawlerHAL:servant
+           , *:base
+           , crawlerHAL:*
+           , epo-api-client:http-client-tls
+           , openalex:http-client-tls
            , iso639:aeson
            , iso639:text
-           , servant-ekg:base
            , servant-ekg:hashable
            , servant-ekg:servant
            , servant-ekg:text
            , servant-ekg:time
-           , servant-xml-conduit:base
            , servant-xml-conduit:bytestring
            , servant-xml-conduit:servant
-           , stemmer:base
+           , servant-auth-server:data-default-class
+           , wuss:template-haskell
 allow-older: aeson:hashable
            , crawlerHAL:servant-client
            , haskell-bee:stm
@@ -203,7 +190,7 @@ allow-older: aeson:hashable
 
 package gargantext
     ghc-options: -fwrite-ide-info
-    
+
 package hmatrix
     ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal -fno-state-hack
 

devops/docker/Dockerfile

@@ -3,18 +3,25 @@ FROM ubuntu:noble
 ## NOTA BENE: In order for this to be built successfully, you have to run ./devops/coreNLP/build.sh first.
 
 ARG DEBIAN_FRONTEND=noninteractive
-ARG GHC=9.4.8
+ARG GHC=9.6.6
 ARG CORENLP=4.5.4
 ARG CORE
 COPY ./shell.nix                                       /builds/gargantext/shell.nix
 COPY ./nix/pkgs.nix                                    /builds/gargantext/nix/pkgs.nix
-COPY ./nix/pinned-23.11.nix                            /builds/gargantext/nix/pinned-23.11.nix
+COPY ./nix/pinned-25.05.nix                            /builds/gargantext/nix/pinned-25.05.nix
 COPY ./devops/coreNLP/build.sh                         /root/devops/coreNLP/build.sh
 COPY ./devops/coreNLP/startServer.sh                   /root/devops/coreNLP/startServer.sh
 COPY ./bin/setup-ci-environment                        /builds/gargantext/bin/setup-ci-environment
 COPY ./bin/install-cabal2stack                         /builds/gargantext/bin/install-cabal2stack
 
 ENV TZ=Europe/Rome
+ENV LANG='en_US.UTF-8' LANGUAGE='en_US:en' LC_ALL='en_US.UTF-8'
+ENV USER=root
+ENV SHELL /bin/bash
+ENV PATH=/root/.nix-profile/bin:$PATH
+ENV PATH=/root/.local/bin:$PATH
+
+
 RUN apt-get update && \
     apt-get install --no-install-recommends -y \
       apt-transport-https \
@@ -47,32 +54,22 @@ RUN apt-get update && \
       unzip && \
     apt-get clean && rm -rf /var/lib/apt/lists/* && \
     mkdir -m 0755 /nix && groupadd -r nixbld && chown root /nix && \
-    for n in $(seq 1 10); do useradd -c "Nix build user $n" -d /var/empty -g nixbld -G nixbld -M -N -r -s "$(command -v nologin)" "nixbld$n"; done
-
-RUN gpg --batch --keyserver keys.openpgp.org     --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C && \
+    for n in $(seq 1 10); do useradd -c "Nix build user $n" -d /var/empty -g nixbld -G nixbld -M -N -r -s "$(command -v nologin)" "nixbld$n"; done && \
+    gpg --batch --keyserver keys.openpgp.org     --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C && \
     gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
-SHELL ["/bin/bash", "-o", "pipefail", "-c"]
-
-RUN cd /root/devops/coreNLP; ./build.sh
 
-RUN set -o pipefail && \
-    bash <(curl -L https://releases.nixos.org/nix/nix-2.15.0/install) --no-daemon && \
-    locale-gen en_US.UTF-8 && chown root -R /nix
+SHELL ["/bin/bash", "-o", "pipefail", "-c"]
 
-ENV LANG='en_US.UTF-8' LANGUAGE='en_US:en' LC_ALL='en_US.UTF-8'
-ENV USER=root
-ENV SHELL /bin/bash
-RUN . "$HOME/.nix-profile/etc/profile.d/nix.sh" && \
+RUN cd /root/devops/coreNLP; ./build.sh && \
+    set -o pipefail && \
+    bash <(curl -L https://releases.nixos.org/nix/nix-2.26.2/install) --no-daemon && \
+    locale-gen en_US.UTF-8 && chown root -R /nix && \
+    . "$HOME/.nix-profile/etc/profile.d/nix.sh" && \
     mkdir -p "/builds/gargantext/" && chmod 777 -R "/builds/gargantext" && \
     echo "source $HOME/.nix-profile/etc/profile.d/nix.sh" >> "$HOME/.bashrc" && \
-    echo `which nix-env`
-
-ENV PATH=/root/.nix-profile/bin:$PATH
-
-RUN . $HOME/.bashrc && nix-env --version
-
-ENV PATH=/root/.local/bin:$PATH
+    echo `which nix-env` && \
+    . $HOME/.bashrc && nix-env --version && \
+    cd /builds/gargantext && nix-shell --run "./bin/install-cabal2stack"
 
-RUN cd /builds/gargantext && nix-shell --run "./bin/install-cabal2stack"
 WORKDIR "/builds/gargantext/"
 

gargantext-settings.toml_toModify

@@ -102,7 +102,7 @@ pass = PASSWORD_TO_CHANGE
 
 [logs]
 log_file = "/var/log/gargantext/backend.log"
-log_level = "LevelDebug"
+log_level = "info"
 log_formatter = "verbose"
 
 

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 3.4
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.7.4.2
+version: 0.0.7.4.5
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -32,6 +32,7 @@ data-files:
     ekg-assets/bootstrap-1.4.0.min.css
     ekg-assets/chart_line_add.png
     ekg-assets/cross.png
+    test-data/ngrams/433-utf-encoding-issue.tsv
     test-data/ngrams/GarganText_DocsList-nodeId-177.json
     test-data/ngrams/GarganText_NgramsTerms-nodeId-177.json
     test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
@@ -97,7 +98,7 @@ flag test-crypto
 -- debug output for the phylo code, so that it doesn't
 -- hinder its performance.
 flag no-phylo-debug-logs
-  default: False
+  default: True
   manual: True
 
 flag enable-benchmarks
@@ -310,6 +311,7 @@ library
       Gargantext.Orphans.Accelerate
       Gargantext.Orphans.OpenAPI
       Gargantext.System.Logging
+      Gargantext.System.Logging.Types
       Gargantext.Utils.Dict
       Gargantext.Utils.Jobs.Error
       Gargantext.Utils.Jobs.Monad
@@ -536,7 +538,7 @@ library
     , fmt
     , formatting ^>= 7.2.0
     , fullstop ^>= 0.1.4
-    , gargantext-graph >=0.1.0.0
+    , gargantext-graph-core >= 0.2.0.0
     , gargantext-prelude
     , graphviz ^>= 2999.20.1.0
     , haskell-bee
@@ -550,7 +552,7 @@ library
     , hstatistics ^>= 0.3.1
     , http-api-data >= 0.5 && < 0.6
     , http-client ^>= 0.7.14
-    , http-client-tls == 0.3.6.1
+    , http-client-tls >= 0.3.6.1 && < 0.4
     , http-conduit >= 2.3.8 && < 2.3.9
     , http-media ^>= 0.8.0.0
     , http-types ^>= 0.12.3
@@ -571,7 +573,7 @@ library
     , morpheus-graphql-app >= 0.24.3 && < 0.28.1
     , morpheus-graphql-server >= 0.24.3 && < 0.28.1
     , morpheus-graphql-subscriptions >= 0.24.3 && < 0.28.1
-    , mtl ^>= 2.2.2
+    , mtl >= 2.2.2 && < 2.4
     , nanomsg-haskell >= 0.2.4 && < 0.3
     , network >= 3.1.4.0
     , network-uri ^>= 2.6.4.1
@@ -598,9 +600,9 @@ library
     , scientific < 0.4
     , serialise ^>= 0.2.4.0
     , servant >= 0.20.1 && < 0.21
-    , servant-auth ^>= 0.4.0.0
+    , servant-auth >= 0.4.0.0 && < 0.5
     , servant-auth-client
-    , servant-auth-server ^>=0.4.6.0
+    , servant-auth-server >=0.4.6.0 && < 0.5
     , servant-auth-swagger ^>= 0.2.10.1
     , servant-blaze ^>= 0.9.1
     , servant-client >= 0.20 && < 0.21
@@ -617,7 +619,7 @@ library
     , servant-xml-conduit ^>= 0.1.0.4
     , shelly >= 1.9 && < 2
     , singletons ^>= 3.0.2
-    , singletons-th >= 3.1 && < 3.2
+    , singletons-th >= 3.1 && < 3.3
     , smtp-mail >= 0.3.0.0
     , split >= 0.2.3.4
     , sqlite-simple >= 0.4.19 && < 0.5
@@ -627,11 +629,12 @@ library
     , stringsearch >= 0.3.6.6
     , swagger2 ^>= 2.8.7
     , tagsoup ^>= 0.14.8
-    , template-haskell ^>= 2.19.0.0
+    , template-haskell >= 2.19.0.0 && < 2.21
     , temporary ^>= 1.3
     , text ^>= 2.0.2
     , text-metrics ^>= 0.3.2
     , time ^>= 1.12.2
+    , transformers
     , transformers-base ^>= 0.4.6
     , tree-diff
     , toml-parser >= 2.0.1.0 && < 3
@@ -650,7 +653,7 @@ library
     , wai-extra ^>= 3.1.8
     , wai-util >= 0.8
     , warp ^>= 3.3.20
-    , websockets ^>= 0.12.7.3
+    , websockets >= 0.12.7.3 && < 0.14
     , wreq ^>= 0.5.3.3
     , xml-conduit ^>= 1.9.1.3
     , xml-types ^>= 0.3.8
@@ -696,7 +699,6 @@ executable gargantext
     , gargantext-prelude
     , haskell-bee
     , MonadRandom ^>= 0.6
-    , monad-logger ^>= 0.3.36
     , optparse-applicative
     , postgresql-simple >= 0.6.4 && <= 0.7.0.0
     , servant >= 0.20.1 && < 0.21
@@ -740,12 +742,11 @@ common commonTestDependencies
     , hspec-wai
     , hspec-wai-json
     , http-client ^>= 0.7.14
-    -- important: 0.3.6.1 uses cryptonite, while > uses crypton
-    , http-client-tls == 0.3.6.1
+    , http-client-tls >= 0.3.6.1 && < 0.4
     , http-types
     , lens >= 5.2.2 && < 5.3
     , monad-control >= 1.0.3 && < 1.1
-    , mtl ^>= 2.2.2
+    , mtl >= 2.2.2 && < 2.4
     , network-uri
     , parsec ^>= 3.1.16.1
     , patches-class ^>= 0.1.0.1
@@ -868,9 +869,11 @@ test-suite garg-test-hspec
     , commonTestDependencies
   type: exitcode-stdio-1.0
   main-is: drivers/hspec/Main.hs
-  build-depends: process ^>= 1.6.18.0
-               , servant >= 0.20.1 && < 0.21
-               , sqlite-simple >= 0.4.19 && < 0.5
+  build-depends:
+      process ^>= 1.6.18.0
+    , servant >= 0.20.1 && < 0.21
+    , sqlite-simple >= 0.4.19 && < 0.5
+    , unix >= 2.7.3 && < 2.9
   other-modules:
       Paths_gargantext
       Test.API

hie.yaml

@@ -4,61 +4,61 @@ cradle:
       component: "lib:gargantext"
 
     - path: "./bin/gargantext-cli/Main.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Admin.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/FileDiff.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/FilterTermsAndCooc.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Import.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Ini.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Init.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Invitations.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/ObfuscateDB.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Parsers.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Phylo.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Phylo/Common.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Phylo/Profile.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Server/Routes.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Types.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Upgrade.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/Paths_gargantext.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-server/Main.hs"
-      component: "gargantext:exe:gargantext-server"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-server/Paths_gargantext.hs"
-      component: "gargantext:exe:gargantext-server"
+      component: "gargantext:exe:gargantext"
 
     - path: "./test"
       component: "gargantext:test:garg-test-tasty"

nix/pinned-24.05.nix

+import (builtins.fetchGit {
+  name = "nixos-24.05";
+  url = "https://github.com/nixos/nixpkgs";
+  ref = "refs/heads/nixos-24.05";
+  rev = "63dacb46bf939521bdc93981b4cbb7ecb58427a0";
+})

nix/pinned-25.05.darwin.nix

+import (builtins.fetchTarball "https://github.com/NixOS/nixpkgs/archive/32fb99ba93fea2798be0e997ea331dd78167f814.tar.gz")

nix/pinned-25.05.nix

+import (builtins.fetchTarball "https://github.com/NixOS/nixpkgs/archive/c46290747b2aaf090f48a478270feb858837bf11.tar.gz")

nix/pkgs.nix

-{ pkgs       ? import ./pinned-23.11.nix {} }:
+{ pkgs ? import (if builtins.elem builtins.currentSystem ["x86_64-darwin" "aarch64-darwin"]
+                 then ./pinned-25.05.darwin.nix
+                 else ./pinned-25.05.nix) {} }:
 
 rec {
   inherit pkgs;
-  ghc948 = if pkgs.stdenv.isDarwin
-           then pkgs.haskell.compiler.ghc948.overrideAttrs (finalAttrs: previousAttrs: {
-                patches = previousAttrs.patches ++ [
-                            # Reverts the linking behavior of GHC to not resolve `-libc++` to `c++`.
-                            (pkgs.fetchpatch {
-                              url = "https://gist.githubusercontent.com/adinapoli/bf722db15f72763bf79dff13a3104b6f/raw/362da0aa3db5c530e0d276183ba68569f216d65a/ghc947-macOS-loadArchive-fix.patch";
-                              sha256 = "sha256-0tHrkWRKFWUewj3uIA0DujVCXo1qgX2lA5p0MIsAHYs=";
-                            })
-                          ];
-                })
-           else pkgs.haskell.compiler.ghc948;
-  cabal_install_3_10_2_1 = pkgs.haskell.lib.compose.justStaticExecutables pkgs.haskell.packages.ghc948.cabal-install;
+  ghc966 = pkgs.haskell.compiler.ghc966;
+  cabal_install = pkgs.haskell.lib.compose.justStaticExecutables pkgs.haskell.packages.ghc966.cabal-install;
   graphviz_dev = pkgs.graphviz.overrideAttrs (finalAttrs: previousAttrs: {
     version = "11.0.0~dev";
     src = pkgs.fetchFromGitLab {
@@ -33,14 +25,10 @@ rec {
                           ];
                 });
 
-  # nng180 = pkgs.nng.overrideAttrs (new: old: rec {
-  #   version = "1.8.0";
-  # });
-  
   igraph_0_10_4 = pkgs.igraph.overrideAttrs (finalAttrs: previousAttrs: {
     version = "0.10.4";
 
-    nativeBuildInputs = previousAttrs.nativeBuildInputs or [] ++ [ pkgs.clang_12 ];
+    nativeBuildInputs = previousAttrs.nativeBuildInputs;
 
     src = pkgs.fetchFromGitHub {
       owner = "igraph";
@@ -53,7 +41,7 @@ rec {
       echo "0.10.4" > IGRAPH_VERSION
     '';
 
-    outputs = [ "out" "doc" ];
+    outputs = [ "dev" "out" "doc" ];
 
     buildInputs = [
       pkgs.arpack
@@ -64,7 +52,6 @@ rec {
       pkgs.libxml2
       pkgs.nanomsg
       pkgs.plfit
-    ] ++ pkgs.lib.optionals pkgs.stdenv.cc.isClang [
       pkgs.llvmPackages.openmp
     ];
 
@@ -81,23 +68,29 @@ rec {
       "-DIGRAPH_ENABLE_LTO=AUTO"
       "-DIGRAPH_ENABLE_TLS=ON"
       "-DBUILD_SHARED_LIBS=ON"
+      "-DCMAKE_INSTALL_PREFIX=${placeholder "out"}"
+      "-DCMAKE_INSTALL_LIBDIR=${placeholder "out"}/lib"
+      "-DCMAKE_INSTALL_DATADIR=${placeholder "out"}/share"
     ];
 
+    doCheck = false;
+
     postInstall = ''
       mkdir -p "$out/share"
       cp -r doc "$out/share"
     '';
 
     postFixup = previousAttrs.postFixup + ''
+      echo "Copying files where they belong .."
       CUR_DIR=$PWD
-      cd "$out/include/igraph" && cp *.h ../
+      cd "$dev/include/igraph" && cp *.h ../
       cd $CUR_DIR
     '';
 
   });
   hsBuildInputs = [
-    ghc948
-    cabal_install_3_10_2_1
+    ghc966
+    cabal_install
     pkgs.haskellPackages.alex
     pkgs.haskellPackages.happy
     pkgs.haskellPackages.pretty-show
@@ -113,25 +106,22 @@ rec {
     hlint
     libffi
     lapack
-    lzma
+    xz
     pcre
     pkg-config
     postgresql
     xz
     zlib
     blas
-    gfortran7
+    gfortran
     expat
     icu
     graphviz
-    clang_12
-    llvm_12
-    gcc12
+    gcc13
     igraph_0_10_4
     libpqxx
     libsodium
     nanomsg
-    # nng180
     zeromq
     curl
   ] ++ ( lib.optionals stdenv.isDarwin [
@@ -139,8 +129,8 @@ rec {
        ]);
   libPaths = pkgs.lib.makeLibraryPath nonhsBuildInputs;
   shellHook = ''
-    export LD_LIBRARY_PATH="${pkgs.gfortran7.cc.lib}:${libPaths}:$LD_LIBRARY_PATH"
-    export LIBRARY_PATH="${pkgs.gfortran7.cc.lib}:${libPaths}"
+    export LD_LIBRARY_PATH="${pkgs.gfortran.cc.lib}:${libPaths}:$LD_LIBRARY_PATH"
+    export LIBRARY_PATH="${pkgs.gfortran.cc.lib}:${libPaths}"
     export PATH="${pkgs.gccStdenv}/bin:$PATH"
     export NIX_CC="${pkgs.gccStdenv}"
     export CC="${pkgs.gccStdenv}/bin/gcc"

shell.nix

@@ -3,9 +3,8 @@ let
   myBuildInputs = [
     pkgs.pkgs.docker-compose
     #pkgs.pkgs.haskell-language-server
-    pkgs.pkgs.stack
     pkgs.pkgs.websocat
-  ];
+  ] ++ pkgs.pkgs.lib.optional (!pkgs.pkgs.stdenv.isDarwin) pkgs.pkgs.stack;
 in
 pkgs.pkgs.mkShell {
   name = pkgs.shell.name;

src/Gargantext/API.hs

@@ -48,14 +48,14 @@ import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Routes.Named (API)
 import Gargantext.API.Routes.Named.EKG (EkgAPI)
 import Gargantext.API.Server.Named (server)
-import Gargantext.Core.Config (gc_notifications_config, gc_frontend_config)
+import Gargantext.Core.Config
 import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_appPort, fc_cors, fc_cookie_settings, microServicesProxyStatus)
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Notifications (withNotifications)
 import Gargantext.Database.Prelude qualified as DB
 import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
 import Gargantext.Prelude hiding (putStrLn, to)
-import Gargantext.System.Logging (withLoggerHoisted)
+import Gargantext.System.Logging (withLoggerIO, renderLogLevel)
 import Network.HTTP.Types hiding (Query)
 import Network.Wai (Middleware, Request, requestHeaders)
 import Network.Wai.Handler.Warp hiding (defaultSettings)
@@ -70,21 +70,20 @@ import System.Cron.Schedule qualified as Cron
 
 -- | startGargantext takes as parameters port number and Toml file.
 startGargantext :: Mode -> PortNumber -> SettingsFile -> IO ()
-startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerHoisted mode $ \logger -> do
+startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerIO mode $ \logger -> do
   config <- readConfig sf <&> (gc_frontend_config . fc_appPort) .~ port
   when (port /= config ^. gc_frontend_config . fc_appPort) $
     panicTrace "TODO: conflicting settings of port"
-  let nc = config ^. gc_notifications_config
-  withNotifications nc $ \dispatcher -> do
+  withNotifications config $ \dispatcher -> do
     env <- newEnv logger config dispatcher
     let fc = env ^. env_config . gc_frontend_config
     let proxyStatus = microServicesProxyStatus fc
     runDbCheck env
-    portRouteInfo nc port proxyStatus
+    startupInfo config port proxyStatus
     app <- makeApp env
     mid <- makeGargMiddleware (fc ^. fc_cors) mode
     periodicActions <- schedulePeriodicActions env
-  
+
     let runServer = run port (mid app) `finally` stopGargantext periodicActions
     case proxyStatus of
       PXY_disabled
@@ -94,7 +93,7 @@ startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerHoisted mod
           proxyCache <- InMemory.newCache (Just oneHour)
           let runProxy  = run proxyPort (mid (microServicesProxyApp proxyCache env))
           Async.race_ runServer runProxy
-  
+
   where runDbCheck env = do
           r <- runExceptT (runReaderT DB.dbCheck env) `catch`
             (\(err :: SomeException) -> pure $ Left err)
@@ -106,11 +105,12 @@ startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerHoisted mod
             Left err -> panicTrace $ "Unexpected exception:" <> show err
         oneHour = Clock.fromNanoSecs 3600_000_000_000
 
-portRouteInfo :: NotificationsConfig -> PortNumber -> MicroServicesProxyStatus -> IO ()
-portRouteInfo nc mainPort proxyStatus = do
+startupInfo :: GargConfig -> PortNumber -> MicroServicesProxyStatus -> IO ()
+startupInfo config mainPort proxyStatus = do
   putStrLn   "=========================================================================================================="
-  putStrLn   " GarganText Main Routes"
+  putStrLn   " GarganText Server"
   putStrLn   "=========================================================================================================="
+  putStrLn $ " - Log Level ...............................: " <> renderLogLevel ll
   putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece mainPort <> "/index.html"
   putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece mainPort <> "/swagger-ui"
   putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece mainPort <> "/gql"
@@ -121,6 +121,8 @@ portRouteInfo nc mainPort proxyStatus = do
   putStrLn $ " - WebSocket address........................: " <> "ws://localhost:" <> toUrlPiece mainPort <> "/ws"
   putStrLn   "=========================================================================================================="
   where
+    nc = config ^. gc_notifications_config
+    ll = config ^. gc_logging . lc_log_level
     renderProxyStatus = case proxyStatus of
       PXY_disabled ->
         " - Microservices proxy .....................: DISABLED (enable in gargantext-settings.toml)"

src/Gargantext/API/Admin/EnvTypes.hs

@@ -25,7 +25,7 @@ module Gargantext.API.Admin.EnvTypes (
   , env_jwt_settings
   , env_pool
   , env_nodeStory
-  
+
   , menv_firewall
   , dev_env_logger
 
@@ -43,7 +43,7 @@ import Database.PostgreSQL.Simple (Connection)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Prelude (GargM, IsGargServer)
-import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..), HasManager(..))
+import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..), HasManager(..), gc_logging, lc_log_level)
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
 import Gargantext.Core.NodeStory
@@ -73,28 +73,6 @@ modeToLoggingLevels = \case
    -- For production, accepts everything but DEBUG.
    Prod -> [minBound .. maxBound] \\ [DEBUG]
 
-instance MonadLogger (GargM Env BackendInternalError) where
-  getLogger = asks _env_logger
-
-instance HasLogger (GargM Env BackendInternalError) where
-  data instance Logger (GargM Env BackendInternalError)  =
-    GargLogger {
-        logger_mode    :: Mode
-      , logger_set     :: FL.LoggerSet
-      }
-  type instance LogInitParams (GargM Env BackendInternalError) = Mode
-  type instance LogPayload (GargM Env BackendInternalError)    = FL.LogStr
-  initLogger mode = do
-    logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
-    pure $ GargLogger mode logger_set
-  destroyLogger (GargLogger{..}) = liftIO $ FL.rmLoggerSet logger_set
-  logMsg (GargLogger mode logger_set) lvl msg = do
-    let pfx = "[" <> show lvl <> "] " :: Text
-    when (lvl `elem` (modeToLoggingLevels mode)) $
-      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
-  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
-
-
 -- Do /not/ treat the data types of this type as strict, because it's convenient
 -- to be able to partially initialise things like an 'Env' during tests, without
 -- having to specify /everything/. This means that when we /construct/ an 'Env',
@@ -142,7 +120,7 @@ instance HasDispatcher Env Dispatcher where
 instance CET.HasCentralExchangeNotification Env where
   ce_notify m = do
     c <- asks (view env_config)
-    liftBase $ CE.notify (_gc_notifications_config c) m
+    liftBase $ CE.notify c m
 
 instance HasManager Env where
   gargHttpManager = env_manager
@@ -190,7 +168,7 @@ makeLenses ''DevEnv
 instance CET.HasCentralExchangeNotification DevEnv where
   ce_notify m = do
     nc <- asks (view dev_env_config)
-    liftBase $ CE.notify (_gc_notifications_config nc) m
+    liftBase $ CE.notify nc m
 
 -- | Our /mock/ job handle.
 data DevJobHandle = DevJobHandle
@@ -244,5 +222,28 @@ instance HasManager DevEnv where
 instance HasNLPServer DevEnv where
   nlpServer = dev_env_config . gc_nlp_config . (to nlpServerMap)
 
-
 instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError)
+
+instance HasLogger (GargM Env BackendInternalError) where
+  data instance Logger (GargM Env BackendInternalError)  =
+    GargLogger {
+        logger_mode    :: Mode
+      , logger_set     :: FL.LoggerSet
+      }
+  type instance LogInitParams (GargM Env BackendInternalError) = Mode
+  type instance LogPayload (GargM Env BackendInternalError)    = FL.LogStr
+  initLogger mode = do
+    logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
+    pure $ GargLogger mode logger_set
+  destroyLogger (GargLogger{..}) = liftIO $ FL.rmLoggerSet logger_set
+  logMsg (GargLogger mode logger_set) lvl msg = do
+    cfg <- view hasConfig
+    let minLvl = cfg ^. gc_logging . lc_log_level
+    when (lvl >= minLvl) $ do
+      let pfx = "[" <> show lvl <> "] " :: Text
+      when (lvl `elem` (modeToLoggingLevels mode)) $
+        liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
+  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+
+instance MonadLogger (GargM Env BackendInternalError) where
+  getLogger = asks _env_logger

src/Gargantext/API/Admin/Settings.hs

@@ -62,7 +62,7 @@ settingsFromEnvironment =
     Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN")
              <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST")
              <*> optSetting "PORT" 3000
-             <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn")
+             <*> (parseLogLevel <$> optSetting "GGTX_LOG_LEVEL" "warn")
              <*> reqSetting "DB_SERVER"
              <*> (parseJwk <$> reqSetting "JWT_SECRET")
              <*> optSetting "SEND_EMAIL" SendEmailViaAws

src/Gargantext/API/Dev.hs

@@ -26,13 +26,13 @@ import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
 import Gargantext.Database.Prelude (Cmd, CmdRandom, connPool, runCmd)
 import Gargantext.Prelude
-import Gargantext.System.Logging ( withLoggerHoisted )
+import Gargantext.System.Logging ( withLoggerIO )
 import Network.HTTP.Client.TLS (newTlsManager)
 import Servant ( ServerError )
 
 -------------------------------------------------------------------
 withDevEnv :: SettingsFile -> (DevEnv -> IO a) -> IO a
-withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
+withDevEnv settingsFile k = withLoggerIO Dev $ \logger -> do
   env <- newDevEnv logger
   k env -- `finally` cleanEnv env
 

src/Gargantext/API/GraphQL/PolicyCheck.hs

@@ -14,7 +14,8 @@ module Gargantext.API.GraphQL.PolicyCheck where
 
 import Prelude
 
-import Control.Monad.Except (MonadError(..), MonadTrans(..))
+import Control.Monad.Except (MonadError(..))
+import Control.Monad.Trans.Class (lift)
 import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
 import Gargantext.API.Auth.PolicyCheck ( BoolExpr, AccessCheck, AccessPolicyManager(..), AccessResult(..))
 import Gargantext.API.Errors.Types ( BackendInternalError(..) )

src/Gargantext/API/Ngrams.hs

@@ -21,6 +21,7 @@ add get
 {-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE IncoherentInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeFamilies      #-}
 {-# LANGUAGE TypeOperators     #-}
 
@@ -84,13 +85,13 @@ module Gargantext.API.Ngrams
 import Control.Lens (view, (^..), (+~), (%~), msumOf, at, ix, _Just, Each(..), (%%~), ifolded, to, withIndex, over)
 import Data.Aeson.Text qualified as DAT
 import Data.List qualified as List
-import Data.Map.Strict qualified as Map
 import Data.Map.Strict.Patch qualified as PM
+import Data.Map.Strict qualified as Map
 import Data.Patch.Class (Action(act), Transformable(..), ours)
 import Data.Set qualified as Set
 import Data.Text (isInfixOf, toLower, unpack)
 import Data.Text.Lazy.IO as DTL ( writeFile )
-import Formatting (hprint, int, (%))
+import Formatting (sformat, int, (%))
 import Gargantext.API.Ngrams.Tools (getNodeStory)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.NodeStory (ArchiveList, HasNodeStory, HasNodeArchiveStoryImmediateSaver(..), HasNodeStoryImmediateSaver(..), NgramsStatePatch', a_history, a_state, a_version, currentVersion)
@@ -99,8 +100,9 @@ import Gargantext.Core.Types (ListType(..), NodeId, ListId, TODO, assertValid, H
 import Gargantext.Core.Types.Query (Limit(..), Offset(..), MinSize(..), MaxSize(..))
 import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast)
 import Gargantext.Database.Query.Table.Ngrams ( text2ngrams, insertNgrams )
-import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf)
 import Gargantext.Prelude.Clock (hasTime, getTime)
+import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf)
+import Gargantext.System.Logging
 import Text.Collate qualified as Unicode
 
 
@@ -517,7 +519,9 @@ unicodeDUCETSorter :: Text -> Text -> Ordering
 unicodeDUCETSorter = Unicode.collate Unicode.rootCollator
 
 getTableNgrams :: forall env err m.
-                  ( HasNodeStory env err m )
+                  ( HasNodeStory env err m
+                  , MonadLogger m
+                  )
                => NodeId
                -> ListId
                -> TabType
@@ -531,7 +535,9 @@ getTableNgrams nodeId listId tabType searchQuery = do
 
 -- | Helper function to get the ngrams table with scores.
 getNgramsTable' :: forall env err m.
-                   ( HasNodeStory env err m )
+                   ( HasNodeStory env err m
+                   , MonadLogger m
+                   )
                 => NodeId
                 -> ListId
                 -> NgramsType
@@ -544,7 +550,9 @@ getNgramsTable' nId listId ngramsType = do
 -- | Helper function to set scores on an `NgramsTable`.
 setNgramsTableScores :: forall env err m t.
                         ( Each t t NgramsElement NgramsElement
-                        , HasNodeStory env err m )
+                        , HasNodeStory env err m
+                        , MonadLogger m
+                        )
                      => NodeId
                      -> ListId
                      -> NgramsType
@@ -555,12 +563,9 @@ setNgramsTableScores nId listId ngramsType table = do
   occurrences <- getOccByNgramsOnlyFast nId listId ngramsType
   --printDebug "[setNgramsTableScores] occurrences" occurrences
   t2 <- getTime
-  liftBase $ do
-    let ngrams_terms = table ^.. each . ne_ngrams
-    -- printDebug "ngrams_terms" ngrams_terms
-    hprint stderr
-      ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
-      (length ngrams_terms) t1 t2
+  let ngrams_terms = table ^.. each . ne_ngrams
+  $(logLocM) DEBUG $ "ngrams_terms: " <> show ngrams_terms
+  $(logLocM) DEBUG $ sformat ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n") (length ngrams_terms) t1 t2
   let
     setOcc ne = ne & ne_occurrences .~ Set.fromList (msumOf (ix (ne ^. ne_ngrams)) occurrences)
 
@@ -580,7 +585,7 @@ needsScores (Just ScoreAsc)  = True
 needsScores (Just ScoreDesc) = True
 needsScores _ = False
 
-getTableNgramsCorpus :: ( HasNodeStory env err m )
+getTableNgramsCorpus :: ( HasNodeStory env err m, MonadLogger m )
                      => NodeId
                      -> TabType
                      -> ListId

src/Gargantext/API/Ngrams/List.hs

@@ -178,35 +178,36 @@ ngramsListFromTSVData tsvData = case decodeTsv of
     binaryData = BSL.fromStrict $ P.encodeUtf8 tsvData
 
     decodeTsv :: Either Prelude.String (Vector NgramsTableMap)
-    decodeTsv = Tsv.decodeWithP tsvToNgramsTableMap
-                               (Tsv.defaultDecodeOptions { Tsv.decDelimiter = fromIntegral (P.ord '\t') })
-                               Tsv.HasHeader
-                               binaryData
+    decodeTsv = Vec.catMaybes <$>
+                   Tsv.decodeWithP tsvToNgramsTableMap
+                                   (Tsv.defaultDecodeOptions { Tsv.decDelimiter = fromIntegral (P.ord '\t') })
+                                   Tsv.HasHeader
+                                   binaryData
 
 -- | Converts a plain TSV 'Record' into an NgramsTableMap
-tsvToNgramsTableMap :: Tsv.Record -> Tsv.Parser NgramsTableMap
+tsvToNgramsTableMap :: Tsv.Record -> Tsv.Parser (Maybe NgramsTableMap)
 tsvToNgramsTableMap record = case Vec.toList record of
   (map P.decodeUtf8 -> [status, label, forms])
-    -> pure $ conv status label forms
-  _ -> Prelude.fail "tsvToNgramsTableMap failed"
+    -> pure $ Just $ conv status label forms
+  -- WARNING: This silently ignores errors (#433)
+  _ -> pure Nothing
 
   where
     conv :: Text -> Text -> Text -> NgramsTableMap
     conv status label forms = Map.singleton (NgramsTerm label)
         $ NgramsRepoElement { _nre_size = 1
-                                             , _nre_list = case status == "map" of
-                                                             True  -> MapTerm
-                                                             False -> case status == "main" of
-                                                                True  -> CandidateTerm
-                                                                False -> StopTerm
-                                             , _nre_root = Nothing
-                                             , _nre_parent = Nothing
-                                             , _nre_children = MSet
-                                                             $ Map.fromList
-                                                             $ map (\form -> (NgramsTerm form, ()))
-                                                             $ filter (\w -> w /= "" && w /= label)
-                                                             $ splitOn "|&|" forms
-                                             }
+                            , _nre_list = case status of
+                                            "map"  -> MapTerm
+                                            "main" -> CandidateTerm
+                                            _      -> StopTerm
+                            , _nre_root = Nothing
+                            , _nre_parent = Nothing
+                            , _nre_children = MSet
+                                            $ Map.fromList
+                                            $ map (\form -> (NgramsTerm form, ()))
+                                            $ filter (\w -> w /= "" && w /= label)
+                                            $ splitOn "|&|" forms
+                            }
 
 ------------------------------------------------------------------------
 

src/Gargantext/API/Node/Update.hs

@@ -63,12 +63,12 @@ updateNode :: (HasNodeStory env err m
            -> JobHandle m
            -> m ()
 updateNode nId (UpdateNodeParamsGraph
-                    (UpdateNodeConfigGraph metric partitionMethod bridgeMethod strength nt1 nt2)) jobHandle = do
+                    (UpdateNodeConfigGraph metric bridgeMethod strength nt1 nt2)) jobHandle = do
 
   markStarted 2 jobHandle
   markProgress 1 jobHandle
   -- printDebug "Computing graph: " method
-  _ <- recomputeGraph nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
+  _ <- recomputeGraph nId bridgeMethod (Just metric) (Just strength) nt1 nt2 True
   -- printDebug "Graph computed: " method
   markComplete jobHandle
 

src/Gargantext/API/Node/Update/Types.hs

@@ -5,8 +5,7 @@ import Data.Aeson
 import Data.Swagger ( ToSchema )
 import Gargantext.Core.Methods.Similarities (GraphMetric(..))
 import Gargantext.Core.Text.Ngrams (NgramsType)
-import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
-import Gargantext.Core.Viz.Graph.Types (Strength)
+import Gargantext.Core.Viz.Graph.Types (BridgenessMethod, Strength)
 import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
 import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType )
 import Gargantext.Prelude
@@ -46,7 +45,6 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
 
 ------------------------------------------------------------------------
 data UpdateNodeConfigGraph = UpdateNodeConfigGraph { methodGraphMetric        :: !GraphMetric
-                                                   , methodGraphClustering    :: !PartitionMethod
                                                    , methodGraphBridgeness    :: !BridgenessMethod
                                                    , methodGraphEdgesStrength :: !Strength
                                                    , methodGraphNodeType1     :: !NgramsType

src/Gargantext/API/Server/Named/Ngrams.hs

@@ -9,8 +9,8 @@ module Gargantext.API.Server.Named.Ngrams (
 import Control.Lens ((%%~))
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
-import Gargantext.API.Admin.Auth (withNamedAccess)
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, PathId (..))
+import Gargantext.API.Admin.Auth (withNamedAccess)
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Metrics qualified as Metrics
@@ -25,11 +25,12 @@ import Gargantext.Core.Types.Query (Limit(..), Offset(..))
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Query.Table.Ngrams ( selectNgramsByDoc )
-import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
 import Gargantext.Database.Schema.Node (node_id, node_parent_id, node_user_id)
 import Gargantext.Prelude
+import Gargantext.System.Logging
 import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..), markFailedNoErr)
 import Servant.Server.Generic (AsServerT)
 
@@ -150,7 +151,7 @@ tableNgramsPostChartsAsync utn jobHandle = do
   -}
 
 scoresRecomputeTableNgrams :: forall env err m.
-                              ( HasNodeStory env err m, HasNodeError err )
+                              ( HasNodeStory env err m, HasNodeError err, MonadLogger m )
                            => NodeId -> TabType -> ListId -> m Int
 scoresRecomputeTableNgrams nId tabType listId = do
   tableMap <- getNgramsTableMap listId ngramsType
@@ -163,7 +164,9 @@ scoresRecomputeTableNgrams nId tabType listId = do
 
 -- | Text search is deactivated for now for ngrams by doc only
 getTableNgramsDoc :: ( HasNodeStory env err m
-                     , HasNodeError err )
+                     , HasNodeError err
+                     , MonadLogger m
+                     )
                   => DocId -> TabType
                   -> ListId -> Limit -> Maybe Offset
                   -> Maybe ListType

src/Gargantext/API/Worker.hs

@@ -36,7 +36,7 @@ serveWorkerAPI f = WorkerAPI { workerAPIPost }
   where
     workerAPIPost i = do
       let job = f i
-      logM DDEBUG $ "[serveWorkerAPI] sending job " <> show job
+      logM DEBUG $ "[serveWorkerAPI] sending job " <> show job
       mId <- sendJob job
       pure $ JobInfo { _ji_message_id = mId
                      , _ji_mNode_id = getWorkerMNodeId job }
@@ -54,4 +54,4 @@ serveWorkerAPIEJob f = WorkerAPI { workerAPIPost }
           mId <- sendJob job
           pure $ JobInfo { _ji_message_id = mId
                          , _ji_mNode_id = getWorkerMNodeId job }
-    
+

src/Gargantext/Core/Config.hs

@@ -12,10 +12,12 @@ Configuration for the gargantext server
 -}
 
 {-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE LambdaCase          #-}
 
 module Gargantext.Core.Config (
     -- * Types
     GargConfig(..)
+  , LogConfig(..)
 
     -- * Lenses
   , gc_datafilepath
@@ -29,7 +31,9 @@ module Gargantext.Core.Config (
   , gc_secrets
   , gc_apis
   , gc_worker
-  , gc_log_level
+  , gc_logging
+  , lc_log_level
+  , lc_log_file
 
   , mkProxyUrl
 
@@ -39,24 +43,43 @@ module Gargantext.Core.Config (
   ) where
 
 import Control.Lens (Getter)
-import Control.Monad.Logger (LogLevel(LevelDebug))
-import Data.Text as T
+import Gargantext.System.Logging.Types (LogLevel, parseLogLevel)
 import Database.PostgreSQL.Simple qualified as PSQL
+import Data.Text as T
 import Gargantext.Core.Config.Mail (MailConfig)
 import Gargantext.Core.Config.NLP (NLPConfig)
-import Gargantext.Core.Config.Worker (WorkerSettings)
 import Gargantext.Core.Config.Types
+import Gargantext.Core.Config.Worker (WorkerSettings)
 import Gargantext.Prelude
 import Network.HTTP.Client qualified as HTTP
 import Servant.Auth.Server (JWTSettings)
 import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
 import Toml.Schema
+import Toml.Schema.FromValue (typeError)
 
 
 -- | strip a given character from end of string
 -- stripRight :: Char -> T.Text -> T.Text
 -- stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s
 
+data LogConfig = LogConfig
+  { _lc_log_file  :: Maybe FilePath
+  , _lc_log_level :: !LogLevel
+  } deriving Show
+
+instance FromValue LogConfig where
+  fromValue = parseTableFromValue $ do
+    _lc_log_file  <- optKey "log_file"
+    _lc_log_level <- reqKeyOf "log_level" parse_log_level
+    pure LogConfig{..}
+
+parse_log_level :: Value' l -> Matcher l LogLevel
+parse_log_level = \case
+  Text' a txt -> case parseLogLevel txt of
+    Left err  -> typeError (T.unpack err) (Text' a txt)
+    Right ll  -> pure ll
+  xs          -> typeError "parse_log_level" xs
+
 -- Non-strict data so that we can use it in tests
 data GargConfig = GargConfig { _gc_datafilepath         :: ~FilePath
                              -- , _gc_repofilepath      :: ~FilePath
@@ -70,12 +93,10 @@ data GargConfig = GargConfig { _gc_datafilepath         :: ~FilePath
                              , _gc_secrets              :: ~SecretsConfig
                              , _gc_apis                 :: ~APIsConfig
                              , _gc_worker               :: ~WorkerSettings
-                             , _gc_log_level            :: ~LogLevel
+                             , _gc_logging              :: ~LogConfig
                              }
   deriving (Generic, Show)
 
-makeLenses ''GargConfig
-
 instance FromValue GargConfig where
   fromValue = parseTableFromValue $ do
     _gc_frontend_config <- reqKey "frontend"
@@ -89,7 +110,7 @@ instance FromValue GargConfig where
     _gc_apis <- reqKey "apis"
     _gc_notifications_config <- reqKey "notifications"
     _gc_worker <- reqKey "worker"
-    let _gc_log_level = LevelDebug
+    _gc_logging <- reqKey "logs"
     return $ GargConfig { _gc_datafilepath
                         , _gc_jobs
                         , _gc_apis
@@ -101,7 +122,7 @@ instance FromValue GargConfig where
                         , _gc_frames
                         , _gc_secrets
                         , _gc_worker
-                        , _gc_log_level }
+                        , _gc_logging }
 instance ToValue GargConfig where
   toValue = defaultTableToValue
 instance ToTable GargConfig where
@@ -139,3 +160,11 @@ class HasJWTSettings env where
 
 class HasManager env where
   gargHttpManager :: Getter env HTTP.Manager
+
+--
+-- Lenses
+--
+
+makeLenses ''LogConfig
+makeLenses ''GargConfig
+

src/Gargantext/Core/Notifications.hs

@@ -12,14 +12,14 @@ Portability : POSIX
 module Gargantext.Core.Notifications
 where
 
-import Gargantext.Core.Config.Types (NotificationsConfig)
+import Gargantext.Core.Config (GargConfig)
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.Dispatcher qualified as D
 import Protolude
 
 
-withNotifications :: NotificationsConfig -> (D.Dispatcher -> IO a) -> IO a
-withNotifications nc cb =
-  D.withDispatcher nc $ \dispatcher -> do
-    withAsync (CE.gServer nc) $ \_ce -> do
+withNotifications :: GargConfig -> (D.Dispatcher -> IO a) -> IO a
+withNotifications gc cb =
+  D.withDispatcher gc $ \dispatcher -> do
+    withAsync (CE.gServer gc) $ \_ce -> do
       cb dispatcher

src/Gargantext/Core/Notifications/CentralExchange.hs

@@ -11,7 +11,7 @@ https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/341
 
 Docs:
 https://dev.sub.gargantext.org/#/share/Notes/187918
-    
+
 -}
 
 module Gargantext.Core.Notifications.CentralExchange (
@@ -23,15 +23,16 @@ import Control.Concurrent.Async qualified as Async
 import Control.Concurrent.STM.TChan qualified as TChan
 import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as BSL
-import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
+import Data.Text qualified as T
+import Gargantext.Core.Config (GargConfig, gc_notifications_config, gc_logging)
 import Gargantext.Core.Config.Types (NotificationsConfig(..))
 import Gargantext.Core.Notifications.CentralExchange.Types
 import Gargantext.Prelude
 import Gargantext.System.Logging (LogLevel(..), withLogger, logMsg)
 import Nanomsg (Pull(..), Push(..), bind, connect, recv, send, withSocket)
 import System.Timeout (timeout)
-    
+
 {-
 
 Central exchange is a service, which gathers messages from various
@@ -42,18 +43,18 @@ The primary goal is to be able to read as many messages as possible
 and then send them to the Dispatcher. Although nanomsg does some
 message buffering, we don't want these messages to pile up, especially
 with many users having updates.
-    
+
 -}
 
-gServer :: NotificationsConfig -> IO ()
-gServer (NotificationsConfig { .. }) = do
+gServer :: GargConfig -> IO ()
+gServer cfg = do
   withSocket Pull $ \s -> do
     withSocket Push $ \s_dispatcher -> do
-      withLogger () $ \ioLogger -> do
-        logMsg ioLogger DDEBUG $ "[central_exchange] binding to " <> T.unpack _nc_central_exchange_bind
+      withLogger log_cfg $ \ioLogger -> do
+        logMsg ioLogger DEBUG $ "[central_exchange] binding to " <> T.unpack _nc_central_exchange_bind
       _ <- bind s $ T.unpack _nc_central_exchange_bind
-      withLogger () $ \ioLogger -> do
-        logMsg ioLogger DDEBUG $ "[central_exchange] connecting to " <> T.unpack _nc_dispatcher_bind
+      withLogger log_cfg $ \ioLogger -> do
+        logMsg ioLogger DEBUG $ "[central_exchange] connecting to " <> T.unpack _nc_dispatcher_bind
       _ <- connect s_dispatcher $ T.unpack _nc_dispatcher_connect
 
       tChan <- TChan.newTChanIO
@@ -63,16 +64,18 @@ gServer (NotificationsConfig { .. }) = do
       -- | the 'tChan' and calls Dispatcher accordingly. This is to
       -- | make reading nanomsg as fast as possible.
       void $ Async.concurrently (worker s_dispatcher tChan) $ do
-        withLogger () $ \ioLogger -> do
+        withLogger log_cfg $ \ioLogger -> do
           forever $ do
             -- putText "[central_exchange] receiving"
             r <- recv s
-            logMsg ioLogger DDEBUG $ "[central_exchange] received: " <> show r
+            logMsg ioLogger DEBUG $ "[central_exchange] received: " <> show r
             -- C.putStrLn $ "[central_exchange] " <> r
             atomically $ TChan.writeTChan tChan r
   where
+    NotificationsConfig{..} = cfg ^. gc_notifications_config
+    log_cfg = cfg ^. gc_logging
     worker s_dispatcher tChan = do
-      withLogger () $ \ioLogger -> do
+      withLogger log_cfg $ \ioLogger -> do
         forever $ do
           r <- atomically $ TChan.readTChan tChan
           case Aeson.decode (BSL.fromStrict r) of
@@ -81,10 +84,10 @@ gServer (NotificationsConfig { .. }) = do
               -- putText $ "[central_exchange] sending that to the dispatcher: " <> show node_id
               -- To make this more robust, use withAsync so we don't
               -- block the main thread (send is blocking)
-              
+
               -- NOTE: If we're flooded with messages, and send is
               -- slow, we might be spawning many threads...
-    
+
               -- NOTE: Currently we just forward the message that we
               -- got. So in theory central exchange isn't needed (we
               -- could ping dispatcher directly). However, I think
@@ -102,16 +105,19 @@ gServer (NotificationsConfig { .. }) = do
               void $ timeout 100_000 $ send s_dispatcher r
             Nothing ->
               logMsg ioLogger ERROR $ "[central_exchange] cannot decode message: " <> show r
-      
 
-notify :: NotificationsConfig -> CEMessage -> IO ()
-notify (NotificationsConfig { _nc_central_exchange_connect }) ceMessage = do
+
+notify :: GargConfig -> CEMessage -> IO ()
+notify cfg ceMessage = do
   Async.withAsync (pure ()) $ \_ -> do
     withSocket Push $ \s -> do
       _ <- connect s $ T.unpack _nc_central_exchange_connect
       let str = Aeson.encode ceMessage
-      withLogger () $ \ioLogger ->
-        logMsg ioLogger DDEBUG $ "[central_exchange] sending: " <> (T.unpack $ TE.decodeUtf8 $ BSL.toStrict str)
+      withLogger log_cfg $ \ioLogger ->
+        logMsg ioLogger DEBUG $ "[central_exchange] sending: " <> (T.unpack $ TE.decodeUtf8 $ BSL.toStrict str)
       -- err <- sendNonblocking s $ BSL.toStrict str
       -- putText $ "[notify] err: " <> show err
       void $ timeout 100_000 $ send s $ BSL.toStrict str
+  where
+    NotificationsConfig { _nc_central_exchange_connect } = cfg ^. gc_notifications_config
+    log_cfg = cfg ^. gc_logging

src/Gargantext/Core/Notifications/Dispatcher.hs

@@ -11,7 +11,7 @@ https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/341
 
 Docs:
 https://dev.sub.gargantext.org/#/share/Notes/187918
-    
+
 -}
 
 module Gargantext.Core.Notifications.Dispatcher (
@@ -38,6 +38,7 @@ import Gargantext.System.Logging (LogLevel(..), withLogger, logMsg)
 import Nanomsg (Pull(..), bind, recv, withSocket)
 import Network.WebSockets qualified as WS
 import StmContainers.Set qualified as SSet
+import Gargantext.Core.Config
 
 {-
 
@@ -45,7 +46,7 @@ Dispatcher is a service, which provides couple of functionalities:
 - handles WebSocket connections and manages them
 - accepts messages from central exchange
 - dispatches these messages to connected users
-    
+
 -}
 
 data Dispatcher =
@@ -55,23 +56,23 @@ data Dispatcher =
 dispatcherSubscriptions :: Dispatcher -> SSet.Set Subscription
 dispatcherSubscriptions = d_subscriptions
 
-withDispatcher :: NotificationsConfig -> (Dispatcher -> IO a) -> IO a
-withDispatcher nc cb = do
+withDispatcher :: GargConfig -> (Dispatcher -> IO a) -> IO a
+withDispatcher cfg cb = do
   subscriptions <- SSet.newIO
 
-  Async.withAsync (dispatcherListener nc subscriptions) $ \_a -> do
+  Async.withAsync (dispatcherListener cfg subscriptions) $ \_a -> do
     let dispatcher = Dispatcher { d_subscriptions = subscriptions }
     cb dispatcher
 
-    
+
 -- | This is a nanomsg socket listener. We want to read the messages
 -- | as fast as possible and then process them gradually in a separate
 -- | thread.
-dispatcherListener :: NotificationsConfig -> SSet.Set Subscription -> IO ()
-dispatcherListener (NotificationsConfig { _nc_dispatcher_bind }) subscriptions = do
+dispatcherListener :: GargConfig -> SSet.Set Subscription -> IO ()
+dispatcherListener config subscriptions = do
   withSocket Pull $ \s -> do
-    withLogger () $ \ioLogger -> do
-      logMsg ioLogger DDEBUG $ "[dispatcherListener] binding to " <> T.unpack _nc_dispatcher_bind
+    withLogger log_cfg $ \ioLogger -> do
+      logMsg ioLogger DEBUG $ "[dispatcherListener] binding to " <> T.unpack _nc_dispatcher_bind
     _ <- bind s $ T.unpack _nc_dispatcher_bind
 
     tChan <- TChan.newTChanIO
@@ -81,7 +82,7 @@ dispatcherListener (NotificationsConfig { _nc_dispatcher_bind }) subscriptions =
     -- NOTE I'm not sure that we need more than 1 worker here, but in
     -- theory, the worker can perform things like user authentication,
     -- DB queries etc so it can be slow sometimes.
-    Async.withAsync (throttle 500_000 throttleTChan sendDataMessageThrottled) $ \_ -> do
+    Async.withAsync (throttle 500_000 throttleTChan (sendDataMessageThrottled log_cfg)) $ \_ -> do
       void $ Async.concurrently (Async.replicateConcurrently 5 $ worker tChan throttleTChan) $ do
         forever $ do
           -- putText "[dispatcher_listener] receiving"
@@ -89,20 +90,22 @@ dispatcherListener (NotificationsConfig { _nc_dispatcher_bind }) subscriptions =
           -- C.putStrLn $ "[dispatcher_listener] " <> r
           atomically $ TChan.writeTChan tChan r
   where
+    NotificationsConfig { _nc_dispatcher_bind } = config ^. gc_notifications_config
+    log_cfg = config ^. gc_logging
     worker tChan throttleTChan = do
       -- tId <- myThreadId
-      
+
       forever $ do
         r <- atomically $ TChan.readTChan tChan
         -- putText $ "[" <> show tId <> "] received a message: " <> decodeUtf8 r
-        
+
         case Aeson.decode (BSL.fromStrict r) of
           Nothing ->
-            withLogger () $ \ioL ->
+            withLogger log_cfg $ \ioL ->
               logMsg ioL DEBUG "[dispatcher_listener] unknown message from central exchange"
           Just ceMessage -> do
-            withLogger () $ \ioL ->
-              logMsg ioL DDEBUG $ "[dispatcher_listener] received " <> show ceMessage
+            withLogger log_cfg $ \ioL ->
+              logMsg ioL DEBUG $ "[dispatcher_listener] received " <> show ceMessage
             -- subs <- atomically $ readTVar subscriptions
             filteredSubs <- atomically $ do
               let subs' = UnfoldlM.filter (pure . ceMessageSubPred ceMessage) $ SSet.unfoldlM subscriptions
@@ -161,10 +164,10 @@ sendNotification throttleTChan ceMessage sub = do
 
 -- | The "true" message sending to websocket. After it was withheld
 -- for a while (for throttling), it is finally sent here
-sendDataMessageThrottled :: (WS.Connection, WS.DataMessage) -> IO ()
-sendDataMessageThrottled (conn, msg) = do
-  withLogger () $ \ioL ->
-    logMsg ioL DDEBUG $ "[sendDataMessageThrottled] dispatching notification: " <> show msg
+sendDataMessageThrottled :: LogConfig -> (WS.Connection, WS.DataMessage) -> IO ()
+sendDataMessageThrottled log_cfg (conn, msg) = do
+  withLogger log_cfg $ \ioL ->
+    logMsg ioL DEBUG $ "[sendDataMessageThrottled] dispatching notification: " <> show msg
   WS.sendDataMessage conn msg
 
 

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

@@ -11,13 +11,18 @@ https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/341
 
 Docs:
 https://dev.sub.gargantext.org/#/share/Notes/187918
-    
+
 -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
-    
-module Gargantext.Core.Notifications.Dispatcher.WebSocket where
+
+module Gargantext.Core.Notifications.Dispatcher.WebSocket (
+  -- * Types
+    WSAPI(..)
+  -- * Functions
+  , wsServer
+  ) where
 
 import Control.Concurrent.Async qualified as Async
 import Control.Exception.Safe qualified as Exc
@@ -29,7 +34,7 @@ import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.Core.Notifications.Dispatcher.Subscriptions
 import Gargantext.Core.Notifications.Dispatcher.Types
 import Gargantext.Core.Notifications.Dispatcher (Dispatcher, dispatcherSubscriptions)
-import Gargantext.Core.Config (HasJWTSettings(jwtSettings))
+import Gargantext.Core.Config (HasJWTSettings(jwtSettings), HasConfig (..), LogConfig, gc_logging)
 import Gargantext.Prelude
 import Gargantext.System.Logging (LogLevel(..), logMsg, withLogger, logM)
 import Network.WebSockets qualified as WS
@@ -39,7 +44,7 @@ import Servant.Auth.Server (JWTSettings, verifyJWT)
 import Servant.Server.Generic (AsServerT)
 import StmContainers.Set as SSet
 
-    
+
 newtype WSAPI mode = WSAPI {
     wsAPIServer :: mode :- "ws" :> Summary "WebSocket endpoint" :> WS.WebSocketPending
   } deriving Generic
@@ -55,12 +60,13 @@ wsServer = WSAPI { wsAPIServer = streamData }
                => WS.PendingConnection -> m ()
     streamData pc = Exc.catches (do
       jwtS <- view jwtSettings
+      log_cfg  <- view (hasConfig . gc_logging)
       d <- view hasDispatcher
       let subscriptions = dispatcherSubscriptions d
-      key <- getWSKey pc
+      key <- getWSKey log_cfg pc
       c <- liftBase $ WS.acceptRequest pc
       let ws = WSKeyConnection (key, c)
-      _ <- liftBase $ Async.concurrently (wsLoop jwtS subscriptions ws) (pingLoop ws)
+      _ <- liftBase $ Async.concurrently (wsLoop log_cfg jwtS subscriptions ws) (pingLoop ws)
       -- _ <- liftIO $ Async.withAsync (pure ()) (\_ -> wsLoop ws)
       pure ()
       ) [ Exc.Handler $ \(err :: WS.ConnectionException) ->
@@ -71,7 +77,7 @@ wsServer = WSAPI { wsAPIServer = streamData }
                 logM ERROR $ "[wsServer] error: " <> show err
                 Exc.throw err ]
 
-  
+
 -- | Send a ping control frame periodically, otherwise the
 -- | connection is dropped. NOTE that 'onPing' message is not
 -- | supported in the JS API: either the browser supports this or
@@ -84,17 +90,17 @@ pingLoop ws = do
     WS.sendPing (wsConn ws) ("" :: Text)
     threadDelay $ 10 * 1000000
 
-      
-wsLoop :: JWTSettings -> SSet.Set Subscription -> WSKeyConnection -> IO a
-wsLoop jwtS subscriptions ws = flip finally disconnect $ do
-  withLogger () $ \ioLogger -> do
+
+wsLoop :: LogConfig -> JWTSettings -> SSet.Set Subscription -> WSKeyConnection -> IO a
+wsLoop log_cfg jwtS subscriptions ws = flip finally disconnect $ do
+  withLogger log_cfg $ \ioLogger -> do
     logMsg ioLogger DEBUG "[wsLoop] connecting"
     wsLoop' CUPublic ioLogger
 
   where
     wsLoop' user ioLogger = do
       dm <- WS.receiveDataMessage (wsConn ws)
-      
+
       newUser <- case dm of
         WS.Text dm' _ -> do
           case Aeson.decode dm' of
@@ -132,25 +138,25 @@ wsLoop jwtS subscriptions ws = flip finally disconnect $ do
         _ -> do
           logMsg ioLogger DEBUG "[wsLoop] binary ws messages not supported"
           return user
-        
+
       wsLoop' newUser ioLogger
 
     disconnect = do
-      withLogger () $ \ioLogger -> do
+      withLogger log_cfg $ \ioLogger -> do
         logMsg ioLogger DEBUG "[wsLoop] disconnecting..."
         _ss <- removeSubscriptionsForWSKey subscriptions ws
         -- putText $ "[wsLoop] subscriptions: " <> show (show <$> ss)
         return ()
 
-    
-        
-getWSKey :: MonadBase IO m => WS.PendingConnection -> m ByteString
-getWSKey pc = do
+
+
+getWSKey :: MonadBase IO m => LogConfig -> WS.PendingConnection -> m ByteString
+getWSKey log_cfg pc = do
   let reqHead = WS.pendingRequest pc
   -- WebSocket specification says that a pending request should send
   -- some unique, Sec-WebSocket-Key string. We use this to compare
   -- connections (WS.Connection doesn't implement an Eq instance).
-  liftBase $ withLogger () $ \ioLogger -> do
+  liftBase $ withLogger log_cfg $ \ioLogger -> do
     logMsg ioLogger DEBUG $ "[wsLoop, getWSKey] headers: " <> show (WS.requestHeaders reqHead)
   let mKey = head $ filter (\(k, _) -> k == "Sec-WebSocket-Key") $ WS.requestHeaders reqHead
   let key' = snd $ fromMaybe (panicTrace "Sec-WebSocket-Key not found!") mKey

src/Gargantext/Core/Viz/Graph/API.hs

@@ -71,10 +71,9 @@ getGraph nId = do
   case graph of
     Nothing     -> do
         let defaultMetric          = Order1
-        let defaultPartitionMethod = Spinglass
         let defaultEdgesStrength   = Strong
-        let defaultBridgenessMethod = BridgenessMethod_Basic
-        graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
+        let defaultBridgenessMethod = BridgenessBasic
+        graph' <- computeGraph cId defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
         mt     <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength
         let mt' = set gm_legend (generateLegend graph') mt
         let
@@ -91,7 +90,6 @@ getGraph nId = do
 --recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
 recomputeGraph :: HasNodeStory env err m
                => NodeId
-               -> PartitionMethod
                -> BridgenessMethod
                -> Maybe GraphMetric
                -> Maybe Strength
@@ -99,7 +97,7 @@ recomputeGraph :: HasNodeStory env err m
                -> NgramsType
                -> Bool
                -> m Graph
-recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
+recomputeGraph nId bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -127,7 +125,7 @@ recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
 
   let computeG mt = do
-        !g <- computeGraph cId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo
+        !g <- computeGraph cId bridgeMethod similarity strength (nt1,nt2) repo
         let mt' = set gm_legend (generateLegend g) mt
         let g' = set graph_metadata (Just mt') g
         _nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
@@ -154,14 +152,13 @@ recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt
 -- TODO remove repo
 computeGraph :: HasNodeError err
              => CorpusId
-             -> PartitionMethod
              -> BridgenessMethod
              -> Similarity
              -> Strength
              -> (NgramsType, NgramsType)
              -> NodeListStory
              -> DBCmd err Graph
-computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo = do
+computeGraph corpusId bridgeMethod similarity strength (nt1,nt2) repo = do
   -- Getting the Node parameters
   lId  <- defaultList corpusId
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -190,7 +187,7 @@ computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2)
 
   -- TODO MultiPartite Here
   liftBase
-        $ cooc2graphWith partitionMethod bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
+        $ cooc2graphWith bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
                                               (Partite (HashMap.keysSet m2) nt2)
                                               )
                                 similarity 0 strength myCooc
@@ -239,7 +236,7 @@ graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m)
                -> m ()
 graphRecompute n jobHandle = do
   markStarted 1 jobHandle
-  _g <- recomputeGraph n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
+  _g <- recomputeGraph n BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
   markComplete jobHandle
 
 graphVersions :: (HasNodeStory env err m)
@@ -274,7 +271,7 @@ graphVersions u nId = do
 recomputeVersions :: HasNodeStory env err m
                   => NodeId
                   -> m Graph
-recomputeVersions nId = recomputeGraph nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
+recomputeVersions nId = recomputeGraph nId BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
 
 ------------------------------------------------------------
 graphClone :: (HasNodeError err)

src/Gargantext/Core/Viz/Graph/Bridgeness.hs

@@ -20,8 +20,6 @@ TODO use Map LouvainNodeId (Map LouvainNodeId)
 
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
-{-# LANGUAGE BangPatterns #-}
-
 module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
   where
 
@@ -31,8 +29,8 @@ import Data.Map.Strict (fromListWith, lookup, toList, mapWithKey, elems)
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Tuple.Extra qualified as Tuple
-import Gargantext.Core.Methods.Similarities (Similarity(..))
-import Gargantext.Prelude hiding (toList)
+import Gargantext.Core.Viz.Graph.Types (BridgenessMethod(..))
+import Gargantext.Prelude hiding (toList, filter)
 import Graph.Types (ClusterNode(..))
 ----------------------------------------------------------------------
 
@@ -66,51 +64,21 @@ clusterNodes2sets = Dico.elems
                   . Dico.fromListWith (<>)
                   . (map ((Tuple.second Set.singleton) . swap . nodeId2comId))
 
-----------------------------------------------------------------------
-data Bridgeness = Bridgeness_Basic { bridgeness_partitions :: [ClusterNode]
-                                   , bridgeness_filter     :: Double
-                                   }
-                | Bridgeness_Advanced { bridgeness_similarity :: Similarity
-                                      , bridgness_confluence  :: Confluence
-                                      }
-                | Bridgeness_Recursive { br_partitions :: [[Set NodeId]]
-                                       , br_filter     :: Double
-                                       , br_similarity :: Similarity
-                                       }
-
-
-type Confluence = Map (NodeId, NodeId) Double
-
--- Filter Links between the Clusters
--- Links: Map (NodeId, NodeId) Double
--- List of Clusters: [Set NodeId]
-bridgeness :: Bridgeness
-            -> Map (NodeId, NodeId) Double
-            -> Map (NodeId, NodeId) Double
-bridgeness (Bridgeness_Recursive sn f sim) m =
-  Map.unions $ [linksBetween] <> map (\s -> bridgeness (Bridgeness_Basic (setNodes2clusterNodes s) (if sim == Conditional then pi*f else f)) m') sn
-    where
-      (linksBetween, m') = Map.partitionWithKey (\(n1,n2) _v -> Map.lookup n1 mapNodeIdClusterId
-                                                             /= Map.lookup n2 mapNodeIdClusterId
-                                                ) $ bridgeness (Bridgeness_Basic clusters f) m
-      clusters = setNodes2clusterNodes (map Set.unions sn)
-      mapNodeIdClusterId = clusterNodes2map clusters
-
-
-bridgeness (Bridgeness_Advanced sim c) m = Map.fromList
-                $ List.filter (\x -> if sim == Conditional then snd x > 0.2 else snd x > 0.02)
-                $ map (\(ks, (v1,_v2)) -> (ks,v1))
-                $ Map.toList
-                $ Map.intersectionWithKey
-                      (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2)) :: Text) (v1, v2)) m c
-
-
-bridgeness (Bridgeness_Basic ns b) m = Map.fromList
-                                     $ List.concat
-                                     $ Map.elems
-                                     $ filterComs (round b)
-                                     $ groupEdges (Map.fromList $ map nodeId2comId ns) m
-
+-- | Filter the edges of a graph based on the computed clustering
+bridgeness :: [ClusterNode]               -- ^ Clustering
+           -> BridgenessMethod            -- ^ basic/advanced flag
+           -> Double                      -- ^ Bridgeness threshold
+           -> Map (NodeId, NodeId) Double -- ^ Input graph
+           -> Map (NodeId, NodeId) Double -- ^ Output graph
+bridgeness partitions method filterThreshold graph =
+  Map.fromList $
+  List.concat  $
+  Map.elems    $
+  (case method of
+     BridgenessBasic    -> filterComs (round filterThreshold)
+     BridgenessAdvanced -> filterComsAdvanced
+  )            $
+  groupEdges (Map.fromList $ map nodeId2comId partitions) graph
 
 groupEdges :: (Ord comId, Ord nodeId)
            => Map nodeId comId
@@ -130,7 +98,7 @@ filterComs :: (Ord n1, Eq n2)
            => Int
            -> Map (n2, n2) [(a3, n1)]
            -> Map (n2, n2) [(a3, n1)]
-filterComs b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
+filterComs b m = Map.filter (not . null) $ mapWithKey filter' m
   where
     filter' (c1,c2) a
       | c1 == c2  = a
@@ -143,40 +111,14 @@ filterComs b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
             t :: Double
             t = fromIntegral $ length $ List.concat $ elems m
 
---------------------------------------------------------------
--- Utils
-{--
-map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
-map2intMap m = IntMap.fromListWith (<>)
-             $ map (\((k1,k2), v) -> if k1 < k2
-                                   then (k1, IntMap.singleton k2 v)
-                                   else (k2, IntMap.singleton k1 v)
-                    )
-             $ Map.toList m
-
-look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
-look (k1,k2) m = if k1 < k2
-                    then case (IntMap.lookup k1 m) of
-                           Just m' -> IntMap.lookup k2 m'
-                           _       -> Nothing
-                    else look (k2,k1) m
-
-
-{-
-Compute the median of a list
-From:  https://hackage.haskell.org/package/dsp-0.2.5.1/docs/src/Numeric.Statistics.Median.html
-Compute the center of the list in a more lazy manner
-and thus halves memory requirement.
--}
-
-median :: (Ord a, Fractional a) => [a] -> a
-median [] = panic "medianFast: empty list has no median"
-median zs =
-   let recurse (x0:_)    (_:[])   = x0
-       recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
-       recurse (_:xs)    (_:_:ys) = recurse xs ys
-       recurse _ _  =
-          panic "median: this error cannot occur in the way 'recurse' is called"
-   in  recurse zs zs
-
--}
+-- Weak links are often due to noise in the data and decrease the readability of the graph. 
+-- This function prunes the links between the clusters when their weight is under a given 'threshold'.  
+filterComsAdvanced :: (Ord a1, Fractional a1, Eq a2)
+                   => Map (a2, a2) [(a3, a1)]
+                   -> Map (a2, a2) [(a3, a1)]
+filterComsAdvanced m = Map.filter (not . null) $ mapWithKey filter' m
+  where
+    threshold = 0.03 -- TODO make this threshold configurable
+    filter' (c1,c2) xs
+      | c1 == c2  = xs
+      | otherwise = List.filter (\(_nn,v) -> v >= threshold) xs

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -23,18 +23,16 @@ import Data.HashSet qualified as HashSet
 import Data.List qualified as List
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
-import Data.Swagger ( ToSchema )
 import Data.Text qualified as Text
 import Data.Vector.Storable qualified as Vec
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
 import Gargantext.Core.Statistics ( pcaReduceTo, Dimension(Dimension) )
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
-import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId, setNodes2clusterNodes)
+import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, nodeId2comId, setNodes2clusterNodes)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
 import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass, spinglass')
-import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
-import Gargantext.Core.Viz.Graph.Types (Attributes(..), Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..), LegendField(..))
+import Gargantext.Core.Viz.Graph.Types (Attributes(..), BridgenessMethod, Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..), LegendField(..))
 import Gargantext.Core.Viz.Graph.Utils (edgesFilter, nodesFilter)
 import Gargantext.Prelude
 import Graph.BAC.ProxemyOptim qualified as BAC
@@ -42,24 +40,6 @@ import Graph.Types (ClusterNode(..))
 import IGraph qualified as Igraph
 import IGraph.Algorithms.Layout qualified as Layout
 import IGraph.Random ( Gen ) -- (Gen(..))
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
-
-data PartitionMethod = Spinglass | Confluence | Infomap
-    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
-instance FromJSON  PartitionMethod
-instance ToJSON    PartitionMethod
-instance ToSchema  PartitionMethod
-instance Arbitrary PartitionMethod where
-  arbitrary = elements [ minBound .. maxBound ]
-
-data BridgenessMethod = BridgenessMethod_Basic | BridgenessMethod_Advanced
-    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
-instance FromJSON  BridgenessMethod
-instance ToJSON    BridgenessMethod
-instance ToSchema  BridgenessMethod
-instance Arbitrary BridgenessMethod where
-  arbitrary = elements [ minBound .. maxBound ]
 
 
 -------------------------------------------------------------
@@ -90,33 +70,18 @@ cooc2graph' distance threshold myCooc
 
 
 -- coocurrences graph computation
-cooc2graphWith :: PartitionMethod
-               -> BridgenessMethod
+cooc2graphWith :: BridgenessMethod
                -> MultiPartite
                -> Similarity
                -> Threshold
                -> Strength
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
-cooc2graphWith Confluence= cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
-cooc2graphWith Infomap   = cooc2graphWith' (infomap "-v -N2")
---cooc2graphWith Infomap   = cooc2graphWith' (infomap "--silent --two-level -N2")
-                        -- TODO: change these options, or make them configurable in UI?
-
-cooc2graphWith' :: Partitions
-                -> BridgenessMethod
-                -> MultiPartite
-                -> Similarity
-                -> Threshold
-                -> Strength
-                -> HashMap (NgramsTerm, NgramsTerm) Int
-                -> IO Graph
-cooc2graphWith' _doPartitions _bridgenessMethod multi similarity threshold strength myCooc = do
+cooc2graphWith bridgenessMethod multi similarity threshold strength myCooc = do
   let (distanceMap, diag, ti) = doSimilarityMap similarity threshold strength myCooc
   distanceMap `seq` diag `seq` ti `seq` pure ()
 
-  partitions <- if (Map.size distanceMap > 0)
+  partitions <- if Map.size distanceMap > 0
       then spinglass' 1 distanceMap
       else panic $ Text.unwords [ "I can not compute the graph you request"
                                 , "because either the quantity of documents"
@@ -130,13 +95,13 @@ cooc2graphWith' _doPartitions _bridgenessMethod multi similarity threshold stren
 
   let
     !confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
-    !bridgeness' = bridgeness
-      (Bridgeness_Basic (partitionsToClusterNodes partitions) 1.0)
-      distanceMap
+    !bridgeness' = bridgeness (partitionsToClusterNodes partitions)
+                              bridgenessMethod
+                              1.0
+                              distanceMap
 
   pure $ data2graph multi ti diag bridgeness' confluence' (setNodes2clusterNodes partitions)
 
-
 -- | A converter from the partition type returned by `spinglass'`
 -- to the partition type required by `bridgeness`
 partitionsToClusterNodes :: [Set Int] -> [ClusterNode]
@@ -154,7 +119,6 @@ partitionsToClusterNodes setlist =
   -- Turn pairs into `ClusterNode`s
   fmap (\(clusterId, nodeId) -> ClusterNode nodeId clusterId)
 
-
 type Reverse = Bool
 
 doSimilarityMap :: Similarity

src/Gargantext/Core/Viz/Graph/Types.hs

@@ -40,6 +40,16 @@ instance ToJSON TypeNode
 instance FromJSON TypeNode
 instance ToSchema TypeNode
 
+
+data BridgenessMethod = BridgenessBasic | BridgenessAdvanced
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+instance FromJSON  BridgenessMethod
+instance ToJSON    BridgenessMethod
+instance ToSchema  BridgenessMethod
+instance Arbitrary BridgenessMethod where
+  arbitrary = elements [ minBound .. maxBound ]
+
+
 data Attributes = Attributes { clust_default :: Int }
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "") ''Attributes)

src/Gargantext/Core/Worker.hs

@@ -37,7 +37,7 @@ import Gargantext.API.Node.New (postNode')
 import Gargantext.API.Node.Update.Types (UpdateNodeParams(..), Granularity (..))
 import Gargantext.API.Node.Update (updateNode)
 import Gargantext.API.Server.Named.Ngrams (tableNgramsPostChartsAsync)
-import Gargantext.Core.Config (hasConfig, gc_database_config, gc_jobs, gc_notifications_config, gc_worker)
+import Gargantext.Core.Config (hasConfig, gc_database_config, gc_jobs, gc_worker, gc_logging)
 import Gargantext.Core.Config.Types (jc_max_docs_scrapers)
 import Gargantext.Core.Config.Worker (WorkerDefinition(..))
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
@@ -83,7 +83,7 @@ notifyJobStarted env (W.State { name }) bm = do
   let mId = messageId bm
   let j = toA $ getMessage bm
   let job = W.job j
-  withLogger () $ \ioL ->
+  withLogger (env ^. w_env_config . gc_logging) $ \ioL ->
     logMsg ioL DEBUG $ "[notifyJobStarted] [" <> name <> " :: " <> show mId <> "] starting job: " <> show j
   let ji = JobInfo { _ji_message_id = messageId bm
                    , _ji_mNode_id = getWorkerMNodeId job }
@@ -99,7 +99,7 @@ notifyJobFinished env (W.State { name }) bm = do
   let mId = messageId bm
   let j = toA $ getMessage bm
   let job = W.job j
-  withLogger () $ \ioL ->
+  withLogger (env ^. w_env_config . gc_logging) $ \ioL ->
     logMsg ioL DEBUG $ "[notifyJobFinished] [" <> name <> " :: " <> show mId <> "] finished job: " <> show j
   let ji = JobInfo { _ji_message_id = messageId bm
                    , _ji_mNode_id = getWorkerMNodeId job }
@@ -115,7 +115,7 @@ notifyJobTimeout env (W.State { name }) bm = do
   let mId = messageId bm
   let j = toA $ getMessage bm
   let job = W.job j
-  withLogger () $ \ioL ->
+  withLogger (env ^. w_env_config . gc_logging) $ \ioL ->
     logMsg ioL ERROR $ "[notifyJobTimeout] [" <> name <> " :: " <> show mId <> "] job timed out: " <> show j
   let ji = JobInfo { _ji_message_id = messageId bm
                    , _ji_mNode_id = getWorkerMNodeId job }
@@ -132,7 +132,7 @@ notifyJobFailed env (W.State { name }) bm exc = do
   let mId = messageId bm
   let j = toA $ getMessage bm
   let job = W.job j
-  withLogger () $ \ioL ->
+  withLogger (env ^. w_env_config . gc_logging) $ \ioL ->
     logMsg ioL ERROR $ "[notifyJobFailed] [" <> name <> " :: " <> show mId <> "] failed job: " <> show j <> "   --- ERROR: " <> show exc
   let ji = JobInfo { _ji_message_id = messageId bm
                    , _ji_mNode_id = getWorkerMNodeId job }
@@ -148,7 +148,7 @@ notifyJobKilled _ _ Nothing = pure ()
 notifyJobKilled env (W.State { name }) (Just bm) = do
   let j = toA $ getMessage bm
   let job = W.job j
-  withLogger () $ \ioL ->
+  withLogger (env ^. w_env_config . gc_logging) $ \ioL ->
     logMsg ioL ERROR $ "[notifyJobKilled] [" <> name <> "] failed job: " <> show j
   let ji = JobInfo { _ji_message_id = messageId bm
                    , _ji_mNode_id = getWorkerMNodeId job }
@@ -213,33 +213,33 @@ performAction env _state bm = do
   let ji = JobInfo { _ji_message_id = messageId bm
                    , _ji_mNode_id = getWorkerMNodeId job }
   let jh = WorkerJobHandle { _w_job_info = ji }
-  
+
   case job of
     Ping -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] ping"
-      liftIO $ CE.notify (env ^. (to _w_env_config) . gc_notifications_config) CET.Ping
-      
+      liftIO $ CE.notify (env ^. (to _w_env_config)) CET.Ping
+
     -- | flow action for a single contact
     AddContact { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] add contact"
       addContact _ac_user _ac_node_id _ac_args jh
-      
+
     -- | Send a file with documents and index them in corpus
     AddCorpusFormAsync { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] add corpus form"
       addToCorpusWithForm _acf_user _acf_cid _acf_args jh
-      
+
     -- | Perform external API search query and index documents in corpus
     AddCorpusWithQuery { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] add corpus with query"
       let limit = Just $ fromIntegral $ env ^. hasConfig . gc_jobs . jc_max_docs_scrapers
       addToCorpusWithQuery _acq_user _acq_cid _acq_args limit jh
-      
+
     -- | Add to annuaire, from given file (not implemented yet)
     AddToAnnuaireWithForm { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] add to annuaire with form"
       Annuaire.addToAnnuaireWithForm _aawf_annuaire_id _aawf_args jh
-      
+
     -- | Saves file to 'data_filepath' (in TOML), adds this file as a node
     AddWithFile { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] add with file"

src/Gargantext/Core/Worker/Env.hs

@@ -10,6 +10,7 @@ Portability : POSIX
 -}
 
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}  -- orphan HasNodeError IOException
 
@@ -19,6 +20,7 @@ module Gargantext.Core.Worker.Env where
 
 import Control.Concurrent.STM.TVar (TVar, modifyTVar, newTVarIO, readTVarIO)
 import Control.Lens (prism', to, view)
+import Control.Lens.TH
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Maybe (fromJust)
 import Data.Pool qualified as Pool
@@ -30,7 +32,7 @@ import Gargantext.API.Job (RemainingSteps(..), jobLogStart, jobLogProgress, jobL
 import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
-import Gargantext.Core.Config (GargConfig(..), HasConfig(..))
+import Gargantext.Core.Config (GargConfig(..), HasConfig(..), gc_logging)
 import Gargantext.Core.Config.Mail qualified as Mail
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Config.Types (SettingsFile(..))
@@ -43,7 +45,7 @@ import Gargantext.Database.Prelude (HasConnectionPool(..))
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Tree.Error (HasTreeError(..))
 import Gargantext.Prelude hiding (to)
-import Gargantext.System.Logging (HasLogger(..), Logger, LogLevel(..), MonadLogger(..), withLogger, logMsg, withLoggerHoisted)
+import Gargantext.System.Logging (HasLogger(..), Logger, LogLevel(..), MonadLogger(..), withLogger, logMsg, withLoggerIO)
 import Gargantext.Utils.Jobs.Monad ( MonadJobStatus(..), JobHandle )
 import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
 import Prelude qualified
@@ -68,7 +70,7 @@ data WorkerJobState = WorkerJobState
 
 
 withWorkerEnv :: SettingsFile -> (WorkerEnv -> IO a) -> IO a
-withWorkerEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
+withWorkerEnv settingsFile k = withLoggerIO Dev $ \logger -> do
   env <- newWorkerEnv logger
   k env -- `finally` cleanEnv env
 
@@ -137,9 +139,9 @@ instance CET.HasCentralExchangeNotification WorkerEnv where
   ce_notify m = do
     c <- asks (view $ to _w_env_config)
     liftBase $ do
-      withLogger () $ \ioL ->
-        logMsg ioL DDEBUG $ "[ce_notify]: " <> show (_gc_notifications_config c) <> " :: " <> show m
-      CE.notify (_gc_notifications_config c) m
+      withLogger (c ^. gc_logging) $ \ioL ->
+        logMsg ioL DEBUG $ "[ce_notify]: " <> show (_gc_notifications_config c) <> " :: " <> show m
+      CE.notify c m
 
 ---------
 instance HasValidationError IOException where
@@ -236,7 +238,7 @@ instance MonadJobStatus WorkerMonad where
                              Nothing -> jobLogFailures steps latest
                              Just msg -> addErrorEvent msg (jobLogFailures steps latest))
   markComplete jh       = updateJobProgress jh jobLogComplete
-  markFailed mb_msg jh  = 
+  markFailed mb_msg jh  =
     updateJobProgress jh (\latest -> case mb_msg of
                              Nothing -> jobLogFailTotal latest
                              Just msg -> jobLogFailTotalWithMessage msg latest)
@@ -264,4 +266,6 @@ updateJobProgress (WorkerJobHandle (ji@JobInfo { _ji_message_id })) f = do
         in
       Just (WorkerJobState { _wjs_job_info = ji
                            , _wjs_job_log = f initJobLog })
-    
+
+
+makeLenses ''WorkerEnv

src/Gargantext/Core/Worker/Jobs.hs

@@ -15,7 +15,7 @@ module Gargantext.Core.Worker.Jobs where
 
 import Async.Worker qualified as W
 import Control.Lens (view)
-import Gargantext.Core.Config (gc_database_config, gc_worker, HasConfig(..), GargConfig)
+import Gargantext.Core.Config (gc_database_config, gc_worker, HasConfig(..), GargConfig, gc_logging)
 import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..))
 import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate)
 import Gargantext.Core.Worker.Jobs.Types (Job(..))
@@ -44,7 +44,7 @@ sendJobWithCfg gcConfig job = do
       b <- initBrokerWithDBCreate (gcConfig ^. gc_database_config) ws
       let queueName = _wdQueue wd
       let job' = (updateJobData job $ W.mkDefaultSendJob' b queueName job) { W.delay = _wsDefaultDelay }
-      withLogger () $ \ioL ->
+      withLogger (gcConfig ^. gc_logging) $ \ioL ->
         logMsg ioL DEBUG $ "[sendJob] sending job " <> show job <> " (delay " <> show (W.delay job') <> ")"
       W.sendJob' job'
 

src/Gargantext/Database/Action/Flow.hs

@@ -418,6 +418,7 @@ insertMasterDocs c lang hs  =  do
   -- add documents to the corpus (create node_node link)
   -- this will enable global database monitoring
 
+  -- maps :: IO Map Ngrams (Map NgramsType (Map NodeId Int))
   mapNgramsDocs' :: HashMap.HashMap ExtractedNgrams (Map NgramsType (Map NodeId (TermsWeight, TermsCount)))
                 <- mapNodeIdNgrams
                 <$> documentIdWithNgrams

src/Gargantext/Database/Types.hs

@@ -32,6 +32,9 @@ data Indexed i a =
 
 makeLenses ''Indexed
 
+instance Functor (Indexed i) where
+  fmap f (Indexed i a) = Indexed i (f a)
+
 instance Bifunctor Indexed where
   first  f (Indexed i a) = Indexed (f i) a
   second g (Indexed i a) = Indexed i (g a)

src/Gargantext/System/Logging.hs

-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies    #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Gargantext.System.Logging (
-    LogLevel(..)
-  , HasLogger(..)
-  , MonadLogger(..)
+    module Gargantext.System.Logging.Types
   , logM
   , logLocM
   , logLoc
   , withLogger
-  , withLoggerHoisted
+  , withLoggerIO
   ) where
 
+import Gargantext.System.Logging.Types
 import Control.Exception.Safe (MonadMask, bracket)
 import Control.Monad (when)
+import Gargantext.Core.Config (LogConfig(..))
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Control
-import Data.Kind (Type)
 import Data.Text qualified as T
 import Data.Time.Clock (getCurrentTime)
 import Language.Haskell.TH hiding (Type)
 import Language.Haskell.TH.Syntax qualified as TH
 import Prelude
 import System.Environment (lookupEnv)
-import Text.Read (readMaybe)
 
 
-data LogLevel =
-  -- | Detailed debug messages
-  DDEBUG
-  -- | Debug messages
-  | DEBUG
-  -- | Information
-  | INFO
-  -- | Normal runtime conditions
-  | NOTICE
-  -- | General Warnings
-  | WARNING
-  -- | General Errors
-  | ERROR
-  -- | Severe situations
-  | CRITICAL
-  -- | Take immediate action
-  | ALERT
-  -- | System is unusable
-  | EMERGENCY
-  deriving (Show, Eq, Ord, Enum, Bounded, Read)
-
--- | This is a barebore logging interface which we
--- can extend to plug a proper logging library, without
--- the details of the logger cropping up everywhere in
--- the rest of the codebase.
-class HasLogger m where
-  data family Logger m        :: Type
-  type family LogInitParams m :: Type
-  type family LogPayload m    :: Type
-  initLogger    :: LogInitParams m -> (forall m1. MonadIO m1 => m1 (Logger m))
-  destroyLogger :: Logger m        -> (forall m1. MonadIO m1 => m1 ())
-  logMsg        :: Logger m        -> LogLevel -> LogPayload m -> m ()
-  logTxt        :: Logger m        -> LogLevel -> T.Text -> m ()
-
--- | Separate typeclass to get hold of a 'Logger' from within a monad.
--- We keey 'HasLogger' and 'MonadLogger' separate to enforce compositionality,
--- i.e. we can still give instances to 'HasLogger' for things like 'IO' without
--- having to force actually acquiring a logger for those monads.
-class HasLogger m => MonadLogger m where
-  getLogger :: m (Logger m)
-
 -- | A variant of 'logTxt' that doesn't require passing an explicit 'Logger'.
 logM :: (Monad m, MonadLogger m) => LogLevel -> T.Text -> m ()
 logM level msg = do
@@ -119,26 +77,29 @@ withLogger params = bracket (initLogger params) destroyLogger
 
 -- | Like 'withLogger', but it allows creating a 'Logger' that can run in
 -- a different monad from within an 'IO' action.
-withLoggerHoisted :: (MonadBaseControl IO m, HasLogger m)
-                  => LogInitParams m
-                  -> (Logger m -> IO a)
-                  -> IO a
-withLoggerHoisted params act = bracket (initLogger params) destroyLogger act
+withLoggerIO :: (MonadBaseControl IO m, HasLogger m)
+             => LogInitParams m
+             -> (Logger m -> IO a)
+             -> IO a
+withLoggerIO params act = bracket (initLogger params) destroyLogger act
 
 -- | A plain logger in the IO monad, waiting for more serious logging solutions like
 -- the one described in https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/229
 instance HasLogger IO where
   data instance Logger IO        = IOLogger LogLevel
-  type instance LogInitParams IO = ()
+  type instance LogInitParams IO = LogConfig
   type instance LogPayload IO    = String
-  initLogger () = do
-    mLvl <- liftIO $ lookupEnv "LOG_LEVEL"
-    let lvl = case mLvl of
-          Nothing      -> INFO
+  initLogger LogConfig{..} = do
+    -- let the env var take precedence over the LogConfig one.
+    mLvl <- liftIO $ lookupEnv "GGTX_LOG_LEVEL"
+    lvl <- case mLvl of
+          Nothing      -> pure _lc_log_level
           Just s       ->
-            case readMaybe s of
-              Nothing -> error $ "unknown log level " <> s
-              Just lvl' -> lvl'
+            case parseLogLevel (T.pack s) of
+              Left err   -> do
+                liftIO $ putStrLn $ "unknown log level " <> s <> ": " <> T.unpack err <> " , ignoring GGTX_LOG_LEVEL"
+                pure $ _lc_log_level
+              Right lvl' -> pure lvl'
     pure $ IOLogger lvl
   destroyLogger _ = pure ()
   logMsg (IOLogger minLvl) lvl msg = do

src/Gargantext/System/Logging/Types.hs

+{-# LANGUAGE TypeFamilies  #-}
+{-# LANGUAGE LambdaCase    #-}
+
+module Gargantext.System.Logging.Types (
+    LogLevel(..)
+  , HasLogger(..)
+  , MonadLogger(..)
+  , parseLogLevel
+  , renderLogLevel
+  , prop_loglevel_roundtrip
+  ) where
+
+import Control.Monad.IO.Class
+import Data.Kind (Type)
+import Data.Text qualified as T
+import Prelude
+
+
+data LogLevel =
+  -- | Debug messages
+    DEBUG
+  -- | Information
+  | INFO
+  -- | Normal runtime conditions
+  | WARNING
+  -- | General Errors
+  | ERROR
+  deriving (Show, Eq, Ord, Enum, Bounded, Read)
+
+renderLogLevel :: LogLevel -> T.Text
+renderLogLevel = \case
+  DEBUG   -> "debug"
+  INFO    -> "info"
+  WARNING -> "warning"
+  ERROR   -> "error"
+
+parseLogLevel :: T.Text -> Either T.Text LogLevel
+parseLogLevel = \case
+  "debug"   -> Right DEBUG
+  "info"    -> Right INFO
+  "warning" -> Right WARNING
+  "warn"    -> Right WARNING
+  "error"   -> Right ERROR
+  xs -> Left ("Invalid log level found: " <> xs)
+
+prop_loglevel_roundtrip :: LogLevel -> Bool
+prop_loglevel_roundtrip ll = (parseLogLevel . renderLogLevel $ ll) == Right ll
+
+-- | This is a barebore logging interface which we
+-- can extend to plug a proper logging library, without
+-- the details of the logger cropping up everywhere in
+-- the rest of the codebase.
+class HasLogger m where
+  data family Logger m        :: Type
+  type family LogInitParams m :: Type
+  type family LogPayload m    :: Type
+  initLogger    :: LogInitParams m -> (forall m1. MonadIO m1 => m1 (Logger m))
+  destroyLogger :: Logger m        -> (forall m1. MonadIO m1 => m1 ())
+  logMsg        :: Logger m        -> LogLevel -> LogPayload m -> m ()
+  logTxt        :: Logger m        -> LogLevel -> T.Text -> m ()
+
+-- | Separate typeclass to get hold of a 'Logger' from within a monad.
+-- We keey 'HasLogger' and 'MonadLogger' separate to enforce compositionality,
+-- i.e. we can still give instances to 'HasLogger' for things like 'IO' without
+-- having to force actually acquiring a logger for those monads.
+class HasLogger m => MonadLogger m where
+  getLogger :: m (Logger m)

stack.yaml

 "allow-newer": true
 "extra-deps":
-- "JuicyPixels-3.3.9"
 - "KMP-0.2.0.0"
-- "OneTuple-0.4.2"
-- "aeson-pretty-0.8.10"
-- "alex-3.5.1.0"
-- "ansi-terminal-1.0.2"
-- "assoc-1.1.1"
-- "atomic-primops-0.8.8"
+- "alex-3.5.2.0"
+- "ansi-wl-pprint-0.6.9"
 - "barbies-2.1.1.0"
-- "base-compat-0.13.1"
-- "base-compat-batteries-0.13.1"
-- "base-orphans-0.9.2"
+- "base-orphans-0.9.3"
 - "base64-1.0"
-- "bifunctors-5.6.2"
-- "binary-orphans-1.0.5"
-- "blaze-html-0.9.2.0"
-- "boring-0.2.2"
-- "bytestring-lexing-0.5.0.14"
-- "bzlib-conduit-0.3.0.3"
-- "cabal-doctest-1.0.10"
-- "cassava-0.5.3.2"
-- "cassava-conduit-0.6.6"
-- "concurrent-output-1.10.21"
-- "conduit-1.3.6"
-- "criterion-measurement-0.2.2.0"
-- "cron-0.7.1"
-- "crypton-1.0.0"
-- "crypton-x509-1.7.7"
-- "data-fix-0.3.4"
-- "dec-0.0.6"
-- "digest-0.0.2.1"
-- "direct-sqlite-2.3.29"
-- "double-conversion-2.0.5.0"
-- "extra-1.7.16"
-- "fast-logger-3.2.3"
-- "fgl-5.8.2.0"
-- "file-embed-0.0.16.0"
+- "bytes-0.17.4"
+- "bytestring-lexing-0.5.0.15"
+- "bzlib-conduit-0.3.0.4"
+- "charset-0.3.11"
+- "comonad-5.0.9"
+- "conduit-extra-1.3.7"
+- "cron-0.7.2"
+- "crypton-1.0.1"
+- "crypton-connection-0.4.3"
+- "data-default-0.8.0.0"
+- "data-default-class-0.2.0.0"
+- "deferred-folds-0.9.18.7"
+- "entropy-0.4.1.11"
 - "file-embed-lzma-0.1"
-- "foldl-1.4.17"
-- "free-5.2"
+- "foldl-1.4.18"
 - "fullstop-0.1.4"
-- "hashable-1.4.4.0"
-- "haskell-src-meta-0.8.14"
+- "graphviz-2999.20.2.1"
+- "half-0.3.2"
+- "happy-2.1.5"
+- "happy-lib-2.1.5"
+- "hashtables-1.4.2"
+- "haskell-src-meta-0.8.15"
 - "hedgehog-1.5"
-- "hslogger-1.3.1.1"
-- "hsparql-0.3.8"
-- "hspec-2.11.9"
-- "hspec-api-2.11.9"
-- "hspec-core-2.11.9"
-- "hspec-discover-2.11.9"
-- "hspec-expectations-0.8.4"
-- "html-entities-1.1.4.7"
+- "hsparql-0.3.9"
 - "http-accept-0.2"
-- "http-api-data-0.5.1"
 - "http-client-0.7.14"
 - "http-conduit-2.3.8.3"
-- "http2-5.0.1"
-- "indexed-traversable-0.1.4"
-- "invariant-0.6.3"
-- "iproute-1.7.14"
-- "json-stream-0.4.6.0"
-- "kan-extensions-5.2.6"
-- "language-c-0.9.3"
-- "libyaml-0.1.4"
-- "libyaml-clib-0.2.5"
+- "integer-logarithms-1.0.4"
+- "invariant-0.6.4"
+- "jose-0.10.0.1"
+- "language-c-0.10.0"
 - "linear-1.23"
-- "logict-0.8.1.0"
-- "lzma-0.0.1.1"
-- "math-functions-0.3.4.4"
-- "megaparsec-9.6.1"
-- "microlens-th-0.4.3.15"
-- "mono-traversable-1.0.17.0"
-- "monoid-extras-0.6.3"
+- "massiv-1.0.4.1"
+- "megaparsec-9.7.0"
+- "microlens-th-0.4.3.16"
+- "monad-logger-0.3.41"
+- "mono-traversable-1.0.21.0"
+- "monoid-extras-0.6.4"
 - "morpheus-graphql-0.28.0"
 - "morpheus-graphql-app-0.28.0"
 - "morpheus-graphql-client-0.28.1"
@@ -81,82 +52,55 @@
 - "morpheus-graphql-core-0.28.1"
 - "morpheus-graphql-server-0.28.0"
 - "morpheus-graphql-subscriptions-0.28.0"
-- "mwc-random-0.15.1.0"
-- "network-control-0.0.2"
+- "mwc-random-0.15.2.0"
 - "opaleye-0.10.3.1"
-- "ordered-containers-0.2.4"
-- "os-string-2.0.6"
-- "password-3.0.4.0"
-- "postgres-options-0.2.2.0"
+- "password-3.1.0.1"
 - "postgresql-libpq-0.10.2.0"
 - "postgresql-libpq-configure-0.10.0.1"
-- "postgresql-simple-0.7.0.0"
-- "primitive-0.7.4.0"
-- "primitive-extras-0.10.2"
-- "primitive-unlifted-2.1.0.0"
-- "protolude-0.3.4"
+- "pretty-simple-4.1.3.0"
+- "primitive-extras-0.10.2.2"
+- "primitive-unlifted-2.2.0.0"
+- "psqueues-0.2.8.1"
 - "rake-0.0.1"
-- "random-1.2.1.2"
+- "random-1.2.1.3"
 - "random-strings-0.1.1.0"
 - "rdf4h-5.1.0"
-- "reflection-2.1.8"
-- "resourcet-1.3.0"
-- "safe-0.3.21"
-- "selective-0.7.0.1"
-- "servant-0.20.2"
-- "servant-auth-0.4.2.0"
-- "servant-auth-client-0.4.2.0"
-- "servant-auth-server-0.4.9.0"
-- "servant-auth-swagger-0.2.11.0"
-- "servant-client-0.20.2"
-- "servant-client-core-0.20.2"
-- "servant-conduit-0.16.1"
+- "reflection-2.1.9"
+- "req-3.13.4"
+- "scheduler-2.0.1.0"
 - "servant-ekg-0.3.1"
-- "servant-server-0.20.2"
-- "servant-swagger-1.2.1"
 - "servant-swagger-ui-0.3.5.5.0.1"
-- "singleton-bool-0.1.8"
-- "singletons-3.0.3"
-- "some-1.0.6"
-- "split-0.2.5"
-- "sqlite-simple-0.4.19.0"
+- "singletons-3.0.4"
+- "smtp-mail-0.5.0.0"
+- "splitmix-0.1.1"
+- "statistics-0.16.3.0"
 - "stemmer-0.5.2"
-- "stm-containers-1.2.1"
-- "stm-hamt-1.2.1"
-- "swagger2-2.8.9"
-- "tagged-0.8.8"
+- "stm-containers-1.2.1.1"
+- "stm-hamt-1.2.1.1"
+- "streaming-commons-0.2.3.0"
+- "tagged-0.8.9"
 - "taggy-0.2.1"
 - "taggy-lens-0.1.2"
-- "tasty-1.5"
-- "tasty-hspec-1.2.0.4"
-- "tasty-hunit-0.10.2"
-- "tasty-quickcheck-0.11"
-- "text-short-0.1.6"
-- "th-compat-0.1.5"
-- "these-1.2.1"
-- "time-compat-1.9.7"
+- "tasty-1.5.3"
+- "tasty-quickcheck-0.11.1"
+- "th-compat-0.1.6"
+- "th-expand-syns-0.4.12.0"
+- "th-lift-0.8.6"
+- "th-orphans-0.13.16"
+- "time-compat-1.9.8"
+- "tls-2.1.7"
+- "tmp-postgres-1.34.1.0"
 - "toml-parser-2.0.1.0"
-- "type-equality-1.0.1"
-- "typed-process-0.2.12.0"
-- "unicode-collation-0.1.3.6"
-- "units-2.4.1.5"
-- "unix-compat-0.7.2"
-- "unix-time-0.4.15"
-- "unordered-containers-0.2.20"
-- "utility-ht-0.0.17.2"
+- "uri-bytestring-0.4.0.0"
 - "uuid-1.3.16"
 - "uuid-types-1.0.6"
-- "validity-0.12.1.0"
-- "vector-algorithms-0.9.0.2"
-- "vector-stream-0.1.0.1"
-- "wai-app-static-3.1.9"
-- "wai-extra-3.1.15"
-- "wai-logger-2.4.1"
+- "vector-algorithms-0.9.1.0"
+- "vector-space-0.19"
+- "wai-extra-3.1.17"
+- "wai-logger-2.5.0"
 - "wai-util-0.8"
-- "warp-3.3.31"
-- "wreq-0.5.4.3"
-- "zip-2.0.1"
-- "zip-archive-0.4.3.2"
+- "websockets-0.13.0.0"
+- "wuss-2.0.2.2"
 - "zlib-0.7.1.0"
 - commit: 334d05519436bb7f20f9926ec76418f5b8afa359
   git: "https://github.com/AccelerateHS/accelerate.git"
@@ -166,10 +110,6 @@
   git: "https://github.com/adinapoli/http-reverse-proxy.git"
   subdirs:
   - .
-- commit: a110807651036ca2228a76507ee35bbf7aedf87a
-  git: "https://github.com/alpmestan/accelerate-arithmetic.git"
-  subdirs:
-  - .
 - commit: b9fca8beee0f23c17a6b2001ec834d071709e6e7
   git: "https://github.com/alpmestan/hmatrix.git"
   subdirs:
@@ -182,10 +122,6 @@
   git: "https://github.com/boolexpr/boolexpr.git"
   subdirs:
   - .
-- commit: 1790fdf9138970dde0dbabf8b270698145a4a88c
-  git: "https://github.com/chessai/eigen.git"
-  subdirs:
-  - .
 - commit: 10a416b9f6c443866b36479c3441ebb3bcdeb7ef
   git: "https://github.com/delanoe/data-time-segment.git"
   subdirs:
@@ -206,10 +142,6 @@
   git: "https://github.com/haskell-github-trust/ekg-json"
   subdirs:
   - .
-- commit: a3875fe652d3bb5acb522674c22c6c814c1b4ad0
-  git: "https://gitlab.iscpif.fr/amestanogullari/accelerate-utility.git"
-  subdirs:
-  - .
 - commit: eb130c71fa17adaceed6ff66beefbccb13df51ba
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git"
   subdirs:
@@ -238,10 +170,10 @@
   git: "https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git"
   subdirs:
   - .
-- commit: 588e104fe7593210956610cab0041fd16584a4ce
+- commit: a08ceed71b297a811f90cb86c3c61dc0b153036b
   git: "https://gitlab.iscpif.fr/gargantext/gargantext-graph.git"
   subdirs:
-  - .
+  - "gargantext-graph-core"
 - commit: 4a9c709613554eed0189b486de2126c18797088c
   git: "https://gitlab.iscpif.fr/gargantext/haskell-bee"
   subdirs:
@@ -254,7 +186,7 @@
   git: "https://gitlab.iscpif.fr/gargantext/haskell-bee"
   subdirs:
   - "haskell-bee/"
-- commit: bb15d828d5ef36eeaa84cccb00598b585048c88e
+- commit: 214b31a2db46de5a2cac24231a3c07a1c4c3fab9
   git: "https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude"
   subdirs:
   - .
@@ -286,7 +218,7 @@
   git: "https://gitlab.iscpif.fr/gargantext/opaleye-textsearch.git"
   subdirs:
   - .
-- commit: 3668d28607867a88b2dfc62158139b3cfd629ddb
+- commit: a591716220cfcabffa24eb29cbaa2517023642af
   git: "https://gitlab.iscpif.fr/gargantext/patches-class.git"
   subdirs:
   - .
@@ -349,6 +281,8 @@ flags:
     tagged: true
   "bytestring-builder":
     bytestring_has_builder: true
+  "bzlib-conduit":
+    "system-bzip2": true
   c2hs:
     base3: true
     regression: false
@@ -358,8 +292,6 @@ flags:
     "optimize-gmp": true
   cereal:
     "bytestring-builder": false
-  "cipher-aes":
-    support_aesni: true
   clock:
     llvm: false
   cmdargs:
@@ -430,13 +362,11 @@ flags:
     donotgetentropy: false
   fgl:
     containers042: true
-  "foldable1-classes-compat":
-    tagged: true
   formatting:
     "no-double-conversion": false
   gargantext:
     "enable-benchmarks": false
-    "no-phylo-debug-logs": false
+    "no-phylo-debug-logs": true
     "test-crypto": false
   graphviz:
     "test-parsing": false
@@ -479,7 +409,6 @@ flags:
   "json-stream":
     conduit: false
   "language-c":
-    allwarnings: false
     iecfpextension: true
     usebytestrings: true
   lens:
@@ -599,6 +528,8 @@ flags:
     "newtype-unsafe": true
   splitmix:
     "optimised-mixer": false
+  statistics:
+    benchpapi: false
   "streaming-commons":
     "use-bytestring-builder": false
   stringsearch:
@@ -620,9 +551,7 @@ flags:
   "time-locale-compat":
     "old-locale": false
   tls:
-    compat: true
-    hans: false
-    network: true
+    devel: false
   "transformers-base":
     orphaninstances: true
   "transformers-compat":
@@ -655,7 +584,6 @@ flags:
     boundschecks: true
     internalchecks: false
     llvm: false
-    properties: true
     unsafechecks: false
   void:
     safe: false
@@ -700,5 +628,5 @@ flags:
     standalone: true
 packages:
 - .
-resolver: "lts-21.25"
+resolver: "lts-22.43"
 "system-ghc": true

test-data/test_config.toml

@@ -52,6 +52,10 @@ user = "gargantua"
 pass = "gargantua_test"
 name = "gargandb_test"
 
+[logs]
+log_file = "/var/log/gargantext/backend.log"
+log_level = "warn"
+
 [mail]
 port = 25
 host = "localhost"

test/Test/API/Notifications.hs

@@ -14,24 +14,24 @@ Portability : POSIX
 {-# LANGUAGE QuasiQuotes      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-    
+
 module Test.API.Notifications (
     tests
   ) where
 
-import Control.Concurrent (threadDelay)
 import Control.Concurrent.STM.TChan
 import Control.Concurrent.STM.TSem (newTSem, signalTSem, TSem)
+import Control.Concurrent (threadDelay)
 import Control.Lens ((^.))
 import Control.Monad (void)
 import Control.Monad.STM (atomically)
 import Data.Aeson qualified as Aeson
 import Data.ByteString qualified as BS
-import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
+import Data.Text qualified as T
 import Fmt ((+|), (|+))
 import Gargantext.API.Admin.Auth.Types (AuthResponse, authRes_token, authRes_tree_id)
-import Gargantext.Core.Config (gc_notifications_config)
+import Gargantext.Core.Config (gc_logging, LogConfig)
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
@@ -47,9 +47,11 @@ import Test.Database.Types (test_config)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Instances ()
-import Text.RawString.QQ (r)
-import Test.Utils (protected, waitForTChanValue, waitForTSem, withValidLoginA)
+import Test.Utils (waitForTChanValue, waitForTSem)
 import Test.Utils.Notifications (withAsyncWSConnection)
+import Test.Utils (protected, withValidLoginA)
+import Text.RawString.QQ (r)
+
 
 
 
@@ -57,10 +59,11 @@ tests :: Spec
 tests = sequential $ around withTestDBAndPort $ do
   describe "Notifications" $ do
     it "ping WS notification works" $ \(SpecContext testEnv port _app _) -> do
-      let nc = (test_config testEnv) ^. gc_notifications_config
+      let cfg     = test_config testEnv
+      let log_cfg = (test_config testEnv) ^. gc_logging
       -- withLogger () $ \ioL -> do
       --   logMsg ioL DEBUG $ "[ping WS notification works] nc: " <> show nc
-      
+
       let topic = DT.Ping
       -- This semaphore is used to inform the main thread that the WS
       -- client has subscribed. I think it's better to use async
@@ -68,34 +71,35 @@ tests = sequential $ around withTestDBAndPort $ do
       wsTSem <- atomically $ newTSem 0
       tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
 
-      withAsyncWSConnection ("127.0.0.1", port) (wsConnection topic wsTSem tchan) $ \_a -> do
+      withAsyncWSConnection ("127.0.0.1", port) (wsConnection log_cfg topic wsTSem tchan) $ \_a -> do
         -- wait for ws process to inform us about topic subscription
         waitForTSem wsTSem 500
-        
+
         threadDelay 300_000
-        CE.notify nc $ CET.Ping
+        CE.notify cfg $ CET.Ping
 
         -- the ping value that should come from the notification
         waitForTChanValue tchan (Just DT.NPing) 1_000
 
     it "ping WS unsubscribe works" $ \(SpecContext testEnv port _app _) -> do
-      let nc = (test_config testEnv) ^. gc_notifications_config      
+      let cfg     = test_config testEnv
+      let log_cfg = (test_config testEnv) ^. gc_logging
       let topic = DT.Ping
 
       -- Setup a WS client connection. Subscribe to a topic and
       -- confirm the notification works. Then unsubscribe from it, and
       -- check that a new notification didn't arrive.
-      
+
       wsTSem <- atomically $ newTSem 0
       tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
-      
+
       -- setup a websocket connection
-      let wsConnect conn = withLogger () $ \_ioL -> do
+      let wsConnect conn = withLogger log_cfg $ \_ioL -> do
             -- logMsg ioL DEBUG $ "[wsConnect] subscribing topic: " <> show topic
             WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe topic)
             -- inform the test process that we sent the subscription request
             atomically $ signalTSem wsTSem
-            
+
             -- logMsg ioL DEBUG $ "[wsConnect] waiting for notification"
             d <- WS.receiveData conn
             -- logMsg ioL DEBUG $ "[wsConnect] received " <> show d
@@ -116,13 +120,13 @@ tests = sequential $ around withTestDBAndPort $ do
               Nothing -> atomically $ writeTChan tchan Nothing
               -- | write something incorrect so the test will fail
               Just _ -> atomically $ writeTChan tchan (Just DT.NPing)
-            
+
       withAsyncWSConnection ("127.0.0.1", port) wsConnect $ \_a -> do
         -- wait for ws process to inform us about topic subscription
         waitForTSem wsTSem 500
-        
+
         threadDelay 300_000
-        CE.notify nc $ CET.Ping
+        CE.notify cfg $ CET.Ping
 
         -- the ping value that should come from the notification
         waitForTChanValue tchan (Just DT.NPing) 1_000
@@ -130,26 +134,24 @@ tests = sequential $ around withTestDBAndPort $ do
         -- wait for lock from ws (it should have unsubscribed by now)
         waitForTSem wsTSem 500
         -- send the notification (which the client shouldn't receive)
-        CE.notify nc $ CET.Ping
+        CE.notify cfg $ CET.Ping
         -- wait for the value
         waitForTChanValue tchan Nothing 1_000
-    
+
     describe "Update tree notifications" $ do
       it "simple WS notification works" $ \(SpecContext testEnv port _app _) -> do
-        let nc = (test_config testEnv) ^. gc_notifications_config
-        
         let topic = DT.UpdateTree 0
         wsTSem <- atomically $ newTSem 0  -- initially locked
         tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
-  
-        withAsyncWSConnection ("127.0.0.1", port) (wsConnection topic wsTSem tchan) $ \_a -> do
+
+        withAsyncWSConnection ("127.0.0.1", port) (wsConnection (test_config testEnv ^. gc_logging) topic wsTSem tchan) $ \_a -> do
           waitForTSem wsTSem 500
-          
+
           let nodeId = 0
-          CE.notify nc $ CET.UpdateTreeFirstLevel nodeId
-  
+          CE.notify (test_config testEnv) $ CET.UpdateTreeFirstLevel nodeId
+
           waitForTChanValue tchan (Just $ DT.NUpdateTree nodeId) 1_000
-      
+
       it "WS notification on node creation works" $ \ctx@(SpecContext _testEnv port app _) -> do
         checkNotification ctx $ \authRes -> do
           let token = authRes ^. authRes_token
@@ -157,20 +159,20 @@ tests = sequential $ around withTestDBAndPort $ do
           let query = [r| {"pn_name": "test", "pn_typename": "NodeCorpus"} |]
           void $ withApplication app $ do
             protected token "POST" (mkUrl port $ "/node/" +| treeId |+ "") query
-  
+
       it "WS notification on node deletion works" $ \ctx@(SpecContext testEnv port app _) -> do
         checkNotification ctx $ \authRes -> do
           let token = authRes ^. authRes_token
           cId <- newCorpusForUser testEnv "alice"
-            
+
           void $ withApplication app $ do
             protected token "DELETE" (mkUrl port $ "/node/" +| cId |+ "") ""
-  
+
       it "WS notification on node rename works" $ \ctx@(SpecContext testEnv port app _) -> do
         checkNotification ctx $ \authRes -> do
           let token = authRes ^. authRes_token
           cId <- newCorpusForUser testEnv "alice"
-          
+
           void $ withApplication app $ do
             let query = [r| {"name": "newName"} |]
             protected token "PUT" (mkUrl port $ "/node/" +| cId |+ "/rename") query
@@ -180,7 +182,7 @@ tests = sequential $ around withTestDBAndPort $ do
           let token = authRes ^. authRes_token
           cId <- newCorpusForUser testEnv "alice"
           cId2 <- newCorpusForUser testEnv "alice"
-          
+
           void $ withApplication app $ do
             let query = BS.fromStrict $ TE.encodeUtf8 $ "[" <> (T.pack $ show cId2) <> "]"
             protected token "PUT" (mkUrl port $ "/node/" +| cId |+ "/move/" +| cId2 |+ "" ) query
@@ -193,9 +195,9 @@ tests = sequential $ around withTestDBAndPort $ do
 checkNotification :: SpecContext a
                   -> (AuthResponse -> IO ())
                   -> IO ()
-checkNotification ctx@(SpecContext _testEnv port _app _) act = do
+checkNotification ctx@(SpecContext testEnv port _app _) act = do
   _ <- dbEnvSetup ctx
-  
+
   withValidLoginA port "alice" (GargPassword "alice") $ \_clientEnv authRes -> do
     -- Subscribe to user tree notifications
     let treeId = authRes ^. authRes_tree_id
@@ -204,26 +206,28 @@ checkNotification ctx@(SpecContext _testEnv port _app _) act = do
     wsTSem <- atomically $ newTSem 0  -- initially locked
     tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
 
-    withAsyncWSConnection ("127.0.0.1", port) (wsConnection topic wsTSem tchan) $ \_a -> do
+    withAsyncWSConnection ("127.0.0.1", port) (wsConnection log_cfg topic wsTSem tchan) $ \_a -> do
       waitForTSem wsTSem 500
 
       act authRes
-  
-      waitForTChanValue tchan (Just $ DT.NUpdateTree treeId) 1_000
 
+      waitForTChanValue tchan (Just $ DT.NUpdateTree treeId) 1_000
+  where
+    log_cfg = (test_config testEnv) ^. gc_logging
 
 
-wsConnection :: DT.Topic
+wsConnection :: LogConfig
+             -> DT.Topic
              -> TSem
              -> TChan (Maybe DT.Notification)
              -> WS.Connection
              -> IO ()
-wsConnection topic wsTSem tchan conn = withLogger () $ \_ioL -> do
+wsConnection log_cfg topic wsTSem tchan conn = withLogger log_cfg $ \_ioL -> do
   -- logMsg ioL DEBUG $ "[wsConnect] subscribing topic: " <> show topic
   WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe topic)
   -- inform the test process that we sent the subscription request
   atomically $ signalTSem wsTSem
-  
+
   -- logMsg ioL DEBUG $ "[wsConnect] waiting for notification"
   d <- WS.receiveData conn
   -- logMsg ioL DEBUG $ "[wsConnect] received " <> show d

test/Test/API/Private/Remote.hs

@@ -32,10 +32,10 @@ withTwoServerInstances :: (SpecContext (TestEnv,Wai.Application,Warp.Port) -> IO
 withTwoServerInstances action =
   withTestDB $ \testEnv1 -> do
     withTestDB $ \testEnv2 -> do
-      garg1App <- withLoggerHoisted Mock $ \ioLogger -> do
+      garg1App <- withLoggerIO Mock $ \ioLogger -> do
                    env <- newTestEnv testEnv1 ioLogger server1Port
                    makeApp env
-      garg2App <- withLoggerHoisted Mock $ \ioLogger -> do
+      garg2App <- withLoggerIO Mock $ \ioLogger -> do
                    env <- newTestEnv testEnv2 ioLogger server2Port
                    makeApp env
 

test/Test/API/Setup.hs

@@ -20,13 +20,15 @@ import Control.Monad.Reader
 import Data.ByteString.Lazy.Char8 qualified as C8L
 import Data.Cache qualified as InMemory
 import Data.Streaming.Network (bindPortTCP)
-import Gargantext.API (makeApp)
 import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..), env_dispatcher)
 import Gargantext.API.Errors.Types
+import Gargantext.API (makeApp)
 import Gargantext.API.Prelude
-import Gargantext.Core.Notifications (withNotifications)
+import Gargantext.Core.Config (gc_logging)
+import Gargantext.Core.Config (gc_notifications_config)
 import Gargantext.Core.Config (_gc_secrets, gc_frontend_config)
 import Gargantext.Core.Config.Types (NotificationsConfig(..), fc_appPort, jwtSettings)
+import Gargantext.Core.Notifications (withNotifications)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Action.User.New
@@ -44,10 +46,10 @@ import Network.HTTP.Client.TLS (newTlsManager)
 import Network.HTTP.Types
 import Network.Wai (Application, responseLBS)
 import Network.Wai.Handler.Warp.Internal
-import Network.WebSockets qualified as WS
 import Network.Wai.Handler.Warp qualified as Warp
 import Network.Wai.Handler.Warp (runSettingsSocket)
 import Network.Wai qualified as Wai
+import Network.WebSockets qualified as WS
 import Prelude hiding (show)
 import Servant.Auth.Client ()
 import Test.Database.Setup (withTestDB)
@@ -108,9 +110,9 @@ nc = NotificationsConfig { _nc_central_exchange_bind = "tcp://*:15560"
 -- | 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.
 withTestDBAndPort :: (SpecContext () -> IO ()) -> IO ()
-withTestDBAndPort action = withNotifications nc $ \dispatcher -> do
-  withTestDB $ \testEnv -> do    
-    withLoggerHoisted Mock $ \ioLogger -> do
+withTestDBAndPort action = withTestDB $ \testEnv -> do
+  withNotifications (cfg testEnv) $ \dispatcher -> do
+    withLoggerIO Mock $ \ioLogger -> do
       env <- newTestEnv testEnv ioLogger 8080
              <&> env_dispatcher .~ dispatcher
       app <- makeApp env
@@ -124,30 +126,32 @@ withTestDBAndPort action = withNotifications nc $ \dispatcher -> do
         [ Handler $ \(err :: WS.ConnectionException) ->
             case err of
               WS.CloseRequest _ _ ->
-                withLogger () $ \ioLogger' ->
+                withLogger (log_cfg testEnv) $ \ioLogger' ->
                   logTxt ioLogger' DEBUG "[withTestDBAndPort] CloseRequest caught"
               WS.ConnectionClosed ->
-                withLogger () $ \ioLogger' ->
+                withLogger (log_cfg testEnv) $ \ioLogger' ->
                   logTxt ioLogger' DEBUG "[withTestDBAndPort] ConnectionClosed caught"
               _ -> do
-                withLogger () $ \ioLogger' ->
+                withLogger (log_cfg testEnv) $ \ioLogger' ->
                   logTxt ioLogger' ERROR $ "[withTestDBAndPort] unknown exception: " <> show err
                 throw err
-        
+
         -- re-throw any other exceptions
         , Handler $ \(err :: SomeException) -> throw err ]
-        
+  where
+    cfg te     = (test_config te) & gc_notifications_config .~ nc
+    log_cfg te = (cfg te) ^. gc_logging
 
 -- | Starts the backend server /and/ the microservices proxy, the former at
 -- a random port, the latter at a predictable port.
 withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO ()
 withBackendServerAndProxy action =
   withTestDB $ \testEnv -> do
-    gargApp <- withLoggerHoisted Mock $ \ioLogger -> do
+    gargApp <- withLoggerIO Mock $ \ioLogger -> do
                  env <- newTestEnv testEnv ioLogger 8080
                  makeApp env
     proxyCache <- InMemory.newCache Nothing
-    proxyApp <- withLoggerHoisted Mock $ \ioLogger -> do
+    proxyApp <- withLoggerIO Mock $ \ioLogger -> do
                   env <- newTestEnv testEnv ioLogger 8080
                   pure $ microServicesProxyApp proxyCache env
 

test/Test/API/UpdateList.hs

@@ -28,21 +28,21 @@ module Test.API.UpdateList (
 
 import Control.Lens (mapped, over)
 import Control.Monad.Fail (fail)
-import Data.Aeson qualified as JSON
 import Data.Aeson.QQ
+import Data.Aeson qualified as JSON
 import Data.ByteString.Lazy qualified as BSL
-import Data.Map.Strict qualified as Map
 import Data.Map.Strict.Patch qualified as PM
+import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
-import Data.Text qualified as T
 import Data.Text.IO qualified as TIO
+import Data.Text qualified as T
 import Fmt
 import Gargantext.API.Admin.Auth.Types (Token)
 import Gargantext.API.Errors
 import Gargantext.API.HashedResponse
-import Gargantext.API.Ngrams qualified as APINgrams
 import Gargantext.API.Ngrams.List ( ngramsListFromTSVData )
 import Gargantext.API.Ngrams.List.Types (WithJsonFile(..), WithTextFile(..))
+import Gargantext.API.Ngrams qualified as APINgrams
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Node.Corpus.New.Types qualified as FType
 import Gargantext.API.Node.Types
@@ -51,6 +51,7 @@ import Gargantext.API.Routes.Named.Corpus
 import Gargantext.API.Routes.Named.Node
 import Gargantext.API.Routes.Named.Private
 import Gargantext.API.Worker (workerAPIPost)
+import Gargantext.Core.Config
 import Gargantext.Core qualified as Lang
 import Gargantext.Core.Text.Corpus.Query (RawQuery(..))
 import Gargantext.Core.Text.List.Social
@@ -63,6 +64,7 @@ import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Prelude hiding (get)
 import Network.Wai.Handler.Warp qualified as Wai
 import Paths_gargantext (getDataFileName)
+import qualified Prelude
 import Servant.Client.Streaming
 import System.FilePath
 import Test.API.Prelude (checkEither, newCorpusForUser, newPrivateFolderForUser)
@@ -75,16 +77,16 @@ import Test.Hspec.Wai.JSON (json)
 import Test.Types (JobPollHandle(..))
 import Test.Utils (pollUntilWorkFinished, protectedJSON, withValidLogin)
 import Text.Printf (printf)
-import qualified Prelude
 
 
-uploadJSONList :: Wai.Port
+uploadJSONList :: LogConfig
+               -> Wai.Port
                -> Token
                -> CorpusId
                -> FilePath
                -> ClientEnv
                -> WaiSession () ListId
-uploadJSONList port token cId pathToNgrams clientEnv = do
+uploadJSONList log_cfg port token cId pathToNgrams clientEnv = do
   ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
   -- Upload the JSON doc
   simpleNgrams' <- liftIO (TIO.readFile =<< getDataFileName pathToNgrams)
@@ -101,7 +103,7 @@ uploadJSONList port token cId pathToNgrams clientEnv = do
   -- j' <- pollUntilFinished token port mkPollUrl j
   ji <- checkEither $ liftIO $ runClientM (add_form_to_list token listId params) clientEnv
   -- liftIO (_jph_status j' `shouldBe` "IsFinished")
-  ji' <- pollUntilWorkFinished port ji
+  ji' <- pollUntilWorkFinished log_cfg port ji
   liftIO $ ji' `shouldBe` ji
   
   pure listId
@@ -116,9 +118,10 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
 
       it "allows uploading a JSON ngrams file" $ \(SpecContext testEnv port app _) -> do
         cId <- newCorpusForUser testEnv "alice"
+        let log_cfg = (test_config testEnv) ^. gc_logging
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
-            listId <- uploadJSONList port token cId "test-data/ngrams/simple.json" clientEnv
+            listId <- uploadJSONList log_cfg port token cId "test-data/ngrams/simple.json" clientEnv
 
             -- Now check that we can retrieve the ngrams
             liftIO $ do
@@ -140,6 +143,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
 
       it "does not create duplicates when uploading JSON (#313)" $ \(SpecContext testEnv port app _) -> do
         cId <- newCorpusForUser testEnv "alice"
+        let log_cfg = (test_config testEnv) ^. gc_logging
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
             -- this term is imported from the .json file
@@ -147,7 +151,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
             -- this is the new term, under which importedTerm will be grouped
             let newTerm = NgramsTerm "new abelian group"
 
-            listId <- uploadJSONList port token cId "test-data/ngrams/simple.json" clientEnv
+            listId <- uploadJSONList log_cfg port token cId "test-data/ngrams/simple.json" clientEnv
 
             let checkNgrams expected = do
                   eng <- liftIO $ runClientM (get_table_ngrams token cId APINgrams.Terms listId 10 Nothing (Just MapTerm) Nothing Nothing Nothing Nothing) clientEnv
@@ -188,7 +192,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
             -- finally, upload the list again, the group should be as
             -- it was before (the bug in #313 was that "abelian group"
             -- was created again as a term with no parent)
-            _ <- uploadJSONList port token cId "test-data/ngrams/simple.json" clientEnv
+            _ <- uploadJSONList log_cfg port token cId "test-data/ngrams/simple.json" clientEnv
 
             -- old (imported) term shouldn't become parentless
             -- (#313 error was that we had [newTerm, importedTerm] instead)
@@ -210,8 +214,14 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
                                 , (NgramsTerm "brazorf", NgramsRepoElement 1 StopTerm Nothing Nothing (MSet mempty))
                               ])])
 
+      it "parses TSV with UTF-8 issues" $ \(SpecContext _testEnv _port _app _) -> do
+        simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/433-utf-encoding-issue.tsv")
+        -- we don't care about the output, only that the file was parsed without errors (this file is garbage)
+        ngramsListFromTSVData simpleNgrams `shouldSatisfy` isRight
+
       it "allows uploading a CSV ngrams file" $ \(SpecContext testEnv port app _) -> do
         cId <- newCorpusForUser testEnv "alice"
+        let log_cfg = (test_config testEnv) ^. gc_logging
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
             ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
@@ -221,7 +231,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
                                       , _wtf_data = simpleNgrams
                                       , _wtf_name = "simple.tsv" }
             ji <- checkEither $ liftIO $ runClientM (add_tsv_to_list token listId params) clientEnv
-            _ <- pollUntilWorkFinished port ji
+            _ <- pollUntilWorkFinished log_cfg port ji
 
             -- Now check that we can retrieve the ngrams
             liftIO $ do
@@ -259,6 +269,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
             void $ createFortranDocsList testEnv port clientEnv token
 
       it "doesn't use trashed documents for score calculation (#385)" $ \(SpecContext testEnv port app _) -> do
+        let log_cfg = (test_config testEnv) ^. gc_logging
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
             corpusId <- createFortranDocsList testEnv port clientEnv token
@@ -277,7 +288,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
               pure tr1
 
 
-            termsNodeId <- uploadJSONList port token corpusId "test-data/ngrams/GarganText_NgramsTerms-nodeId-177.json" clientEnv
+            termsNodeId <- uploadJSONList log_cfg port token corpusId "test-data/ngrams/GarganText_NgramsTerms-nodeId-177.json" clientEnv
 
             liftIO $ do
               -- Now let's check the score for the \"fortran\" ngram.
@@ -345,19 +356,26 @@ createDocsList testDataPath testEnv port clientEnv token = do
   simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath)
   let newWithForm = mkNewWithForm simpleDocs (T.pack $ takeBaseName testDataPath)
   ji <- checkEither $ liftIO $ runClientM (add_file_async token corpusId newWithForm) clientEnv
-  ji' <- pollUntilWorkFinished port ji
+  ji' <- pollUntilWorkFinished log_cfg port ji
   liftIO $ ji' `shouldBe` ji
   pure corpusId
+  where
+    log_cfg = (test_config testEnv) ^. gc_logging
 
 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 port clientEnv token nodeId = do
+updateNode :: LogConfig
+           -> Int
+           -> ClientEnv
+           -> Token
+           -> NodeId
+           -> WaiSession () ()
+updateNode log_cfg port clientEnv token nodeId = do
   let params = UpdateNodeParamsTexts Both
   ji <- checkEither $ liftIO $ runClientM (update_node token nodeId params) clientEnv
-  ji' <- pollUntilWorkFinished port ji
+  ji' <- pollUntilWorkFinished log_cfg port ji
   liftIO $ ji' `shouldBe` ji
 
 mkNewWithForm :: T.Text -> T.Text -> NewWithForm

test/Test/Database/Operations.hs

@@ -10,7 +10,6 @@ module Test.Database.Operations (
    , nodeStoryTests
   ) where
 
-import Control.Monad.Except
 import Control.Monad.Reader
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE

test/Test/Database/Setup.hs

@@ -2,7 +2,7 @@
 
 module Test.Database.Setup (
     withTestDB
-  , fakeTomlPath
+  , testTomlPath
   , testEnvToPgConnectionInfo
   ) where
 
@@ -28,7 +28,7 @@ import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
 import Gargantext.Core.Worker (initWorkerState)
 import Gargantext.Core.Worker.Env (WorkerEnv(..))
 import Gargantext.Prelude
-import Gargantext.System.Logging (withLoggerHoisted)
+import Gargantext.System.Logging (withLoggerIO)
 import Paths_gargantext
 import Prelude qualified
 import Shelly hiding (FilePath, run)
@@ -43,8 +43,8 @@ dbUser = "gargantua"
 dbPassword = "gargantua_test"
 dbName = "gargandb_test"
 
-fakeTomlPath :: IO SettingsFile
-fakeTomlPath = SettingsFile <$> getDataFileName "test-data/test_config.toml"
+testTomlPath :: IO SettingsFile
+testTomlPath = SettingsFile <$> getDataFileName "test-data/test_config.toml"
 
 gargDBSchema :: IO FilePath
 gargDBSchema = getDataFileName "devops/postgres/schema.sql"
@@ -81,7 +81,7 @@ setup = do
     Left err -> Prelude.fail $ show err
     Right db -> do
       let connInfo = tmpDBToConnInfo db
-      gargConfig <- fakeTomlPath >>= readConfig
+      gargConfig <- testTomlPath >>= readConfig
                     -- fix db since we're using tmp-postgres
                     <&> (gc_database_config .~ connInfo)
                     -- <&> (gc_worker . wsDatabase .~ connInfo)
@@ -98,8 +98,8 @@ setup = do
       bootstrapDB db pool gargConfig
       ugen <- emptyCounter
       test_nodeStory <- fromDBNodeStoryEnv pool
-      withLoggerHoisted Mock $ \logger -> do
-  
+      withLoggerIO Mock $ \logger -> do
+
         let wPoolConfig = defaultPoolConfig (PG.connectPostgreSQL (Tmp.toConnectionString db))
                                             PG.close
                                             idleTime
@@ -107,7 +107,7 @@ setup = do
         wPool <- newPool (setNumStripes (Just 2) wPoolConfig)
         wNodeStory <- fromDBNodeStoryEnv wPool
         _w_env_job_state <- newTVarIO Nothing
-        withLoggerHoisted Mock $ \wioLogger -> do
+        withLoggerIO Mock $ \wioLogger -> do
           let wEnv = WorkerEnv { _w_env_config = gargConfig
                                , _w_env_logger = wioLogger
                                , _w_env_pool = wPool

test/Test/Database/Types.hs

@@ -147,7 +147,10 @@ instance HasLogger (GargM TestEnv BackendInternalError) where
     pure $ GargTestLogger mode test_logger_set
   destroyLogger GargTestLogger{..} = liftIO $ FL.rmLoggerSet test_logger_set
   logMsg (GargTestLogger mode logger_set) lvl msg = do
-    let pfx = "[" <> show lvl <> "] " :: Text
-    when (lvl `elem` (modeToLoggingLevels mode)) $
-      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
+    cfg <- view hasConfig
+    let minLvl = cfg ^. gc_logging . lc_log_level
+    when (lvl >= minLvl) $ do
+      let pfx = "[" <> show lvl <> "] " :: Text
+      when (lvl `elem` (modeToLoggingLevels mode)) $
+        liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
   logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)

test/Test/Utils.hs

@@ -35,19 +35,20 @@ import Control.Concurrent.STM.TSem (TSem, waitTSem)
 import Control.Concurrent.STM.TVar (newTVarIO, writeTVar, readTVarIO)
 import Control.Exception.Safe ()
 import Control.Monad ()
-import Data.Aeson qualified as JSON
 import Data.Aeson.KeyMap qualified as KM
+import Data.Aeson qualified as JSON
 import Data.ByteString.Char8 qualified as B
 import Data.ByteString.Lazy qualified as L
 import Data.Map.Strict qualified as Map
-import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
-import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TLE
+import Data.Text.Lazy qualified as TL
+import Data.Text qualified as T
 import Data.TreeDiff
 import Gargantext.API.Admin.Auth.Types (AuthRequest(..), AuthResponse, Token, authRes_token)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Routes.Types (xGargErrorScheme)
+import Gargantext.Core.Config (LogConfig)
 import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
 import Gargantext.Core.Types.Individu (Username, GargPassword)
 import Gargantext.Core.Worker.Types (JobInfo(..))
@@ -55,21 +56,21 @@ import Gargantext.Prelude
 import Gargantext.System.Logging (withLogger, logMsg, LogLevel(..))
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import Network.HTTP.Client qualified as HTTP
-import Network.HTTP.Types (Header, Method, status200)
 import Network.HTTP.Types.Header (hAccept, hAuthorization, hContentType)
+import Network.HTTP.Types (Header, Method, status200)
 import Network.Wai.Handler.Warp (Port)
 import Network.Wai.Test (SResponse(..))
 import Network.WebSockets qualified as WS
 import Prelude qualified
-import Servant.Client.Streaming (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM, makeClientRequest, defaultMakeClientRequest)
 import Servant.Client.Core (BaseUrl)
 import Servant.Client.Core.Request qualified as Client
+import Servant.Client.Streaming (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM, makeClientRequest, defaultMakeClientRequest)
 import System.Environment (lookupEnv)
 import System.Timeout qualified as Timeout
 import Test.API.Routes (auth_api)
 import Test.Hspec.Expectations
-import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request)
 import Test.Hspec.Wai.JSON (FromValue(..))
+import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request)
 import Test.Hspec.Wai.Matcher (MatchHeader(..), ResponseMatcher(..), bodyEquals, formatHeader, match)
 import Test.Tasty.HUnit (Assertion, assertBool)
 import Test.Utils.Notifications (withWSConnection, millisecond)
@@ -252,10 +253,11 @@ gargMkRequest traceEnabled bu clientRq = do
 
 
 pollUntilWorkFinished :: HasCallStack
-                      => Port
+                      => LogConfig
+                      -> Port
                       -> JobInfo
                       -> WaiSession () JobInfo
-pollUntilWorkFinished port ji = do
+pollUntilWorkFinished log_cfg port ji = do
   let waitSecs = 60
   isFinishedTVar <- liftIO $ newTVarIO False
   let wsConnect =
@@ -271,24 +273,24 @@ pollUntilWorkFinished port ji = do
             case dec of
               Nothing -> pure ()
               Just (DT.NUpdateWorkerProgress ji' jl) -> do
-                withLogger () $ \ioL ->
+                withLogger log_cfg $ \ioL ->
                   logMsg ioL DEBUG $ "[pollUntilWorkFinished] received " <> show ji' <> ", " <> show jl
                 if ji' == ji && isFinished jl
                 then do
-                  withLogger () $ \ioL ->
+                  withLogger log_cfg $ \ioL ->
                     logMsg ioL DEBUG $ "[pollUntilWorkFinished] FINISHED! " <> show ji'
                   atomically $ writeTVar isFinishedTVar True
                 else
                   pure ()
               _ -> pure ()
- 
+
   liftIO $ withAsync wsConnect $ \_ -> do
     mRet <- Timeout.timeout (waitSecs * 1000 * millisecond) $ do
       let go = do
             finished <- readTVarIO isFinishedTVar
             if finished
               then do
-                withLogger () $ \ioL ->
+                withLogger log_cfg $ \ioL ->
                   logMsg ioL DEBUG $ "[pollUntilWorkFinished] JOB FINISHED: " <> show ji
                 return True
               else do
@@ -298,7 +300,7 @@ pollUntilWorkFinished port ji = do
     case mRet of
       Nothing -> panicTrace $ "[pollUntilWorkFinished] timed out while waiting to finish job " <> show ji
       Just _ -> return ji
-      
+
 
   where
     isFinished (JobLog { .. }) = _scst_remaining == Just 0
@@ -317,7 +319,7 @@ waitUntil pred' timeoutMs = do
   -- shortcut for testing mTimeout
   p <- pred'
   unless p (expectationFailure "Predicate test failed")
-  
+
   where
     performTest = do
       p <- pred'

test/drivers/hspec/Main.hs

@@ -6,9 +6,10 @@ import Control.Monad
 import Data.Text (isInfixOf)
 import Data.Text qualified as T
 import Gargantext.Prelude hiding (isInfixOf)
-import Shelly hiding (FilePath)
 import System.IO
 import System.Process
+import System.Posix.Process
+import System.Posix.Signals
 import Test.API qualified as API
 import Test.Database.Operations qualified as DB
 import Test.Hspec
@@ -21,7 +22,13 @@ startCoreNLPServer = do
   devNull <- openFile "/dev/null" WriteMode
   let p = proc "./startServer.sh" []
   (_, _, _, hdl) <- (createProcess $ p { cwd = Just "devops/coreNLP/stanford-corenlp-current"
-                    , delegate_ctlc = True
+                    -- NOTE(adn) Issue #451, this one has to stay disabled, because if we
+                    -- turn it on, despite the confusing documentation on the `process` library
+                    -- it will cause the Haskell RTS to completely ignore the Ctrl^c and instead
+                    -- delegate it exclusively to the process here, which means that our CoreNLP
+                    -- server will shut down correctly, but the test running will stop responding
+                    -- to Ctrl^C requests.
+                    , delegate_ctlc = False
                     , create_group = True
                     , std_out = UseHandle devNull
                     , std_err = UseHandle devNull
@@ -34,12 +41,14 @@ startCoreNLPServer = do
                                              | otherwise -> throwIO e
   pure hdl
 
-stopCoreNLPServer :: ProcessHandle -> IO ()
-stopCoreNLPServer ph = do
-  putText "calling stop core nlp"
-  interruptProcessGroupOf ph
-  putText "calling stop core nlp - done"
-
+killProcessTree :: ProcessHandle -> IO ()
+killProcessTree ph = do
+  pid <- getPid ph
+  case pid of
+    Nothing -> putText "Process already terminated"
+    Just p -> do
+      pgid <- getProcessGroupIDOf p
+      signalProcessGroup keyboardSignal pgid
 
 -- It's especially important to use Hspec for DB tests, because,
 -- unlike 'tasty', 'Hspec' has explicit control over parallelism,
@@ -55,9 +64,9 @@ stopCoreNLPServer ph = do
 main :: IO ()
 main = do
   hSetBuffering stdout NoBuffering
-  -- TODO Ideally remove start/stop notifications and use
-  -- Test/API/Setup to initialize this in env
-  bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ sequential $ do
+  bracket startCoreNLPServer killProcessTree (const run_tests)
+  where
+    run_tests = hspec $ sequential $ do
       API.tests
       ReverseProxy.tests
       DB.tests