[MERGE] Stable Version

.envrc

 use_nix
+#use_flake
 export LANG=C.UTF-8

.gitignore

@@ -4,6 +4,10 @@
 
 # Profiling
 *.prof
+*.prof.html
+*.hp
+*.eventlog
+*.eventlog.html
 profiling
 
 # Stack
@@ -38,3 +42,6 @@ tmp*repo*json
 data
 
 devops/docker/js-cache
+
+cabal.project.local
+gargantext_profile_out.dot

.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:v2.3
+image: adinapoli/gargantext:v3.3
 
 variables:
   STACK_ROOT: "${CI_PROJECT_DIR}/.stack-root"
@@ -11,8 +11,8 @@ variables:
   CACHE_COMPRESSION_LEVEL: "fast"
 
 stages:
-  - stack
   - cabal
+  - stack
   - bench
   - test
 
@@ -26,6 +26,7 @@ stack:
   script:
     - echo "Building the project from '$CI_PROJECT_DIR'"
     - nix-shell --run "stack build --no-terminal --fast --dry-run"
+  allow_failure: false
 
 cabal:
   stage: cabal
@@ -36,11 +37,12 @@ cabal:
       - .cabal/
     policy: pull-push
   script:
-    - nix-shell --run "./bin/update-cabal-project $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build --ghc-options='-O2 -fclear-plugins'"
+    - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build --flags test-crypto --ghc-options='-O0 -fclear-plugins'"
   allow_failure: false
 
 bench:
   stage: bench
+  when: manual # trigger it manually, as it causes full recompilation with optimisations enabled.
   cache:
     key: cabal.project
     paths:
@@ -48,8 +50,8 @@ bench:
       - .cabal/
     policy: pull-push
   script:
-    - nix-shell --run "./bin/update-cabal-project $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-bench --ghc-options='-O2 -fclear-plugins'"
-  allow_failure: false
+    - 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'"
+  allow_failure: true
 
 test:
   stage: test
@@ -74,7 +76,7 @@ test:
       echo $CABAL
       echo $TEST_NIX_PATH
       git config --global --add safe.directory '*'
-      nix-shell --run "./bin/update-cabal-project $CABAL_STORE_DIR"
+      nix-shell --run "./bin/update-project-dependencies $CABAL_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/
@@ -82,7 +84,7 @@ test:
       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 --ghc-options='-O0 -fclear-plugins'\""
+      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'\""
       chown -R root:root dist-newstyle/
       chown -R root:root /root/
       chown -R root:root $CABAL_STORE_DIR

.mailmap

+Alexandre Delanoë <alexandre.delanoe@iscpif.fr> <alexandre.delanoe@iscpif.fr>
+Alexandre Delanoë <alexandre.delanoe@iscpif.fr> <devel+git@delanoe.org>
+Alfredo Di Napoli <alfredo@well-typed.com> <alfredo.dinapoli@gmail.com>
+Alfredo Di Napoli <alfredo@well-typed.com> <alfredo@well-typed.com>
+Alp Mestanogullari <alp@well-typed.com> <alp@well-typed.com>
+Christian Merten <christian@merten.dev> <christian@merten.dev>
+David Chavalarias <david.chavalarias@iscpif.fr> <david.chavalarias@iscpif.fr>
+Fabien Manière <fabien@cnrs.iscpif.fr> <fabien.maniere@cnrs.fr>
+Fabien Manière <fabien@cnrs.iscpif.fr> <fabien@cnrs.iscpif.fr>
+Fabien Manière <fabien@cnrs.iscpif.fr> <fmaniere.pro@gmail.com>
+Gargamelle <gargamelle@gargantext.org>
+Guillaume Chérel <guillaume.cherel@iscpif.fr> <guillaume.cherel@iscpif.fr>
+Justin Woo <moomoowoo@gmail.com> <moomoowoo@gmail.com>
+Karen Konou <konoukaren@gmail.com> <konoukaren@gmail.com>
+Maël Nicolas <mael.nicolas@imt.fr> <mael.nicolas@imt.fr>
+Nicolas Pouillard <nicolas.pouillard@gmail.com> <nicolas.pouillard@gmail.com>
+Nicolas Pouillard <nicolas.pouillard@gmail.com> <np.t0@nicolaspouillard.fr>
+Przemysław Kaminski <pk@intrepidus.pl> <pk@intrepidus.pl>
+Quentin Lobbé <quentin.lobbe@iscpif.fr> <quentin.lobbe@gmail.com>
+Quentin Lobbé <quentin.lobbe@iscpif.fr> <quentin.lobbe@iscpif.fr>
+Sudhir Kumar <s@atomicits.com> <s@atomicits.com>

CHANGELOG.md

+## Version 0.0.6.9.9.9.6.7.1 [RELEASE CANDIDATE 007]
+
+* [BACK][FIX] Adding .mailmap file
+* [FRONT][FIX][[Tree search] Enrich search results with the path of the node (#638)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/638)
+
+## Version 0.0.6.9.9.9.6.7 [RELEASE CANDIDATE 007]
+
+* [BACK][RELATED][Singulars and plurals not grouped anymore (#169)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/169)
+* [FRONT][RELATED][Machting Documents are not displayed anymore in graph (#636)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/636)
+
+## Version 0.0.6.9.9.9.6.6 [RELEASE CANDIDATE 007]
+
+* [BACK][FIX][[Terms] Importing JSON or CSV seems to add new terms to the old ones, rather than overwriting and replacing them all (#313)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/313)
+* [BACK][FIX][Coherent Stemming interface (#324)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/324)
+* [FRONT][RELATED][[Node phylo] Phylomemy displays terms with broken accented words (#632)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/632)
+
+## Version 0.0.6.9.9.9.6.5.1 [RELEASE CANDIDATE 007]
+
+* [FRONT][FIX][Machting Documents are not displayed anymore in graph (#636)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/636)
+
+## Version 0.0.6.9.9.9.6.5 [RELEASE CANDIDATE 007]
+
+* [BACK][WIP][Singulars and plurals not grouped anymore (#169)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/169)
+* [BACK][FEAT][Coherent Stemming interface (#324)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/324)
+* [BACK][FIX] Order 1 aligned with first implementation with tests
+
+## Version 0.0.6.9.9.9.6.4 [RELEASE CANDIDATE 007]
+
+* [BACK][FEAT][[Node Phylo] Change the default value of findAncestors to False (#314)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/314)
+* [BACK][OPTIM][Export Data as zip for all exports (#312)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/312)
+* [BACK][METRICS] SQL queries to follow the community (export to CSV)
+
+## Version 0.0.6.9.9.9.6.3 [Release Candidate for 007]
+
+* [BACK][OPTIM] Option to enable GHC buld with O2 option
+
+## Version 0.0.6.9.9.9.6.2 [Release Candidate for 007]
+
+* [BACK][FIX][Node stories insertion error (SqlError violates foreign key constraint) (#303)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/303)
+* [BACK][DOC][Welcome: Door To enter the project (#177)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/177)
+* [BACK][OPTIM][Improve Phylo robustness and performance (#292)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/292)
+
+## Version 0.0.6.9.9.9.6.1
+
+* [BACK][FEAT][Removing Order2_A and Order2_B and use Order2 only instead (#308)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/308)
+
+## Version 0.0.6.9.9.9.6
+
+* [BACK][FEAT][Removing Order2_A and Order2_B and use Order2 only instead (#308)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/308)
+
+## Version 0.0.6.9.9.9.5
+
+* [BACK][CI][Improving CI](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/247)
+* [FRONT][ERGO][Display Phylomemy parameters (#580)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/580)
+
+## Version 0.0.6.9.9.9.4.9.3
+
+* [FRONT][FIX][Try to invite someone without email (#600)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/600)
+
+## Version 0.0.6.9.9.9.4.9.2
+
+* [FRONT][FIX][getLangs (#628)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/628)
+* [FRONT][FIX][The first change in the map term is never taken into account (#622)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/622)
+* [BACK][FIX][Different Logins (#302)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/302)
+* [GUIDELINES][About MR] a way to better coordinate
+
+## Version 0.0.6.9.9.9.4.9.1
+
+* [FRONT][ERRORFORMAT][Try to invite someone without email (#600)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/600)
+
+## Version 0.0.6.9.9.9.4.9
+
+* [FRONT][ERRORFORMAT][Try to invite someone without email (#600)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/600)
+* [BACK][CABAL][Stack2cabal install (#301)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/301)
+
+## Version 0.0.6.9.9.9.4.8
+
+* [BACK][GHC][Upgrade] Upgrade to 947
+* [BACK][FIX][[API HAL] Remove useless first 2 characters before authors and sources: ", " (#296)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/296)
+* [BACK][FIX][Add server options to obfuscate credentials from logs (#298)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/298)
+* [BACK][FIX][[Corpus HAL] (Backend) Remove/comment the HAL "All" lang choice (#299)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/299)
+* [FRONT][FIX][[Corpus HAL] Remove/comment the HAL "All" lang choice (#624)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/624)
+
+## Version 0.0.6.9.9.9.4.7
+
+* [BACK][LOGS][Add server options to obfuscate credentials from logs (#298)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/298)
+* [BACK][DOC] README
+
+## Version 0.0.6.9.9.9.4.6
+
+* [FRONT][FIX][Try to invite someone without email (#600)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/600)
+
 ## Version 0.0.6.9.9.9.4.5
 
 * [FRONT][FIX][The first change in the map term is never taken into account (#622)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/622)

DEVELOPER_GUIDELINES.md

@@ -89,7 +89,9 @@ as empty as possible. This seems obvious but has several advantages:
 
 ### Keep CI green.
 
-**Guideline: Do not merge any MR which doesn't have green CI. 'docs' failures are allowed.**
+** Before asking for a Merge Request, make sure your branch has a green CI.**
+
+**Guideline: We will not merge any MR which doesn't have green CI. 'docs' failures are allowed.**
 
 Continuous Integration (e.g. CI) is a "public proof" that the project is building and
 behaving correctly. Therefore, it's extremely important that we don't merge anything that doesn't
@@ -119,6 +121,9 @@ When opening a new issue, make sure to do the following:
 
 When opening a MR, make sure to do the following:
 
+- Check your branch has a green CI first please. If you need help or
+  discussion, use the comments in the issue related to your current
+  working branch.
 - If this is closing an issue, consider using one of the [closing patterns](https://docs.gitlab.com/ee/user/project/issues/managing_issues.html#default-closing-pattern)
   to automatically close the associated issue when the MR is merged. For example, you can say "Fixes #XXX"
   (where `XXX` is an issue number) in the MR description;

README.md

@@ -39,12 +39,16 @@ Disclaimer: since this project is still in development, this document remains in
   ```
 ### Installation
 
-This project can be built with either Stack or Cabal. For historical reasons, we generate a `cabal.project` from the `stack.yaml`, and we do not commit the former to the repo, to have a single "source of truth".
-However, it's always possible to generate a `cabal.project` thanks to [stack2cabal](https://hackage.haskell.org/package/stack2cabal).
+This project can be built with either Stack or Cabal. We keep up-to-date the `cabal.project` (which allows us
+to build with `cabal` by default) but we support `stack` thanks to thanks to
+[cabal2stack](https://github.com/iconnect/cabal2stack), which allows us to generate a valid `stack.yaml` from
+a `cabal.project`. Due to the fact gargantext requires a particular set of system dependencies (C++ libraries,
+toolchains, etc) we use [nix](https://nixos.org/) to setup an environment with all the required system
+dependencies, in a sandboxed and isolated fashion.
 
 #### Install Nix 
 
-Gargantext requires [Nix](https://github.com/NixOS/nix) to provide system dependencies (for example, C libraries), but its use is limited to that. In order to install [Nix](https://nixos.org/download.html):
+As said, Gargantext requires [Nix](https://github.com/NixOS/nix) to provide system dependencies (for example, C libraries), but its use is limited to that. In order to install [Nix](https://nixos.org/download.html):
 
 ```shell
 sh <(curl -L https://nixos.org/nix/install) --daemon
@@ -56,24 +60,77 @@ nix-env --version
 nix-env (Nix) 2.19.2
 ```
 
-**Important:** Before building the project with either `stack` or `cabal` you need to be in the correct Nix shell, which will fetch all the required system dependencies. To do so, just type:
+**Important:** Before building the project with either `stack` or `cabal` you need to be in the correct Nix shell, which will fetch all the required system dependencies. To do so, just type **inside your haskell-gargantext folder**:
 
 ```shell
 nix-shell
 ```
 
-This will take a bit of time the first time.
+This will take a bit of time as it has to download/build the dependencies, but this will be needed only the first time.
 
 ### Build: choose cabal (new) or stack (old)
 
 #### With Cabal (recommanded)
 
+##### Turning off optimization flags
+
+Create a `cabal.project.local` file (don't commit it to git!):
+```
+package gargantext
+    ghc-options: -fwrite-ide-info -hiedir=".stack-work/hiedb" -O0
+
+package gargantext-admin
+    ghc-options: -O0
+
+package gargantext-cli
+    ghc-options: -O0
+
+package gargantext-db-obfuscation
+    ghc-options: -O0
+
+package gargantext-import
+    ghc-options: -O0
+
+package gargantext-init
+    ghc-options: -O0
+
+package gargantext-invitations
+    ghc-options: -O0
+
+package gargantext-phylo
+    ghc-options: -O0
+
+package gargantext-server
+    ghc-options: -O0
+
+package gargantext-upgrade
+    ghc-options: -O0
+
+package gargantext-graph
+    ghc-options: -O0
+
+package hmatrix
+    ghc-options: -O0
+
+package sparse-linear
+    ghc-options: -O0
+```
+
+##### Building
+
 First, into `nix-shell`:
 ```shell
 cabal update
 cabal install
 ```
 
+Alternatively, if you want to run the command "from the outside", in your current shell:
+
+```
+nix-shell --run "cabal update"
+nix-shell --run "cabal install"
+```
+
 #### With Stack
 
 Install [Stack (or Haskell Tool Stack)](https://docs.haskellstack.org/en/stable/):
@@ -95,28 +152,32 @@ stack build --fast
 ```
 
 
-#### Keeping the cabal.project updated with stack.yaml
+#### Keeping the stack.yaml updated with the cabal.project
 
-(Section for Developers using cabal only)
+(Section for Developers using stack only)
 
-Once you have a valid version of `cabal`, building requires generating a valid `cabal.project`. This can be done by installing `stack2cabal`:
+Once you have a valid version of `stack`, building requires generating a valid `stack.yaml`.
+This can be obtained by installing `cabal2stack`:
 
 ```shell
-cabal v2-install stack2cabal-1.0.14
+git clone https://github.com/iconnect/cabal2stack.git
+cd cabal2stack
 ```
 
+Then, depending on what build system you are using, either build with `cabal install --overwrite-policy=always` or `stack install`.
+
 And finally:
 
 ```shell
-stack2cabal --no-run-hpack -p '2023-06-25'
-cabal v2-build
+cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
+stack build
 ```
 
-
-Simply run:
+The good news is that you don't have to do all of this manually; during development, after modifying the
+`cabal.project`, it's enough to do:
 
 ```shell
-./bin/update-cabal-project
+./bin/update-project-dependencies
 ```
 
 ## Initialization <a name="init"></a>
@@ -125,7 +186,7 @@ Simply run:
 
 ``` sh
 # If docker is not installed:
-# curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/dev/devops/docker/docker-install | sh
+# curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/dev/devops/docker/install_docker | sh
 cd devops/docker
 docker compose up
 ```
@@ -174,6 +235,18 @@ From the Backend root folder (haskell-gargantext):
 
 For frontend development and compilation, see the [Frontend Readme.md](https://gitlab.iscpif.fr/gargantext/purescript-gargantext#dev)
 
+### Running tests
+
+From nix shell:
+
+```
+cabal v2-test --test-show-details=streaming
+```
+
+Or, from "outside":
+```
+nix-shell --run "cabal v2-test --test-show-details=streaming"
+```
 ### Working on libraries
 
 When a devlopment is needed on libraries (for instance, the HAL crawler in https://gitlab.iscpif.fr/gargantext/crawlers):
@@ -184,10 +257,10 @@ When a devlopment is needed on libraries (for instance, the HAL crawler in https
       - turn off (temporarily) the `hal` in `source-repository-package` 
    2. When changes work and tests are OK, commit in repo `hal`
 2. When changes are commited / merged:
-   1. Get the hash id, and edit `stack.yaml` with the **new commit id**
-   2. run `./bin/update-cabal-project`
-      - get an error that sha256 don't match, so update the `./bin/update-cabal-project` with new sha256 hash
-      - run again `./bin/update-cabal-project` (to make sure it's a fixed point now)
+   1. Get the hash id, and edit `cabal.project` with the **new commit id**
+   2. run `./bin/update-project-dependencies`
+      - get an error that sha256 don't match, so update the `./bin/update-project-dependencies` with new sha256 hash
+      - run again `./bin/update-project-dependencies` (to make sure it's a fixed point now)
 
 > Note: without `stack.yaml` we would have to only fix `cabal.project` -> `source-repository-package` commit id. Sha256 is there to make sure CI reruns the tests.
 

bench-data/phylo/bpa-config.json

+{
+    "corpusPath"     : "Gargantext_DocsList-nodeId-185487.csv",
+    "listPath"       : "Gargantext_NgramsList-185488.csv",
+    "outputPath"     : "data",
+    "corpusParser"   : {
+        "tag" : "Csv",
+        "_csv_limit" : 1500000
+    },
+    "listParser" : "V3",
+    "phyloName"      : "bpa",
+    "phyloScale"     : 2,
+    "similarity" : {
+        "tag" : "WeightedLogJaccard",
+        "_wlj_sensibility" : 0.5,
+        "_wlj_minSharedNgrams" : 1
+    },
+    "seaElevation" : {
+        "tag" : "Evolving",
+        "_evol_neighborhood" : true
+    },
+    "defaultMode" : false,
+    "findAncestors" : true,
+    "phyloSynchrony" : {
+        "tag" : "ByProximityThreshold",
+        "_bpt_threshold" : 0.6,
+        "_bpt_sensibility" : 0,
+        "_bpt_scope" : "AllBranches",
+        "_bpt_strategy" : "MergeAllGroups"
+    },
+    "phyloQuality" : {
+        "tag" : "Quality",
+        "_qua_granularity" : 0.1,
+        "_qua_minBranch" : 2
+    },
+    "timeUnit" : {
+        "tag" : "Week",
+        "_week_period" : 4,
+        "_week_step" : 2,
+        "_week_matchingFrame" : 5
+    },
+    "clique" : {
+        "tag" : "Fis",
+        "_fis_support" : 3,
+        "_fis_size" : 1
+    },
+    "exportLabel" : [
+        {
+            "tag" : "BranchLabel",
+            "_branch_labelTagger" : "MostEmergentTfIdf",
+            "_branch_labelSize" : 2
+        },
+        {
+            "tag" : "GroupLabel",
+            "_group_labelTagger" : "MostEmergentInclusive",
+            "_group_labelSize" : 2
+        }
+    ],
+    "exportSort" : {
+        "tag" : "ByHierarchy",
+	    "_sort_order" : "Desc"
+    },
+    "exportFilter" : [
+        {
+            "tag" : "ByBranchSize",
+            "_branch_size" : 2
+        }
+    ]
+}

bench/Main.hs

@@ -25,7 +25,7 @@ phyloConfig = PhyloConfig {
   , similarity = WeightedLogJaccard {_wlj_sensibility = 0.5, _wlj_minSharedNgrams = 2}
   , seaElevation = Constante {_cons_start = 0.1, _cons_gap = 0.1}
   , defaultMode = True
-  , findAncestors = True
+  , findAncestors = False
   , phyloSynchrony = ByProximityThreshold {_bpt_threshold = 0.5, _bpt_sensibility = 0.0, _bpt_scope = AllBranches, _bpt_strategy = MergeAllGroups}
   , phyloQuality = Quality {_qua_granularity = 0.8, _qua_minBranch = 3}
   , timeUnit = Year {_year_period = 3, _year_step = 1, _year_matchingFrame = 5}

bin/gargantext-golden-file-diff/Main.hs

+
+module Main where
+
+import Prelude
+import Data.TreeDiff.Class
+import Data.TreeDiff.Pretty
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import System.Environment (getArgs)
+import System.Exit (exitFailure)
+import Control.Monad (unless)
+import qualified Data.List as L
+
+-- | Renders in a pretty way the content of two golden files. The
+-- first file should contain the expected output, the second the
+-- actual data generated by the test suite.
+main :: IO ()
+main = do
+  (refPath:newPath:_) <- getArgs
+  ref <- T.lines <$> TIO.readFile refPath
+  new <- T.lines <$> TIO.readFile newPath
+
+  let differences = filter (\(r,n) -> r /= n) $ zip ref new
+
+  unless (L.null differences) $ do
+    putStrLn $ show $ ansiWlEditExpr $ ediff' (map fst differences) (map snd differences)
+    exitFailure

bin/gargantext-phylo-profile/Main.hs

+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Common
+import Data.Aeson
+import Data.List (nub)
+import Gargantext.Core.Viz.Phylo
+import Gargantext.Core.Viz.Phylo.API.Tools
+import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
+import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
+import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig, toPeriods, getTimePeriod, getTimeStep)
+import GHC.IO.Encoding
+import GHC.Stack
+import Paths_gargantext
+import Prelude
+import qualified Data.Text as T
+import Shelly
+import System.Directory
+
+--------------
+-- | Main | --
+--------------
+
+phyloConfig :: FilePath -> PhyloConfig
+phyloConfig outdir = PhyloConfig {
+    corpusPath = "corpus.csv"
+  , listPath = "list.csv"
+  , outputPath = outdir
+  , corpusParser = Csv {_csv_limit = 150000}
+  , listParser = V4
+  , phyloName = "phylo_profile_test"
+  , phyloScale = 2
+  , similarity = WeightedLogJaccard {_wlj_sensibility = 0.5, _wlj_minSharedNgrams = 2}
+  , seaElevation = Constante {_cons_start = 0.1, _cons_gap = 0.1}
+  , defaultMode = True
+  , findAncestors = False
+  , phyloSynchrony = ByProximityThreshold {_bpt_threshold = 0.5, _bpt_sensibility = 0.0, _bpt_scope = AllBranches, _bpt_strategy = MergeAllGroups}
+  , phyloQuality = Quality {_qua_granularity = 0.8, _qua_minBranch = 3}
+  , timeUnit = Year {_year_period = 3, _year_step = 1, _year_matchingFrame = 5}
+  , clique = MaxClique {_mcl_size = 5, _mcl_threshold = 1.0e-4, _mcl_filter = ByThreshold}
+  , exportLabel = [ BranchLabel {_branch_labelTagger = MostEmergentTfIdf, _branch_labelSize = 2}
+                  , GroupLabel {_group_labelTagger = MostEmergentInclusive, _group_labelSize = 2}
+                  ]
+  , exportSort = ByHierarchy {_sort_order = Desc}
+  , exportFilter = [ByBranchSize {_branch_size = 3.0}]
+  }
+
+
+main :: HasCallStack => IO ()
+main = do
+
+    shelly $ escaping False $ withTmpDir $ \tdir -> do
+      curDir <- pwd
+      let output = curDir <> "/" <> "gargantext_profile_out.dot"
+      chdir tdir $ do
+        liftIO $ setLocaleEncoding utf8
+
+        bpaConfig      <- liftIO $ getDataFileName "bench-data/phylo/bpa-config.json"
+        corpusPath'    <- liftIO $ getDataFileName "bench-data/phylo/GarganText_DocsList-nodeId-185487.csv"
+        listPath'      <- liftIO $ getDataFileName "bench-data/phylo/GarganText_NgramsList-185488.csv"
+        (Right config) <- fmap (\pcfg -> pcfg { outputPath = tdir
+                                              , corpusPath = corpusPath'
+                                              , listPath   = listPath'
+                                              }) <$> liftIO (eitherDecodeFileStrict' bpaConfig)
+
+        mapList <-  liftIO $ fileToList (listParser config) (listPath config)
+
+        corpus  <- liftIO $ if (defaultMode config)
+                    then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
+                    else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config)  mapList
+
+        liftIO $ do
+          printIOComment (show (length corpus) <> " parsed docs from the corpus")
+          printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")
+          printIOComment (show (length mapList) <> " Size ngs_terms List Map Ngrams")
+          printIOMsg "Reconstruct the phylo"
+
+          -- check the existing backup files
+
+          let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
+          let backupPhylo = (outputPath config) <> "backupPhylo_"   <> (configToSha BackupPhylo config) <> ".json"
+
+          phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
+          phyloExists            <- doesFileExist backupPhylo
+
+          -- reconstruct the phylo
+
+          phylo <- if phyloExists
+                      then do
+                        printIOMsg "Reconstruct the phylo from an existing file"
+                        readPhylo backupPhylo
+                      else do
+                        if phyloWithoutLinkExists
+                          then do
+                            printIOMsg "Reconstruct the phylo from an existing file without links"
+                            phyloWithoutLink <- readPhylo backupPhyloWithoutLink
+                            writePhylo backupPhyloWithoutLink phyloWithoutLink
+                            pure $ toPhylo (setConfig config phyloWithoutLink)
+                          else do
+                            printIOMsg "Reconstruct the phylo from scratch"
+                            phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
+                            writePhylo backupPhyloWithoutLink phyloWithoutLink
+                            pure $ toPhylo (setConfig config phyloWithoutLink)
+
+          writePhylo backupPhylo phylo
+
+          printIOMsg "End of reconstruction, start the export"
+
+          let dot = toPhyloExport (setConfig config phylo)
+
+          dotToFile output dot
+        echo "Done."

bin/gargantext-phylo/Main.hs

@@ -46,210 +46,7 @@ import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude hiding (hash, replace)
 import Prelude qualified
 import System.Directory (listDirectory,doesFileExist)
-
-data Backup = BackupPhyloWithoutLink | BackupPhylo deriving (Show)
-
----------------
--- | Tools | --
----------------
-
--- | To get all the files in a directory or just a file
-getFilesFromPath :: FilePath -> IO [FilePath]
-getFilesFromPath path = do
-  if (isSuffixOf "/" path)
-    then (listDirectory path)
-    else return [path]
-
-----------------
--- | Parser | --
-----------------
-
--- | To filter the Ngrams of a document based on the termList
-termsInText :: Patterns -> Text -> [Text]
-termsInText pats txt = nub $ concat $ map (map unwords) $ extractTermsWithList pats txt
-
-
--- | To transform a Wos file (or [file]) into a list of Docs
-wosToDocs :: Int -> Patterns -> TimeUnit -> FilePath -> IO [Document]
-wosToDocs limit patterns time path = do
-      files <- getFilesFromPath path
-      take limit
-        <$> map (\d -> let title = fromJust $ _hd_title d
-                           abstr = if (isJust $ _hd_abstract d)
-                                   then fromJust $ _hd_abstract d
-                                   else ""
-                        in Document (toPhyloDate
-                                      (fromIntegral $ fromJust $ _hd_publication_year d)
-                                      (fromJust $ _hd_publication_month d)
-                                      (fromJust $ _hd_publication_day d) time)
-                                    (toPhyloDate'
-                                      (fromIntegral $ fromJust $ _hd_publication_year d)
-                                      (fromJust $ _hd_publication_month d)
-                                      (fromJust $ _hd_publication_day d) time)
-                                    (termsInText patterns $ title <> " " <> abstr) Nothing [] time)
-        <$> concat
-        <$> mapConcurrently (\file ->
-              filter (\d -> (isJust $ _hd_publication_year d)
-                         && (isJust $ _hd_title d))
-                <$> fromRight [] <$> parseFile WOS Plain (path <> file) ) files
-
-
--- To transform a Csv file into a list of Document
-csvToDocs :: CorpusParser -> Patterns -> TimeUnit -> FilePath -> IO [Document]
-csvToDocs parser patterns time path =
-  case parser of
-    Wos  _     -> Prelude.error "csvToDocs: unimplemented"
-    Csv  limit -> Vector.toList
-      <$> Vector.take limit
-      <$> Vector.map (\row -> Document (toPhyloDate  (Csv.fromMIntOrDec Csv.defaultYear $ csv_publication_year row) (fromMaybe Csv.defaultMonth $ csv_publication_month row) (fromMaybe Csv.defaultDay $ csv_publication_day row) time)
-                                       (toPhyloDate' (Csv.fromMIntOrDec Csv.defaultYear $ csv_publication_year row) (fromMaybe Csv.defaultMonth $ csv_publication_month row) (fromMaybe Csv.defaultDay $ csv_publication_day row) time)
-                                       (termsInText patterns $ (csv_title row) <> " " <> (csv_abstract row))
-                                       Nothing
-                                       []
-                                       time
-                     ) <$> snd <$> either (\err -> panicTrace $ "CSV error" <> (show err)) identity <$> Csv.readCSVFile path
-    Csv' limit -> Vector.toList
-      <$> Vector.take limit
-      <$> Vector.map (\row -> Document (toPhyloDate  (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)
-                                       (toPhyloDate' (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)
-                                       (termsInText patterns $ (csv'_title row) <> " " <> (csv'_abstract row))
-                                       (Just $ csv'_weight row)
-                                       (map (T.strip . pack) $ splitOn ";" (unpack $ (csv'_source row)))
-                                       time
-                     ) <$> snd <$> Csv.readWeightedCsv path
-
-
--- To parse a file into a list of Document
-fileToDocsAdvanced :: CorpusParser -> FilePath -> TimeUnit -> TermList -> IO [Document]
-fileToDocsAdvanced parser path time lst = do
-  let patterns = buildPatterns lst
-  case parser of
-      Wos limit  -> wosToDocs limit  patterns time path
-      Csv  _     -> csvToDocs parser patterns time path
-      Csv' _     -> csvToDocs parser patterns time path
-
-fileToDocsDefault :: CorpusParser -> FilePath -> [TimeUnit] -> TermList -> IO [Document]
-fileToDocsDefault parser path timeUnits lst = 
-  if length timeUnits > 0
-    then
-      do 
-        let timeUnit = (head' "fileToDocsDefault" timeUnits)
-        docs <- fileToDocsAdvanced parser path timeUnit lst  
-        let periods = toPeriods (sort $ nub $ map date docs) (getTimePeriod timeUnit) (getTimeStep timeUnit)
-        if (length periods < 3)
-         then fileToDocsDefault parser path (tail timeUnits) lst
-         else pure docs
-    else panicTrace "this corpus is incompatible with the phylomemy reconstruction"
-
--- on passe à passer la time unit dans la conf envoyé au phyloMaker
--- dans le phyloMaker si default est true alors dans le setDefault ou pense à utiliser la TimeUnit de la conf 
-
-
----------------
--- | Label | --
----------------
-
-
--- Config time parameters to label
-timeToLabel :: PhyloConfig -> [Char]
-timeToLabel config = case (timeUnit config) of
-      Epoch p s f -> ("time_epochs" <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Year  p s f -> ("time_years"  <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Month p s f -> ("time_months" <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Week  p s f -> ("time_weeks"  <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Day   p s f -> ("time_days"   <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-
-
-seaToLabel :: PhyloConfig -> [Char]
-seaToLabel config = case (seaElevation config) of
-      Constante start step   -> ("sea_cst_"  <> (show start) <> "_" <> (show step))
-      Adaptative granularity -> ("sea_adapt" <> (show granularity))
-      Evolving _ -> ("sea_evolv")
-
-
-sensToLabel :: PhyloConfig -> [Char]
-sensToLabel config = case (similarity config) of
-      Hamming _ _ -> Prelude.error "sensToLabel: unimplemented"
-      WeightedLogJaccard s _ -> ("WeightedLogJaccard_"  <> show s)
-      WeightedLogSim s _ -> ( "WeightedLogSim-sens_"  <> show s)
-
-
-cliqueToLabel :: PhyloConfig -> [Char]
-cliqueToLabel config = case (clique config) of
-      Fis s s' -> "fis_" <> (show s) <> "_" <> (show s')
-      MaxClique s t f ->  "clique_" <> (show s)<> "_"  <> (show f)<> "_"  <> (show t)
-
-
-syncToLabel :: PhyloConfig -> [Char]
-syncToLabel config = case (phyloSynchrony config) of
-      ByProximityThreshold scl sync_sens scope _ -> ("scale_" <> (show scope) <> "_" <> (show sync_sens)  <> "_"  <> (show scl))
-      ByProximityDistribution _ _ -> "syncToLabel: unimplemented"
-
-qualToConfig :: PhyloConfig -> [Char]
-qualToConfig config = case (phyloQuality config) of
-      Quality g m -> "quality_" <> (show g) <> "_" <> (show m)
-
-
--- To set up the export file's label from the configuration
-configToLabel :: PhyloConfig -> [Char]
-configToLabel config = outputPath config
-                    <> (unpack $ phyloName config)
-                    <> "-" <> (timeToLabel config)
-                    <> "-scale_" <> (show (phyloScale config))
-                    <> "-" <> (seaToLabel config)
-                    <> "-" <> (sensToLabel config)
-                    <> "-" <> (cliqueToLabel config)
-                    <> "-level_" <> (show (_qua_granularity $ phyloQuality config))
-                    <> "-" <> (syncToLabel config)
-                    <> ".dot"
-
-
--- To write a sha256 from a set of config's parameters
-configToSha :: Backup -> PhyloConfig -> [Char]
-configToSha stage config = unpack
-                         $ replace "/" "-"
-                         $ T.pack (show (hash $ C8.pack label))
-  where
-    label :: [Char]
-    label = case stage of
-      BackupPhyloWithoutLink -> (corpusPath    config)
-                       <> (listPath      config)
-                       <> (timeToLabel   config)
-                       <> (cliqueToLabel config)
-      BackupPhylo   -> (corpusPath    config)
-                       <> (listPath      config)
-                       <> (timeToLabel   config)
-                       <> (cliqueToLabel config)
-                       <> (sensToLabel   config)
-                       <> (seaToLabel    config)
-                       <> (syncToLabel   config)
-                       <> (qualToConfig  config)
-                       <> (show (phyloScale config))
-
-
-readListV4 :: [Char] -> IO NgramsList
-readListV4 path = do
-  listJson <- (eitherDecode <$> readJson path) :: IO (Either Prelude.String NgramsList)
-  case listJson of
-    Left err -> do
-      putStrLn err
-      Prelude.error "readListV4 unimplemented"
-    Right listV4 -> pure listV4
-
-
-fileToList  :: ListParser -> FilePath -> IO TermList
-fileToList parser path =
-  case parser of
-    V3 -> csvMapTermList path
-    V4 -> fromJust
-      <$> toTermList MapTerm NgramsTerms
-      <$> readListV4 path
-
-
---------------
--- | Main | --
---------------
-
+import Common
 
 main :: IO ()
 main = do
@@ -273,7 +70,7 @@ main = do
             corpus  <- if (defaultMode config)
                         then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
                         else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config)  mapList
-            
+
             printIOComment (show (length corpus) <> " parsed docs from the corpus")
 
             printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")

bin/install

 #!/bin/bash
 
-#stack install --nix --profile --test --fast --no-install-ghc --skip-ghc-check
-
-# Another solution to build
-# nix-shell
-# stack build
-# If you have a linker issue:
-# stack build --extra-lib-dirs=/nix/store/r3x96j3kmcs8dv4l02rrjmbhm535jycy-icu4c-72.1/lib
-
-if [[ $1 == "dev" ]] ;
-  then
-    echo "DEV install"
-    #env LANG=en_US.UTF-8 LC_ALL=en_US.UTF-8 stack --nix install --no-install-ghc --skip-ghc-check --no-haddock-deps
-  else
-    echo "PROD install (with documentation)"
-    nix-shell --run "cabal update && cabal build && cabal --overwrite-policy=always install"
-    #env LANG=C.UTF-8 stack install --haddock --nix --test --no-install-ghc --skip-ghc-check --no-haddock-deps
-fi
+echo "GarganText, build, install, test and documentation"
+nix-shell --run "cabal update                                     \\
+                 && cabal v2-build --ghc-options=-O2              \\
+                 && cabal --overwrite-policy=always install       \\
+                 && cabal v2-test --test-show-details=streaming   \\
+                 && cabal haddock"

bin/install-cabal2stack

+#!/usr/bin/env bash
+
+set -euxo pipefail
+
+current_dir=$(basename "$PWD")
+
+if [ "$current_dir" == "bin" ]; then
+    source ./setup-ci-environment
+else
+    source ./bin/setup-ci-environment
+fi
+
+cabal --store-dir=$STORE_DIR v2-update "hackage.haskell.org,${INDEX_STATE}"
+
+# Install cabal2stack if it can't be found.
+if ! cabal2stack --help &> /dev/null
+then
+    echo "cabal2stack could not be found"
+    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
+    cd $CURDIR
+    rm -rf cabal2stack-installer
+fi

bin/metrics/global/corpora.sql

+WITH total AS (SELECT * from nodes n where n.typename = 30)
+    , sum AS (SELECT count(*) AS "TOTAL" from total)
+    , increase AS (SELECT count(*) from total as t WHERE t.date >= date_trunc('month', current_date - interval '3' month))
+SELECT *,
+  (SELECT TO_CHAR((ROUND(100 * NULLIF((SELECT * from increase),0) / NULLIF((SELECT * from sum), 0))), 'fm99%')  AS "CREATED LAST 3 MONTHS")
+     FROM sum
+
+
+
+

bin/metrics/global/graphs.sql

+WITH total AS (SELECT * from nodes n where n.typename = 9)
+    , sum AS (SELECT count(*) AS "TOTAL" from total)
+    , increase AS (SELECT count(*) from total as t WHERE t.date >= date_trunc('month', current_date - interval '3' month))
+SELECT *,
+  (SELECT TO_CHAR((ROUND(100 * NULLIF((SELECT * from increase),0) / NULLIF((SELECT * from sum), 0))), 'fm99%')  AS "CREATED LAST 3 MONTHS")
+     FROM sum
+

bin/metrics/global/phylo.sql

+WITH total AS (SELECT * from nodes n where n.typename = 90)
+    , sum AS (SELECT count(*) AS "TOTAL" from total)
+    , increase AS (SELECT count(*) from total as t WHERE t.date >= date_trunc('month', current_date - interval '3' month))
+SELECT *,
+  (SELECT TO_CHAR((ROUND(100 * NULLIF((SELECT * from increase),0) / NULLIF((SELECT * from sum), 0))), 'fm99%')  AS "CREATED LAST 3 MONTHS")
+     FROM sum
+

bin/metrics/global/teams.sql

+WITH total AS (SELECT * from nodes n where n.typename = 210)
+    , sum AS (SELECT count(*) AS "TOTAL" from total)
+    , increase AS (SELECT count(*) from total as t WHERE t.date >= date_trunc('month', current_date - interval '3' month))
+SELECT *,
+  (SELECT TO_CHAR((ROUND(100 * NULLIF((SELECT * from increase),0) / NULLIF((SELECT * from sum), 0))), 'fm99%')  AS "CREATED LAST 3 MONTHS")
+     FROM sum
+
+
+
+

bin/metrics/global/users.sql

+WITH total AS (SELECT * from auth_user as A)
+    , sum AS (SELECT count(*) AS "TOTAL" from total)
+    , increase AS (SELECT count(*) from total as t WHERE t.date_joined >= date_trunc('month', current_date - interval '3' month))
+SELECT *,
+  (SELECT TO_CHAR((ROUND(100 * NULLIF((SELECT * from increase),0) / NULLIF((SELECT * from sum), 0))), 'fm99%')  AS "CREATED LAST 3 MONTHS")
+     FROM sum
+
+
+
+

bin/metrics/histo/corpora.sql

+\COPY (SELECT count(*), date_trunc('month', n.date) FROM nodes n WHERE n.typename = 30 GROUP BY 2 ORDER BY 2) TO '/tmp/corpora.csv' (FORMAT csv);
+
+

bin/metrics/histo/graphs.sql

+
+\COPY (SELECT count(*), date_trunc('month', n.date) from nodes n where n.typename = 9 group by 2 ORDER BY 2) TO '/tmp/graphs.csv' (FORMAT csv);
+

bin/metrics/histo/phylo.sql

+\COPY (select count(*), date_trunc('month', n.date) from nodes n where n.typename = 90 group by 2 ORDER BY 2) TO '/tmp/phylos.csv' (FORMAT csv);
+

bin/metrics/histo/teams.sql

+
+\COPY (select count(*), date_trunc('month', n.date) from nodes n where n.typename = 210 group by 2 ORDER BY 2) TO '/tmp/teams.csv' (FORMAT csv);
+
+
+
+
+
+

bin/metrics/histo/users.sql

+
+\COPY (select count(*), date_trunc('month', a.date_joined) from auth_user a group by 2) TO '/tmp/users.csv' (FORMAT csv);
+
+
+
+
+

bin/setup-ci-environment

+#!/usr/bin/env bash
+
+set -euxo pipefail
+
+DEFAULT_STORE=$HOME/.cabal
+STORE_DIR="${1:-$DEFAULT_STORE}"
+INDEX_STATE="2023-12-10T10:34:46Z"

bin/update-cabal-project

-#!/usr/bin/env bash
-
-set -euxo pipefail
-
-DEFAULT_STORE=$HOME/.cabal
-STORE_DIR="${1:-$DEFAULT_STORE}"
-
-# README!
-# Every time you modify the `stack.yaml` and as result the relevant `cabal.project`
-# changes, you have to make sure to update the `expected_cabal_project_hash` and
-# `expected_cabal_project_freeze_hash` 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="69e03370a602f40243373515ff884a2cd50dc02eb6f52cd23ba9016a61fe8069"
-expected_cabal_project_freeze_hash="796f0109611f3381278b1885ae1fa257c4177b99885eb04701938f1107c06ee5"
-
-cabal --store-dir=$STORE_DIR v2-update 'hackage.haskell.org,2023-11-23T20:05:40Z'
-
-# Install stack2cabal if it can't be found.
-if ! stack2cabal --help &> /dev/null
-then
-    echo "stack2cabal could not be found"
-    cabal --store-dir=$STORE_DIR v2-install --index-state="2023-11-23T20:05:40Z" stack2cabal-1.0.14 --overwrite-policy=always
-fi
-stack2cabal --no-run-hpack -p '2023-11-23 20:05:40'
-
-actual_cabal_project_hash=$(sha256sum cabal.project | awk '{printf "%s",$1}')
-actual_cabal_project_freeze_hash=$(sha256sum cabal.project.freeze | awk '{printf "%s",$1}')
-if [[ $actual_cabal_project_hash != $expected_cabal_project_hash ]]; then
-  echo "ERROR! hash mismatch between expected cabal.project and the one computed by stack2cabal."
-  exit 1
-else
-  echo "cabal.project updated successfully."
-fi
-if [[ $actual_cabal_project_freeze_hash != $expected_cabal_project_freeze_hash ]]; then
-  echo "ERROR! hash mismatch between expected cabal.project.freeze and the one computed by stack2cabal."
-  exit 1
-else
-  echo "cabal.project.freeze updated successfully."
-fi

bin/update-project-dependencies

+#!/usr/bin/env bash
+
+set -euxo pipefail
+
+current_dir=$(basename "$PWD")
+
+if [ "$current_dir" == "bin" ]; then
+    source ./setup-ci-environment
+    ./install-cabal2stack
+else
+    source ./bin/setup-ci-environment
+    ./bin/install-cabal2stack
+fi
+
+# README!
+# Every time you modify the `cabal.project`, you have to make sure to update
+# the `expected_cabal_project_hash` and `expected_cabal_project_freeze_hash`
+# 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="1cbb47fd3f929a01b3b968cc2e148dcbf5ef4e662e14ed9832d32471a68f6766"
+expected_cabal_project_freeze_hash="2c8960ffcf1b94aa11a3543e3b5facd2db5af19569fecaec4bc0ab4c1edd22a5"
+
+cabal --store-dir=$STORE_DIR v2-build --dry-run
+cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
+cabal --store-dir=$STORE_DIR v2-freeze
+
+# 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.
+echo -e "\e[33mPatching cabal.project.freeze to remove redundant constraint on gargantext\e[0m"
+sed -i '/^ *gargantext/d' cabal.project.freeze
+
+actual_cabal_project_hash=$(sha256sum cabal.project | awk '{printf "%s",$1}')
+actual_cabal_project_freeze_hash=$(sha256sum cabal.project.freeze | awk '{printf "%s",$1}')
+if [[ $actual_cabal_project_hash != $expected_cabal_project_hash ]]; then
+  echo -e "\e[31mERROR! hash mismatch between expected cabal.project and the one computed by cabal2stack.\e[0m"
+  echo -e "\e[33mPlease update the hashes inside the './bin/update-project-dependencies' file.\e[0m"
+  exit 1
+else
+  echo -e "\e[32mstack.yaml updated successfully.\e[0m"
+fi
+if [[ $actual_cabal_project_freeze_hash != $expected_cabal_project_freeze_hash ]]; then
+  echo -e "\e[31mERROR! hash mismatch between expected cabal.project.freeze and the one computed by cabal2stack.\e[0m"
+  echo -e "\e[33mPlease update the hashes inside the './bin/update-project-dependencies' file.\e[0m"
+  exit 1
+else
+  echo -e "\e[32mcabal.project.freeze updated successfully.\e[0m"
+fi

cabal.project

 -- Generated by stack2cabal
 
-index-state: 2023-12-04T09:05:40Z
+index-state: 2023-12-10T10:34:46Z
 
-with-compiler: ghc-8.10.7
+with-compiler: ghc-9.4.7
 
 packages:
     ./
 
+source-repository-package
+    type: git
+    location: https://github.com/AccelerateHS/accelerate.git
+    tag: 334d05519436bb7f20f9926ec76418f5b8afa359
+
+source-repository-package
+    type: git
+    location: https://github.com/AccelerateHS/accelerate-llvm.git
+    tag: 2b5d69448557e89002c0179ea1aaf59bb757a6e3
+    subdir: accelerate-llvm-native/
+            accelerate-llvm/
+
 source-repository-package
     type: git
     location: https://github.com/adinapoli/boolexpr.git
@@ -14,30 +26,35 @@ source-repository-package
 
 source-repository-package
     type: git
-    location: https://github.com/adinapoli/haskell-opaleye.git
-    tag: e9a29582ac66198dd2c2fdc3f8c8a4b1e6fbe004
+    location: https://github.com/adinapoli/duckling.git
+    tag: 23603a832117e5352d5b0fb9bb1110228324b35a
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/accelerate.git
-    tag: 640b5af87cea94b61c7737d878e6f7f2fca5c015
+    location: https://github.com/garganscript/haskell-opaleye.git
+    tag: 6cf1bcfe215143efac17919cfd0abdd60e0f717c
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/accelerate-arithmetic.git
-    tag: a110807651036ca2228a76507ee35bbf7aedf87a
+    location: https://github.com/adinapoli/llvm-hs.git
+    tag: 7533a9ccd3bfe77141745f6b61039a26aaf5c83b
+    subdir: llvm-hs
+            llvm-hs-pure
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/accelerate-llvm.git
-    tag: 944f5a4aea35ee6aedb81ea754bf46b131fce9e3
-    subdir: accelerate-llvm-native/
-            accelerate-llvm/
+    location: https://github.com/adinapoli/text16-compat.git
+    tag: 85533b5d597e6fc5498411b4bcfc76380ec80d71
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/ekg-json.git
-    tag: fd7e5d7325939103cd87d0dc592faf644160341c
+    location: https://github.com/adinapoli/wikiparsec.git
+    tag: b3519a0351ae9515497680571f76200c24dedb53
+
+source-repository-package
+    type: git
+    location: https://github.com/alpmestan/accelerate-arithmetic.git
+    tag: a110807651036ca2228a76507ee35bbf7aedf87a
 
 source-repository-package
     type: git
@@ -56,6 +73,11 @@ source-repository-package
     tag: bc6ca8058077b0b5702ea4b88bd4189cfcad267a
     subdir: sparse-linear
 
+source-repository-package
+    type: git
+    location: https://github.com/chessai/eigen.git
+    tag: 8fff32a43df743c8c83428a86dd566a0936a4fba
+
 source-repository-package
     type: git
     location: https://github.com/delanoe/data-time-segment.git
@@ -71,11 +93,6 @@ source-repository-package
     location: https://gitlab.iscpif.fr/amestanogullari/accelerate-utility.git
     tag: a3875fe652d3bb5acb522674c22c6c814c1b4ad0
 
-source-repository-package
-    type: git
-    location: https://gitlab.iscpif.fr/cgenie/patches-class.git
-    tag: 125c7cb90ab8f0cd6ac4a526dbdf302d10c945e9
-
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
@@ -89,27 +106,27 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-    tag: 25a1e9558075462a82660987920a698b8863dd63
+    tag: bfa9069b4ff70f341ca3244e8aff9e83eb4b8b73
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git
-    tag: 3db385e767d2100d8abe900833c6e7de3ac55e1b
+    tag: e9b594a4718acc06db037f6d3f429a90db76c267
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
-    tag: c1aba6034ceddcd1cdd0378c3841068c96accca7
+    tag: c0a08d62c40a169b7934ceb7cb12c39952160e7a
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/openalex.git
-    tag: 35a95e7e8da655f868d5420aa29e835a813fa3a2
+    tag: ceb8f2cebd4890b6d9d151ab01ee14e925bc0499
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git
-    tag: 234ad423fa682307ff4843ae4acd725dcc6ffc55
+    tag: 300764df4f78ea6175535f9b78b884cc2aa9da61
 
 source-repository-package
     type: git
@@ -119,12 +136,12 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
-    tag: 5a8dc3a0a1a4774ec2eb9df5f0f0b0a7dd172f09
+    tag: 618f711a530df56caefbb1577c4bf3d5ff45e214
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/haskell-igraph.git
-    tag: 2a28524134b68421f30f6e97961063018f814a82
+    tag: 9f8a2f4a014539826a4eab3215cc70c0813f20cb
 
 source-repository-package
     type: git
@@ -143,37 +160,32 @@ source-repository-package
 
 source-repository-package
     type: git
-    location: https://github.com/haskell-servant/servant.git
-    tag: c2af6e775d1d36f2011d43aff230bb502f8fba63
-    subdir: servant-auth/servant-auth-client/
-            servant-auth/servant-auth-server/
-            servant-auth/servant-auth/
-            servant-client-core/
-            servant-client/
-            servant-server/
-            servant/
+    location: https://gitlab.iscpif.fr/gargantext/patches-class.git
+    tag: 3668d28607867a88b2dfc62158139b3cfd629ddb
 
 source-repository-package
     type: git
-    location: https://github.com/robstewart57/rdf4h.git
-    tag: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
+    location: https://gitlab.iscpif.fr/gargantext/servant-xml-conduit.git
+    tag: 339fd608341bd2652cf5c0e9e76a3293acffbea6
+
+source-repository-package
+    type: git
+    location: https://github.com/MercuryTechnologies/ekg-json.git
+    tag: 232db57d6ce0940fcc902adf30a9ed3f3561f21d
 
 source-repository-package
     type: git
-    location: https://github.com/rspeer/wikiparsec.git
-    tag: 9637a82344bb70f7fa8f02e75db3c081ccd434ce
+    location: https://github.com/robstewart57/rdf4h.git
+    tag: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
 
 allow-older: *
 allow-newer: *
 
 package gargantext
     ghc-options: -fwrite-ide-info -hiedir=".stack-work/hiedb"
-
-package gargantext-graph
-    ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal  -fno-state-hack
-
+    
 package hmatrix
-    ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal  -fno-state-hack
+    ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal -fno-state-hack
 
 package sparse-linear
-    ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal  -fno-state-hack
+    ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal -fno-state-hack

devops/docker/Dockerfile

-FROM ubuntu:jammy
+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=8.10.7
-ARG STACK=2.7.3
-ARG CABAL=3.10.1.0
+ARG GHC=9.4.7
 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-22.05.nix                            /builds/gargantext/nix/pinned-22.05.nix
-COPY ./nix/overlays/Cabal-3.10.1.0.nix                 /builds/gargantext/nix/overlays/Cabal-3.10.1.0.nix
-COPY ./nix/overlays/cabal-install-3.10.1.0.nix         /builds/gargantext/nix/overlays/cabal-install-3.10.1.0.nix
-COPY ./nix/overlays/cabal-install-solver-3.10.1.0.nix  /builds/gargantext/nix/overlays/cabal-install-solver-3.10.1.0.nix
-COPY ./nix/overlays/Cabal-syntax-3.10.1.0.nix          /builds/gargantext/nix/overlays/Cabal-syntax-3.10.1.0.nix
-COPY ./nix/overlays/directory-1.3.7.0.nix              /builds/gargantext/nix/overlays/directory-1.3.7.0.nix
-COPY ./nix/overlays/hackage-security-0.6.2.3.nix       /builds/gargantext/nix/overlays/hackage-security-0.6.2.3.nix
-COPY ./nix/overlays/process-1.6.15.0.nix               /builds/gargantext/nix/overlays/process-1.6.15.0.nix
+COPY ./nix/pinned-23.11.nix                            /builds/gargantext/nix/pinned-23.11.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
 RUN apt-get update && \
@@ -34,13 +27,13 @@ RUN apt-get update && \
       git \
       gnupg2 \
       libffi-dev \
-      libffi7 \
+      libffi8 \
       libgmp-dev \
       libgmp10 \
       libncurses-dev \
-      libncurses5 \
+      libncurses6 \
       libnuma-dev \
-      libtinfo5 \
+      libtinfo6 \
       locales \
       lsb-release \
       software-properties-common \
@@ -50,7 +43,7 @@ RUN apt-get update && \
       vim \
       xz-utils \
       zlib1g-dev \
-      openjdk-18-jdk \
+      openjdk-21-jdk \
       unzip && \
     apt-get clean && rm -rf /var/lib/apt/lists/* && \
     mkdir -m 0755 /nix && groupadd -r nixbld && chown root /nix && \
@@ -80,5 +73,6 @@ RUN . $HOME/.bashrc && nix-env --version
 
 ENV PATH=/root/.local/bin:$PATH
 
-RUN cd /builds/gargantext && nix-shell
+RUN cd /builds/gargantext && nix-shell --run "./bin/install-cabal2stack"
 WORKDIR "/builds/gargantext/"
+

gargantext-cors-settings.toml

+allowed-origins = [
+    "https://demo.gargantext.org"
+  , "https://formation.gargantext.org"
+  , "https://academia.sub.gargantext.org"
+  , "https://cnrs.gargantext.org"
+  , "https://imt.sub.gargantext.org"
+  , "https://helloword.gargantext.org"
+  , "https://complexsystems.gargantext.org"
+  , "https://europa.gargantext.org"
+  , "https://earth.sub.gargantext.org"
+  , "https://health.sub.gargantext.org"
+  , "https://msh.sub.gargantext.org"
+  , "https://dev.sub.gargantext.org"
+  , "http://localhost:8008"
+  ]
+
+use-origins-for-hosts = true

gargantext.ini_toModify

@@ -40,6 +40,9 @@ FRAME_ISTEX_URL  = URL_TO_CHANGE
 MAX_DOCS_PARSERS = 1000000
 MAX_DOCS_SCRAPERS = 10000
 
+# Specific Services
+EPO_API_URL =
+
 # in seconds
 JS_JOB_TIMEOUT = 1800
 JS_ID_TIMEOUT = 1800

nix/pinned-23.05.nix

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

nix/pinned-23.11.nix

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

nix/pkgs.nix

-{ pkgs       ? import ./pinned-22.05.nix {} }:
+{ pkgs       ? import ./pinned-23.11.nix {} }:
 
 rec {
   inherit pkgs;
-  # If we are on a Mac, in order to build successfully with cabal we need a bit more work.
-  ghc = if pkgs.stdenv.isDarwin
-           then haskell1.compiler.ghc8107.overrideAttrs (finalAttrs: previousAttrs: {
-                # See https://github.com/NixOS/nixpkgs/pull/149942/files
+  ghc947 = if pkgs.stdenv.isDarwin
+           then pkgs.haskell.compiler.ghc947.overrideAttrs (finalAttrs: previousAttrs: {
                 patches = previousAttrs.patches ++ [
                             # Reverts the linking behavior of GHC to not resolve `-libc++` to `c++`.
                             (pkgs.fetchpatch {
-                              url = "https://raw.githubusercontent.com/input-output-hk/haskell.nix/613ec38dbd62ab7929178c9c7ffff71df9bb86be/overlays/patches/ghc/ghc-macOS-loadArchive-fix.patch";
-                              sha256 = "0IUpuzjZb1G+gP3q6RnwQbW4mFzc/OZ/7QqZy+57kx0=";
+                              url = "https://gist.githubusercontent.com/adinapoli/bf722db15f72763bf79dff13a3104b6f/raw/362da0aa3db5c530e0d276183ba68569f216d65a/ghc947-macOS-loadArchive-fix.patch";
+                              sha256 = "sha256-0tHrkWRKFWUewj3uIA0DujVCXo1qgX2lA5p0MIsAHYs=";
                             })
                           ];
                 })
-           else pkgs.haskell.compiler.ghc8107;
+           else pkgs.haskell.compiler.ghc947;
+  cabal_install_3_10_1_0 = pkgs.haskell.lib.compose.justStaticExecutables pkgs.haskell.packages.ghc947.cabal-install;
   graphviz = pkgs.graphviz.overrideAttrs (finalAttrs: previousAttrs: {
                 # Increase the YY_BUF_SIZE, see https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/290#note_9015
                 patches = [
@@ -24,26 +23,12 @@ rec {
                             })
                           ];
                 });
-  haskell1 = pkgs.haskell // {
-      packages = pkgs.haskell.packages // {
-        ghc8107 = pkgs.haskell.packages.ghc8107.override {
-          overrides = self: super: {
-            directory            = self.callPackage ./overlays/directory-1.3.7.0.nix {};
-            process              = self.callPackage ./overlays/process-1.6.15.0.nix {};
-            hackage-security     = self.callPackage ./overlays/hackage-security-0.6.2.3.nix {};
-            Cabal                = self.callPackage ./overlays/Cabal-3.10.1.0.nix {};
-            Cabal-syntax         = self.callPackage ./overlays/Cabal-syntax-3.10.1.0.nix {};
-            cabal-install-solver = self.callPackage ./overlays/cabal-install-solver-3.10.1.0.nix {};
-            cabal-install        = self.callPackage ./overlays/cabal-install-3.10.1.0.nix {};
-          };
-        };
-      };
-  };
-  cabal_install_3_10_1_0 = pkgs.haskell.lib.compose.justStaticExecutables haskell1.packages.ghc8107.cabal-install;
 
   igraph_0_10_4 = pkgs.igraph.overrideAttrs (finalAttrs: previousAttrs: {
     version = "0.10.4";
 
+    nativeBuildInputs = previousAttrs.nativeBuildInputs or [] ++ [ pkgs.clang_12 ];
+
     src = pkgs.fetchFromGitHub {
       owner = "igraph";
       repo = "igraph";
@@ -77,7 +62,7 @@ rec {
       "-DIGRAPH_USE_INTERNAL_GMP=OFF"
       "-DIGRAPH_USE_INTERNAL_PLFIT=OFF"
       "-DIGRAPH_GLPK_SUPPORT=ON"
-      "-DIGRAPH_GRAPHML_SUPPORT=ON"
+      "-DIGRAPH_GRAPHML_SUPPORT=OFF"
       "-DIGRAPH_OPENMP_SUPPORT=ON"
       "-DIGRAPH_ENABLE_LTO=AUTO"
       "-DIGRAPH_ENABLE_TLS=ON"
@@ -97,8 +82,11 @@ rec {
 
   });
   hsBuildInputs = [
-    ghc
+    ghc947
     cabal_install_3_10_1_0
+    pkgs.haskellPackages.alex
+    pkgs.haskellPackages.happy
+    pkgs.haskellPackages.pretty-show
   ];
   nonhsBuildInputs = with pkgs; [
     bzip2
@@ -113,20 +101,23 @@ rec {
     lapack
     lzma
     pcre
-    pkgconfig
+    pkg-config
     postgresql
     xz
     zlib
     blas
     gfortran7
-    #    gfortran7.cc.lib
     expat
     icu
     graphviz
-    llvm_9
+    clang_12
+    llvm_12
+    gcc12
     igraph_0_10_4
     libpqxx
     libsodium
+    zeromq
+    curl
   ] ++ ( lib.optionals stdenv.isDarwin [
        darwin.apple_sdk.frameworks.Accelerate
        ]);
@@ -134,8 +125,11 @@ rec {
   shellHook = ''
     export LD_LIBRARY_PATH="${pkgs.gfortran7.cc.lib}:${libPaths}:$LD_LIBRARY_PATH"
     export LIBRARY_PATH="${pkgs.gfortran7.cc.lib}:${libPaths}"
+    export PATH="${pkgs.gccStdenv}/bin:$PATH"
+    export NIX_CC="${pkgs.gccStdenv}"
+    export CC="${pkgs.gccStdenv}/bin/gcc"
   '';
-  shell = pkgs.mkShell {
+  shell = pkgs.mkShell.override { stdenv = pkgs.gccStdenv; } {
     name = "gargantext-shell";
     buildInputs = hsBuildInputs ++ nonhsBuildInputs;
     inherit shellHook;

src/Gargantext/API.hs

@@ -38,17 +38,18 @@ import Control.Concurrent
 import Control.Lens hiding (Level)
 import Data.List (lookup)
 import Data.Text (pack)
+import Data.Text.Encoding qualified as TE
 import Data.Text.IO (putStrLn)
 import Data.Validity
 import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
 import Gargantext.API.Admin.Settings (newEnv)
-import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
+import Gargantext.API.Admin.Settings.CORS
+import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings)
 import Gargantext.API.EKG
-import Gargantext.API.Ngrams (saveNodeStoryImmediate)
+import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Routes
 import Gargantext.API.Server (server)
-import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude qualified as DB
 import Gargantext.Prelude hiding (putStrLn)
 import Gargantext.System.Logging
@@ -58,7 +59,7 @@ import Network.Wai.Handler.Warp hiding (defaultSettings)
 import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.RequestLogger
 import Paths_gargantext (getDataDir)
-import Servant
+import Servant hiding (Header)
 import System.Cron.Schedule qualified as Cron
 import System.FilePath
 
@@ -69,9 +70,9 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
   runDbCheck env
   portRouteInfo port
   app <- makeApp env
-  mid <- makeDevMiddleware mode
+  mid <- makeGargMiddleware (env ^. settings.corsSettings) mode
   periodicActions <- schedulePeriodicActions env
-  run port (mid app) `finally` stopGargantext env periodicActions
+  run port (mid app) `finally` stopGargantext periodicActions
 
   where runDbCheck env = do
           r <- runExceptT (runReaderT DB.dbCheck env) `catch`
@@ -91,19 +92,10 @@ portRouteInfo port = do
 -- | Stops the gargantext server and cancels all the periodic actions
 -- scheduled to run up to that point.
 -- TODO clean this Monad condition (more generic) ?
-stopGargantext :: HasNodeStoryImmediateSaver env => env -> [ThreadId] -> IO ()
-stopGargantext env scheduledPeriodicActions = do
+stopGargantext :: [ThreadId] -> IO ()
+stopGargantext scheduledPeriodicActions = do
   forM_ scheduledPeriodicActions killThread
   putStrLn "----- Stopping gargantext -----"
-  runReaderT saveNodeStoryImmediate env
-
-{-
-startGargantextMock :: PortNumber -> IO ()
-startGargantextMock port = do
-  portRouteInfo port
-  application <- makeMockApp . MockEnv $ FireWall False
-  run port application
--}
 
 -- | Schedules all sorts of useful periodic actions to be run while
 -- the server is alive accepting requests.
@@ -144,94 +136,30 @@ fireWall req fw = do
        then pure True
        else pure False
 
-{-
--- makeMockApp :: Env -> IO (Warp.Settings, Application)
-makeMockApp :: MockEnv -> IO Application
-makeMockApp env = do
-    let serverApp = appMock
-
-    -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
-    --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
-    let checkOriginAndHost app req resp = do
-            blocking <- fireWall req (env ^. menv_firewall)
-            case blocking  of
-                True  -> app req resp
-                False -> resp ( responseLBS status401 []
-                              "Invalid Origin or Host header")
-
-    let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
---          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
-            { corsOrigins        = Nothing --  == /*
-            , corsMethods        = [ methodGet   , methodPost   , methodPut
-                                   , methodDelete, methodOptions, methodHead]
-            , corsRequestHeaders = ["authorization", "content-type"]
-            , corsExposedHeaders = Nothing
-            , corsMaxAge         = Just ( 60*60*24 ) -- one day
-            , corsVaryOrigin     = False
-            , corsRequireOrigin  = False
+makeGargMiddleware :: CORSSettings -> Mode -> IO Middleware
+makeGargMiddleware crsSettings mode = do
+    let corsMiddleware = cors $ \_incomingRq -> Just
+          simpleCorsResourcePolicy
+            { corsOrigins = Just (map mkCorsOrigin (crsSettings ^. corsAllowedOrigins), True)
+            , corsMethods = [ methodGet   , methodPost   , methodPut
+                            , methodDelete, methodOptions, methodHead]
             , corsIgnoreFailures = False
-            }
-
-    --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
-    --          $ Warp.defaultSettings
-
-    --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
-    pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
--}
-
-
-makeDevMiddleware :: Mode -> IO Middleware
-makeDevMiddleware mode = do
--- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
--- logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
---    let checkOriginAndHost app req resp = do
---            blocking <- fireWall req (env ^. menv_firewall)
---            case blocking  of
---                True  -> app req resp
---                False -> resp ( responseLBS status401 []
---                              "Invalid Origin or Host header")
---
-    let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
---          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
-            { corsOrigins        = Nothing --  == /*
-            , corsMethods        = [ methodGet   , methodPost   , methodPut
-                                   , methodDelete, methodOptions, methodHead]
-            , corsRequestHeaders = ["authorization", "content-type"]
-            , corsExposedHeaders = Nothing
+            , corsRequestHeaders = ["authorization", "content-type", "x-garg-error-scheme"]
             , corsMaxAge         = Just ( 60*60*24 ) -- one day
-            , corsVaryOrigin     = False
-            , corsRequireOrigin  = False
-            , corsIgnoreFailures = False
             }
-
-    --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
-    --          $ Warp.defaultSettings
-
-    --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
     case mode of
       Prod -> pure $ logStdout . corsMiddleware
-      _    -> pure $ logStdoutDev . corsMiddleware
+      _    -> do
+        loggerMiddleware <- logStdoutDevSanitised
+        pure $ loggerMiddleware . corsMiddleware
+  where
+    mkCorsOrigin :: CORSOrigin -> Origin
+    mkCorsOrigin = TE.encodeUtf8 . _CORSOrigin
 
 ---------------------------------------------------------------------
 -- | API Global
 ---------------------------------------------------------------------
 
----------------------------
-
-
--- TODO-SECURITY admin only: withAdmin
--- Question: How do we mark admins?
-{-
-serverGargAdminAPI :: GargServer GargAdminAPI
-serverGargAdminAPI =  roots
-                 :<|> nodesAPI
--}
-
----------------------------------------------------------------------
---gargMock :: Server GargAPI
---gargMock = mock apiGarg Proxy
----------------------------------------------------------------------
-
 makeApp :: Env -> IO Application
 makeApp env = do
   serv <- server env
@@ -243,11 +171,8 @@ makeApp env = do
     cfg :: Servant.Context AuthContext
     cfg = env ^. settings . jwtSettings
        :. env ^. settings . cookieSettings
-    -- :. authCheck env
        :. EmptyContext
 
---appMock :: Application
---appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 ---------------------------------------------------------------------
 api :: Proxy API
 api  = Proxy
@@ -258,19 +183,3 @@ apiWithEkg = Proxy
 apiGarg :: Proxy GargAPI
 apiGarg  = Proxy
 ---------------------------------------------------------------------
-
-{- UNUSED
---import GHC.Generics (D1, Meta (..), Rep, Generic)
---import GHC.TypeLits (AppendSymbol, Symbol)
----------------------------------------------------------------------
--- Type Family for the Documentation
-type family TypeName (x :: *) :: Symbol where
-    TypeName Int  = "Int"
-    TypeName Text = "Text"
-    TypeName x    = GenericTypeName x (Rep x ())
-
-type family GenericTypeName t (r :: *) :: Symbol where
-    GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
-
-type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
--}

src/Gargantext/API/Admin/Auth.hs

@@ -119,9 +119,11 @@ auth :: (HasSettings env, HasAuthenticationError err, DbCmd' env err m)
 auth (AuthRequest u p) = do
   checkAuthRequest' <- checkAuthRequest u p
   case checkAuthRequest' of
-    InvalidUser     -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid username or password")
-    InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid username or password")
-    Valid to trId uId   -> pure $ AuthResponse (Just $ AuthValid to trId uId) Nothing
+    InvalidUser     -> do
+      throwError $ _AuthenticationError # InvalidUsernameOrPassword
+    InvalidPassword -> do
+      throwError $ _AuthenticationError # InvalidUsernameOrPassword
+    Valid to trId uId   -> pure $ AuthResponse to trId uId
 
 --type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
 

src/Gargantext/API/Admin/Auth/Types.hs

@@ -23,7 +23,7 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId, UserId (..))
 import Gargantext.Prelude hiding (reverse)
 import Servant.Auth.Server
-import Test.QuickCheck (elements, oneof)
+import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Crypto.JWT as Jose
 
@@ -35,21 +35,12 @@ data AuthRequest = AuthRequest { _authReq_username :: Username
                                }
   deriving (Generic)
 
--- TODO: Use an HTTP error to wrap AuthInvalid
-data AuthResponse = AuthResponse { _authRes_valid :: Maybe AuthValid
-                                 , _authRes_inval :: Maybe AuthInvalid
+data AuthResponse = AuthResponse { _authRes_token   :: Token
+                                 , _authRes_tree_id :: TreeId
+                                 , _authRes_user_id :: UserId
                                  }
   deriving (Generic, Eq, Show)
 
-data AuthInvalid = AuthInvalid { _authInv_message :: Text }
-  deriving (Generic, Eq, Show)
-
-data AuthValid = AuthValid { _authVal_token   :: Token
-                           , _authVal_tree_id :: TreeId
-                           , _authVal_user_id :: UserId
-                           }
-  deriving (Generic, Eq, Show)
-
 type Token  = Text
 type TreeId = NodeId
 
@@ -61,25 +52,21 @@ data AuthenticatedUser = AuthenticatedUser
   , _auth_user_id :: UserId
   } deriving (Generic)
 
-$(deriveJSON (JSON.defaultOptions { JSON.fieldLabelModifier = tail . dropWhile ((/=) '_') . tail }) ''AuthenticatedUser)
-
 makeLenses ''AuthenticatedUser
 
 instance ToSchema AuthenticatedUser where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
 
-instance ToJWT AuthenticatedUser
-instance FromJWT AuthenticatedUser
-
 data AuthenticationError
   = LoginFailed NodeId UserId Jose.Error
+  | InvalidUsernameOrPassword
+  | UserNotAuthorized UserId Text
   deriving (Show, Eq)
 
 -- TODO-SECURITY why is the CookieSettings necessary?
 type AuthContext = '[JWTSettings, CookieSettings] -- , BasicAuthCfg
 
 -- | Instances
-$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
 instance ToSchema AuthRequest where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
 
@@ -89,26 +76,10 @@ instance Arbitrary AuthRequest where
                        , p <- arbitraryPassword
                        ]
 
-$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
 instance ToSchema AuthResponse where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
 instance Arbitrary AuthResponse where
-  arbitrary = oneof [ AuthResponse Nothing . Just      <$> arbitrary
-                    , flip AuthResponse Nothing . Just <$> arbitrary ]
-
-$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
-instance ToSchema AuthInvalid where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
-instance Arbitrary AuthInvalid where
-  arbitrary = elements [ AuthInvalid m
-                       | m <- [ "Invalid user", "Invalid password"]
-                       ]
-
-$(deriveJSON (unPrefix "_authVal_") ''AuthValid)
-instance ToSchema AuthValid where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
-instance Arbitrary AuthValid where
-  arbitrary = elements [ AuthValid to' tr u
+  arbitrary = elements [ AuthResponse to' tr u
                        | to' <- ["token0", "token1"]
                        , tr <- map UnsafeMkNodeId [1..3]
                        , u <-  map UnsafeMkUserId [1..3]
@@ -124,21 +95,39 @@ type Password = Text
 
 data ForgotPasswordRequest = ForgotPasswordRequest { _fpReq_email :: Email }
   deriving (Generic )
-$(deriveJSON (unPrefix "_fpReq_") ''ForgotPasswordRequest)
 instance ToSchema ForgotPasswordRequest where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpReq_")
 
 data ForgotPasswordResponse = ForgotPasswordResponse { _fpRes_status :: Text }
   deriving (Generic )
-$(deriveJSON (unPrefix "_fpRes_") ''ForgotPasswordResponse)
 instance ToSchema ForgotPasswordResponse where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpRes_")
 
 data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
   deriving (Generic )
-$(deriveJSON (unPrefix "_fpGet_") ''ForgotPasswordGet)
 instance ToSchema ForgotPasswordGet where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_")
 
-makeLenses ''AuthValid
+--
+-- Lenses
+--
+
 makeLenses ''AuthResponse
+
+--
+-- JSON instances
+--
+
+$(deriveJSON (JSON.defaultOptions { JSON.fieldLabelModifier = tail . dropWhile ((/=) '_') . tail }) ''AuthenticatedUser)
+$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
+$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
+$(deriveJSON (unPrefix "_fpReq_") ''ForgotPasswordRequest)
+$(deriveJSON (unPrefix "_fpRes_") ''ForgotPasswordResponse)
+$(deriveJSON (unPrefix "_fpGet_") ''ForgotPasswordGet)
+
+--
+-- JWT instances
+--
+
+instance ToJWT AuthenticatedUser
+instance FromJWT AuthenticatedUser

src/Gargantext/API/Admin/EnvTypes.hs

@@ -136,9 +136,6 @@ instance HasConnectionPool Env where
 instance HasNodeStoryEnv Env where
   hasNodeStory = env_nodeStory
 
-instance HasNodeStoryVar Env where
-  hasNodeStoryVar = hasNodeStory . nse_getter
-
 instance HasNodeStoryImmediateSaver Env where
   hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
 
@@ -314,9 +311,6 @@ instance HasSettings DevEnv where
 instance HasNodeStoryEnv DevEnv where
   hasNodeStory = dev_env_nodeStory
 
-instance HasNodeStoryVar DevEnv where
-  hasNodeStoryVar = hasNodeStory . nse_getter
-
 instance HasNodeStoryImmediateSaver DevEnv where
   hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
 

src/Gargantext/API/Admin/Settings.hs

@@ -24,9 +24,11 @@ import Control.Lens
 import Control.Monad.Logger (LogLevel(..))
 import Control.Monad.Reader
 import Data.ByteString.Lazy qualified as L
-import Data.Pool (Pool, createPool)
+import Data.Pool (Pool)
+import qualified Data.Pool as Pool
 import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Settings.CORS
 import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
@@ -56,9 +58,9 @@ devSettings jwkFile = do
   jwkExists <- doesFileExist jwkFile
   when (not jwkExists) $ writeKey jwkFile
   jwk       <- readKey jwkFile
+  gargCorsSettings <- loadGargCorsSettings
   pure $ Settings
-    { _allowedOrigin = "http://localhost:8008"
-    , _allowedHost = "localhost:3000"
+    { _corsSettings = gargCorsSettings
     , _appPort = 3000
     , _logLevelLimit = LevelDebug
 --    , _dbServer = "localhost"
@@ -217,7 +219,7 @@ newEnv logger port file = do
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)
-newPool param = createPool (connect param) close 1 (60*60) 8
+newPool param = Pool.newPool $ Pool.setNumStripes (Just 1) $ Pool.defaultPoolConfig (connect param) close (60*60) 8
 
 {-
 cleanEnv :: (HasConfig env, HasRepo env) => env -> IO ()

src/Gargantext/API/Admin/Settings/CORS.hs

+{--| Support in Gargantext for CORS (Cross-origin resource sharing) --}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Gargantext.API.Admin.Settings.CORS where
+
+import Prelude
+
+import Data.Text qualified as T
+import Toml
+import Gargantext.System.Logging
+import Paths_gargantext
+import Data.String
+import Control.Arrow
+import Control.Lens.TH
+
+newtype CORSOrigin = CORSOrigin { _CORSOrigin :: T.Text }
+  deriving (Show, Eq, IsString)
+
+data CORSSettings =
+  CORSSettings {
+    _corsAllowedOrigins :: [CORSOrigin]
+  , _corsAllowedHosts   :: [CORSOrigin]
+  -- | If 'True', we will reuse the origin whitelist
+  -- as the allowed hosts as well. This allows, for example,
+  -- to connect from \"demo.gargantext.org\" to \"dev.sub.gargantext.org\"
+  -- and vice-versa.
+  , _corsUseOriginsForHosts :: !Bool
+  } deriving (Show, Eq)
+
+corsOriginCodec :: TomlBiMap CORSOrigin AnyValue
+corsOriginCodec = _Orig >>> _Text
+  where
+   _Orig :: BiMap e CORSOrigin T.Text
+   _Orig = iso _CORSOrigin CORSOrigin
+
+corsSettingsCodec :: TomlCodec CORSSettings
+corsSettingsCodec = CORSSettings <$> (Toml.arrayOf corsOriginCodec "allowed-origins" .= _corsAllowedOrigins)
+                                 <*> pure mempty -- FIXME(adn) Currently we don't need to support this field.
+                                 <*> Toml.bool "use-origins-for-hosts" .= _corsUseOriginsForHosts
+
+-- | Loads the 'CORSSettings' from the 'toml' file.
+loadGargCorsSettings :: IO CORSSettings
+loadGargCorsSettings = do
+  corsFile <- getDataFileName "gargantext-cors-settings.toml"
+  tomlRes <- Toml.decodeFileEither corsSettingsCodec corsFile
+  case tomlRes of
+      Left errs      -> do
+        withLogger () $ \ioLogger -> do
+          logMsg ioLogger WARNING $ T.unpack $ "Error, gargantext-cors-settings.toml parsing failed: " <> Toml.prettyTomlDecodeErrors errs
+          pure $ CORSSettings ["http://localhost:8008"] ["http://localhost:3000"] False
+      Right settings0 -> case _corsUseOriginsForHosts settings0 of
+        True  -> pure $ settings0 { _corsAllowedHosts = "http://localhost:3000" : (_corsAllowedOrigins settings0) }
+        False -> pure $ settings0 { _corsAllowedHosts = "http://localhost:3000" : (_corsAllowedHosts settings0) }
+
+
+makeLenses ''CORSSettings

src/Gargantext/API/Admin/Types.hs

--- |
-
 {-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Admin.Types where
@@ -7,6 +5,7 @@ module Gargantext.API.Admin.Types where
 import Control.Lens
 import Control.Monad.Logger (LogLevel)
 import GHC.Enum
+import Gargantext.API.Admin.Settings.CORS
 import Gargantext.Prelude
 import Servant.Auth.Server (JWTSettings, CookieSettings(..))
 import Servant.Client (BaseUrl)
@@ -20,8 +19,7 @@ data SendEmailType = SendEmailViaAws
     deriving (Show, Read, Enum, Bounded, Generic)
 
 data Settings = Settings
-    { _allowedOrigin   :: !ByteString   -- allowed origin for CORS
-    , _allowedHost     :: !ByteString   -- allowed host for CORS
+    { _corsSettings    :: !CORSSettings   -- CORS settings
     , _appPort         :: !PortNumber
     , _logLevelLimit   :: !LogLevel -- log level from the monad-logger package
 --    , _dbServer        :: Text

src/Gargantext/API/Count.hs

@@ -104,18 +104,12 @@ messages =  toMessage $ [ (400, ["Ill formed query             "])
 instance Arbitrary Message where
     arbitrary = elements messages
 
-instance FromJSON Message
-instance ToJSON   Message
-
 instance ToSchema Message
 -----------------------------------------------------------------------
 data Counts = Counts { results :: [Either Message Count]
                      } deriving (Eq, Show, Generic)
 
 
-instance FromJSON Counts
-instance ToJSON   Counts
-
 instance Arbitrary Counts where
     arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
                                  , Right (Count IsTex  (Just 150))
@@ -131,8 +125,6 @@ data Count = Count { count_name    :: Scraper
                    }
                    deriving (Eq, Show, Generic)
 
-$(deriveJSON (unPrefix "count_") ''Count)
-
 instance ToSchema Count where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
 --instance Arbitrary Count where
@@ -141,3 +133,16 @@ instance ToSchema Count where
 -----------------------------------------------------------------------
 count :: Monad m => Query -> m Counts
 count _ = undefined
+
+--
+-- JSON instances
+--
+
+instance FromJSON Message
+instance ToJSON   Message
+
+$(deriveJSON (unPrefix "count_") ''Count)
+
+instance FromJSON Counts
+instance ToJSON   Counts
+

src/Gargantext/API/Dev.hs

@@ -12,21 +12,23 @@ Portability : POSIX
 -- Use only for dev/repl
 module Gargantext.API.Dev where
 
+import Control.Lens (view)
 import Control.Monad (fail)
-import Gargantext.API.Admin.EnvTypes
-import Gargantext.API.Admin.Settings
-import Gargantext.API.Errors.Types
-import Gargantext.API.Ngrams (saveNodeStoryImmediate)
-import Gargantext.API.Prelude
+import Data.Pool (withResource)
+import Database.PostgreSQL.Simple qualified as PGS
+import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
+import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool )
+import Gargantext.API.Errors.Types ( BackendInternalError )
+import Gargantext.API.Prelude ( GargM )
 import Gargantext.Core.NLP (nlpServerMap)
-import Gargantext.Core.NodeStory
-import Gargantext.Database.Prelude (Cmd', Cmd'', databaseParameters, runCmd)
+import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
+import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, databaseParameters, runCmd)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (readConfig)
 import Gargantext.Prelude.Mail qualified as Mail
 import Gargantext.Prelude.NLP qualified as NLP
-import Gargantext.System.Logging
-import Servant
+import Gargantext.System.Logging ( withLoggerHoisted )
+import Servant ( ServerError )
 
 type IniPath  = FilePath
 -------------------------------------------------------------------
@@ -68,13 +70,11 @@ runCmdReplServantErr = runCmdRepl
 -- using HasConnectionPool and HasRepoVar.
 runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
 runCmdDev env f =
-  (either (fail . show) pure =<< runCmd env f)
+  either (fail . show) pure =<< runCmd env f
 
 runCmdGargDev :: DevEnv -> GargM DevEnv BackendInternalError a -> IO a
 runCmdGargDev env cmd =
-  (either (fail . show) pure =<< runExceptT (runReaderT cmd env))
-    `finally`
-  runReaderT saveNodeStoryImmediate env
+  either (fail . show) pure =<< runExceptT (runReaderT cmd env)
 
 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
 runCmdDevNoErr = runCmdDev
@@ -84,3 +84,9 @@ runCmdDevServantErr = runCmdDev
 
 runCmdReplEasy :: Cmd'' DevEnv BackendInternalError a -> IO a
 runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
+
+-- | Execute a function that takes PSQL.Connection from the DB pool as
+--   first parameter.
+--   e.g.: runCmdReplEasyDB $ \c -> getNodeStory' c
+runCmdReplEasyDB :: (PGS.Connection -> IO a) -> IO a
+runCmdReplEasyDB f = runCmdReplEasy $ view connPool >>= (\p -> liftBase $ withResource p f)

src/Gargantext/API/Errors.hs

@@ -12,6 +12,7 @@ module Gargantext.API.Errors (
   -- * Conversion functions
   , backendErrorToFrontendError
   , frontendErrorToServerError
+  , frontendErrorToGQLServerError
 
   -- * Temporary shims
   , showAsServantJSONErr
@@ -20,6 +21,10 @@ module Gargantext.API.Errors (
 import Prelude
 
 import Control.Exception
+import Data.Aeson qualified as JSON
+import Data.Text qualified as T
+import Data.Text.Lazy qualified as TL
+import Data.Text.Lazy.Encoding qualified as TE
 import Data.Validity ( prettyValidation )
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Errors.Class as Class
@@ -28,20 +33,19 @@ import Gargantext.API.Errors.Types as Types
 import Gargantext.Database.Query.Table.Node.Error hiding (nodeError)
 import Gargantext.Database.Query.Tree hiding (treeError)
 import Gargantext.Utils.Jobs.Monad (JobError(..))
+import Network.HTTP.Types.Status qualified as HTTP
 import Servant.Server
-import qualified Data.Aeson as JSON
-import qualified Data.Text as T
-import qualified Network.HTTP.Types.Status as HTTP
-import qualified Data.Text.Lazy.Encoding as TE
-import qualified Data.Text.Lazy as TL
 
 $(deriveHttpStatusCode ''BackendErrorCode)
 
 data GargErrorScheme
   = -- | The old error scheme.
     GES_old
-    -- | The new error scheme, that returns a 'FrontendError'.
+  -- | The new error scheme, that returns a 'FrontendError'.
   | GES_new
+  -- | Error scheme for GraphQL, has to be slightly different
+  --   {errors: [{message, extensions: { ... }}]}
+  --   https://spec.graphql.org/June2018/#sec-Errors
     deriving (Show, Eq)
 
 -- | Transforms a backend internal error into something that the frontend
@@ -49,26 +53,56 @@ data GargErrorScheme
 -- as we later encode this into a 'ServerError' in the main server handler.
 backendErrorToFrontendError :: BackendInternalError -> FrontendError
 backendErrorToFrontendError = \case
-  InternalNodeError nodeError
-    -> nodeErrorToFrontendError nodeError
-  InternalTreeError treeError
-    -> treeErrorToFrontendError treeError
-  InternalValidationError validationError
-    -> mkFrontendErr' "A validation error occurred"
-         $ FE_validation_error $ case prettyValidation validationError of
-             Nothing -> "unknown_validation_error"
-             Just v  -> T.pack v
   InternalAuthenticationError authError
     -> authErrorToFrontendError authError
-  InternalServerError internalServerError
-    -> internalServerErrorToFrontendError internalServerError
+  InternalNodeError nodeError
+    -> nodeErrorToFrontendError nodeError
   InternalJobError jobError
     -> jobErrorToFrontendError jobError
+  InternalServerError internalServerError
+    -> internalServerErrorToFrontendError internalServerError
+  InternalTreeError treeError
+    -> treeErrorToFrontendError treeError
   -- As this carries a 'SomeException' which might exposes sensible
   -- information, we do not send to the frontend its content.
   InternalUnexpectedError _
     -> let msg = T.pack $ "An unexpected error occurred. Please check your server logs."
        in mkFrontendErr' msg $ FE_internal_server_error msg
+  InternalValidationError validationError
+    -> mkFrontendErr' "A validation error occurred"
+         $ FE_validation_error $ case prettyValidation validationError of
+             Nothing -> "unknown_validation_error"
+             Just v  -> T.pack v
+
+frontendErrorToGQLServerError :: FrontendError -> ServerError
+frontendErrorToGQLServerError fe@(FrontendError diag ty _) =
+  ServerError { errHTTPCode     = HTTP.statusCode $ backendErrorTypeToErrStatus ty
+              , errReasonPhrase = T.unpack diag
+              , errBody         = JSON.encode (GraphQLError fe)
+              , errHeaders      = [("Content-Type", "application/json")]
+              }
+
+authErrorToFrontendError :: AuthenticationError -> FrontendError
+authErrorToFrontendError = \case
+  -- For now, we ignore the Jose error, as they are too specific
+  -- (i.e. they should be logged internally to Sentry rather than shared
+  -- externally).
+  LoginFailed nid uid _
+    -> mkFrontendErr' "Invalid username/password, or invalid session token." $ FE_login_failed_error nid uid
+  InvalidUsernameOrPassword
+    -> mkFrontendErr' "Invalid username or password." $ FE_login_failed_invalid_username_or_password
+  UserNotAuthorized uId msg
+    -> mkFrontendErr' "User not authorized. " $ FE_user_not_authorized uId msg
+
+-- | Converts a 'FrontendError' into a 'ServerError' that the servant app can
+-- return to the frontend.
+frontendErrorToServerError :: FrontendError -> ServerError
+frontendErrorToServerError fe@(FrontendError diag ty _) =
+  ServerError { errHTTPCode     = HTTP.statusCode $ backendErrorTypeToErrStatus ty
+              , errReasonPhrase = T.unpack diag
+              , errBody         = JSON.encode fe
+              , errHeaders      = mempty
+              }
 
 internalServerErrorToFrontendError :: ServerError -> FrontendError
 internalServerErrorToFrontendError = \case
@@ -86,14 +120,6 @@ jobErrorToFrontendError = \case
   UnknownJob jobId   -> mkFrontendErrNoDiagnostic $ FE_job_unknown_job jobId
   JobException err   -> mkFrontendErrNoDiagnostic $ FE_job_generic_exception (T.pack $ displayException err)
 
-authErrorToFrontendError :: AuthenticationError -> FrontendError
-authErrorToFrontendError = \case
-  -- For now, we ignore the Jose error, as they are too specific
-  -- (i.e. they should be logged internally to Sentry rather than shared
-  -- externally).
-  LoginFailed nid uid _
-    -> mkFrontendErr' "Invalid username/password, or invalid session token." $ FE_login_failed_error nid uid
-
 nodeErrorToFrontendError :: NodeError -> FrontendError
 nodeErrorToFrontendError ne = case ne of
   NoListFound lid
@@ -145,16 +171,6 @@ treeErrorToFrontendError te = case te of
   EmptyRoot          -> mkFrontendErrShow FE_tree_empty_root
   TooManyRoots roots -> mkFrontendErrShow $ FE_tree_too_many_roots roots
 
--- | Converts a 'FrontendError' into a 'ServerError' that the servant app can
--- return to the frontend.
-frontendErrorToServerError :: FrontendError -> ServerError
-frontendErrorToServerError fe@(FrontendError diag ty _) =
-  ServerError { errHTTPCode     = HTTP.statusCode $ backendErrorTypeToErrStatus ty
-              , errReasonPhrase = T.unpack diag
-              , errBody         = JSON.encode fe
-              , errHeaders      = mempty
-              }
-
 showAsServantJSONErr :: BackendInternalError -> ServerError
 showAsServantJSONErr (InternalNodeError err@(NoListFound {}))  = err404 { errBody = JSON.encode err }
 showAsServantJSONErr (InternalNodeError err@NoRootFound{})     = err404 { errBody = JSON.encode err }

src/Gargantext/API/Errors/Types/Backend.hs

@@ -36,6 +36,8 @@ data BackendErrorCode
   | EC_400__validation_error
   -- authentication errors
   | EC_403__login_failed_error
+  | EC_403__login_failed_invalid_username_or_password
+  | EC_403__user_not_authorized
   -- tree errors
   | EC_404__tree_root_not_found
   | EC_404__tree_empty_root

src/Gargantext/API/GraphQL.hs

@@ -22,7 +22,7 @@ import Data.ByteString.Lazy.Char8 ( ByteString )
 import Data.Morpheus ( App, deriveApp )
 import Data.Morpheus.Server ( httpPlayground )
 import Data.Morpheus.Subscriptions ( Event (..), httpPubApp )
-import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..), Undefined(..) )
+import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..), Undefined, defaultRootResolver)
 import Data.Proxy
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
@@ -65,9 +65,9 @@ data Query m
     , context_ngrams      :: GQLCTX.ContextNgramsArgs -> m [Text]
     , contexts            :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
     , contexts_for_ngrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
-    , imt_schools         :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
+    , imt_schools         :: m [GQLIMT.School]
     , job_logs            :: GQLAT.JobLogArgs -> m (Map Int JobLog)
-    , languages           :: GQLNLP.LanguagesArgs -> m GQLNLP.LanguagesMap
+    , languages           :: m [GQLNLP.LanguageTuple]
     , nodes               :: GQLNode.NodeArgs -> m [GQLNode.Node]
     , nodes_corpus        :: GQLNode.CorpusArgs -> m [GQLNode.Corpus]
     , node_parent         :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
@@ -111,7 +111,7 @@ rootResolver
   -> AccessPolicyManager
   -> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined
 rootResolver authenticatedUser policyManager =
-  RootResolver
+  defaultRootResolver
     { queryResolver = Query { annuaire_contacts   = GQLA.resolveAnnuaireContacts
                             , context_ngrams      = GQLCTX.resolveContextNgrams
                             , contexts            = GQLCTX.resolveNodeContext
@@ -133,7 +133,7 @@ rootResolver authenticatedUser policyManager =
                                   , update_user_epo_api_token = GQLUser.updateUserEPOAPIToken
                                   , delete_team_membership = GQLTeam.deleteTeamMembership
                                   , update_node_context_category = GQLCTX.updateNodeContextCategory }
-    , subscriptionResolver = Undefined }
+    }
 
 -- | Main GraphQL "app".
 app

src/Gargantext/API/GraphQL/Context.hs

@@ -25,10 +25,10 @@ import Data.Morpheus.Types
 import Data.Text (pack)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Gargantext.API.Admin.Types (HasSettings)
-import Gargantext.API.Errors.Types
+import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument)
+import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument )
 import Gargantext.Database.Admin.Types.Node (ContextTitle, NodeId(..), NodeTypeId, UserId, unNodeId, ContextId (..))
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.NodeContext (getNodeContext, getContextsForNgramsTerms, ContextForNgramsTerms(..), {- getContextNgrams, -} getContextNgramsMatchingFTS)
@@ -71,8 +71,6 @@ data HyperdataRowDocumentGQL =
                           , hrd_source             :: Text
                           , hrd_title              :: Text
                           , hrd_url                :: Text
-                          , hrd_uniqId             :: Text
-                          , hrd_uniqIdBdd          :: Text
                           } deriving (Generic, GQLType, Show)
 
 data NodeContextGQL = NodeContextGQL
@@ -216,8 +214,6 @@ toHyperdataRowDocumentGQL hyperdata =
                                      , hrd_source             = _hr_source
                                      , hrd_title              = _hr_title
                                      , hrd_url                = _hr_url
-                                     , hrd_uniqId             = _hr_uniqId
-                                     , hrd_uniqIdBdd          = _hr_uniqIdBdd
                                      }
     HyperdataRowContact { } -> Nothing
 

src/Gargantext/API/GraphQL/IMT.hs

 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Gargantext.API.GraphQL.IMT
   ( School(..)
@@ -13,10 +13,11 @@ import Gargantext.API.GraphQL.Types
 import Gargantext.Core.Ext.IMT (School(..), schools)
 import Gargantext.Prelude
 
-data SchoolsArgs
-  = SchoolsArgs
-    { } deriving (Generic, GQLType)
+newtype SchoolsArgs
+  = SchoolsArgs ()
+    deriving stock (Generic)
+    deriving anyclass (GQLType)
 
 resolveSchools
-  :: SchoolsArgs -> GqlM e env [School]
-resolveSchools SchoolsArgs { } = pure $ schools
+  :: GqlM e env [School]
+resolveSchools = pure $ schools

src/Gargantext/API/GraphQL/NLP.hs

 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Gargantext.API.GraphQL.NLP
   ( Lang(..)
   , LanguagesArgs(..)
   , LanguagesMap
+  , LanguageTuple
   , resolveLanguages
   )
   where
@@ -18,11 +19,17 @@ import Gargantext.Prelude
 import Protolude
 import qualified Data.Map.Strict as Map
 
-data LanguagesArgs
-  = LanguagesArgs
-    { } deriving (Generic, GQLType)
+newtype LanguagesArgs
+  = LanguagesArgs ()
+    deriving stock (Generic)
+    deriving anyclass (GQLType)
 
 type LanguagesMap = Map.Map Lang NLPServer
+data LanguageTuple =
+  LanguageTuple { lt_lang   :: Lang
+                , lt_server :: NLPServer }
+    deriving stock (Generic)
+    deriving anyclass (GQLType)
 
 data NLPServer = NLPServer
   {
@@ -32,11 +39,11 @@ data NLPServer = NLPServer
   deriving (Show, Eq, Generic, GQLType)
 
 resolveLanguages
-  :: HasNLPServer env => LanguagesArgs -> GqlM e env LanguagesMap
-resolveLanguages LanguagesArgs { } = do
-  -- pure $ allLangs
+  :: HasNLPServer env => GqlM e env [LanguageTuple]
+resolveLanguages = do
   lift $ do
     ns <- view nlpServer
     printDebug "[resolveLanguages] nlpServer" ns
-    pure $ Map.map (\(NLPServerConfig { .. }) -> NLPServer { server
-                                                           , url = Protolude.show url }) ns
+    pure $ [LanguageTuple { lt_lang = lang
+                          , lt_server = NLPServer { server, url = Protolude.show url } }
+           | (lang, NLPServerConfig { .. }) <- Map.toList ns]

src/Gargantext/API/GraphQL/Node.hs

@@ -15,7 +15,7 @@ Portability : POSIX
 module Gargantext.API.GraphQL.Node where
 
 import Data.Aeson
-import Data.HashMap.Strict qualified as HashMap
+import Data.Aeson.KeyMap qualified as KM
 import Data.Morpheus.Types ( GQLType )
 import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types
@@ -126,7 +126,7 @@ toCorpus N.Node { .. } = Corpus { id = NN.unNodeId _node_id
 
 pubmedAPIKeyFromValue :: Value -> Maybe PUBMED.APIKey
 pubmedAPIKeyFromValue (Object kv) =
-  case HashMap.lookup "pubmed_api_key" kv of
+  case KM.lookup "pubmed_api_key" kv of
     Nothing -> Nothing
     Just v  -> case fromJSON v of
       Error _    -> Nothing

src/Gargantext/API/GraphQL/Team.hs

@@ -16,6 +16,7 @@ module Gargantext.API.GraphQL.Team where
 
 import Data.Morpheus.Types (GQLType, ResolverM)
 import Data.Text qualified as T
+import Gargantext.API.Admin.Auth.Types (AuthenticationError(..))
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types
 import Gargantext.API.GraphQL.Types (GqlM)
@@ -86,10 +87,12 @@ deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } =
     [] -> panicTrace $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
     (( _, node_u):_) -> do
       testAuthUser <- lift $ authUser (nId node_u) token
-      case testAuthUser of
-        Invalid -> panicTrace "[deleteTeamMembership] failed to validate user"
+      lift $ case testAuthUser of
+        -- Invalid -> panicTrace "[deleteTeamMembership] failed to validate user"
+        Invalid -> do
+          throwError $ InternalAuthenticationError $ UserNotAuthorized (uId node_u) "This user is not team owner"
         Valid -> do
-          lift $ deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)]
+          deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)]
   where
     uId Node { _node_user_id } = _node_user_id
     nId Node { _node_id } = _node_id

src/Gargantext/API/GraphQL/Utils.hs

@@ -8,8 +8,11 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+{-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME(adn) GraphQL will need updating.
+
 module Gargantext.API.GraphQL.Utils where
 
+import Control.Lens ((^.))
 import Control.Lens.Getter (view)
 import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
 import Data.Text qualified as T
@@ -20,7 +23,6 @@ import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude (Cmd')
 import Gargantext.Prelude
 import Servant.Auth.Server (verifyJWT, JWTSettings)
-import Control.Lens ((^.))
 
 unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
 unPrefix prefix options = options { fieldLabelModifier = nflm }

src/Gargantext/API/Middleware.hs

+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns      #-}
+
+{-| Edit 'sensitiveKeywords' to extend the list of redacted fields. -}
+module Gargantext.API.Middleware (
+  logStdoutDevSanitised
+  ) where
+
+import Control.Lens
+import Control.Monad.Logger
+import Data.Aeson qualified as A
+import Data.Aeson.Lens qualified as L
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Builder qualified as BS
+import Data.ByteString.Char8 qualified as C8
+import Data.ByteString.Lazy qualified as B
+import Data.CaseInsensitive qualified as CI
+import Data.List qualified as L
+import Data.String
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Network.HTTP.Types
+import Network.HTTP.Types.Header
+import Network.Wai
+import Network.Wai.Middleware.RequestLogger
+import Prelude
+import System.Console.ANSI
+
+-- | Like 'logStdoutDev' from \"wai-extra\", but redacts (or omits altogether) payloads which might have
+-- sensitive information
+logStdoutDevSanitised :: IO Middleware
+logStdoutDevSanitised = mkRequestLogger $ defaultRequestLoggerSettings { outputFormat = CustomOutputFormatWithDetailsAndHeaders customOutput }
+-- |
+-- Like 'key', but uses 'at' instead of 'ix'. This is handy when
+-- adding and removing object keys:
+--
+-- >>> "{\"a\": 100, \"b\": 200}" & atKey "a" .~ Nothing
+-- "{\"b\":200}"
+--
+-- >>> "{\"a\": 100, \"b\": 200}" & atKey "c" ?~ String "300"
+-- "{\"a\":100,\"b\":200,\"c\":\"300\"}"
+atKey :: L.AsValue t => T.Text -> Traversal' t (Maybe A.Value)
+atKey i = L._Object . at (fromString $ T.unpack i)
+{-# INLINE atKey #-}
+
+customOutput :: OutputFormatterWithDetailsAndHeaders
+customOutput _zonedDate rq status _mb_response_size request_dur (sanitiseBody . mconcat -> reqbody) raw_response (map sanitiseHeader -> headers) =
+  let params = map sanitiseQueryItem (queryString rq)
+  in mkRequestLog params reqbody <> mkResponseLog
+
+  where
+
+    mkRequestLog :: [QueryItem] -> ByteString -> LogStr
+    mkRequestLog params bdy =
+        foldMap toLogStr (ansiMethod' (requestMethod rq))
+            <> " "
+            <> toLogStr (rawPathInfo rq)
+            <> "\n"
+            <> foldMap (\(k, mb_v) -> toLogStr $ show (k, mb_v)) params
+            <> toLogStr bdy
+            <> "\n"
+            <> foldMap (\(k, v) -> toLogStr $ mconcat $ ansiColor' White $ "  " <> CI.original k <> ": " <> v <> "\n") headers
+            <> "\n"
+
+    mkResponseLog :: LogStr
+    mkResponseLog =
+      foldMap toLogStr (ansiColor' White "  Status: ")
+          <> foldMap toLogStr (ansiStatusCode' status (C8.pack (show $ statusCode status) <> " " <> statusMessage status))
+          <> " "
+          <> (toLogStr . B.toStrict $ (BS.toLazyByteString raw_response))
+          <> " "
+          <> "Served in " <> toLogStr (C8.pack $ show $ request_dur)
+          <> "\n"
+
+sanitiseBody :: ByteString -> ByteString
+sanitiseBody blob = L.foldr (\k acc -> over (atKey k) (updateField k) acc) blob sensitiveKeywords
+  where
+    updateField :: T.Text -> Maybe A.Value -> Maybe A.Value
+    updateField _ Nothing = Nothing
+    updateField k (Just x)
+      | A.String _v <- x
+      , k `elem` sensitiveKeywords
+      = Just $ A.String "*****"
+      | otherwise
+      = Just x
+
+sanitiseQueryItem :: QueryItem -> QueryItem
+sanitiseQueryItem (k, mb_v)
+  | TE.decodeUtf8 k `elem` sensitiveKeywords
+  = (k, (\v -> if C8.null v then mempty else "*****") <$> mb_v)
+  | otherwise
+  = (k, mb_v)
+
+-- /NOTE:/ Extend this list to filter for more sensitive keywords.
+sensitiveKeywords :: [T.Text]
+sensitiveKeywords = [
+    "password"
+  , "api_key"
+  , "apiKey"
+  , "pubmedAPIKey"
+  ]
+
+
+sanitiseHeader :: Header -> Header
+sanitiseHeader (hName, content)
+  | hName == hAuthorization = (hName, "*****")
+  | hName == hCookie        = (hName, "*****")
+  | hName == hSetCookie     = (hName, "*****")
+  | otherwise               = (hName, content)
+
+ansiColor' :: Color -> BS.ByteString -> [BS.ByteString]
+ansiColor' color bs =
+    [ C8.pack $ setSGRCode [SetColor Foreground Dull color]
+    , bs
+    , C8.pack $ setSGRCode [Reset]
+    ]
+
+-- | Tags http method with a unique color.
+ansiMethod' :: BS.ByteString -> [BS.ByteString]
+ansiMethod' m = case m of
+    "GET" -> ansiColor' Cyan m
+    "HEAD" -> ansiColor' Cyan m
+    "PUT" -> ansiColor' Green m
+    "POST" -> ansiColor' Yellow m
+    "DELETE" -> ansiColor' Red m
+    _ -> ansiColor' Magenta m
+
+ansiStatusCode' :: Status -> ByteString -> [BS.ByteString]
+ansiStatusCode' (Status c _) t = case C8.take 1 (C8.pack . show $ c) of
+    "2" -> ansiColor' Green t
+    "3" -> ansiColor' Yellow t
+    "4" -> ansiColor' Red t
+    "5" -> ansiColor' Magenta t
+    _ -> ansiColor' Blue t